source: cprs/trunk/CPRS-Chart/Options/fOptionsPatientSelection.pas@ 1316

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

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