Module

fOptionsDays

Path

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

Last Modified

7/15/2014 3:26:40 PM

Units Used in Interface

Name Comments
fBase508Form -
fOptions -

Units Used in Implementation

Name Comments
rOptions -
uOptions -

Classes

Name Comments
TfrmOptionsDays -

Procedures

Name Owner Declaration Scope Comments
AdjustLabLabel TfrmOptionsDays procedure AdjustLabLabel; Private -
AdjustVisitLabel TfrmOptionsDays procedure AdjustVisitLabel; Private -
btnLabDefaultsClick TfrmOptionsDays procedure btnLabDefaultsClick(Sender: TObject); Public/Published -
btnOKClick TfrmOptionsDays procedure btnOKClick(Sender: TObject); Public/Published -
btnVisitDefaultsClick TfrmOptionsDays procedure btnVisitDefaultsClick(Sender: TObject); Public/Published -
DialogOptionsDays - procedure DialogOptionsDays(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); Interfaced Create the form and make it modal, return an action
FormCreate TfrmOptionsDays procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmOptionsDays procedure FormShow(Sender: TObject); Public/Published
Get lab defaults, personal values, visit defaults, personal values
tags for textboxes hold setting, tags on spinbuttons hold default,
tag of 1 on buttons indicate system default being used
spnLabInpatientClick TfrmOptionsDays procedure spnLabInpatientClick(Sender: TObject; Button: TUDBtnType); Public/Published -
spnLabOutpatientClick TfrmOptionsDays procedure spnLabOutpatientClick(Sender: TObject; Button: TUDBtnType); Public/Published -
spnVisitStartClick TfrmOptionsDays procedure spnVisitStartClick(Sender: TObject; Button: TUDBtnType); Public/Published -
spnVisitStopClick TfrmOptionsDays procedure spnVisitStopClick(Sender: TObject; Button: TUDBtnType); Public/Published -
txtLabInpatientChange TfrmOptionsDays procedure txtLabInpatientChange(Sender: TObject); Public/Published -
txtLabInpatientExit TfrmOptionsDays procedure txtLabInpatientExit(Sender: TObject); Public/Published -
txtLabInpatientKeyPress TfrmOptionsDays procedure txtLabInpatientKeyPress(Sender: TObject; var Key: Char); Public/Published -
txtLabOutpatientChange TfrmOptionsDays procedure txtLabOutpatientChange(Sender: TObject); Public/Published -
txtLabOutpatientExit TfrmOptionsDays procedure txtLabOutpatientExit(Sender: TObject); Public/Published -
txtVisitStartExit TfrmOptionsDays procedure txtVisitStartExit(Sender: TObject); Public/Published -
txtVisitStartKeyPress TfrmOptionsDays procedure txtVisitStartKeyPress(Sender: TObject; var Key: Char); Public/Published -
txtVisitStartKeyUp TfrmOptionsDays procedure txtVisitStartKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
txtVisitStopExit TfrmOptionsDays procedure txtVisitStopExit(Sender: TObject); Public/Published -
txtVisitStopKeyPress TfrmOptionsDays procedure txtVisitStopKeyPress(Sender: TObject; var Key: Char); Public/Published -
txtVisitStopKeyUp TfrmOptionsDays procedure txtVisitStopKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -

Global Variables

Name Type Declaration Comments
frmOptionsDays TfrmOptionsDays frmOptionsDays: TfrmOptionsDays; -


Module Source

