source: cprs/trunk/CPRS-Chart/Options/fOptionsLists.pas@ 730

Last change on this file since 730 was 456, checked in by Kevin Toppenberg, 16 years ago

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