source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Options/fOptionsLists.pas@ 1706

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

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