340 lines
9.1 KiB
Plaintext
340 lines
9.1 KiB
Plaintext
unit fPatientFlagMulti;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, fAutoSz, ORCtrls, ExtCtrls, ComCtrls, rMisc, fBase508Form,
|
|
VA508AccessibilityManager;
|
|
|
|
type
|
|
{This object holds a List of Notes Linked to a PRF as Returned VIA the RPCBroker}
|
|
TPRFNotes = class(TObject)
|
|
private
|
|
FPRFNoteList : TStringList;
|
|
public
|
|
//procedure to show the Notes in a ListView, requires a listview parameter
|
|
procedure ShowActionsOnList(DisplayList : TCaptionListView);
|
|
//procedure to load the notes, this will call the RPC
|
|
procedure Load(TitleIEN : Int64; DFN : String);
|
|
function getNoteIEN(index: integer): String;
|
|
constructor create;
|
|
destructor Destroy(); override;
|
|
end;
|
|
|
|
TfrmFlags = class(TfrmBase508Form)
|
|
Panel1: TPanel;
|
|
Splitter3: TSplitter;
|
|
Splitter1: TSplitter;
|
|
lblFlags: TLabel;
|
|
lstFlagsCat2: TORListBox;
|
|
memFlags: TRichEdit;
|
|
pnlNotes: TPanel;
|
|
lvPRF: TCaptionListView;
|
|
lblNoteTitle: TLabel;
|
|
Splitter2: TSplitter;
|
|
pnlBottom: TORAutoPanel;
|
|
btnClose: TButton;
|
|
lstFlagsCat1: TORListBox;
|
|
lblCat1: TLabel;
|
|
TimerTextFlash: TTimer;
|
|
procedure lstFlagsCat1Click(Sender: TObject);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure lvPRFClick(Sender: TObject);
|
|
procedure lvPRFKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure TimerTextFlashTimer(Sender: TObject);
|
|
procedure lstFlagsCat2Click(Sender: TObject);
|
|
private
|
|
FFlagID: integer;
|
|
FPRFNotes : TPRFNotes;
|
|
FNoteTitle: String;
|
|
procedure GetNotes(SelectedList : TORListBox);
|
|
procedure MakeCat1FlagsStandOut;
|
|
procedure LoadSelectedFlagData(SelectedList : TORListBox);
|
|
procedure ActivateSpecificFlag;
|
|
procedure PutFlagsOnLists(flags, Cat1List, Cat2List: TStrings);
|
|
function GetListToActivate : TORListBox;
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
const
|
|
HIDDEN_COL = 'Press enter or space bar to view this note:';
|
|
//TIU GET LINKED PRF NOTES, return position constants
|
|
NOTE_IEN_POS = 1;
|
|
ACTION_POS = 2;
|
|
NOTE_DATE_POS = 3;
|
|
AUTHOR_POS = 4;
|
|
//TIU GET PRF TITLE, return position constants
|
|
NOTE_TITLE_IEN = 1;
|
|
NOTE_TITLE = 2;
|
|
|
|
|
|
procedure ShowFlags(FlagId: integer = 0);
|
|
|
|
implementation
|
|
|
|
uses uCore,uOrPtf,ORFn, ORNet, uConst, fRptBox, rCover;
|
|
{$R *.dfm}
|
|
|
|
procedure ShowFlags(FlagId: integer);
|
|
var
|
|
frmFlags: TfrmFlags;
|
|
begin
|
|
frmFlags := TFrmFlags.Create(Nil);
|
|
try
|
|
SetFormPosition(frmFlags);
|
|
if HasFlag then
|
|
begin
|
|
with frmFlags do begin
|
|
FFlagID := FlagId;
|
|
PutFlagsOnLists(FlagList, lstFlagsCat1.Items, lstFlagsCat2.Items);
|
|
end;
|
|
frmFlags.memFlags.SelStart := 0;
|
|
ResizeFormToFont(TForm(frmFlags));
|
|
frmFlags.ShowModal;
|
|
end
|
|
finally
|
|
frmFlags.Release;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmFlags.lstFlagsCat1Click(Sender: TObject);
|
|
begin
|
|
if lstFlagsCat1.ItemIndex >= 0 then
|
|
begin
|
|
with lstFlagsCat2 do
|
|
Selected[ItemIndex] := False;
|
|
LoadSelectedFlagData(lstFlagsCat1);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmFlags.FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if Key = VK_ESCAPE then
|
|
Close;
|
|
end;
|
|
|
|
|
|
procedure TfrmFlags.FormShow(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
SetFormPosition(Self);
|
|
if lstFlagsCat1.Count > 0 then
|
|
MakeCat1FlagsStandOut;
|
|
|
|
ActivateSpecificFlag;
|
|
end;
|
|
|
|
procedure TfrmFlags.FormCreate(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
FFlagID := 0;
|
|
end;
|
|
|
|
procedure TfrmFlags.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
inherited;
|
|
SaveUserBounds(Self);
|
|
end;
|
|
|
|
procedure TfrmFlags.GetNotes(SelectedList : TORListBox);
|
|
var
|
|
NoteTitleIEN, FlagID : Int64;
|
|
begin
|
|
if FPRFNotes = nil then
|
|
FPRFNotes := TPRFNotes.Create;
|
|
FlagID := SelectedList.ItemID;
|
|
CallV('TIU GET PRF TITLE', [Patient.DFN,FlagID]);
|
|
FNoteTitle := Piece(RPCBrokerV.Results[0],U,NOTE_TITLE);
|
|
lblNoteTitle.Caption := 'Signed, Linked Notes of Title: '+ FNoteTitle;
|
|
NoteTitleIEN := StrToInt(Piece(RPCBrokerV.Results[0],U,NOTE_TITLE_IEN));
|
|
FPRFNotes.Load(NoteTitleIEN,Patient.DFN);
|
|
FPRFNotes.ShowActionsOnList(lvPRF);
|
|
with lvPRF do begin
|
|
|
|
Columns.BeginUpdate;
|
|
Columns.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
{ TPRFNotes }
|
|
|
|
constructor TPRFNotes.create;
|
|
begin
|
|
inherited;
|
|
FPRFNoteList := TStringList.create;
|
|
end;
|
|
|
|
destructor TPRFNotes.Destroy;
|
|
begin
|
|
FPRFNoteList.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TPRFNotes.getNoteIEN(index: integer): String;
|
|
begin
|
|
Result := Piece(FPRFNoteList[index],U,NOTE_IEN_POS);
|
|
end;
|
|
|
|
procedure TPRFNotes.Load(TitleIEN: Int64; DFN: String);
|
|
const
|
|
REVERSE_CHRONO = 1;
|
|
begin
|
|
CallV('TIU GET LINKED PRF NOTES', [DFN,TitleIEN,REVERSE_CHRONO]);
|
|
FastAssign(RPCBrokerV.Results, FPRFNoteList);
|
|
end;
|
|
|
|
procedure TPRFNotes.ShowActionsOnList(DisplayList: TCaptionListView);
|
|
var
|
|
i : integer;
|
|
ListItem: TListItem;
|
|
begin
|
|
DisplayList.Clear;
|
|
for i := 0 to FPRFNoteList.Count-1 do
|
|
begin
|
|
//Caption="Text for Screen Reader" SubItem1=Flag SubItem2=Date SubItem3=Action SubItem4=Note
|
|
ListItem := DisplayList.Items.Add;
|
|
ListItem.Caption := HIDDEN_COL; //Screen readers don't read the first column title on a listview.
|
|
ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,NOTE_DATE_POS));
|
|
ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,ACTION_POS));
|
|
ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,AUTHOR_POS));
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmFlags.FormDestroy(Sender: TObject);
|
|
begin
|
|
FPRFNotes.Free;
|
|
end;
|
|
|
|
procedure TfrmFlags.lvPRFClick(Sender: TObject);
|
|
begin
|
|
if lvPRF.ItemIndex > -1 then
|
|
begin
|
|
NotifyOtherApps(NAE_REPORT, 'TIU^' + FPRFNotes.getNoteIEN(lvPRF.ItemIndex));
|
|
ReportBox(DetailPosting(FPRFNotes.getNoteIEN(lvPRF.ItemIndex)), FNoteTitle, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmFlags.lvPRFKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if (Key = VK_SPACE) or (Key = VK_RETURN) then
|
|
lvPRFClick(Sender);
|
|
end;
|
|
|
|
|
|
procedure TfrmFlags.MakeCat1FlagsStandOut;
|
|
Const
|
|
FONT_INC = 4;
|
|
clBrightOrange = TColor($3ABEF3); //Blue 58 Green 190 Red 243
|
|
begin
|
|
lblCat1.Font.Size := lblCat1.Font.Size + FONT_INC;
|
|
lstFlagsCat1.Font.Size := lstFlagsCat1.Font.Size + FONT_INC;
|
|
lblCat1.Color := Get508CompliantColor(clBrightOrange);
|
|
lstFlagsCat1.Color := Get508CompliantColor(clBrightOrange);
|
|
lblCat1.Font.Color := Get508CompliantColor(clWhite);
|
|
lstFlagsCat1.Font.Color := Get508CompliantColor(clWhite);
|
|
TimerTextFlash.Enabled := true;
|
|
end;
|
|
|
|
procedure TfrmFlags.TimerTextFlashTimer(Sender: TObject);
|
|
begin
|
|
if lblCat1.Font.Color = Get508CompliantColor(clWhite) then
|
|
lblCat1.Font.Color := Get508CompliantColor(clBlack)
|
|
else
|
|
lblCat1.Font.Color := Get508CompliantColor(clWhite);
|
|
end;
|
|
|
|
procedure TfrmFlags.LoadSelectedFlagData(SelectedList: TORListBox);
|
|
var
|
|
FlagArray: TStringList;
|
|
begin
|
|
FlagArray := TStringList.Create;
|
|
GetActiveFlg(FlagArray, Patient.DFN, SelectedList.ItemID);
|
|
if FlagArray.Count > 0 then
|
|
QuickCopy(FlagArray, memFlags);
|
|
memFlags.SelStart := 0;
|
|
GetNotes(SelectedList);
|
|
end;
|
|
|
|
procedure TfrmFlags.lstFlagsCat2Click(Sender: TObject);
|
|
begin
|
|
if lstFlagsCat2.ItemIndex >= 0 then
|
|
begin
|
|
with lstFlagsCat1 do
|
|
Selected[ItemIndex] := False;
|
|
LoadSelectedFlagData(lstFlagsCat2);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmFlags.ActivateSpecificFlag;
|
|
var
|
|
idx: integer;
|
|
SelectedList : TORListBox;
|
|
begin
|
|
idx := 0;
|
|
SelectedList := GetListToActivate;
|
|
if FFlagID > 0 then
|
|
idx := SelectedList.SelectByIEN(FFlagId);
|
|
SelectedList.ItemIndex := idx;
|
|
SelectedList.OnClick(Self);
|
|
ActiveControl := memFlags;
|
|
GetNotes(SelectedList);
|
|
end;
|
|
|
|
function TfrmFlags.GetListToActivate: TORListBox;
|
|
begin
|
|
Result := nil;
|
|
if FFlagID > 0 then begin
|
|
if lstFlagsCat1.SelectByIEN(FFlagId) > -1 then
|
|
Result := lstFlagsCat1
|
|
else if lstFlagsCat2.SelectByIEN(FFlagId) > -1 then
|
|
Result := lstFlagsCat2
|
|
end;
|
|
if Result = nil then
|
|
if lstFlagsCat1.Items.Count > 0 then
|
|
Result := lstFlagsCat1
|
|
else
|
|
Result := lstFlagsCat2;
|
|
|
|
end;
|
|
|
|
procedure TfrmFlags.PutFlagsOnLists(flags, Cat1List, Cat2List: TStrings);
|
|
Const
|
|
FLAG_TYPE_POS = 3;
|
|
TRUE_STRING = '1';
|
|
var
|
|
i, TypeOneCount, TypeTwoCount : integer;
|
|
begin
|
|
TypeOneCount := 0;
|
|
TypeTwoCount := 0;
|
|
for i := 0 to flags.Count-1 do begin
|
|
if Piece(flags[i],U,FLAG_TYPE_POS) = TRUE_STRING then begin
|
|
Cat1List.Add(flags[i]);
|
|
Inc(TypeOneCount);
|
|
end else begin
|
|
Cat2List.Add(flags[i]);
|
|
Inc(TypeTwoCount);
|
|
end;
|
|
end;
|
|
If TypeOneCount > 0 then
|
|
lblCat1.Caption := 'Category I Flags: ' + IntToStr(TypeOneCount) + ' Item(s)'
|
|
else
|
|
lblCat1.Caption := 'Category I Flags';
|
|
|
|
If TypeTwoCount > 0 then
|
|
lblFlags.Caption := 'Category II Flags: ' + IntToStr(TypeTwoCount) + ' Item(s)'
|
|
else
|
|
lblFlags.Caption := 'Category II Flags';
|
|
end;
|
|
|
|
|
|
end.
|