source: cprs/branches/tmg-cprs/CPRS-Chart/fLabCollTimes.pas@ 1156

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

Initial upload of TMG-CPRS 1.0.26.69

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