source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptionsDays.pas@ 1784

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

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