[456] | 1 | unit fPatientFlagMulti;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
---|
[830] | 7 | Dialogs, StdCtrls, fAutoSz, ORCtrls, ExtCtrls, ComCtrls, rMisc, fBase508Form,
|
---|
| 8 | VA508AccessibilityManager;
|
---|
[456] | 9 |
|
---|
| 10 | type
|
---|
| 11 | {This object holds a List of Notes Linked to a PRF as Returned VIA the RPCBroker}
|
---|
| 12 | TPRFNotes = class(TObject)
|
---|
| 13 | private
|
---|
| 14 | FPRFNoteList : TStringList;
|
---|
| 15 | public
|
---|
| 16 | //procedure to show the Notes in a ListView, requires a listview parameter
|
---|
| 17 | procedure ShowActionsOnList(DisplayList : TCaptionListView);
|
---|
| 18 | //procedure to load the notes, this will call the RPC
|
---|
| 19 | procedure Load(TitleIEN : Int64; DFN : String);
|
---|
| 20 | function getNoteIEN(index: integer): String;
|
---|
| 21 | constructor create;
|
---|
| 22 | destructor Destroy(); override;
|
---|
| 23 | end;
|
---|
| 24 |
|
---|
[830] | 25 | TfrmFlags = class(TfrmBase508Form)
|
---|
[1679] | 26 | Panel1: TPanel;
|
---|
| 27 | Splitter3: TSplitter;
|
---|
[456] | 28 | Splitter1: TSplitter;
|
---|
| 29 | lblFlags: TLabel;
|
---|
[830] | 30 | lstFlagsCat2: TORListBox;
|
---|
[456] | 31 | memFlags: TRichEdit;
|
---|
| 32 | pnlNotes: TPanel;
|
---|
| 33 | lvPRF: TCaptionListView;
|
---|
| 34 | lblNoteTitle: TLabel;
|
---|
| 35 | Splitter2: TSplitter;
|
---|
| 36 | pnlBottom: TORAutoPanel;
|
---|
| 37 | btnClose: TButton;
|
---|
[830] | 38 | lstFlagsCat1: TORListBox;
|
---|
| 39 | lblCat1: TLabel;
|
---|
| 40 | TimerTextFlash: TTimer;
|
---|
| 41 | procedure lstFlagsCat1Click(Sender: TObject);
|
---|
[456] | 42 | procedure FormKeyDown(Sender: TObject; var Key: Word;
|
---|
| 43 | Shift: TShiftState);
|
---|
| 44 | procedure FormShow(Sender: TObject);
|
---|
| 45 | procedure FormCreate(Sender: TObject);
|
---|
| 46 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
| 47 | procedure FormDestroy(Sender: TObject);
|
---|
| 48 | procedure lvPRFClick(Sender: TObject);
|
---|
| 49 | procedure lvPRFKeyDown(Sender: TObject; var Key: Word;
|
---|
| 50 | Shift: TShiftState);
|
---|
[830] | 51 | procedure TimerTextFlashTimer(Sender: TObject);
|
---|
| 52 | procedure lstFlagsCat2Click(Sender: TObject);
|
---|
[456] | 53 | private
|
---|
| 54 | FFlagID: integer;
|
---|
| 55 | FPRFNotes : TPRFNotes;
|
---|
| 56 | FNoteTitle: String;
|
---|
[830] | 57 | procedure GetNotes(SelectedList : TORListBox);
|
---|
| 58 | procedure MakeCat1FlagsStandOut;
|
---|
| 59 | procedure LoadSelectedFlagData(SelectedList : TORListBox);
|
---|
| 60 | procedure ActivateSpecificFlag;
|
---|
| 61 | procedure PutFlagsOnLists(flags, Cat1List, Cat2List: TStrings);
|
---|
| 62 | function GetListToActivate : TORListBox;
|
---|
[456] | 63 | public
|
---|
| 64 | { Public declarations }
|
---|
| 65 | end;
|
---|
| 66 | const
|
---|
| 67 | HIDDEN_COL = 'Press enter or space bar to view this note:';
|
---|
| 68 | //TIU GET LINKED PRF NOTES, return position constants
|
---|
| 69 | NOTE_IEN_POS = 1;
|
---|
| 70 | ACTION_POS = 2;
|
---|
| 71 | NOTE_DATE_POS = 3;
|
---|
| 72 | AUTHOR_POS = 4;
|
---|
| 73 | //TIU GET PRF TITLE, return position constants
|
---|
| 74 | NOTE_TITLE_IEN = 1;
|
---|
| 75 | NOTE_TITLE = 2;
|
---|
| 76 |
|
---|
| 77 |
|
---|
| 78 | procedure ShowFlags(FlagId: integer = 0);
|
---|
| 79 |
|
---|
| 80 | implementation
|
---|
| 81 |
|
---|
| 82 | uses uCore,uOrPtf,ORFn, ORNet, uConst, fRptBox, rCover;
|
---|
| 83 | {$R *.dfm}
|
---|
| 84 |
|
---|
| 85 | procedure ShowFlags(FlagId: integer);
|
---|
| 86 | var
|
---|
| 87 | frmFlags: TfrmFlags;
|
---|
| 88 | begin
|
---|
| 89 | frmFlags := TFrmFlags.Create(Nil);
|
---|
| 90 | try
|
---|
| 91 | SetFormPosition(frmFlags);
|
---|
| 92 | if HasFlag then
|
---|
| 93 | begin
|
---|
[830] | 94 | with frmFlags do begin
|
---|
| 95 | FFlagID := FlagId;
|
---|
| 96 | PutFlagsOnLists(FlagList, lstFlagsCat1.Items, lstFlagsCat2.Items);
|
---|
| 97 | end;
|
---|
[456] | 98 | frmFlags.memFlags.SelStart := 0;
|
---|
| 99 | ResizeFormToFont(TForm(frmFlags));
|
---|
| 100 | frmFlags.ShowModal;
|
---|
| 101 | end
|
---|
| 102 | finally
|
---|
| 103 | frmFlags.Release;
|
---|
| 104 | end;
|
---|
| 105 | end;
|
---|
| 106 |
|
---|
[830] | 107 | procedure TfrmFlags.lstFlagsCat1Click(Sender: TObject);
|
---|
[456] | 108 | begin
|
---|
[830] | 109 | if lstFlagsCat1.ItemIndex >= 0 then
|
---|
[456] | 110 | begin
|
---|
[830] | 111 | with lstFlagsCat2 do
|
---|
| 112 | Selected[ItemIndex] := False;
|
---|
| 113 | LoadSelectedFlagData(lstFlagsCat1);
|
---|
[456] | 114 | end;
|
---|
| 115 | end;
|
---|
| 116 |
|
---|
| 117 | procedure TfrmFlags.FormKeyDown(Sender: TObject; var Key: Word;
|
---|
| 118 | Shift: TShiftState);
|
---|
| 119 | begin
|
---|
| 120 | if Key = VK_ESCAPE then
|
---|
| 121 | Close;
|
---|
| 122 | end;
|
---|
| 123 |
|
---|
| 124 |
|
---|
| 125 | procedure TfrmFlags.FormShow(Sender: TObject);
|
---|
| 126 | begin
|
---|
| 127 | inherited;
|
---|
| 128 | SetFormPosition(Self);
|
---|
[830] | 129 | if lstFlagsCat1.Count > 0 then
|
---|
| 130 | MakeCat1FlagsStandOut;
|
---|
| 131 |
|
---|
| 132 | ActivateSpecificFlag;
|
---|
[456] | 133 | end;
|
---|
| 134 |
|
---|
| 135 | procedure TfrmFlags.FormCreate(Sender: TObject);
|
---|
| 136 | begin
|
---|
| 137 | inherited;
|
---|
| 138 | FFlagID := 0;
|
---|
| 139 | end;
|
---|
| 140 |
|
---|
| 141 | procedure TfrmFlags.FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
| 142 | begin
|
---|
| 143 | inherited;
|
---|
| 144 | SaveUserBounds(Self);
|
---|
| 145 | end;
|
---|
| 146 |
|
---|
[830] | 147 | procedure TfrmFlags.GetNotes(SelectedList : TORListBox);
|
---|
[456] | 148 | var
|
---|
| 149 | NoteTitleIEN, FlagID : Int64;
|
---|
| 150 | begin
|
---|
| 151 | if FPRFNotes = nil then
|
---|
| 152 | FPRFNotes := TPRFNotes.Create;
|
---|
[830] | 153 | FlagID := SelectedList.ItemID;
|
---|
[456] | 154 | CallV('TIU GET PRF TITLE', [Patient.DFN,FlagID]);
|
---|
| 155 | FNoteTitle := Piece(RPCBrokerV.Results[0],U,NOTE_TITLE);
|
---|
| 156 | lblNoteTitle.Caption := 'Signed, Linked Notes of Title: '+ FNoteTitle;
|
---|
| 157 | NoteTitleIEN := StrToInt(Piece(RPCBrokerV.Results[0],U,NOTE_TITLE_IEN));
|
---|
| 158 | FPRFNotes.Load(NoteTitleIEN,Patient.DFN);
|
---|
| 159 | FPRFNotes.ShowActionsOnList(lvPRF);
|
---|
| 160 | with lvPRF do begin
|
---|
| 161 |
|
---|
| 162 | Columns.BeginUpdate;
|
---|
| 163 | Columns.EndUpdate;
|
---|
| 164 | end;
|
---|
| 165 | end;
|
---|
| 166 |
|
---|
| 167 | { TPRFNotes }
|
---|
| 168 |
|
---|
| 169 | constructor TPRFNotes.create;
|
---|
| 170 | begin
|
---|
| 171 | inherited;
|
---|
| 172 | FPRFNoteList := TStringList.create;
|
---|
| 173 | end;
|
---|
| 174 |
|
---|
| 175 | destructor TPRFNotes.Destroy;
|
---|
| 176 | begin
|
---|
| 177 | FPRFNoteList.Free;
|
---|
| 178 | inherited;
|
---|
| 179 | end;
|
---|
| 180 |
|
---|
| 181 | function TPRFNotes.getNoteIEN(index: integer): String;
|
---|
| 182 | begin
|
---|
| 183 | Result := Piece(FPRFNoteList[index],U,NOTE_IEN_POS);
|
---|
| 184 | end;
|
---|
| 185 |
|
---|
| 186 | procedure TPRFNotes.Load(TitleIEN: Int64; DFN: String);
|
---|
| 187 | const
|
---|
| 188 | REVERSE_CHRONO = 1;
|
---|
| 189 | begin
|
---|
| 190 | CallV('TIU GET LINKED PRF NOTES', [DFN,TitleIEN,REVERSE_CHRONO]);
|
---|
[830] | 191 | FastAssign(RPCBrokerV.Results, FPRFNoteList);
|
---|
[456] | 192 | end;
|
---|
| 193 |
|
---|
| 194 | procedure TPRFNotes.ShowActionsOnList(DisplayList: TCaptionListView);
|
---|
| 195 | var
|
---|
| 196 | i : integer;
|
---|
| 197 | ListItem: TListItem;
|
---|
| 198 | begin
|
---|
| 199 | DisplayList.Clear;
|
---|
| 200 | for i := 0 to FPRFNoteList.Count-1 do
|
---|
| 201 | begin
|
---|
| 202 | //Caption="Text for Screen Reader" SubItem1=Flag SubItem2=Date SubItem3=Action SubItem4=Note
|
---|
| 203 | ListItem := DisplayList.Items.Add;
|
---|
| 204 | ListItem.Caption := HIDDEN_COL; //Screen readers don't read the first column title on a listview.
|
---|
| 205 | ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,NOTE_DATE_POS));
|
---|
| 206 | ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,ACTION_POS));
|
---|
| 207 | ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,AUTHOR_POS));
|
---|
| 208 | end;
|
---|
| 209 | end;
|
---|
| 210 |
|
---|
| 211 | procedure TfrmFlags.FormDestroy(Sender: TObject);
|
---|
| 212 | begin
|
---|
| 213 | FPRFNotes.Free;
|
---|
| 214 | end;
|
---|
| 215 |
|
---|
| 216 | procedure TfrmFlags.lvPRFClick(Sender: TObject);
|
---|
| 217 | begin
|
---|
| 218 | if lvPRF.ItemIndex > -1 then
|
---|
| 219 | begin
|
---|
| 220 | NotifyOtherApps(NAE_REPORT, 'TIU^' + FPRFNotes.getNoteIEN(lvPRF.ItemIndex));
|
---|
| 221 | ReportBox(DetailPosting(FPRFNotes.getNoteIEN(lvPRF.ItemIndex)), FNoteTitle, True);
|
---|
| 222 | end;
|
---|
| 223 | end;
|
---|
| 224 |
|
---|
| 225 | procedure TfrmFlags.lvPRFKeyDown(Sender: TObject; var Key: Word;
|
---|
| 226 | Shift: TShiftState);
|
---|
| 227 | begin
|
---|
| 228 | if (Key = VK_SPACE) or (Key = VK_RETURN) then
|
---|
| 229 | lvPRFClick(Sender);
|
---|
| 230 | end;
|
---|
| 231 |
|
---|
[830] | 232 |
|
---|
| 233 | procedure TfrmFlags.MakeCat1FlagsStandOut;
|
---|
| 234 | Const
|
---|
| 235 | FONT_INC = 4;
|
---|
| 236 | clBrightOrange = TColor($3ABEF3); //Blue 58 Green 190 Red 243
|
---|
| 237 | begin
|
---|
| 238 | lblCat1.Font.Size := lblCat1.Font.Size + FONT_INC;
|
---|
| 239 | lstFlagsCat1.Font.Size := lstFlagsCat1.Font.Size + FONT_INC;
|
---|
| 240 | lblCat1.Color := Get508CompliantColor(clBrightOrange);
|
---|
| 241 | lstFlagsCat1.Color := Get508CompliantColor(clBrightOrange);
|
---|
| 242 | lblCat1.Font.Color := Get508CompliantColor(clWhite);
|
---|
| 243 | lstFlagsCat1.Font.Color := Get508CompliantColor(clWhite);
|
---|
| 244 | TimerTextFlash.Enabled := true;
|
---|
| 245 | end;
|
---|
| 246 |
|
---|
| 247 | procedure TfrmFlags.TimerTextFlashTimer(Sender: TObject);
|
---|
| 248 | begin
|
---|
| 249 | if lblCat1.Font.Color = Get508CompliantColor(clWhite) then
|
---|
| 250 | lblCat1.Font.Color := Get508CompliantColor(clBlack)
|
---|
| 251 | else
|
---|
| 252 | lblCat1.Font.Color := Get508CompliantColor(clWhite);
|
---|
| 253 | end;
|
---|
| 254 |
|
---|
| 255 | procedure TfrmFlags.LoadSelectedFlagData(SelectedList: TORListBox);
|
---|
| 256 | var
|
---|
| 257 | FlagArray: TStringList;
|
---|
| 258 | begin
|
---|
| 259 | FlagArray := TStringList.Create;
|
---|
| 260 | GetActiveFlg(FlagArray, Patient.DFN, SelectedList.ItemID);
|
---|
| 261 | if FlagArray.Count > 0 then
|
---|
| 262 | QuickCopy(FlagArray, memFlags);
|
---|
| 263 | memFlags.SelStart := 0;
|
---|
| 264 | GetNotes(SelectedList);
|
---|
| 265 | end;
|
---|
| 266 |
|
---|
| 267 | procedure TfrmFlags.lstFlagsCat2Click(Sender: TObject);
|
---|
| 268 | begin
|
---|
| 269 | if lstFlagsCat2.ItemIndex >= 0 then
|
---|
| 270 | begin
|
---|
| 271 | with lstFlagsCat1 do
|
---|
| 272 | Selected[ItemIndex] := False;
|
---|
| 273 | LoadSelectedFlagData(lstFlagsCat2);
|
---|
| 274 | end;
|
---|
| 275 | end;
|
---|
| 276 |
|
---|
| 277 | procedure TfrmFlags.ActivateSpecificFlag;
|
---|
| 278 | var
|
---|
| 279 | idx: integer;
|
---|
| 280 | SelectedList : TORListBox;
|
---|
| 281 | begin
|
---|
| 282 | idx := 0;
|
---|
| 283 | SelectedList := GetListToActivate;
|
---|
| 284 | if FFlagID > 0 then
|
---|
| 285 | idx := SelectedList.SelectByIEN(FFlagId);
|
---|
| 286 | SelectedList.ItemIndex := idx;
|
---|
| 287 | SelectedList.OnClick(Self);
|
---|
| 288 | ActiveControl := memFlags;
|
---|
| 289 | GetNotes(SelectedList);
|
---|
| 290 | end;
|
---|
| 291 |
|
---|
| 292 | function TfrmFlags.GetListToActivate: TORListBox;
|
---|
| 293 | begin
|
---|
| 294 | Result := nil;
|
---|
| 295 | if FFlagID > 0 then begin
|
---|
| 296 | if lstFlagsCat1.SelectByIEN(FFlagId) > -1 then
|
---|
| 297 | Result := lstFlagsCat1
|
---|
| 298 | else if lstFlagsCat2.SelectByIEN(FFlagId) > -1 then
|
---|
| 299 | Result := lstFlagsCat2
|
---|
| 300 | end;
|
---|
| 301 | if Result = nil then
|
---|
| 302 | if lstFlagsCat1.Items.Count > 0 then
|
---|
| 303 | Result := lstFlagsCat1
|
---|
| 304 | else
|
---|
| 305 | Result := lstFlagsCat2;
|
---|
| 306 |
|
---|
| 307 | end;
|
---|
| 308 |
|
---|
| 309 | procedure TfrmFlags.PutFlagsOnLists(flags, Cat1List, Cat2List: TStrings);
|
---|
| 310 | Const
|
---|
| 311 | FLAG_TYPE_POS = 3;
|
---|
| 312 | TRUE_STRING = '1';
|
---|
| 313 | var
|
---|
[1679] | 314 | i, TypeOneCount, TypeTwoCount : integer;
|
---|
[830] | 315 | begin
|
---|
[1679] | 316 | TypeOneCount := 0;
|
---|
| 317 | TypeTwoCount := 0;
|
---|
[830] | 318 | for i := 0 to flags.Count-1 do begin
|
---|
[1679] | 319 | if Piece(flags[i],U,FLAG_TYPE_POS) = TRUE_STRING then begin
|
---|
| 320 | Cat1List.Add(flags[i]);
|
---|
| 321 | Inc(TypeOneCount);
|
---|
| 322 | end else begin
|
---|
[830] | 323 | Cat2List.Add(flags[i]);
|
---|
[1679] | 324 | Inc(TypeTwoCount);
|
---|
| 325 | end;
|
---|
[830] | 326 | end;
|
---|
[1679] | 327 | If TypeOneCount > 0 then
|
---|
| 328 | lblCat1.Caption := 'Category I Flags: ' + IntToStr(TypeOneCount) + ' Item(s)'
|
---|
| 329 | else
|
---|
| 330 | lblCat1.Caption := 'Category I Flags';
|
---|
| 331 |
|
---|
| 332 | If TypeTwoCount > 0 then
|
---|
| 333 | lblFlags.Caption := 'Category II Flags: ' + IntToStr(TypeTwoCount) + ' Item(s)'
|
---|
| 334 | else
|
---|
| 335 | lblFlags.Caption := 'Category II Flags';
|
---|
[830] | 336 | end;
|
---|
| 337 |
|
---|
[1679] | 338 |
|
---|
[456] | 339 | end.
|
---|