1     unit fOptionsDays;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ExtCtrls, fOptions, ComCtrls, OrFn, ORCtrls, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmOptionsDays = class(TfrmBase508Form)
12        pnlBottom: TPanel;
13        btnOK: TButton;
14        btnCancel: TButton;
15        bvlTop: TBevel;
16        bvlMiddle: TBevel;
17        txtLabInpatient: TCaptionEdit;
18        spnLabInpatient: TUpDown;
19        txtLabOutpatient: TCaptionEdit;
20        spnLabOutpatient: TUpDown;
21        txtVisitStart: TCaptionEdit;
22        spnVisitStart: TUpDown;
23        txtVisitStop: TCaptionEdit;
24        spnVisitStop: TUpDown;
25        lblVisit: TStaticText;
26        lblVisitStop: TLabel;
27        lblVisitStart: TLabel;
28        lblLabOutpatient: TLabel;
29        lblLabInpatient: TLabel;
30        lblLab: TStaticText;
31        lblVisitValue: TMemo;
32        lblLabValue: TMemo;
33        btnLabDefaults: TButton;
34        btnVisitDefaults: TButton;
35        bvlBottom: TBevel;
36        procedure FormCreate(Sender: TObject);
37        procedure FormShow(Sender: TObject);
38        procedure spnVisitStartClick(Sender: TObject; Button: TUDBtnType);
39        procedure spnVisitStopClick(Sender: TObject; Button: TUDBtnType);
40        procedure spnLabInpatientClick(Sender: TObject; Button: TUDBtnType);
41        procedure spnLabOutpatientClick(Sender: TObject; Button: TUDBtnType);
42        procedure txtLabInpatientKeyPress(Sender: TObject; var Key: Char);
43        procedure btnLabDefaultsClick(Sender: TObject);
44        procedure btnVisitDefaultsClick(Sender: TObject);
45        procedure btnOKClick(Sender: TObject);
46        procedure txtLabInpatientChange(Sender: TObject);
47        procedure txtLabInpatientExit(Sender: TObject);
48        procedure txtLabOutpatientChange(Sender: TObject);
49        procedure txtLabOutpatientExit(Sender: TObject);
50        procedure txtVisitStartExit(Sender: TObject);
51        procedure txtVisitStartKeyUp(Sender: TObject; var Key: Word;
52          Shift: TShiftState);
53        procedure txtVisitStopExit(Sender: TObject);
54        procedure txtVisitStopKeyUp(Sender: TObject; var Key: Word;
55          Shift: TShiftState);
56        procedure txtVisitStartKeyPress(Sender: TObject; var Key: Char);
57        procedure txtVisitStopKeyPress(Sender: TObject; var Key: Char);
58      private
59        { Private declarations }
60        FStartEntered: boolean;
61        FStopEntered: boolean;
62        procedure AdjustVisitLabel;
63        procedure AdjustLabLabel;
64      public
65        { Public declarations }
66      end;
67    
68    var
69      frmOptionsDays: TfrmOptionsDays;
70    
71    procedure DialogOptionsDays(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
72    
73    implementation
74    
75    uses rOptions, uOptions;
76    
77    {$R *.DFM}
78    
79    procedure DialogOptionsDays(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
80    // create the form and make it modal, return an action
81    var
82      frmOptionsDays: TfrmOptionsDays;
83    begin
84      frmOptionsDays := TfrmOptionsDays.Create(Application);
85      actiontype := 0;
86      try
87        with frmOptionsDays do
88        begin
89          if (topvalue < 0) or (leftvalue < 0) then
90            Position := poScreenCenter
91          else
92          begin
93            Position := poDesigned;
94            Top := topvalue;
95            Left := leftvalue;
96          end;
97          ResizeAnchoredFormToFont(frmOptionsDays);
98          ShowModal;
99          actiontype := btnOK.Tag;
100       end;
101     finally
102       frmOptionsDays.Release;
103     end;
104   end;
105   
106   procedure TfrmOptionsDays.FormCreate(Sender: TObject);
107   begin
108     FStartEntered := false;
109     FStopEntered := false;
110   end;
111   
112   procedure TfrmOptionsDays.FormShow(Sender: TObject);
113     //get lab defaults, personal values, visit defaults, personal values
114     //tags for textboxes hold setting, tags on spinbuttons hold default,
115     //tag of 1 on buttons indicate system default being used
116   var
117     labin, labout, visitstart, visitstop: integer;
118     labindef, laboutdef, visitstartdef, visitstopdef: integer;
119   begin
120     rpcGetLabDays(labindef, laboutdef);
121     rpcGetLabUserDays(labin, labout);
122     rpcGetApptDays(visitstartdef, visitstopdef);
123     rpcGetApptUserDays(visitstart, visitstop);
124   
125     txtLabInpatient.Text := inttostr(-labin);
126     txtLabInpatient.Tag := labin;
127     txtLabOutpatient.Text := inttostr(-labout);
128     txtLabOutpatient.Tag := labout;
129     txtVisitStart.Tag := visitstart - 1;
130     txtVisitStop.Tag := visitstop - 1;
131   
132     spnLabInpatient.Tag := labindef;
133     spnLabOutpatient.Tag := laboutdef;
134     spnVisitStart.Tag := visitstartdef;
135     spnVisitStop.Tag := visitstopdef;
136   
137     spnLabInpatientClick(self, btNext);
138     spnLabOutpatientClick(self, btNext);
139     spnVisitStartClick(self, btNext);
140     spnVisitStopClick(self, btNext);
141     
142     txtLabInpatient.SetFocus;
143   end;
144   
145   procedure TfrmOptionsDays.spnVisitStartClick(Sender: TObject;
146     Button: TUDBtnType);
147   var
148     tagnum: integer;
149   begin
150     with txtVisitStart do
151     begin
152       if FStartEntered then
153       begin
154         if Hint = '' then Hint := 'T';
155         tagnum := RelativeDate(Hint);
156         if tagnum = INVALID_DAYS then
157         begin
158           Text := Hint;
159           beep;
160           InfoBox('Start Date entry was invalid', 'Warning', MB_OK or MB_ICONWARNING);
161           ShowDisplay(txtVisitStart);
162           FStartEntered := false;
163           exit;
164         end
165         else
166         begin
167           DateLimits(DAYS_LIMIT, tagnum);
168           if tagnum <> INVALID_DAYS then
169             Tag := tagnum;
170         end;
171       end;
172       SetFocus;
173       if Button = btNext then tagnum := Tag + 1
174       else tagnum := Tag - 1;
175       Text := Hint;
176       DateLimits(DAYS_LIMIT, tagnum);
177       if tagnum <> INVALID_DAYS then
178         Tag := tagnum;
179       ShowDisplay(txtVisitStart);
180     end;
181     btnVisitDefaults.Tag := 0;
182     AdjustVisitLabel;
183     FStartEntered := false;
184   end;
185   
186   procedure TfrmOptionsDays.spnVisitStopClick(Sender: TObject;
187     Button: TUDBtnType);
188   var
189     tagnum: integer;
190   begin
191     with txtVisitStop do
192     begin
193       if FStopEntered then
194       begin
195         if Hint = '' then Hint := 'T';
196         tagnum := RelativeDate(Hint);
197         if tagnum = INVALID_DAYS then
198         begin
199           Text := Hint;
200           beep;
201           InfoBox('Stop Date entry was invalid', 'Warning', MB_OK or MB_ICONWARNING);
202           ShowDisplay(txtVisitStop);
203           FStopEntered := false;
204           exit;
205         end
206         else
207         begin
208           DateLimits(DAYS_LIMIT, tagnum);
209           if tagnum = INVALID_DAYS then
210           begin
211             Text := Hint;
212             ShowDisplay(txtVisitStop);
213             FStopEntered := false;
214             exit;
215           end;
216         end;
217       end;
218       SetFocus;
219       if Button = btNext then tagnum := Tag + 1
220       else tagnum := Tag - 1;
221       Text := Hint;
222       DateLimits(DAYS_LIMIT, tagnum);
223       if tagnum <> INVALID_DAYS then
224         Tag := tagnum;
225       ShowDisplay(txtVisitStop);
226     end;
227     btnVisitDefaults.Tag := 0;
228     AdjustVisitLabel;
229     FStopEntered := false;
230   end;
231   
232   procedure TfrmOptionsDays.spnLabInpatientClick(Sender: TObject;
233     Button: TUDBtnType);
234   begin
235    // txtLabInpatient.SetFocus; cq:13554
236     txtLabInpatient.Tag := strtointdef(txtLabInpatient.Text, 0);
237     btnLabDefaults.Tag := 0;
238     AdjustLabLabel;
239   end;
240   
241   procedure TfrmOptionsDays.spnLabOutpatientClick(Sender: TObject;
242     Button: TUDBtnType);
243   begin
244     //txtLabOutpatient.SetFocus;  cq:13554
245     txtLabOutpatient.Tag := strtointdef(txtLabOutpatient.Text, 0);
246     btnLabDefaults.Tag := 0;
247     AdjustLabLabel;
248   end;
249   
250   procedure TfrmOptionsDays.txtLabInpatientKeyPress(Sender: TObject;
251     var Key: Char);
252   begin
253     if Key = #13 then
254     begin
255       Perform(WM_NextDlgCtl, 0, 0);
256       exit;
257     end;
258     if not (Key in ['0'..'9', #8]) then
259     begin
260       Key := #0;
261       beep;
262     end;
263   end;
264   
265   procedure TfrmOptionsDays.btnLabDefaultsClick(Sender: TObject);
266   begin
267     txtLabInpatient.Text := inttostr(spnLabInpatient.Tag);
268     spnLabInpatientClick(self, btNext);
269     txtLabOutpatient.Text := inttostr(spnLabOutpatient.Tag);
270     spnLabOutpatientClick(self, btNext);
271     btnLabDefaults.Tag := 1;
272   end;
273   
274   procedure TfrmOptionsDays.btnVisitDefaultsClick(Sender: TObject);
275   begin
276     txtVisitStart.Tag := spnVisitStart.Tag - 1;
277     spnVisitStartClick(self, btNext);
278     txtVisitStop.Tag := spnVisitStop.Tag - 1;
279     spnVisitStopClick(self, btNext);
280     btnVisitDefaults.Tag := 1;
281   end;
282   
283   procedure TfrmOptionsDays.AdjustVisitLabel;
284   var
285     start, stop: string;
286   begin
287     start := txtVisitStart.Text;
288     stop := txtVisitStop.Text;
289     if start <> 'Today' then start := start + ' days';
290     if stop <> 'Today' then stop := stop + ' days';
291     lblVisitValue.Text := 'Appointments and visits will be displayed on the cover sheet '
292                            + 'from ' + start + ' to ' + stop + '.'
293   end;
294   
295   procedure TfrmOptionsDays.AdjustLabLabel;
296   begin
297     lblLabValue.Text := 'Lab results will be displayed on the cover sheet '
298                          + 'back ' + txtLabInpatient.Text + ' days for inpatients and '
299                          + txtLabOutpatient.Text + ' days for outpatients.';
300   end;
301   
302   procedure TfrmOptionsDays.btnOKClick(Sender: TObject);
303   begin
304     rpcSetDays(txtLabInpatient.Tag, txtLabOutpatient.Tag, txtVisitStart.Tag, txtVisitStop.Tag);
305   end;
306   
307   procedure TfrmOptionsDays.txtLabInpatientChange(Sender: TObject);
308   var
309     maxvalue: integer;
310   begin
311     maxvalue := spnLabInpatient.Max;
312     with txtLabInpatient do
313     begin
314       if strtointdef(Text, maxvalue) > maxvalue then
315       begin
316         beep;
317         InfoBox('Number must be < ' + inttostr(maxvalue), 'Warning', MB_OK or MB_ICONWARNING);
318         if strtointdef(Text, 0) > maxvalue then
319           Text := inttostr(maxvalue);
320       end;
321     end;
322     spnLabInpatientClick(self, btNext);
323   end;
324   
325   procedure TfrmOptionsDays.txtLabInpatientExit(Sender: TObject);
326   begin
327     with txtLabInpatient do
328     begin
329       if Text = '' then
330       begin
331         Text := '0';
332         spnLabInpatientClick(self, btNext);
333       end
334       else if (Copy(Text, 1, 1) = '0') and (length(Text) > 1) then
335       begin
336         Text := inttostr(strtointdef(Text, 0));
337         spnLabInpatientClick(self, btNext);
338       end;
339     end;
340   end;
341   
342   procedure TfrmOptionsDays.txtLabOutpatientChange(Sender: TObject);
343   var
344     maxvalue: integer;
345   begin
346     maxvalue := spnLabOutpatient.Max;
347     with txtLabOutpatient do
348     begin
349       if strtointdef(Text, maxvalue) > maxvalue then
350       begin
351         beep;
352         InfoBox('Number must be < ' + inttostr(maxvalue), 'Warning', MB_OK or MB_ICONWARNING);
353         if strtointdef(Text, 0) > maxvalue then
354           Text := inttostr(maxvalue);
355       end;
356     end;
357     spnLabOutpatientClick(self, btNext);
358   end;
359   
360   procedure TfrmOptionsDays.txtLabOutpatientExit(Sender: TObject);
361   begin
362     with txtLabOutpatient do
363     begin
364       if Text = '' then
365       begin
366         Text := '0';
367         spnLabOutpatientClick(self, btNext);
368       end
369       else if (Copy(Text, 1, 1) = '0') and (length(Text) > 1) then
370       begin
371         Text := inttostr(strtointdef(Text, 0));
372         spnLabOutpatientClick(self, btNext);
373       end;
374     end;
375   end;
376   
377   procedure TfrmOptionsDays.txtVisitStartExit(Sender: TObject);
378   begin
379     with txtVisitStart do
380     if Text = '' then
381     begin
382       Text := 'T-1';
383       Hint := 'T-1';
384       spnVisitStartClick(self, btNext);
385     end;
386     TextExit(txtVisitStart, FStartEntered, DAYS_LIMIT);
387     AdjustVisitLabel;
388   end;
389   
390   procedure TfrmOptionsDays.txtVisitStartKeyUp(Sender: TObject;
391     var Key: Word; Shift: TShiftState);
392   begin
393     txtVisitStart.Hint := txtVisitStart.Text;   // put text in hint since text not available to spin
394     FStartEntered := true;
395   end;
396   
397   procedure TfrmOptionsDays.txtVisitStopExit(Sender: TObject);
398   begin
399     with txtVisitStop do
400     if Text = '' then
401     begin
402       Text := 'T-1';
403       Hint := 'T-1';
404       spnVisitStopClick(self, btNext);
405     end;
406     TextExit(txtVisitStop, FStopEntered, DAYS_LIMIT);
407     AdjustVisitLabel;
408   end;
409   
410   procedure TfrmOptionsDays.txtVisitStopKeyUp(Sender: TObject; var Key: Word;
411     Shift: TShiftState);
412   begin
413     txtVisitStop.Hint := txtVisitStop.Text;   // put text in hint since text not available to spin
414     FStopEntered := true;
415   end;
416   
417   procedure TfrmOptionsDays.txtVisitStartKeyPress(Sender: TObject;
418     var Key: Char);
419   begin
420     if key = #13 then
421     begin
422       FStartEntered := true;
423       Perform(WM_NextDlgCtl, 0, 0);
424     end;
425   end;
426   
427   procedure TfrmOptionsDays.txtVisitStopKeyPress(Sender: TObject;
428     var Key: Char);
429   begin
430     if key = #13 then
431     begin
432       FStopEntered := true;
433       Perform(WM_NextDlgCtl, 0, 0);
434     end;
435   end;
436   
437   end.

Module Calls (2 levels)


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

Module Called-By (2 levels)


fOptionsDays
  fOptions┘ 
  fFrame┘