source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptionsLists.pas@ 1096

Last change on this file since 1096 was 453, checked in by Kevin Toppenberg, 17 years ago

Initial upload of TMG-CPRS 1.0.26.69
File size: 18.9 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOptionsLists;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 StdCtrls, ExtCtrls, ORCtrls, OrFn, Menus, DKLang;
9
10type
11 TfrmOptionsLists = class(TForm)
12 pnlBottom: TPanel;
13 btnOK: TButton;
14 btnCancel: TButton;
15 lblAddby: TLabel;
16 lblPatientsAdd: TLabel;
17 lblPersonalPatientList: TLabel;
18 lblPersonalLists: TLabel;
19 lstAddBy: TORComboBox;
20 btnPersonalPatientRA: TButton;
21 btnPersonalPatientR: TButton;
22 lstListPats: TORListBox;
23 lstPersonalPatients: TORListBox;
24 btnListAddAll: TButton;
25 btnNewList: TButton;
26 btnDeleteList: TButton;
27 lstPersonalLists: TORListBox;
28 radAddByType: TRadioGroup;
29 btnListSaveChanges: TButton;
30 btnListAdd: TButton;
31 lblInfo: TMemo;
32 bvlBottom: TBevel;
33 mnuPopPatient: TPopupMenu;
34 mnuPatientID: TMenuItem;
35 DKLanguageController1: TDKLanguageController;
36 procedure FormCreate(Sender: TObject);
37 procedure btnNewListClick(Sender: TObject);
38 procedure radAddByTypeClick(Sender: TObject);
39 procedure lstPersonalListsChange(Sender: TObject);
40 procedure lstAddByClick(Sender: TObject);
41 procedure btnDeleteListClick(Sender: TObject);
42 procedure btnListSaveChangesClick(Sender: TObject);
43 procedure btnPersonalPatientRAClick(Sender: TObject);
44 procedure btnListAddAllClick(Sender: TObject);
45 procedure btnPersonalPatientRClick(Sender: TObject);
46 procedure lstPersonalPatientsChange(Sender: TObject);
47 procedure btnListAddClick(Sender: TObject);
48 procedure lstListPatsChange(Sender: TObject);
49 procedure FormShow(Sender: TObject);
50 procedure lstAddByNeedData(Sender: TObject; const StartFrom: String;
51 Direction, InsertAt: Integer);
52 procedure btnOKClick(Sender: TObject);
53 procedure mnuPatientIDClick(Sender: TObject);
54 procedure lstListPatsMouseDown(Sender: TObject; Button: TMouseButton;
55 Shift: TShiftState; X, Y: Integer);
56 procedure lstPersonalPatientsMouseDown(Sender: TObject;
57 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
58 procedure lstAddByKeyPress(Sender: TObject; var Key: Char);
59 private
60 { Private declarations }
61 FLastList: integer;
62 procedure AddIfUnique(entry: string; aList: TORListBox);
63 public
64 { Public declarations }
65 end;
66
67var
68 frmOptionsLists: TfrmOptionsLists;
69
70procedure DialogOptionsLists(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
71
72implementation
73
74uses fOptionsNewList, rOptions, uOptions, rCore, fPtSelOptns;
75
76{$R *.DFM}
77
78const
79 LIST_ADD = 1;
80 LIST_PERSONAL = 2;
81
82procedure DialogOptionsLists(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
83// create the form and make it modal, return an action
84var
85 frmOptionsLists: TfrmOptionsLists;
86begin
87 frmOptionsLists := TfrmOptionsLists.Create(Application);
88 actiontype := 0;
89 try
90 with frmOptionsLists do
91 begin
92 if (topvalue < 0) or (leftvalue < 0) then
93 Position := poScreenCenter
94 else
95 begin
96 Position := poDesigned;
97 Top := topvalue;
98 Left := leftvalue;
99 end;
100 ResizeAnchoredFormToFont(frmOptionsLists);
101 ShowModal;
102 actiontype := btnOK.Tag;
103 end;
104 finally
105 frmOptionsLists.Release;
106 end;
107end;
108
109procedure TfrmOptionsLists.FormCreate(Sender: TObject);
110begin
111 rpcGetPersonalLists(lstPersonalLists.Items);
112 radAddByType.ItemIndex := 0;
113 radAddByTypeClick(self);
114 FLastList := 0;
115end;
116
117procedure TfrmOptionsLists.btnNewListClick(Sender: TObject);
118var
119 newlist: string;
120 newlistnum: integer;
121begin
122 newlist := '';
123 DialogOptionsNewList(Font.Size, newlist);
124 newlistnum := strtointdef(Piece(newlist, '^', 1), 0);
125 if newlistnum > 0 then
126 begin
127 with lstPersonalLists do
128 begin
129 Items.Add(newlist);
130 SelectByIEN(newlistnum);
131 end;
132 lstPersonalListsChange(self);
133 lstPersonalPatients.Items.Clear;
134 lstPersonalPatientsChange(self);
135 end;
136end;
137
138procedure TfrmOptionsLists.radAddByTypeClick(Sender: TObject);
139begin
140 with lstAddBy do
141 begin
142 case radAddByType.ItemIndex of
143 0: begin
144 ListItemsOnly := true;
145 LongList := true;
146 InitLongList('');
147// lblAddby.Caption := 'Patient:'; <-- original line. //kt 8/8/2007
148 lblAddby.Caption := DKLangConstW('fOptionsLists_Patientx'); //kt added 8/8/2007
149 end;
150 1: begin
151 ListItemsOnly := false;
152 LongList := false;
153 ListWardAll(lstAddBy.Items);
154// lblAddby.Caption := 'Ward:'; <-- original line. //kt 8/8/2007
155 lblAddby.Caption := DKLangConstW('fOptionsLists_Wardx'); //kt added 8/8/2007
156 end;
157 2: begin
158 ListItemsOnly := true;
159 LongList := true;
160 InitLongList('');
161// lblAddby.Caption := 'Clinic:'; <-- original line. //kt 8/8/2007
162 lblAddby.Caption := DKLangConstW('fOptionsLists_Clinicx'); //kt added 8/8/2007
163 end;
164 3: begin
165 ListItemsOnly := true;
166 LongList := true;
167 InitLongList('');
168// lblAddby.Caption := 'Provider:'; <-- original line. //kt 8/8/2007
169 lblAddby.Caption := DKLangConstW('fOptionsLists_Providerx'); //kt added 8/8/2007
170 end;
171 4: begin
172 ListItemsOnly := false;
173 LongList := false;
174 ListSpecialtyAll(lstAddBy.Items);
175// lblAddby.Caption := 'Specialty:'; <-- original line. //kt 8/8/2007
176 lblAddby.Caption := DKLangConstW('fOptionsLists_Specialtyx'); //kt added 8/8/2007
177 end;
178 5: begin
179 ListItemsOnly := false;
180 LongList := false;
181 ListTeamAll(lstAddBy.Items);
182// lblAddby.Caption := 'List:'; <-- original line. //kt 8/8/2007
183 lblAddby.Caption := DKLangConstW('fOptionsLists_Listx'); //kt added 8/8/2007
184 end;
185 end;
186 lstAddby.Caption := lblAddby.Caption;
187 ItemIndex := -1;
188 Text := '';
189 end;
190 lstListPats.Items.Clear;
191 lstListPatsChange(self);
192end;
193
194procedure TfrmOptionsLists.AddIfUnique(entry: string; aList: TORListBox);
195var
196 i: integer;
197 ien: string;
198 inlist: boolean;
199begin
200 ien := Piece(entry, '^', 1);
201 inlist := false;
202 with aList do
203 for i := 0 to Items.Count - 1 do
204 if ien = Piece(Items[i], '^', 1) then
205 begin
206 inlist := true;
207 break;
208 end;
209 if not inlist then
210 aList.Items.Add(entry);
211end;
212
213procedure TfrmOptionsLists.lstPersonalListsChange(Sender: TObject);
214begin
215 if btnListSaveChanges.Enabled then
216 begin
217// if InfoBox('Do you want to save changes to ' <-- original line. //kt 8/8/2007
218 if InfoBox(DKLangConstW('fOptionsLists_Do_you_want_to_save_changes_to') //kt added 8/8/2007
219 + Piece(lstPersonalLists.Items[FLastList], '^', 2) + '?',
220// 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then <-- original line. //kt 8/8/2007
221 DKLangConstW('fOptionsLists_Confirmation'), MB_YESNO or MB_ICONQUESTION) = IDYES then //kt added 8/8/2007
222 btnListSaveChangesClick(self);
223 end;
224 if lstPersonalLists.ItemIndex > -1 then FLastList := lstPersonalLists.ItemIndex;
225 lstPersonalPatients.Items.Clear;
226 btnDeleteList.Enabled := lstPersonalLists.ItemIndex > -1;
227 with lstPersonalLists do
228 begin
229 if (ItemIndex < 0) or (Items.Count <1) then
230 begin
231 btnListAdd.Enabled := false;
232 btnListAddAll.Enabled := false;
233 btnPersonalPatientR.Enabled := false;
234 btnPersonalPatientRA.Enabled := false;
235 btnListSaveChanges.Enabled := false;
236 exit;
237 end;
238 ListPtByTeam(lstPersonalPatients.Items, strtointdef(Piece(Items[ItemIndex], '^', 1), 0));
239 btnDeleteList.Enabled := true;
240 end;
241 if lstPersonalPatients.Items.Count = 1 then // avoid selecting '^No patients found.' msg
242 if Piece(lstPersonalPatients.Items[0], '^', 1) = '' then
243 begin
244 btnPersonalPatientR.Enabled := false;
245 btnPersonalPatientRA.Enabled := false;
246 exit;
247 end;
248 btnPersonalPatientR.Enabled := lstPersonalPatients.SelCount > 0;
249 btnPersonalPatientRA.Enabled := lstPersonalPatients.Items.Count > 0;
250 btnListSaveChanges.Enabled := false;
251end;
252
253procedure TfrmOptionsLists.lstAddByClick(Sender: TObject);
254var
255 ien: string;
256 visitstart, visitstop, i: integer;
257 visittoday, visitbegin, visitend: TFMDateTime;
258 aList: TStringList;
259 PtRec: TPtIDInfo;
260begin
261 if lstAddBy.ItemIndex < 0 then exit;
262 ien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
263 case radAddByType.ItemIndex of
264 0:
265 begin
266 PtRec := GetPtIDInfo(ien);
267// lblAddBy.Caption := 'Patient: SSN: ' + PtRec.SSN; <-- original line. //kt 8/8/2007
268 lblAddBy.Caption := DKLangConstW('fOptionsLists_Patientx___SSNx') + PtRec.SSN; //kt added 8/8/2007
269 lstAddby.Caption := lblAddby.Caption;
270 AddIfUnique(lstAddBy.Items[lstAddBy.ItemIndex], lstListPats);
271 end;
272 1:
273 begin
274 ListPtByWard(lstListPats.Items, strtointdef(ien,0));
275 end;
276 2:
277 begin
278 rpcGetApptUserDays(visitstart, visitstop); // use user's date range for appointments
279 visittoday := FMToday;
280 visitbegin := FMDateTimeOffsetBy(visittoday, LowerOf(visitstart, visitstop));
281 visitend := FMDateTimeOffsetBy(visittoday, HigherOf(visitstart, visitstop));
282 aList := TStringList.Create;
283 ListPtByClinic(lstListPats.Items, strtointdef(ien, 0), floattostr(visitbegin), floattostr(visitend));
284 for i := 0 to aList.Count - 1 do
285 AddIfUnique(aList[i], lstListPats);
286 aList.Free;
287 end;
288 3:
289 begin
290 ListPtByProvider(lstListPats.Items, strtoint64def(ien,0));
291 end;
292 4:
293 begin
294 ListPtBySpecialty(lstListPats.Items, strtointdef(ien,0));
295 end;
296 5:
297 begin
298 ListPtByTeam(lstListPats.Items, strtointdef(ien,0));
299 end;
300 end;
301 if lstListPats.Items.Count = 1 then // avoid selecting '^No patients found.' msg
302 if Piece(lstListPats.Items[0], '^', 1) = '' then
303 begin
304 btnListAddAll.Enabled := false;
305 btnListAdd.Enabled := false;
306 exit;
307 end;
308 btnListAddAll.Enabled := (lstListPats.Items.Count > 0) and (lstPersonalLists.ItemIndex > -1);
309 btnListAdd.Enabled := (lstListPats.SelCount > 0) and (lstPersonalLists.ItemIndex > -1);
310end;
311
312procedure TfrmOptionsLists.btnDeleteListClick(Sender: TObject);
313var
314 oldindex: integer;
315 deletemsg: string;
316begin
317 with lstPersonalLists do
318// deletemsg := 'You have selected "' + DisplayText[ItemIndex] <-- original line. //kt 8/8/2007
319 deletemsg := DKLangConstW('fOptionsLists_You_have_selected_x') + DisplayText[ItemIndex] //kt added 8/8/2007
320// + '" to be deleted.' + CRLF + 'Are you sure you want to delete this list?'; <-- original line. //kt 8/8/2007
321 + DKLangConstW('fOptionsLists_x_to_be_deletedx') + CRLF + DKLangConstW('fOptionsLists_Are_you_sure_you_want_to_delete_this_listx'); //kt added 8/8/2007
322//if InfoBox(deletemsg, 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then <-- original line. //kt 8/8/2007
323 if InfoBox(deletemsg, DKLangConstW('fOptionsLists_Confirmation'), MB_YESNO or MB_ICONQUESTION) = IDYES then //kt added 8/8/2007
324 begin
325 btnListSaveChanges.Enabled := false;
326 with lstPersonalLists do
327 begin
328 oldindex := ItemIndex;
329 if oldindex > -1 then
330 begin
331 rpcDeleteList(Piece(Items[oldindex], '^', 1));
332 Items.Delete(oldindex);
333 btnPersonalPatientRAClick(self);
334 btnListSaveChanges.Enabled := false;
335 end;
336 if Items.Count > 0 then
337 begin
338 if oldindex = 0 then
339 ItemIndex := 0
340 else if oldindex > (Items.Count - 1) then
341 ItemIndex := Items.Count - 1
342 else
343 ItemIndex := oldindex;
344 btnListSaveChanges.Enabled := false;
345 lstPersonalListsChange(self);
346 end;
347 end;
348 end;
349end;
350
351procedure TfrmOptionsLists.btnListSaveChangesClick(Sender: TObject);
352var
353 listien: integer;
354begin
355 listien := strtointdef(Piece(lstPersonalLists.Items[FLastList], '^', 1), 0);
356 rpcSaveListChanges(lstPersonalPatients.Items, listien);
357 btnListSaveChanges.Enabled := false;
358end;
359
360procedure TfrmOptionsLists.btnPersonalPatientRAClick(Sender: TObject);
361begin
362 lstPersonalPatients.Items.Clear;
363 btnPersonalPatientR.Enabled := lstPersonalPatients.SelCount > 0;
364 btnPersonalPatientRA.Enabled := lstPersonalPatients.Items.Count > 0;
365 btnListSaveChanges.Enabled := true;
366end;
367
368procedure TfrmOptionsLists.btnListAddAllClick(Sender: TObject);
369var
370 i: integer;
371begin
372 with lstPersonalPatients do
373 begin
374 if Items.Count = 1 then
375 if Piece(Items[0], '^', 1) = '' then
376 Items.Clear;
377 end;
378 with lstListPats do
379 begin
380 for i := 0 to Items.Count - 1 do
381 AddIfUnique(Items[i], lstPersonalPatients);
382 Items.Clear;
383 lstPersonalPatientsChange(self);
384 lstAddBy.ItemIndex := -1;
385 btnListAddAll.Enabled := false;
386 lstPersonalPatientsChange(self);
387 end;
388 btnListSaveChanges.Enabled := true;
389end;
390
391procedure TfrmOptionsLists.btnPersonalPatientRClick(Sender: TObject);
392var
393 i: integer;
394begin
395 if not btnPersonalPatientR.Enabled then exit;
396 with lstPersonalPatients do
397 for i := Items.Count - 1 downto 0 do
398 if Selected[i] then
399 Items.Delete(i);
400 btnPersonalPatientR.Enabled := lstPersonalPatients.SelCount > 0;
401 btnPersonalPatientRA.Enabled := lstPersonalPatients.Items.Count > 0;
402 btnListSaveChanges.Enabled := true;
403end;
404
405procedure TfrmOptionsLists.lstPersonalPatientsChange(Sender: TObject);
406begin
407 if lstPersonalPatients.SelCount = 1 then // avoid selecting '^No patients found.' msg
408 if Piece(lstPersonalPatients.Items[0], '^', 1) = '' then
409 begin
410 btnPersonalPatientR.Enabled := false;
411 btnPersonalPatientRA.Enabled := false;
412 exit;
413 end;
414 btnPersonalPatientR.Enabled := lstPersonalPatients.SelCount > 0;
415 btnPersonalPatientRA.Enabled := lstPersonalPatients.Items.Count > 0;
416end;
417
418procedure TfrmOptionsLists.btnListAddClick(Sender: TObject);
419var
420 i: integer;
421begin
422 if not btnListAdd.Enabled then exit;
423 with lstPersonalPatients do
424 begin
425 if Items.Count = 1 then
426 if Piece(Items[0], '^', 1) = '' then
427 Items.Clear;
428 end;
429 with lstListPats do
430 for i := Items.Count - 1 downto 0 do
431 if Selected[i] then
432 begin
433 AddIfUnique(Items[i], lstPersonalPatients);
434 Items.Delete(i);
435 end;
436 lstListPatsChange(self);
437 lstPersonalPatientsChange(self);
438 btnListSaveChanges.Enabled := true;
439end;
440
441procedure TfrmOptionsLists.lstListPatsChange(Sender: TObject);
442begin
443 if lstListPats.SelCount = 1 then // avoid selecting '^No patients found.' msg
444 if Piece(lstListPats.Items[0], '^', 1) = '' then
445 exit;
446 btnListAdd.Enabled := (lstListPats.SelCount > 0) and (lstPersonalLists.ItemIndex > -1);
447 btnListAddAll.Enabled := (lstListPats.Items.Count > 0) and (lstPersonalLists.ItemIndex > -1);
448end;
449
450procedure TfrmOptionsLists.FormShow(Sender: TObject);
451begin
452 with lstPersonalLists do
453 if Items.Count < 1 then
454// showmessage('You have no personal lists. Use "New List..." to create one.') <-- original line. //kt 8/8/2007
455 showmessage(DKLangConstW('fOptionsLists_You_have_no_personal_listsx_Use_xNew_Listxxxx_to_create_onex')) //kt added 8/8/2007
456 else
457 begin
458 ItemIndex := 0;
459 lstPersonalListsChange(self);
460 end;
461end;
462
463procedure TfrmOptionsLists.lstAddByNeedData(Sender: TObject;
464 const StartFrom: String; Direction, InsertAt: Integer);
465begin
466 with lstAddBy do
467 begin
468 case radAddByType.ItemIndex of
469 0: begin
470 Pieces := '2';
471 ForDataUse(SubSetOfPatients(StartFrom, Direction));
472 end;
473 1: begin
474 Pieces := '2';
475 end;
476 2: begin
477 Pieces := '2';
478 ForDataUse(SubSetOfClinics(StartFrom, Direction));
479 end;
480 3: begin
481 Pieces := '2,3';
482 ForDataUse(SubSetOfProviders(StartFrom, Direction));
483 end;
484 4: begin
485 Pieces := '2';
486 end;
487 5: begin
488 Pieces := '2';
489 end;
490 end;
491 end;
492end;
493
494procedure TfrmOptionsLists.btnOKClick(Sender: TObject);
495begin
496 if btnListSaveChanges.Enabled then
497 begin
498// if InfoBox('Do you want to save changes to ' <-- original line. //kt 8/8/2007
499 if InfoBox(DKLangConstW('fOptionsLists_Do_you_want_to_save_changes_to') //kt added 8/8/2007
500 + Piece(lstPersonalLists.Items[FLastList], '^', 2) + '?',
501// 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then <-- original line. //kt 8/8/2007
502 DKLangConstW('fOptionsLists_Confirmation'), MB_YESNO or MB_ICONQUESTION) = IDYES then //kt added 8/8/2007
503 btnListSaveChangesClick(self);
504 end;
505end;
506
507procedure TfrmOptionsLists.mnuPatientIDClick(Sender: TObject);
508begin
509 case mnuPopPatient.Tag of
510 LIST_PERSONAL: DisplayPtInfo(lstPersonalPatients.ItemID);
511 LIST_ADD: DisplayPtInfo(lstListPats.ItemID);
512 end;
513end;
514
515procedure TfrmOptionsLists.lstListPatsMouseDown(Sender: TObject;
516 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
517begin
518 mnuPopPatient.AutoPopup := (lstListPats.Items.Count > 0)
519 and (lstListPats.ItemIndex > -1)
520 and (lstListPats.SelCount = 1)
521 and (Button = mbRight)
522 and (btnListAdd.Enabled);
523 mnuPopPatient.Tag := LIST_ADD;
524end;
525
526procedure TfrmOptionsLists.lstPersonalPatientsMouseDown(Sender: TObject;
527 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
528begin
529 mnuPopPatient.AutoPopup := (lstPersonalPatients.Items.Count > 0)
530 and (lstPersonalPatients.ItemIndex > -1)
531 and (lstPersonalPatients.SelCount = 1)
532 and (Button = mbRight)
533 and (btnPersonalPatientR.Enabled);
534 mnuPopPatient.Tag := LIST_PERSONAL;
535end;
536
537procedure TfrmOptionsLists.lstAddByKeyPress(Sender: TObject;
538 var Key: Char);
539
540 procedure ShowMatchingPatients;
541 begin
542 with lstAddBy do
543 begin
544 if ShortCount > 0 then
545 begin
546 if ShortCount = 1 then
547 begin
548 ItemIndex := 0;
549 end;
550 Items.Add(LLS_LINE);
551 Items.Add(LLS_SPACE);
552 end;
553 InitLongList('');
554 end;
555 Key := #0; //Now that we've selected it, don't process the last keystroke!
556 end;
557
558var
559 FutureText: string;
560begin
561 if radAddByType.ItemIndex = 0 {patient} then
562 begin
563 with lstAddBy do
564 begin
565 FutureText := Text + Key;
566 if frmPtSelOptns.IsLast5(FutureText) then
567 begin
568 ListPtByLast5(Items, FutureText);
569 ShowMatchingPatients;
570 end
571 else if frmPtSelOptns.IsFullSSN(FutureText) then
572 begin
573 ListPtByFullSSN(Items, FutureText);
574 ShowMatchingPatients;
575 end;
576 end;
577 end;
578end;
579
580end.
Note: See TracBrowser for help on using the repository browser.