Module

fRenewOutMed

Path

C:\CPRS\CPRS30\fRenewOutMed.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fAutoSz -
fBase508Form -
rODBase -
rODMeds -
rOrders -

Classes

Name Comments
TfrmRenewOutMed -

Procedures

Name Owner Declaration Scope Comments
cmdCancelClick TfrmRenewOutMed procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmRenewOutMed procedure cmdOKClick(Sender: TObject); Public/Published -
FormCreate TfrmRenewOutMed procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmRenewOutMed procedure FormShow(Sender: TObject); Public/Published -
VA508ComponentAccessibility1StateQuery TfrmRenewOutMed procedure VA508ComponentAccessibility1StateQuery(Sender: TObject; var Text: string); Public/Published -

Functions

Name Owner Declaration Scope Comments
ExecuteRenewOutMed - function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string; AnOrder: TOrder): Boolean; Interfaced -

Global Variables

Name Type Declaration Comments
MaxRefills Integer MaxRefills: Integer; -

Constants

Name Declaration Scope Comments
TC_ERR_REFILL 'Refills' Global -
TX_ERR_REFILL 'The number of refills must be in the range of 0 through ' Global -


Module Source

1     unit fRenewOutMed;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, Mask, ORCtrls, ExtCtrls, fBase508Form,
8       VA508AccessibilityManager, VA508AccessibilityRouter, rODBase, rODMeds;
9     
10    type
11      TfrmRenewOutMed = class(TfrmBase508Form)
12        memOrder: TCaptionMemo;
13        pnlButtons: TPanel;
14        cmdOK: TButton;
15        cmdCancel: TButton;
16        pnlMiddle: TPanel;
17        cboPickup: TORComboBox;
18        lblPickup: TLabel;
19        txtRefills: TCaptionEdit;
20        lblRefills: TLabel;
21        VA508ComponentAccessibility1: TVA508ComponentAccessibility;
22        procedure FormCreate(Sender: TObject);
23        procedure cmdOKClick(Sender: TObject);
24        procedure cmdCancelClick(Sender: TObject);
25        procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
26          var Text: string);
27        procedure FormShow(Sender: TObject);
28      private
29        OKPressed: Boolean;
30      end;
31    
32    function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
33      AnOrder: TOrder): Boolean;
34    
35    implementation
36    
37    {$R *.DFM}
38    
39    var
40     MaxRefills: Integer;
41    
42    const
43      TX_ERR_REFILL = 'The number of refills must be in the range of 0 through ';
44      TC_ERR_REFILL = 'Refills';
45    
46    function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
47      AnOrder: TOrder): Boolean;
48    var
49      frmRenewOutMed: TfrmRenewOutMed;
50      DestList: TList;
51      HasObject: Boolean;
52      i: Integer;
53      Drug, Days, OrID: string;
54    begin
55      Result := False;
56      DestList := TList.Create();
57      try
58        LoadResponses(DestList, 'X' + AnOrder.ID, HasObject);
59    
60        for I := 0 to DestList.Count - 1 do begin
61          if TResponse(DestList.Items[i]).PromptID = 'DRUG' then Drug := TResponse(DestList.Items[i]).IValue
62          else if TResponse(DestList.Items[i]).PromptID = 'SUPPLY' then Days := TResponse(DestList.Items[i]).IValue
63          else if TResponse(DestList.Items[i]).PromptID = 'ORDERABLE' then OrID := TResponse(DestList.Items[i]).IValue;
64        end;
65    
66        MaxRefills := CalcMaxRefills(Drug, StrToInt(Days), StrToInt(OrID), AnOrder.EventName = 'D');
67    
68      frmRenewOutMed := TfrmRenewOutMed.Create(Application);
69      try
70        ResizeFormToFont(TForm(frmRenewOutMed));
71        frmRenewOutMed.memOrder.SetTextBuf(PChar(AnOrder.Text));
72        frmRenewOutMed.txtRefills.Text := IntToStr(Refills);
73        frmRenewOutMed.cboPickup.SelectByID(Pickup);
74        frmRenewOutMed.ShowModal;
75        if frmRenewOutMed.OKPressed then
76        begin
77          Result := True;
78          Refills := StrToIntDef(frmRenewOutMed.txtRefills.Text, Refills);
79          Pickup := frmRenewOutMed.cboPickup.ItemID;
80        end;
81      finally
82       frmRenewOutMed.Release;
83      end;
84      finally
85        DestList.Free;
86      end;
87    end;
88    
89    procedure TfrmRenewOutMed.FormCreate(Sender: TObject);
90    begin
91      inherited;
92      OKPressed := False;
93      with cboPickup.Items do
94      begin
95        Add('W^at Window');
96        Add('M^by Mail');
97        Add('C^in Clinic');
98      end;
99    end;
100   
101   procedure TfrmRenewOutMed.FormShow(Sender: TObject);
102   begin
103     inherited;
104     if ScreenReaderSystemActive then
105     begin
106       memOrder.TabStop := true;
107       memOrder.SetFocus;
108     end;
109   end;
110   
111   procedure TfrmRenewOutMed.VA508ComponentAccessibility1StateQuery(
112     Sender: TObject; var Text: string);
113   begin
114     inherited;
115     Text := memOrder.Text;
116   end;
117   
118   procedure TfrmRenewOutMed.cmdOKClick(Sender: TObject);
119   var
120     NumRefills: Integer;
121   begin
122     inherited;
123     NumRefills := StrToIntDef(txtRefills.Text, -1);
124     if (NumRefills < 0) or (NumRefills > MaxRefills) then
125     begin
126       InfoBox(TX_ERR_REFILL + IntToStr(MaxRefills), TC_ERR_REFILL, MB_OK);
127       Exit;
128     end;
129     OKPressed := True;
130     Close;
131   end;
132   
133   procedure TfrmRenewOutMed.cmdCancelClick(Sender: TObject);
134   begin
135     inherited;
136     Close;
137   end;
138   
139   end.

Module Calls (2 levels)


fRenewOutMed
 ├rOrders
 │ ├uCore
 │ ├rCore
 │ ├uConst
 │ ├UBAGlobals
 │ └UBACore
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rODBase
 │ ├uCore...
 │ ├uConst
 │ ├rOrders...
 │ ├uOrders
 │ ├uODBase
 │ └fODBase
 └rODMeds
   ├uCore...
   └uConst

Module Called-By (2 levels)


  fRenewOutMed
fOrdersRenew┘ 
   fOrders┤   
     fMeds┘