source: cprs/branches/foia-cprs/CPRS-Chart/Options/fOptionsDays.pas@ 707

Last change on this file since 707 was 459, checked in by Kevin Toppenberg, 17 years ago

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