Module

fConsultBD

Path

C:\CPRS\CPRS30\Consults\fConsultBD.pas

Last Modified

7/15/2014 3:26:34 PM

Units Used in Interface

Name Comments
fBase508Form -
uConsults -

Units Used in Implementation

Name Comments
rConsults -
rCore -

Classes

Name Comments
TfrmConsultsByDate -

Procedures

Name Owner Declaration Scope Comments
calBeginDateKeyPress TfrmConsultsByDate procedure calBeginDateKeyPress(Sender: TObject; var Key: Char); Public/Published -
calEndDateKeyPress TfrmConsultsByDate procedure calEndDateKeyPress(Sender: TObject; var Key: Char); Public/Published -
cmdCancelClick TfrmConsultsByDate procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmConsultsByDate procedure cmdOKClick(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
SelectConsultDateRange - function SelectConsultDateRange(FontSize: Integer; CurrentContext: TSelectContext; var ConsultDateRange: TConsultDateRange): boolean; Interfaced Displays date range select form for progress Consults and returns a record of the selection

Constants

Name Declaration Scope Comments
TX_DATE_ERR 'Enter valid beginning and ending dates or press Cancel.' Global -
TX_DATE_ERR_CAP 'Error in Date Range' Global -


Module Source

1     unit fConsultBD;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
7       StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uConsults, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmConsultsByDate = class(TfrmBase508Form)
12        pnlBase: TORAutoPanel;
13        lblBeginDate: TLabel;
14        calBeginDate: TORDateBox;
15        lblEndDate: TLabel;
16        calEndDate: TORDateBox;
17        radSort: TRadioGroup;
18        cmdOK: TButton;
19        cmdCancel: TButton;
20        procedure cmdOKClick(Sender: TObject);
21        procedure cmdCancelClick(Sender: TObject);
22        procedure calBeginDateKeyPress(Sender: TObject; var Key: Char);
23        procedure calEndDateKeyPress(Sender: TObject; var Key: Char);
24      private
25        FChanged: Boolean;
26        FBeginDate: string;
27        FEndDate: string;
28        FAscending: Boolean;
29      end;
30    
31      TConsultDateRange = record
32        Changed: Boolean;
33        BeginDate: string;
34        EndDate: string;
35        Ascending: Boolean;
36      end;
37    
38    function SelectConsultDateRange(FontSize: Integer; CurrentContext: TSelectContext; var ConsultDateRange: TConsultDateRange): boolean;
39    
40    implementation
41    
42    {$R *.DFM}
43    
44    uses rCore, rConsults;
45    
46    const
47       TX_DATE_ERR = 'Enter valid beginning and ending dates or press Cancel.';
48       TX_DATE_ERR_CAP = 'Error in Date Range';
49    
50    function SelectConsultDateRange(FontSize: Integer; CurrentContext: TSelectContext; var ConsultDateRange: TConsultDateRange): boolean;
51    { displays date range select form for progress Consults and returns a record of the selection }
52    var
53      frmConsultsByDate: TfrmConsultsByDate;
54      W, H: Integer;
55      CurrentBegin, CurrentEnd: string;
56    begin
57      frmConsultsByDate := TfrmConsultsByDate.Create(Application);
58      try
59        with frmConsultsByDate do
60        begin
61          Font.Size := FontSize;
62          W := ClientWidth;
63          H := ClientHeight;
64          ResizeToFont(FontSize, W, H);
65          ClientWidth  := W; pnlBase.Width  := W;
66          ClientHeight := H; pnlBase.Height := H;
67          FChanged := False;
68          with radSort do {if SortConsultsAscending then ItemIndex := 0 else} ItemIndex := 1;
69          CurrentBegin := CurrentContext.BeginDate;
70          CurrentEnd := CurrentContext.EndDate;
71          if CurrentBegin <> '' then
72            calBeginDate.Text := CurrentBegin;
73          if CurrentEnd <> '' then
74            calEndDate.Text := CurrentEnd;
75          if calEndDate.Text = '' then calEndDate.Text := 'TODAY';
76          ShowModal;
77          with ConsultDateRange do
78          begin
79            Changed := FChanged;
80            BeginDate := FBeginDate;
81            EndDate := FEndDate;
82            Ascending := FAscending;
83            Result := Changed ;
84          end; {with ConsultDateRange}
85        end; {with frmConsultsByDate}
86      finally
87        frmConsultsByDate.Release;
88      end;
89    end;
90    
91    procedure TfrmConsultsByDate.cmdOKClick(Sender: TObject);
92    var
93      bdate, edate: TFMDateTime;
94    begin
95      bdate := StrToFMDateTime(calBeginDate.Text);
96      edate   := StrToFMDateTime(calEndDate.Text);
97      if ((bdate > 0) and (edate > 0)) and (bdate <= edate) then
98      begin
99        FChanged := True;
100       FBeginDate := calBeginDate.Text;
101       FEndDate := calEndDate.Text;
102       FAscending := radSort.ItemIndex = 0;
103       Close;
104     end else
105     begin
106       InfoBox(TX_DATE_ERR, TX_DATE_ERR_CAP, MB_OK or MB_ICONWARNING);
107       Exit;
108     end;
109   end;
110   
111   procedure TfrmConsultsByDate.cmdCancelClick(Sender: TObject);
112   begin
113     Close;
114   end;
115   
116   procedure TfrmConsultsByDate.calBeginDateKeyPress(Sender: TObject;
117     var Key: Char);
118   begin
119     if (Key = #13) then cmdOKClick(Self);
120   end;
121   
122   procedure TfrmConsultsByDate.calEndDateKeyPress(Sender: TObject;
123     var Key: Char);
124   begin
125     if (Key = #13) then cmdOKClick(Self);
126   end;
127   
128   end.

Module Calls (2 levels)


fConsultBD
 ├uConsults
 │ └uConst
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 └rCore
   └uCore

Module Called-By (2 levels)


         fConsultBD
        fConsults┘ 
         fFrame┤   
         fNotes┤   
     fPrintList┤   
fReminderDialog┤   
        fReview┤   
       fSurgery┤   
    fConsultAct┤   
      fCsltNote┘