Module

fOptionsPatientSelection

Path

C:\CPRS\CPRS30\Options\fOptionsPatientSelection.pas

Last Modified

7/15/2014 3:26:40 PM

Units Used in Interface

Name Comments
fBase508Form -

Units Used in Implementation

Name Comments
rCore -
rOptions -
uOptions -

Classes

Name Comments
TfrmOptionsPatientSelection -

Procedures

Name Owner Declaration Scope Comments
btnOKClick TfrmOptionsPatientSelection procedure btnOKClick(Sender: TObject); Public/Published -
cboFridayNeedData TfrmOptionsPatientSelection procedure cboFridayNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboMondayNeedData TfrmOptionsPatientSelection procedure cboMondayNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboProviderExit TfrmOptionsPatientSelection procedure cboProviderExit(Sender: TObject); Public/Published -
cboProviderKeyUp TfrmOptionsPatientSelection procedure cboProviderKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboProviderNeedData TfrmOptionsPatientSelection procedure cboProviderNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboSaturdayNeedData TfrmOptionsPatientSelection procedure cboSaturdayNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboSundayNeedData TfrmOptionsPatientSelection procedure cboSundayNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboThursdayNeedData TfrmOptionsPatientSelection procedure cboThursdayNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboTuesdayNeedData TfrmOptionsPatientSelection procedure cboTuesdayNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboWednesdayNeedData TfrmOptionsPatientSelection procedure cboWednesdayNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
DialogOptionsPatientSelection - procedure DialogOptionsPatientSelection(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); Interfaced Create the form and make it modal, return an action
FormCreate TfrmOptionsPatientSelection procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmOptionsPatientSelection procedure FormShow(Sender: TObject); Public/Published -
NextControl TfrmOptionsPatientSelection procedure NextControl(Key: Char); Public Public declarations
radListSourceClick TfrmOptionsPatientSelection procedure radListSourceClick(Sender: TObject); Public/Published -
spnVisitStartClick TfrmOptionsPatientSelection procedure spnVisitStartClick(Sender: TObject; Button: TUDBtnType); Public/Published -
spnVisitStopClick TfrmOptionsPatientSelection procedure spnVisitStopClick(Sender: TObject; Button: TUDBtnType); Public/Published -
txtVisitStartExit TfrmOptionsPatientSelection procedure txtVisitStartExit(Sender: TObject); Public/Published -
txtVisitStartKeyPress TfrmOptionsPatientSelection procedure txtVisitStartKeyPress(Sender: TObject; var Key: Char); Public/Published -
txtVisitStartKeyUp TfrmOptionsPatientSelection procedure txtVisitStartKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
txtVisitStopExit TfrmOptionsPatientSelection procedure txtVisitStopExit(Sender: TObject); Public/Published -
txtVisitStopKeyPress TfrmOptionsPatientSelection procedure txtVisitStopKeyPress(Sender: TObject; var Key: Char); Public/Published -
txtVisitStopKeyUp TfrmOptionsPatientSelection procedure txtVisitStopKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -

Global Variables

Name Type Declaration Comments
frmOptionsPatientSelection TfrmOptionsPatientSelection frmOptionsPatientSelection: TfrmOptionsPatientSelection; -


Module Source

