source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fPatientFlagMulti.pas@ 1709

Last change on this file since 1709 was 1693, checked in by healthsevak, 10 years ago

Committing the files for first time to this new branch
File size: 9.1 KB
Line 
1unit fPatientFlagMulti;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, fAutoSz, ORCtrls, ExtCtrls, ComCtrls, rMisc, fBase508Form,
8 VA508AccessibilityManager;
9
10type
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;
66const
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
78procedure ShowFlags(FlagId: integer = 0);
79
80implementation
81
82uses uCore,uOrPtf,ORFn, ORNet, uConst, fRptBox, rCover;
83{$R *.dfm}
84
85procedure ShowFlags(FlagId: integer);
86var
87 frmFlags: TfrmFlags;
88begin
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;
105end;
106
107procedure TfrmFlags.lstFlagsCat1Click(Sender: TObject);
108begin
109 if lstFlagsCat1.ItemIndex >= 0 then
110 begin
111 with lstFlagsCat2 do
112 Selected[ItemIndex] := False;
113 LoadSelectedFlagData(lstFlagsCat1);
114 end;
115end;
116
117procedure TfrmFlags.FormKeyDown(Sender: TObject; var Key: Word;
118 Shift: TShiftState);
119begin
120 if Key = VK_ESCAPE then
121 Close;
122end;
123
124
125procedure TfrmFlags.FormShow(Sender: TObject);
126begin
127 inherited;
128 SetFormPosition(Self);
129 if lstFlagsCat1.Count > 0 then
130 MakeCat1FlagsStandOut;
131
132 ActivateSpecificFlag;
133end;
134
135procedure TfrmFlags.FormCreate(Sender: TObject);
136begin
137 inherited;
138 FFlagID := 0;
139end;
140
141procedure TfrmFlags.FormClose(Sender: TObject; var Action: TCloseAction);
142begin
143 inherited;
144 SaveUserBounds(Self);
145end;
146
147procedure TfrmFlags.GetNotes(SelectedList : TORListBox);
148var
149 NoteTitleIEN, FlagID : Int64;
150begin
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;
165end;
166
167{ TPRFNotes }
168
169constructor TPRFNotes.create;
170begin
171 inherited;
172 FPRFNoteList := TStringList.create;
173end;
174
175destructor TPRFNotes.Destroy;
176begin
177 FPRFNoteList.Free;
178 inherited;
179end;
180
181function TPRFNotes.getNoteIEN(index: integer): String;
182begin
183 Result := Piece(FPRFNoteList[index],U,NOTE_IEN_POS);
184end;
185
186procedure TPRFNotes.Load(TitleIEN: Int64; DFN: String);
187const
188 REVERSE_CHRONO = 1;
189begin
190 CallV('TIU GET LINKED PRF NOTES', [DFN,TitleIEN,REVERSE_CHRONO]);
191 FastAssign(RPCBrokerV.Results, FPRFNoteList);
192end;
193
194procedure TPRFNotes.ShowActionsOnList(DisplayList: TCaptionListView);
195var
196 i : integer;
197 ListItem: TListItem;
198begin
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;
209end;
210
211procedure TfrmFlags.FormDestroy(Sender: TObject);
212begin
213 FPRFNotes.Free;
214end;
215
216procedure TfrmFlags.lvPRFClick(Sender: TObject);
217begin
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;
223end;
224
225procedure TfrmFlags.lvPRFKeyDown(Sender: TObject; var Key: Word;
226 Shift: TShiftState);
227begin
228 if (Key = VK_SPACE) or (Key = VK_RETURN) then
229 lvPRFClick(Sender);
230end;
231
232
233procedure TfrmFlags.MakeCat1FlagsStandOut;
234Const
235 FONT_INC = 4;
236 clBrightOrange = TColor($3ABEF3); //Blue 58 Green 190 Red 243
237begin
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;
245end;
246
247procedure TfrmFlags.TimerTextFlashTimer(Sender: TObject);
248begin
249 if lblCat1.Font.Color = Get508CompliantColor(clWhite) then
250 lblCat1.Font.Color := Get508CompliantColor(clBlack)
251 else
252 lblCat1.Font.Color := Get508CompliantColor(clWhite);
253end;
254
255procedure TfrmFlags.LoadSelectedFlagData(SelectedList: TORListBox);
256var
257 FlagArray: TStringList;
258begin
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);
265end;
266
267procedure TfrmFlags.lstFlagsCat2Click(Sender: TObject);
268begin
269 if lstFlagsCat2.ItemIndex >= 0 then
270 begin
271 with lstFlagsCat1 do
272 Selected[ItemIndex] := False;
273 LoadSelectedFlagData(lstFlagsCat2);
274 end;
275end;
276
277procedure TfrmFlags.ActivateSpecificFlag;
278var
279 idx: integer;
280 SelectedList : TORListBox;
281begin
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);
290end;
291
292function TfrmFlags.GetListToActivate: TORListBox;
293begin
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
307end;
308
309procedure TfrmFlags.PutFlagsOnLists(flags, Cat1List, Cat2List: TStrings);
310Const
311 FLAG_TYPE_POS = 3;
312 TRUE_STRING = '1';
313var
314 i, TypeOneCount, TypeTwoCount : integer;
315begin
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';
336end;
337
338
339end.
Note: See TracBrowser for help on using the repository browser.