source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptionsPatientSelection.pas@ 1156

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

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