source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fODLabImmedColl.pas@ 1727

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

Upgrade to version 27

File size: 2.8 KB
Line 
1unit fODLabImmedColl;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORCtrls, ORDtTm, ExtCtrls, ORFn, fBase508Form,
8 VA508AccessibilityManager;
9
10type
11 TfrmODLabImmedColl = class(TfrmBase508Form)
12 memImmedCollect: TCaptionMemo;
13 calImmedCollect: TORDateBox;
14 cmdOK: TORAlignButton;
15 cmdCancel: TORAlignButton;
16 pnlBase: TORAutoPanel;
17 lblImmedColl: TOROffsetLabel;
18 procedure cmdCancelClick(Sender: TObject);
19 procedure cmdOKClick(Sender: TObject);
20 procedure FormShow(Sender: TObject);
21 procedure calImmedCollectKeyUp(Sender: TObject; var Key: Word;
22 Shift: TShiftState);
23 private
24 FCollTime: string;
25 { Private declarations }
26 public
27 { Public declarations }
28 end;
29
30function SelectImmediateCollectTime(FontSize: integer; CollTime: string): string;
31
32implementation
33
34{$R *.DFM}
35
36uses rODLab;
37
38const
39 TX_NOTIME_TEXT = 'Enter or select a collection time or press Cancel.';
40 TX_NOTIME_CAP = 'Missing Date/Time';
41 TX_BADTIME_CAP = 'Invalid Immediate Collect Time';
42
43function SelectImmediateCollectTime(FontSize: integer; CollTime: string): string;
44{ displays select form for immediate collect time and returns a record of the selection }
45var
46 frmODLabImmedColl: TfrmODLabImmedColl;
47begin
48 frmODLabImmedColl := TfrmODLabImmedColl.Create(Application);
49 try
50 ResizeAnchoredFormToFont(frmODLabImmedColl);
51 with frmODLabImmedColl do
52 begin
53 FCollTime := CollTime;
54 ShowModal;
55 Result := FCollTime;
56 end;
57 finally
58 frmODLabImmedColl.Release;
59 end;
60end;
61
62procedure TfrmODLabImmedColl.cmdCancelClick(Sender: TObject);
63begin
64 FCollTime := '-1' ;
65 Close;
66end;
67
68procedure TfrmODLabImmedColl.cmdOKClick(Sender: TObject);
69var
70 x: string;
71begin
72 if calImmedCollect.FMDateTime = 0 then
73 begin
74 InfoBox(TX_NOTIME_TEXT, TX_NOTIME_CAP, MB_OK or MB_ICONWARNING);
75 Exit;
76 end;
77 if calImmedCollect.FMDateTime > 0 then
78 begin
79 x := ValidImmCollTime(calImmedCollect.FMDateTime);
80 if Piece(x ,U, 1) = '1' then
81 FCollTime := calImmedCollect.Text
82 else
83 begin
84 InfoBox(MixedCase(Piece(x ,U, 2)), TX_BADTIME_CAP, MB_OK or MB_ICONWARNING);
85 Exit;
86 end;
87 end
88 else
89 FCollTime := '-1';
90 Close;
91end;
92
93
94procedure TfrmODLabImmedColl.FormShow(Sender: TObject);
95begin
96 FastAssign(ImmediateCollectTimes, memImmedCollect.Lines);
97 if Length(FCollTime) > 0 then
98 calImmedCollect.Text := FCollTime
99 else
100 calImmedCollect.FMDateTime := GetDefaultImmCollTime;
101 ActiveControl := calImmedCollect;
102end;
103
104procedure TfrmODLabImmedColl.calImmedCollectKeyUp(Sender: TObject;
105 var Key: Word; Shift: TShiftState);
106begin
107 if Key = VK_ESCAPE then
108 begin
109 Key := 0;
110 cmdCancelClick(cmdCancel);
111 end;
112end;
113
114end.
Note: See TracBrowser for help on using the repository browser.