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

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

Upgrading to version 27

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