source: cprs/trunk/CPRS-Chart/Options/fOptionsOther.pas@ 1684

Last change on this file since 1684 was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28
File size: 9.2 KB
Line 
1unit fOptionsOther;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, ComCtrls, ORCtrls, ORFn, rOrders, uCore, ORDtTm, fBase508Form,
8 VA508AccessibilityManager;
9
10type
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
63var
64 frmOptionsOther: TfrmOptionsOther;
65
66const
67 ENC_MAX_LIMIT = 999;
68
69procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
70
71implementation
72
73{$R *.DFM}
74
75uses
76 rOptions, uOptions, rCore, rSurgery, uConst, fMeds, VAUtils;
77
78procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
79// create the form and make it modal, return an action
80var
81 frmOptionsOther: TfrmOptionsOther;
82begin
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;
103end;
104
105procedure TfrmOptionsOther.FormShow(Sender: TObject);
106// displays defaults
107// opening tab^use last tab^autosave seconds^verify note title
108var
109 last: integer;
110 values, tab: string;
111begin
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);
141end;
142
143procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
144// opening tab^use last tab^autosave seconds^verify note title
145var
146 values, theVal: string;
147begin
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;
213end;
214
215procedure TfrmOptionsOther.FormCloseQuery(Sender: TObject;
216 var CanClose: Boolean);
217begin
218 inherited;
219 CanClose := OK2Closed;
220
221end;
222
223procedure TfrmOptionsOther.FormCreate(Sender: TObject);
224begin
225 FStartDT := 0;
226 FStopDT := 0;
227end;
228
229procedure TfrmOptionsOther.dtStartExit(Sender: TObject);
230begin
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;
238end;
239
240procedure TfrmOptionsOther.dtStopExit(Sender: TObject);
241begin
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;
250end;
251
252procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
253begin
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; *)
261end;
262
263procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
264begin
265with 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;
280end;
281
282procedure TfrmOptionsOther.txtEncStopChange(Sender: TObject);
283begin
284with 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;
299end;
300
301procedure TfrmOptionsOther.txtEncStartExit(Sender: TObject);
302begin
303with txtEncStart do
304 if Text = '' then
305 Text := '0';
306end;
307
308procedure TfrmOptionsOther.txtEncStopExit(Sender: TObject);
309begin
310with txtEncStart do
311 if Text = '' then
312 Text := '0';
313end;
314
315procedure TfrmOptionsOther.btnCancelClick(Sender: TObject);
316begin
317 inherited;
318 OK2Closed := True;
319end;
320
321procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
322begin
323txtEncStart.Text := IntToStr(FEncDefStartDays);
324txtEncStop.Text := IntToStr(FEncDefStopDays);
325end;
326
327end.
Note: See TracBrowser for help on using the repository browser.