Module

fLabCollTimes

Path

C:\CPRS\CPRS30\fLabCollTimes.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fBase508Form -

Units Used in Implementation

Name Comments
rCore -
rODLab -
uCore -

Classes

Name Comments
TfrmLabCollectTimes -

Procedures

Name Owner Declaration Scope Comments
calLabCollectChange TfrmLabCollectTimes procedure calLabCollectChange(Sender: TObject); Public/Published -
calMonthClick TfrmLabCollectTimes procedure calMonthClick(Sender: TObject); Public/Published -
calMonthKeyDown TfrmLabCollectTimes procedure calMonthKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cmdCancelClick TfrmLabCollectTimes procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmLabCollectTimes procedure cmdOKClick(Sender: TObject); Public/Published -
FormCreate TfrmLabCollectTimes procedure FormCreate(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
GetFutureLabTime - function GetFutureLabTime(ACollDate: TFMDateTime): string; Interfaced -


Module Source

1     unit fLabCollTimes;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ORCtrls, ORDtTm, ORFn, ExtCtrls, ComCtrls, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmLabCollectTimes = class(TfrmBase508Form)
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    
33    implementation
34    
35    uses
36      rCore, uCore, ORNet, rODLab;
37    
38    {$R *.DFM}
39    function GetFutureLabTime(ACollDate: TFMDateTime): string;
40    var
41      frmLabCollectTimes: TfrmLabCollectTimes;
42    begin
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;
56    end;
57    
58    procedure TfrmLabCollectTimes.calLabCollectChange(Sender: TObject);
59    begin
60      with lstLabColltimes do
61        begin
62          Clear;
63          GetLabTimesForDate(Items, calLabCollect.FMDateTime, Encounter.Location);
64          ItemIndex := 0;
65        end;
66    end;
67    
68    procedure TfrmLabCollectTimes.cmdOKClick(Sender: TObject);
69    begin
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 := '';
78    end;
79    
80    procedure TfrmLabCollectTimes.cmdCancelClick(Sender: TObject);
81    begin
82      FFutureLabCollTime := '';
83      Close;
84    end;
85    
86    procedure TfrmLabCollectTimes.calMonthClick(Sender: TObject);
87    begin
88      calLabCollect.FMDateTime := DateTimeToFMDateTime(calMonth.Date);
89      calMonth.SetFocus;
90    end;
91    
92    procedure TfrmLabCollectTimes.FormCreate(Sender: TObject);
93    begin
94      ResizeAnchoredFormToFont(self);
95    end;
96    
97    procedure TfrmLabCollectTimes.calMonthKeyDown(Sender: TObject;
98      var Key: Word; Shift: TShiftState);
99    begin
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;
106   end;
107   
108   end.

Module Calls (2 levels)


fLabCollTimes
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 └rODLab
   └uCore...

Module Called-By (2 levels)


        fLabCollTimes
             fODLab┤ 
          uOrders┤ │ 
fODLabOthCollSamp┘ │ 
           fODBBank┘ 
       uOrders...┘