source: cprs/branches/foia-cprs/CPRS-Chart/Options/fOptionsPatientSelection.pas@ 607

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

Adding foia-cprs branch
File size: 15.0 KB
Line 
1unit fOptionsPatientSelection;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, ORCtrls, OrFn, ComCtrls;
8
9type
10 TfrmOptionsPatientSelection = class(TForm)
11 pnlBottom: TPanel;
12 btnOK: TButton;
13 btnCancel: TButton;
14 cboProvider: TORComboBox;
15 cboTreating: TORComboBox;
16 cboTeam: TORComboBox;
17 cboWard: TORComboBox;
18 cboMonday: TORComboBox;
19 cboTuesday: TORComboBox;
20 cboWednesday: TORComboBox;
21 cboThursday: TORComboBox;
22 cboFriday: TORComboBox;
23 cboSaturday: TORComboBox;
24 cboSunday: TORComboBox;
25 txtVisitStart: TCaptionEdit;
26 txtVisitStop: TCaptionEdit;
27 spnVisitStart: TUpDown;
28 spnVisitStop: TUpDown;
29 lblClinicDays: TLabel;
30 lblMonday: TLabel;
31 lblTuesday: TLabel;
32 lblWednesday: TLabel;
33 lblThursday: TLabel;
34 lblFriday: TLabel;
35 lblSaturday: TLabel;
36 lblSunday: TLabel;
37 lblVisitStart: TLabel;
38 lblVisitStop: TLabel;
39 lblVisitDateRange: TMemo;
40 lblInfo: TMemo;
41 lbWard: TLabel;
42 lblTeam: TLabel;
43 lblTreating: TLabel;
44 lblProvider: TLabel;
45 radListSource: TRadioGroup;
46 grpSortOrder: TGroupBox;
47 radAlphabetical: TRadioButton;
48 radRoomBed: TRadioButton;
49 radAppointmentDate: TRadioButton;
50 radTerminalDigit: TRadioButton;
51 radSource: TRadioButton;
52 bvlBottom: TBevel;
53 procedure FormCreate(Sender: TObject);
54 procedure FormShow(Sender: TObject);
55 procedure spnVisitStartClick(Sender: TObject; Button: TUDBtnType);
56 procedure spnVisitStopClick(Sender: TObject; Button: TUDBtnType);
57 procedure btnOKClick(Sender: TObject);
58 procedure txtVisitStartExit(Sender: TObject);
59 procedure txtVisitStopExit(Sender: TObject);
60 procedure txtVisitStartKeyUp(Sender: TObject; var Key: Word;
61 Shift: TShiftState);
62 procedure txtVisitStopKeyUp(Sender: TObject; var Key: Word;
63 Shift: TShiftState);
64 procedure cboProviderExit(Sender: TObject);
65 procedure radListSourceClick(Sender: TObject);
66 procedure cboMondayNeedData(Sender: TObject; const StartFrom: String;
67 Direction, InsertAt: Integer);
68 procedure cboTuesdayNeedData(Sender: TObject; const StartFrom: String;
69 Direction, InsertAt: Integer);
70 procedure cboWednesdayNeedData(Sender: TObject;
71 const StartFrom: String; Direction, InsertAt: Integer);
72 procedure cboThursdayNeedData(Sender: TObject; const StartFrom: String;
73 Direction, InsertAt: Integer);
74 procedure cboFridayNeedData(Sender: TObject; const StartFrom: String;
75 Direction, InsertAt: Integer);
76 procedure cboSaturdayNeedData(Sender: TObject; const StartFrom: String;
77 Direction, InsertAt: Integer);
78 procedure cboSundayNeedData(Sender: TObject; const StartFrom: String;
79 Direction, InsertAt: Integer);
80 procedure cboProviderNeedData(Sender: TObject; const StartFrom: String;
81 Direction, InsertAt: Integer);
82 procedure txtVisitStartKeyPress(Sender: TObject; var Key: Char);
83 procedure txtVisitStopKeyPress(Sender: TObject; var Key: Char);
84 procedure cboProviderKeyUp(Sender: TObject; var Key: Word;
85 Shift: TShiftState);
86 private
87 { Private declarations }
88 FStartEntered: boolean;
89 FStopEntered: boolean;
90 FProviderSpecial: boolean; // used to avoid duplicate action on cboProviderKeyUp
91 public
92 { Public declarations }
93 procedure NextControl(Key: Char);
94 end;
95
96var
97 frmOptionsPatientSelection: TfrmOptionsPatientSelection;
98
99procedure DialogOptionsPatientSelection(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
100
101implementation
102
103uses rOptions, uOptions, rCore;
104
105{$R *.DFM}
106
107procedure DialogOptionsPatientSelection(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
108// create the form and make it modal, return an action
109var
110 frmOptionsPatientSelection: TfrmOptionsPatientSelection;
111begin
112 frmOptionsPatientSelection := TfrmOptionsPatientSelection.Create(Application);
113 actiontype := 0;
114 try
115 with frmOptionsPatientSelection do
116 begin
117 FProviderSpecial := false;
118 if (topvalue < 0) or (leftvalue < 0) then
119 Position := poScreenCenter
120 else
121 begin
122 Position := poDesigned;
123 Top := topvalue;
124 Left := leftvalue;
125 end;
126 ResizeAnchoredFormToFont(frmOptionsPatientSelection);
127 ShowModal;
128 actiontype := btnOK.Tag;
129 end;
130 finally
131 frmOptionsPatientSelection.Release;
132 end;
133end;
134
135procedure TfrmOptionsPatientSelection.FormCreate(Sender: TObject);
136begin
137 FStartEntered := false;
138 FStopEntered := false;
139 cboMonday.InitLongList('');
140 cboTuesday.InitLongList('');
141 cboWednesday.InitLongList('');
142 cboThursday.InitLongList('');
143 cboFriday.InitLongList('');
144 cboSaturday.InitLongList('');
145 cboSunday.InitLongList('');
146 cboProvider.InitLongList('');
147 ListSpecialtyAll(cboTreating.Items);
148 ListTeamAll(cboTeam.Items);
149 ListWardAll(cboWard.Items);
150end;
151
152procedure TfrmOptionsPatientSelection.FormShow(Sender: TObject);
153var
154 visitstart, visitstop: integer;
155 mon, tues, wed, thurs, fri, sat, sun: integer;
156 visitstartdef, visitstopdef: integer;
157 defprovider, deftreating, deflist, defward: integer;
158begin
159 rpcGetClinicUserDays(visitstart, visitstop);
160 visitstartdef := visitstart;
161 visitstopdef := visitstop;
162 txtVisitStart.Tag := visitstart - 1;
163 txtVisitStop.Tag := visitstop - 1;
164 spnVisitStart.Tag := visitstartdef;
165 spnVisitStop.Tag := visitstopdef;
166 spnVisitStartClick(self, btNext);
167 spnVisitStopClick(self, btNext);
168
169 rpcGetClinicDefaults(mon, tues, wed, thurs, fri, sat, sun);
170 cboMonday.SelectByIEN(mon);
171 if cboMonday.Text = '' then
172 cboMonday.SetExactByIEN(mon, ExternalName(mon, 44));
173 cboTuesday.SelectByIEN(tues);
174 if cboTuesday.Text = '' then
175 cboTuesday.SetExactByIEN(tues, ExternalName(tues, 44));
176 cboWednesday.SelectByIEN(wed);
177 if cboWednesday.Text = '' then
178 cboWednesday.SetExactByIEN(wed, ExternalName(wed, 44));
179 cboThursday.SelectByIEN(thurs);
180 if cboThursday.Text = '' then
181 cboThursday.SetExactByIEN(thurs, ExternalName(thurs, 44));
182 cboFriday.SelectByIEN(fri);
183 if cboFriday.Text = '' then
184 cboFriday.SetExactByIEN(fri, ExternalName(fri, 44));
185 cboSaturday.SelectByIEN(sat);
186 if cboSaturday.Text = '' then
187 cboSaturday.SetExactByIEN(sat, ExternalName(sat, 44));
188 cboSunday.SelectByIEN(sun);
189 if cboSunday.Text = '' then
190 cboSunday.SetExactByIEN(sun, ExternalName(sun, 44));
191
192 with radListSource do
193 case DfltPtListSrc of
194 'P': ItemIndex := 0;
195 'S': ItemIndex := 1;
196 'T': ItemIndex := 2;
197 'W': ItemIndex := 3;
198 'C': ItemIndex := 4;
199 'M': ItemIndex := 5;
200 end;
201 radListSourceClick(self);
202
203 case rpcGetListOrder of
204 'A': radAlphabetical.Checked := true;
205 'R':
206 begin
207 if radRoomBed.Enabled then
208 radRoomBed.Checked := true
209 else
210 radAlphabetical.Checked := True;
211 end;
212 'P':
213 begin
214 if radAppointmentDate.Enabled then
215 radAppointmentDate.Checked := true
216 else
217 radAlphabetical.Checked := True;
218 end;
219 'T': radTerminalDigit.Checked := true;
220 'S': radSource.Checked := true;
221 else
222 radAlphabetical.Checked := true;
223 end;
224
225 rpcGetListSourceDefaults(defprovider, deftreating, deflist, defward);
226 cboProvider.SelectByIEN(defprovider);
227 cboTreating.SelectByIEN(deftreating);
228 cboTeam.SelectByIEN(deflist);
229 cboWard.SelectByIEN(defward);
230
231 radListSource.SetFocus;
232end;
233
234procedure TfrmOptionsPatientSelection.spnVisitStartClick(Sender: TObject;
235 Button: TUDBtnType);
236var
237 tagnum: integer;
238begin
239 with txtVisitStart do
240 begin
241 if FStartEntered then
242 begin
243 if Hint = '' then Hint := 'T';
244 tagnum := RelativeDate(Hint);
245 if tagnum = INVALID_DAYS then
246 begin
247 Text := Hint;
248 beep;
249 InfoBox('Start Date entry was invalid', 'Warning', MB_OK or MB_ICONWARNING);
250 ShowDisplay(txtVisitStart);
251 FStartEntered := false;
252 exit;
253 end
254 else
255 begin
256 DateLimits(SELECTION_LIMIT, tagnum);
257 if tagnum <> INVALID_DAYS then
258 Tag := tagnum;
259 end;
260 end;
261 SetFocus;
262 if Button = btNext then tagnum := Tag + 1
263 else tagnum := Tag - 1;
264 Text := Hint;
265 DateLimits(SELECTION_LIMIT, tagnum);
266 if tagnum <> INVALID_DAYS then
267 Tag := tagnum;
268 ShowDisplay(txtVisitStart);
269 end;
270 FStartEntered := false;
271end;
272
273procedure TfrmOptionsPatientSelection.spnVisitStopClick(Sender: TObject;
274 Button: TUDBtnType);
275var
276 tagnum: integer;
277begin
278 with txtVisitStop do
279 begin
280 if FStopEntered then
281 begin
282 if Hint = '' then Hint := 'T';
283 tagnum := RelativeDate(Hint);
284 if tagnum = INVALID_DAYS then
285 begin
286 Text := Hint;
287 beep;
288 InfoBox('Stop Date entry was invalid', 'Warning', MB_OK or MB_ICONWARNING);
289 ShowDisplay(txtVisitStop);
290 FStopEntered := false;
291 exit;
292 end
293 else
294 begin
295 DateLimits(SELECTION_LIMIT, tagnum);
296 Tag := tagnum;
297 end;
298 end;
299 SetFocus;
300 if Button = btNext then tagnum := Tag + 1
301 else tagnum := Tag - 1;
302 Text := Hint;
303 DateLimits(SELECTION_LIMIT, tagnum);
304 Tag := tagnum;
305 ShowDisplay(txtVisitStop);
306 end;
307 FStopEntered := false;
308end;
309
310procedure TfrmOptionsPatientSelection.btnOKClick(Sender: TObject);
311var
312 StartDays, StopDays, mon, tues, wed, thurs, fri, sat, sun: integer;
313 PLSource, PLSort: Char;
314 prov, spec, team, ward: integer;
315begin
316 StartDays := txtVisitStart.Tag;
317 StopDays := txtVisitStop.Tag;
318 mon := cboMonday.ItemIEN;
319 tues := cboTuesday.ItemIEN;
320 wed := cboWednesday.ItemIEN;
321 thurs := cboThursday.ItemIEN;
322 fri := cboFriday.ItemIEN;
323 sat := cboSaturday.ItemIEN;
324 sun := cboSunday.ItemIEN;
325 rpcSetClinicDefaults(StartDays, StopDays, mon, tues, wed, thurs, fri, sat, sun);
326 case radListSource.ItemIndex of
327 0: PLSource := 'P';
328 1: PLSource := 'S';
329 2: PLSource := 'T';
330 3: PLSource := 'W';
331 4: PLSource := 'C';
332 5: PLSource := 'M';
333 else
334 PLSource := 'P';
335 end;
336 if radAlphabetical.Checked then PLSort := 'A'
337 else if radRoomBed.Checked then PLSort := 'R'
338 else if radAppointmentDate.Checked then PLSort := 'P'
339 else if radSource.Checked then PLSort := 'S'
340 else PLSort := 'T';
341 prov := cboProvider.ItemIEN;
342 spec := cboTreating.ItemIEN;
343 team := cboTeam.ItemIEN;
344 ward := cboWard.ItemIEN;
345 rpcSetPtListDefaults(PLSource, PLSort, prov, spec, team, ward);
346 ResetDfltSort;
347end;
348
349procedure TfrmOptionsPatientSelection.txtVisitStartExit(Sender: TObject);
350begin
351 with txtVisitStart do
352 if Text = '' then
353 begin
354 Text := 'T-1';
355 Hint := 'T-1';
356 spnVisitStartClick(self, btNext);
357 end;
358 TextExit(txtVisitStart, FStartEntered, SELECTION_LIMIT);
359end;
360
361procedure TfrmOptionsPatientSelection.txtVisitStopExit(Sender: TObject);
362begin
363 with txtVisitStop do
364 if Text = '' then
365 begin
366 Text := 'T-1';
367 Hint := 'T-1';
368 spnVisitStopClick(self, btNext);
369 end;
370 TextExit(txtVisitStop, FStopEntered, SELECTION_LIMIT);
371end;
372
373procedure TfrmOptionsPatientSelection.txtVisitStartKeyUp(Sender: TObject;
374 var Key: Word; Shift: TShiftState);
375begin
376 txtVisitStart.Hint := txtVisitStart.Text; // put text in hint since text not available to spin
377 FStartEntered := true;
378end;
379
380procedure TfrmOptionsPatientSelection.txtVisitStopKeyUp(Sender: TObject;
381 var Key: Word; Shift: TShiftState);
382begin
383 txtVisitStop.Hint := txtVisitStop.Text; // put text in hint since text not available to spin
384 FStopEntered := true;
385end;
386
387procedure TfrmOptionsPatientSelection.cboProviderExit(Sender: TObject);
388begin
389 with (Sender as TORComboBox) do
390 if ItemIndex < 0 then
391 Text := '';
392end;
393
394procedure TfrmOptionsPatientSelection.radListSourceClick(Sender: TObject);
395begin
396 if radListSource.ItemIndex = 4 then
397 begin
398 if radRoomBed.Checked then
399 radAlphabetical.Checked := true;
400 radRoomBed.Enabled := false;
401 radAppointmentDate.Enabled := true;
402 end
403 else
404 begin
405 if radAppointmentDate.Checked then
406 radAlphabetical.Checked := true;
407 radAppointmentDate.Enabled := false;
408 radRoomBed.Enabled := true;
409 end;
410 if radListSource.ItemIndex = 5 then
411 begin
412 radSource.Enabled := true;
413 radAppointmentDate.Enabled := true;
414 radRoomBed.Enabled := false;
415 end
416 else
417 radSource.Enabled := false;
418end;
419
420procedure TfrmOptionsPatientSelection.cboMondayNeedData(Sender: TObject;
421 const StartFrom: String; Direction, InsertAt: Integer);
422begin
423 cboMonday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
424end;
425
426procedure TfrmOptionsPatientSelection.cboTuesdayNeedData(Sender: TObject;
427 const StartFrom: String; Direction, InsertAt: Integer);
428begin
429 cboTuesday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
430end;
431
432procedure TfrmOptionsPatientSelection.cboWednesdayNeedData(Sender: TObject;
433 const StartFrom: String; Direction, InsertAt: Integer);
434begin
435 cboWednesday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
436end;
437
438procedure TfrmOptionsPatientSelection.cboThursdayNeedData(Sender: TObject;
439 const StartFrom: String; Direction, InsertAt: Integer);
440begin
441 cboThursday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
442end;
443
444procedure TfrmOptionsPatientSelection.cboFridayNeedData(Sender: TObject;
445 const StartFrom: String; Direction, InsertAt: Integer);
446begin
447 cboFriday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
448end;
449
450procedure TfrmOptionsPatientSelection.cboSaturdayNeedData(Sender: TObject;
451 const StartFrom: String; Direction, InsertAt: Integer);
452begin
453 cboSaturday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
454end;
455
456procedure TfrmOptionsPatientSelection.cboSundayNeedData(Sender: TObject;
457 const StartFrom: String; Direction, InsertAt: Integer);
458begin
459 cboSunday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
460end;
461
462procedure TfrmOptionsPatientSelection.cboProviderNeedData(Sender: TObject;
463 const StartFrom: String; Direction, InsertAt: Integer);
464begin
465 cboProvider.ForDataUse(SubSetOfProviders(StartFrom, Direction));
466end;
467
468procedure TfrmOptionsPatientSelection.NextControl(Key: Char);
469begin
470 if Key = #13 then Perform(WM_NextDlgCtl, 0, 0);
471end;
472
473procedure TfrmOptionsPatientSelection.txtVisitStartKeyPress(
474 Sender: TObject; var Key: Char);
475begin
476 if Key = #13 then
477 begin
478 FStartEntered := true;
479 Perform(WM_NextDlgCtl, 0, 0);
480 end;
481end;
482
483procedure TfrmOptionsPatientSelection.txtVisitStopKeyPress(Sender: TObject;
484 var Key: Char);
485begin
486 if Key = #13 then
487 begin
488 FStopEntered := true;
489 FProviderSpecial := true; // used to avoid duplicate action on cboProviderKeyUp
490 Perform(WM_NextDlgCtl, 0, 0);
491 end;
492end;
493
494procedure TfrmOptionsPatientSelection.cboProviderKeyUp(Sender: TObject;
495 var Key: Word; Shift: TShiftState);
496begin
497 if not FProviderSpecial then NextControl(Char(Key));
498 FProviderSpecial := false;
499end;
500
501end.
Note: See TracBrowser for help on using the repository browser.