1 | unit fPatientFlagMulti;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
---|
7 | Dialogs, StdCtrls, fAutoSz, ORCtrls, ExtCtrls, ComCtrls, rMisc, fBase508Form,
|
---|
8 | VA508AccessibilityManager;
|
---|
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 |
|
---|
25 | TfrmFlags = class(TfrmBase508Form)
|
---|
26 | Panel1: TPanel;
|
---|
27 | Splitter3: TSplitter;
|
---|
28 | Splitter1: TSplitter;
|
---|
29 | lblFlags: TLabel;
|
---|
30 | lstFlagsCat2: TORListBox;
|
---|
31 | memFlags: TRichEdit;
|
---|
32 | pnlNotes: TPanel;
|
---|
33 | lvPRF: TCaptionListView;
|
---|
34 | lblNoteTitle: TLabel;
|
---|
35 | Splitter2: TSplitter;
|
---|
36 | pnlBottom: TORAutoPanel;
|
---|
37 | btnClose: TButton;
|
---|
38 | lstFlagsCat1: TORListBox;
|
---|
39 | lblCat1: TLabel;
|
---|
40 | TimerTextFlash: TTimer;
|
---|
41 | procedure lstFlagsCat1Click(Sender: TObject);
|
---|
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);
|
---|
51 | procedure TimerTextFlashTimer(Sender: TObject);
|
---|
52 | procedure lstFlagsCat2Click(Sender: TObject);
|
---|
53 | private
|
---|
54 | FFlagID: integer;
|
---|
55 | FPRFNotes : TPRFNotes;
|
---|
56 | FNoteTitle: String;
|
---|
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;
|
---|
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
|
---|
94 | with frmFlags do begin
|
---|
95 | FFlagID := FlagId;
|
---|
96 | PutFlagsOnLists(FlagList, lstFlagsCat1.Items, lstFlagsCat2.Items);
|
---|
97 | end;
|
---|
98 | frmFlags.memFlags.SelStart := 0;
|
---|
99 | ResizeFormToFont(TForm(frmFlags));
|
---|
100 | frmFlags.ShowModal;
|
---|
101 | end
|
---|
102 | finally
|
---|
103 | frmFlags.Release;
|
---|
104 | end;
|
---|
105 | end;
|
---|
106 |
|
---|
107 | procedure TfrmFlags.lstFlagsCat1Click(Sender: TObject);
|
---|
108 | begin
|
---|
109 | if lstFlagsCat1.ItemIndex >= 0 then
|
---|
110 | begin
|
---|
111 | with lstFlagsCat2 do
|
---|
112 | Selected[ItemIndex] := False;
|
---|
113 | LoadSelectedFlagData(lstFlagsCat1);
|
---|
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);
|
---|
129 | if lstFlagsCat1.Count > 0 then
|
---|
130 | MakeCat1FlagsStandOut;
|
---|
131 |
|
---|
132 | ActivateSpecificFlag;
|
---|
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 |
|
---|
147 | procedure TfrmFlags.GetNotes(SelectedList : TORListBox);
|
---|
148 | var
|
---|
149 | NoteTitleIEN, FlagID : Int64;
|
---|
150 | begin
|
---|
151 | if FPRFNotes = nil then
|
---|
152 | FPRFNotes := TPRFNotes.Create;
|
---|
153 | FlagID := SelectedList.ItemID;
|
---|
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]);
|
---|
191 | FastAssign(RPCBrokerV.Results, FPRFNoteList);
|
---|
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 |
|
---|
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
|
---|
314 | i, TypeOneCount, TypeTwoCount : integer;
|
---|
315 | begin
|
---|
316 | TypeOneCount := 0;
|
---|
317 | TypeTwoCount := 0;
|
---|
318 | for i := 0 to flags.Count-1 do begin
|
---|
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
|
---|
323 | Cat2List.Add(flags[i]);
|
---|
324 | Inc(TypeTwoCount);
|
---|
325 | end;
|
---|
326 | end;
|
---|
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';
|
---|
336 | end;
|
---|
337 |
|
---|
338 |
|
---|
339 | end.
|
---|