1     unit fOptionsPatientSelection;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ExtCtrls, ORCtrls, OrFn, ComCtrls, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
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    
97    var
98      frmOptionsPatientSelection: TfrmOptionsPatientSelection;
99    
100   procedure DialogOptionsPatientSelection(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
101   
102   implementation
103   
104   uses rOptions, uOptions, rCore;
105   
106   {$R *.DFM}
107   
108   procedure DialogOptionsPatientSelection(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
109   // create the form and make it modal, return an action
110   var
111     frmOptionsPatientSelection: TfrmOptionsPatientSelection;
112   begin
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;
134   end;
135   
136   procedure TfrmOptionsPatientSelection.FormCreate(Sender: TObject);
137   begin
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);
151   end;
152   
153   procedure TfrmOptionsPatientSelection.FormShow(Sender: TObject);
154   var
155     visitstart, visitstop: integer;
156     mon, tues, wed, thurs, fri, sat, sun: integer;
157     visitstartdef, visitstopdef: integer;
158     defprovider, deftreating, deflist, defward: integer;
159   begin
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;
233   end;
234   
235   procedure TfrmOptionsPatientSelection.spnVisitStartClick(Sender: TObject;
236     Button: TUDBtnType);
237   var
238     tagnum: integer;
239   begin
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;
272   end;
273   
274   procedure TfrmOptionsPatientSelection.spnVisitStopClick(Sender: TObject;
275     Button: TUDBtnType);
276   var
277     tagnum: integer;
278   begin
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;
309   end;
310   
311   procedure TfrmOptionsPatientSelection.btnOKClick(Sender: TObject);
312   var
313     StartDays, StopDays, mon, tues, wed, thurs, fri, sat, sun: integer;
314     PLSource, PLSort: Char;
315     prov, spec, team, ward: integer;
316   begin
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;
348   end;
349   
350   procedure TfrmOptionsPatientSelection.txtVisitStartExit(Sender: TObject);
351   begin
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);
360   end;
361   
362   procedure TfrmOptionsPatientSelection.txtVisitStopExit(Sender: TObject);
363   begin
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);
372   end;
373   
374   procedure TfrmOptionsPatientSelection.txtVisitStartKeyUp(Sender: TObject;
375     var Key: Word; Shift: TShiftState);
376   begin
377     txtVisitStart.Hint := txtVisitStart.Text;   // put text in hint since text not available to spin
378     FStartEntered := true;
379   end;
380   
381   procedure TfrmOptionsPatientSelection.txtVisitStopKeyUp(Sender: TObject;
382     var Key: Word; Shift: TShiftState);
383   begin
384     txtVisitStop.Hint := txtVisitStop.Text;   // put text in hint since text not available to spin
385     FStopEntered := true;
386   end;
387   
388   procedure TfrmOptionsPatientSelection.cboProviderExit(Sender: TObject);
389   begin
390     with (Sender as TORComboBox) do
391     if ItemIndex < 0 then
392       Text := '';
393   end;
394   
395   procedure TfrmOptionsPatientSelection.radListSourceClick(Sender: TObject);
396   begin
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;
419   end;
420   
421   procedure TfrmOptionsPatientSelection.cboMondayNeedData(Sender: TObject;
422     const StartFrom: String; Direction, InsertAt: Integer);
423   begin
424     cboMonday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
425   end;
426   
427   procedure TfrmOptionsPatientSelection.cboTuesdayNeedData(Sender: TObject;
428     const StartFrom: String; Direction, InsertAt: Integer);
429   begin
430     cboTuesday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
431   end;
432   
433   procedure TfrmOptionsPatientSelection.cboWednesdayNeedData(Sender: TObject;
434     const StartFrom: String; Direction, InsertAt: Integer);
435   begin
436     cboWednesday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
437   end;
438   
439   procedure TfrmOptionsPatientSelection.cboThursdayNeedData(Sender: TObject;
440     const StartFrom: String; Direction, InsertAt: Integer);
441   begin
442     cboThursday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
443   end;
444   
445   procedure TfrmOptionsPatientSelection.cboFridayNeedData(Sender: TObject;
446     const StartFrom: String; Direction, InsertAt: Integer);
447   begin
448     cboFriday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
449   end;
450   
451   procedure TfrmOptionsPatientSelection.cboSaturdayNeedData(Sender: TObject;
452     const StartFrom: String; Direction, InsertAt: Integer);
453   begin
454     cboSaturday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
455   end;
456   
457   procedure TfrmOptionsPatientSelection.cboSundayNeedData(Sender: TObject;
458     const StartFrom: String; Direction, InsertAt: Integer);
459   begin
460     cboSunday.ForDataUse(SubSetOfClinics(StartFrom, Direction));
461   end;
462   
463   procedure TfrmOptionsPatientSelection.cboProviderNeedData(Sender: TObject;
464     const StartFrom: String; Direction, InsertAt: Integer);
465   begin
466     cboProvider.ForDataUse(SubSetOfProviders(StartFrom, Direction));
467   end;
468   
469   procedure TfrmOptionsPatientSelection.NextControl(Key: Char);
470   begin
471     if Key = #13 then Perform(WM_NextDlgCtl, 0, 0);
472   end;
473   
474   procedure TfrmOptionsPatientSelection.txtVisitStartKeyPress(
475     Sender: TObject; var Key: Char);
476   begin
477     if Key = #13 then
478     begin
479       FStartEntered := true;
480       Perform(WM_NextDlgCtl, 0, 0);
481     end;
482   end;
483   
484   procedure TfrmOptionsPatientSelection.txtVisitStopKeyPress(Sender: TObject;
485     var Key: Char);
486   begin
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;
493   end;
494   
495   procedure TfrmOptionsPatientSelection.cboProviderKeyUp(Sender: TObject;
496     var Key: Word; Shift: TShiftState);
497   begin
498     if not FProviderSpecial then NextControl(Char(Key));
499     FProviderSpecial := false;
500   end;
501   
502   end.

Module Calls (2 levels)


fOptionsPatientSelection
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rOptions
 │ └rCore
 ├uOptions
 │ ├rCore...
 │ └fRptBox
 └rCore...

Module Called-By (2 levels)


fOptionsPatientSelection
              fOptions┘ 
              fFrame┘