Module

fOptionsOther

Path

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

Last Modified

7/15/2014 3:26:40 PM

Units Used in Interface

Name Comments
fBase508Form -
rOrders -
uCore -

Units Used in Implementation

Name Comments
fMeds -
rCore -
rOptions -
rSurgery -
uConst -
uOptions -

Classes

Name Comments
TfrmOptionsOther -

Procedures

Name Owner Declaration Scope Comments
btnCancelClick TfrmOptionsOther procedure btnCancelClick(Sender: TObject); Public/Published -
btnEncDefaultsClick TfrmOptionsOther procedure btnEncDefaultsClick(Sender: TObject); Public/Published -
btnOKClick TfrmOptionsOther procedure btnOKClick(Sender: TObject); Public/Published Opening tab^use last tab^autosave seconds^verify note title
DialogOptionsOther - procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); Interfaced Create the form and make it modal, return an action
dtStartChange TfrmOptionsOther procedure dtStartChange(Sender: TObject); Public/Published -
dtStartExit TfrmOptionsOther procedure dtStartExit(Sender: TObject); Public/Published -
dtStopExit TfrmOptionsOther procedure dtStopExit(Sender: TObject); Public/Published -
FormCloseQuery TfrmOptionsOther procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); Public/Published -
FormCreate TfrmOptionsOther procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmOptionsOther procedure FormShow(Sender: TObject); Public/Published
Displays defaults
 opening tab^use last tab^autosave seconds^verify note title
txtEncStartChange TfrmOptionsOther procedure txtEncStartChange(Sender: TObject); Public/Published -
txtEncStartExit TfrmOptionsOther procedure txtEncStartExit(Sender: TObject); Public/Published -
txtEncStopChange TfrmOptionsOther procedure txtEncStopChange(Sender: TObject); Public/Published -
txtEncStopExit TfrmOptionsOther procedure txtEncStopExit(Sender: TObject); Public/Published -

Global Variables

Name Type Declaration Comments
frmOptionsOther TfrmOptionsOther frmOptionsOther: TfrmOptionsOther; -

Constants

Name Declaration Scope Comments
ENC_MAX_LIMIT 999 Interfaced -


Module Source

