source: cprs/trunk/CPRS-Chart/Options/fOptionsDays.pas@ 837

Last change on this file since 837 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27
File size: 12.0 KB
Line 
1unit fOptionsDays;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, fOptions, ComCtrls, OrFn, ORCtrls, fBase508Form,
8 VA508AccessibilityManager;
9
10type
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
68var
69 frmOptionsDays: TfrmOptionsDays;
70
71procedure DialogOptionsDays(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
72
73implementation
74
75uses rOptions, uOptions;
76
77{$R *.DFM}
78
79procedure DialogOptionsDays(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
80// create the form and make it modal, return an action
81var
82 frmOptionsDays: TfrmOptionsDays;
83begin
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;
104end;
105
106procedure TfrmOptionsDays.FormCreate(Sender: TObject);
107begin
108 FStartEntered := false;
109 FStopEntered := false;
110end;
111
112procedure 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
116var
117 labin, labout, visitstart, visitstop: integer;
118 labindef, laboutdef, visitstartdef, visitstopdef: integer;
119begin
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;
143end;
144
145procedure TfrmOptionsDays.spnVisitStartClick(Sender: TObject;
146 Button: TUDBtnType);
147var
148 tagnum: integer;
149begin
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;
184end;
185
186procedure TfrmOptionsDays.spnVisitStopClick(Sender: TObject;
187 Button: TUDBtnType);
188var
189 tagnum: integer;
190begin
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;
230end;
231
232procedure TfrmOptionsDays.spnLabInpatientClick(Sender: TObject;
233 Button: TUDBtnType);
234begin
235 // txtLabInpatient.SetFocus; cq:13554
236 txtLabInpatient.Tag := strtointdef(txtLabInpatient.Text, 0);
237 btnLabDefaults.Tag := 0;
238 AdjustLabLabel;
239end;
240
241procedure TfrmOptionsDays.spnLabOutpatientClick(Sender: TObject;
242 Button: TUDBtnType);
243begin
244 //txtLabOutpatient.SetFocus; cq:13554
245 txtLabOutpatient.Tag := strtointdef(txtLabOutpatient.Text, 0);
246 btnLabDefaults.Tag := 0;
247 AdjustLabLabel;
248end;
249
250procedure TfrmOptionsDays.txtLabInpatientKeyPress(Sender: TObject;
251 var Key: Char);
252begin
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;
263end;
264
265procedure TfrmOptionsDays.btnLabDefaultsClick(Sender: TObject);
266begin
267 txtLabInpatient.Text := inttostr(spnLabInpatient.Tag);
268 spnLabInpatientClick(self, btNext);
269 txtLabOutpatient.Text := inttostr(spnLabOutpatient.Tag);
270 spnLabOutpatientClick(self, btNext);
271 btnLabDefaults.Tag := 1;
272end;
273
274procedure TfrmOptionsDays.btnVisitDefaultsClick(Sender: TObject);
275begin
276 txtVisitStart.Tag := spnVisitStart.Tag - 1;
277 spnVisitStartClick(self, btNext);
278 txtVisitStop.Tag := spnVisitStop.Tag - 1;
279 spnVisitStopClick(self, btNext);
280 btnVisitDefaults.Tag := 1;
281end;
282
283procedure TfrmOptionsDays.AdjustVisitLabel;
284var
285 start, stop: string;
286begin
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 + '.'
293end;
294
295procedure TfrmOptionsDays.AdjustLabLabel;
296begin
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.';
300end;
301
302procedure TfrmOptionsDays.btnOKClick(Sender: TObject);
303begin
304 rpcSetDays(txtLabInpatient.Tag, txtLabOutpatient.Tag, txtVisitStart.Tag, txtVisitStop.Tag);
305end;
306
307procedure TfrmOptionsDays.txtLabInpatientChange(Sender: TObject);
308var
309 maxvalue: integer;
310begin
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);
323end;
324
325procedure TfrmOptionsDays.txtLabInpatientExit(Sender: TObject);
326begin
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;
340end;
341
342procedure TfrmOptionsDays.txtLabOutpatientChange(Sender: TObject);
343var
344 maxvalue: integer;
345begin
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);
358end;
359
360procedure TfrmOptionsDays.txtLabOutpatientExit(Sender: TObject);
361begin
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;
375end;
376
377procedure TfrmOptionsDays.txtVisitStartExit(Sender: TObject);
378begin
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;
388end;
389
390procedure TfrmOptionsDays.txtVisitStartKeyUp(Sender: TObject;
391 var Key: Word; Shift: TShiftState);
392begin
393 txtVisitStart.Hint := txtVisitStart.Text; // put text in hint since text not available to spin
394 FStartEntered := true;
395end;
396
397procedure TfrmOptionsDays.txtVisitStopExit(Sender: TObject);
398begin
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;
408end;
409
410procedure TfrmOptionsDays.txtVisitStopKeyUp(Sender: TObject; var Key: Word;
411 Shift: TShiftState);
412begin
413 txtVisitStop.Hint := txtVisitStop.Text; // put text in hint since text not available to spin
414 FStopEntered := true;
415end;
416
417procedure TfrmOptionsDays.txtVisitStartKeyPress(Sender: TObject;
418 var Key: Char);
419begin
420 if key = #13 then
421 begin
422 FStartEntered := true;
423 Perform(WM_NextDlgCtl, 0, 0);
424 end;
425end;
426
427procedure TfrmOptionsDays.txtVisitStopKeyPress(Sender: TObject;
428 var Key: Char);
429begin
430 if key = #13 then
431 begin
432 FStopEntered := true;
433 Perform(WM_NextDlgCtl, 0, 0);
434 end;
435end;
436
437end.
Note: See TracBrowser for help on using the repository browser.