source: cprs/trunk/CPRS-Chart/fLabCollTimes.pas@ 601

Last change on this file since 601 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76

File size: 2.7 KB
Line 
1unit fLabCollTimes;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORCtrls, ORDtTm, ORFn, ExtCtrls, ComCtrls;
8
9type
10 TfrmLabCollectTimes = class(TForm)
11 calLabCollect: TORDateBox;
12 lstLabCollTimes: TORListBox;
13 cmdOK: TButton;
14 cmdCancel: TButton;
15 lblFutureTimes: TMemo;
16 calMonth: TMonthCalendar;
17 procedure calLabCollectChange(Sender: TObject);
18 procedure cmdOKClick(Sender: TObject);
19 procedure cmdCancelClick(Sender: TObject);
20 procedure calMonthClick(Sender: TObject);
21 procedure FormCreate(Sender: TObject);
22 procedure calMonthKeyDown(Sender: TObject; var Key: Word;
23 Shift: TShiftState);
24 private
25 FFutureLabCollTime: string;
26 public
27 { Public declarations }
28 end;
29
30 function GetFutureLabTime(ACollDate: TFMDateTime): string;
31
32implementation
33
34uses
35 rCore, uCore, ORNet, rODLab;
36
37{$R *.DFM}
38function GetFutureLabTime(ACollDate: TFMDateTime): string;
39var
40 frmLabCollectTimes: TfrmLabCollectTimes;
41begin
42 frmLabCollectTimes := TfrmLabCollectTimes.Create(Application);
43 try
44 with frmLabCollectTimes do
45 begin
46 calLabCollect.FMDateTime := Trunc(ACollDate);
47 calMonth.Date := FMDateTimeToDateTime(calLabCollect.FMDateTime);
48 FFutureLabCollTime := '';
49 ShowModal;
50 Result := FFutureLabCollTime;
51 end; {with frmLabCollectTimes}
52 finally
53 frmLabCollectTimes.Release;
54 end;
55end;
56
57procedure TfrmLabCollectTimes.calLabCollectChange(Sender: TObject);
58begin
59 with lstLabColltimes do
60 begin
61 Clear;
62 GetLabTimesForDate(Items, calLabCollect.FMDateTime, Encounter.Location);
63 ItemIndex := 0;
64 end;
65end;
66
67procedure TfrmLabCollectTimes.cmdOKClick(Sender: TObject);
68begin
69 if lstLabCollTimes.ItemIEN > 0 then
70 begin
71 with calLabCollect, lstLabCollTimes do
72 FFutureLabCollTime := RelativeTime + '@' + ItemID;
73 Close;
74 end
75 else
76 FFutureLabCollTime := '';
77end;
78
79procedure TfrmLabCollectTimes.cmdCancelClick(Sender: TObject);
80begin
81 FFutureLabCollTime := '';
82 Close;
83end;
84
85procedure TfrmLabCollectTimes.calMonthClick(Sender: TObject);
86begin
87 calLabCollect.FMDateTime := DateTimeToFMDateTime(calMonth.Date);
88 calMonth.SetFocus;
89end;
90
91procedure TfrmLabCollectTimes.FormCreate(Sender: TObject);
92begin
93 ResizeAnchoredFormToFont(self);
94end;
95
96procedure TfrmLabCollectTimes.calMonthKeyDown(Sender: TObject;
97 var Key: Word; Shift: TShiftState);
98begin
99 case Key of
100 VK_LEFT: calMonth.Date := calMonth.Date - 1;
101 VK_RIGHT: calMonth.Date := calMonth.Date + 1;
102 VK_UP: calMonth.Date := calMonth.Date - 7;
103 VK_DOWN: calMonth.Date := calMonth.Date + 7;
104 end;
105end;
106
107end.
Note: See TracBrowser for help on using the repository browser.