1     unit fOptionsOther;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ExtCtrls, ComCtrls, ORCtrls, ORFn, rOrders, uCore, ORDtTm, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmOptionsOther = class(TfrmBase508Form)
12        pnlBottom: TPanel;
13        btnOK: TButton;
14        btnCancel: TButton;
15        bvlBottom: TBevel;
16        stStart: TStaticText;
17        stStop: TStaticText;
18        dtStart: TORDateBox;
19        dtStop: TORDateBox;
20        lblMedsTab: TLabel;
21        lblTabDefault: TStaticText;
22        lblTab: TLabel;
23        cboTab: TORComboBox;
24        chkLastTab: TCheckBox;
25        Bevel1: TBevel;
26        lblEncAppts: TLabel;
27        stStartEncAppts: TStaticText;
28        txtTodayMinus: TStaticText;
29        txtEncStart: TCaptionEdit;
30        txtDaysMinus: TStaticText;
31        spnEncStart: TUpDown;
32        txtDaysPlus: TStaticText;
33        spnEncStop: TUpDown;
34        txtEncStop: TCaptionEdit;
35        txtTodayPlus: TStaticText;
36        stStopEncAppts: TStaticText;
37        Bevel2: TBevel;
38        btnEncDefaults: TButton;
39        procedure FormShow(Sender: TObject);
40        procedure btnOKClick(Sender: TObject);
41        procedure FormCreate(Sender: TObject);
42        procedure dtStartExit(Sender: TObject);
43        procedure dtStopExit(Sender: TObject);
44        procedure dtStartChange(Sender: TObject);
45        procedure txtEncStartChange(Sender: TObject);
46        procedure txtEncStopChange(Sender: TObject);
47        procedure txtEncStartExit(Sender: TObject);
48        procedure txtEncStopExit(Sender: TObject);
49        procedure btnEncDefaultsClick(Sender: TObject);
50        procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
51        procedure btnCancelClick(Sender: TObject);
52      private
53        { Private declarations }
54        FstartDt: TFMDateTime;
55        FstopDt: TFMDateTime;
56        FEncStartDays, FEncStopDays, FEncDefStartDays, FEncDefStopDays: integer;
57        OK2Closed: boolean;
58        //FDefaultEvent: string;
59      public
60        { Public declarations }
61      end;
62    
63    var
64      frmOptionsOther: TfrmOptionsOther;
65    
66    const
67      ENC_MAX_LIMIT = 999;
68    
69    procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
70    
71    implementation
72    
73    {$R *.DFM}
74    
75    uses
76      rOptions, uOptions, rCore, rSurgery, uConst, fMeds, VAUtils;
77    
78    procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
79    // create the form and make it modal, return an action
80    var
81      frmOptionsOther: TfrmOptionsOther;
82    begin
83      frmOptionsOther := TfrmOptionsOther.Create(Application);
84      actiontype := 0;
85      try
86        with frmOptionsOther do
87        begin
88          if (topvalue < 0) or (leftvalue < 0) then
89            Position := poScreenCenter
90          else
91          begin
92            Position := poDesigned;
93            Top := topvalue;
94            Left := leftvalue;
95          end;
96          ResizeAnchoredFormToFont(frmOptionsOther);
97          ShowModal;
98          actiontype := btnOK.Tag;
99        end;
100     finally
101       frmOptionsOther.Release;
102     end;
103   end;
104   
105   procedure TfrmOptionsOther.FormShow(Sender: TObject);
106   // displays defaults
107   // opening tab^use last tab^autosave seconds^verify note title
108   var
109     last: integer;
110     values, tab: string;
111   begin
112     OK2Closed := True;
113     FastAssign(rpcGetOtherTabs, cboTab.Items);
114     if (cboTab.Items.IndexOf('Surgery') > -1) and (not ShowSurgeryTab) then
115       cboTab.Items.Delete(cboTab.Items.IndexOf('Surgery'));
116     values := rpcGetOther;
117     tab := Piece(values, '^', 1);
118     last := strtointdef(Piece(values, '^', 2), 0);
119     cboTab.SelectByID(tab);
120     cboTab.Tag := strtointdef(tab, -1);
121     chkLastTab.Checked := last = 1;
122     chkLastTab.Tag := last;
123     cboTab.SetFocus;
124     rpcGetRangeForMeds(FstartDt, FstopDt);
125     if FstartDt > 1 then
126       dtStart.Text := FormatFMDateTime('mmm d, yyyy',FstartDt);
127     if FstopDt > 1 then
128       dtStop.Text  := FormatFMDateTime('mmm d, yyyy', FstopDt);
129     rpcGetRangeForEncs(FEncDefStartDays, FEncDefStopDays, True); // True gets params settings above User/Service level.
130     if FEncDefStartDays < 1 then
131       FEncDefStartDays := 0;
132     if FEncDefStopDays < 1 then
133       FEncDefStopDays := 0;
134     rpcGetRangeForEncs(FEncStartDays, FEncStopDays, False);      // False gets User/Service params.
135     if ((FEncStartDays < 0) and (FEncStartDays <> 0)) then
136       FEncStartDays := FEncDefStartDays;
137     txtEncStart.Text := IntToStr(FEncStartDays);
138     if ((FEncStopDays < 0) and (FEncStopDays <> 0)) then
139       FEncStopDays := FEncDefStopDays;
140     txtEncStop.Text := IntToStr(FEncStopDays);
141   end;
142   
143   procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
144   // opening tab^use last tab^autosave seconds^verify note title
145   var
146     values, theVal: string;
147   begin
148     OK2Closed := True;
149     values := '';
150     if cboTab.ItemIEN <> cboTab.Tag then
151       values := values + cboTab.ItemID;
152     values := values + '^';
153     if chkLastTab.Checked then
154       if chkLastTab.Tag <> 1 then
155         values := values + '1';
156     if not chkLastTab.Checked then
157       if chkLastTab.Tag <> 0 then
158         values := values + '0';
159     values := values + '^^';
160     rpcSetOther(values);
161      if (dtStart.Text = '') and (dtStop.Text = '') then
162       begin
163         if InfoBox('A date range is not set for the meds tab. Continue?', 'No Date Range Defined', MB_YESNO) = ID_NO then
164         begin
165            dtStart.SetFocus;
166            OK2Closed := false;
167            Exit;
168         end;
169       end
170     else if (dtStart.Text = '') or (dtStop.Text = '') then
171       begin
172         ShowMsg('A complete date range needs to be set. ');
173         if dtStart.Text = '' then dtStart.SetFocus
174         else dtStop.SetFocus;
175         OK2Closed := false;
176         Exit;
177       end;
178     //if Pos('Y', Uppercase(dtStart.Text))>0 then
179     if Uppercase(Copy(dtStart.Text, Length(dtStart.Text), Length(dtStart.Text))) = 'Y' then
180   
181       begin
182         ShowMsg('Start Date relative date cannot have a Y');
183         OK2Closed := false;
184         dtStart.SetFocus;
185         Exit;
186       end;
187     //if Pos('Y', Uppercase(dtStop.Text))>0 then
188     if Uppercase(Copy(dtStop.Text, Length(dtStop.Text), Length(dtStop.Text))) = 'Y' then
189       begin
190         ShowMsg('Stop Date relative date cannot have a Y');
191         OK2Closed := false;
192         dtStart.SetFocus;
193         Exit;
194       end;
195     if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
196     begin
197       if dtStop.FMDateTime < dtStart.FMDateTime then
198       begin
199         ShowMsg('The stop time can not prior to the start time.');
200         dtStop.FMDateTime := FMToday;
201         dtStop.SetFocus;
202         OK2Closed := false;
203         Exit;
204       end;
205       theVal := dtStart.RelativeTime + ';' + dtStop.RelativeTime;
206       rpcPutRangeForMeds(theVal);
207     end;
208     if (dtStart.Text = '') and (dtStop.Text = '') then
209       rpcPutRangeForMeds('');
210     rpcPutRangeForEncs(txtEncStart.Text, txtEncStop.Text);
211     if frmMeds <> nil then
212       frmMeds.RefreshMedLists;
213   end;
214   
215   procedure TfrmOptionsOther.FormCloseQuery(Sender: TObject;
216     var CanClose: Boolean);
217   begin
218     inherited;
219     CanClose := OK2Closed;
220     
221   end;
222   
223   procedure TfrmOptionsOther.FormCreate(Sender: TObject);
224   begin
225     FStartDT  := 0;
226     FStopDT   := 0;
227   end;
228   
229   procedure TfrmOptionsOther.dtStartExit(Sender: TObject);
230   begin
231     if dtStart.FMDateTime > FMToday then
232     begin
233       ShowMsg('Start time can not greater than today.');
234       dtStart.FMDateTime := FMToday;
235       dtStart.SetFocus;
236       Exit;
237     end;
238   end;
239   
240   procedure TfrmOptionsOther.dtStopExit(Sender: TObject);
241   begin
242     if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
243       if (dtStop.FMDateTime < dtStart.FMDateTime) then
244       begin
245         ShowMsg('Stop time can not prior to start time');
246         dtStop.FMDateTime := FMToday;
247         dtStop.SetFocus;
248         Exit;
249       end;
250   end;
251   
252   procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
253   begin
254    (* if (dtStart.FMDateTime > FMToday) then
255     begin
256       ShowMsg('Start time can not greater than today.');
257       dtStart.FMDateTime := FMToday;
258       dtStart.SetFocus;
259       Exit;
260     end;    *)
261   end;
262   
263   procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
264   begin
265   with txtEncStart do
266     begin
267       if Text = '' then
268         Exit;
269       if Text = ' ' then
270         Text := '0';
271       if StrToInt(Text) < 0 then
272         Text := '0';
273       if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
274         begin
275           Text := IntToStr(ENC_MAX_LIMIT);
276           Beep;
277           InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING);
278         end;
279     end;
280   end;
281   
282   procedure TfrmOptionsOther.txtEncStopChange(Sender: TObject);
283   begin
284   with txtEncStop do
285     begin
286       if Text = '' then
287         Exit;
288       if Text = ' ' then
289         Text := '0';
290       if StrToInt(Text) < 0 then
291         Text := '0';
292       if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
293         begin
294           Text := IntToStr(ENC_MAX_LIMIT);
295           Beep;
296           InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING);
297         end;
298     end;
299   end;
300   
301   procedure TfrmOptionsOther.txtEncStartExit(Sender: TObject);
302   begin
303   with txtEncStart do
304     if Text = '' then
305       Text := '0';
306   end;
307   
308   procedure TfrmOptionsOther.txtEncStopExit(Sender: TObject);
309   begin
310   with txtEncStart do
311     if Text = '' then
312       Text := '0';
313   end;
314   
315   procedure TfrmOptionsOther.btnCancelClick(Sender: TObject);
316   begin
317     inherited;
318     OK2Closed := True;
319   end;
320   
321   procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
322   begin
323   txtEncStart.Text := IntToStr(FEncDefStartDays);
324   txtEncStop.Text := IntToStr(FEncDefStopDays);
325   end;
326   
327   end.

Module Calls (2 levels)


fOptionsOther
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rOptions
 │ └rCore
 ├rCore...
 ├rSurgery
 │ ├rCore...
 │ ├uCore
 │ └uSurgery
 └fMeds
   ├fPage
   ├rOrders
   ├uConst
   ├rMeds
   ├uCore...
   ├fFrame
   ├fRptBox
   ├uOrders
   ├fODBase
   ├fOrdersDC
   ├fOrdersHold
   ├fOrdersUnhold
   ├fOrdersRenew
   ├fOrdersRefill
   ├fMedCopy
   ├fOrders
   ├rODBase
   └fActivateDeactivate

Module Called-By (2 levels)


fOptionsOther
   fOptions┘ 
   fFrame┘