source: cprs/trunk/CPRS-Chart/fPatientFlagMulti.pas@ 1071

Last change on this file since 1071 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

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