Module

fOrdersRefill

Path

C:\CPRS\CPRS30\Orders\fOrdersRefill.pas

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -

Units Used in Implementation

Name Comments
rMeds -
rMisc -
rOrders -
uConst -
uCore -

Classes

Name Comments
TfrmRefillOrders -

Procedures

Name Owner Declaration Scope Comments
cmdCancelClick TfrmRefillOrders procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmRefillOrders procedure cmdOKClick(Sender: TObject); Public/Published -
FormClose TfrmRefillOrders procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmRefillOrders procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmRefillOrders procedure FormShow(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
ExecuteRefillOrders - function ExecuteRefillOrders(SelectedList: TList): Boolean; Interfaced -


Module Source

1     unit fOrdersRefill;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager;
8     
9     type
10      TfrmRefillOrders = class(TfrmAutoSz)
11        pnlBottom: TPanel;
12        cmdOK: TButton;
13        cmdCancel: TButton;
14        grbPickUp: TGroupBox;
15        radWindow: TRadioButton;
16        radMail: TRadioButton;
17        radClinic: TRadioButton;
18        pnlClient: TPanel;
19        lstOrders: TCaptionListBox;
20        lblOrders: TLabel;
21        procedure FormCreate(Sender: TObject);
22        procedure cmdOKClick(Sender: TObject);
23        procedure cmdCancelClick(Sender: TObject);
24        procedure FormClose(Sender: TObject; var Action: TCloseAction);
25        procedure FormShow(Sender: TObject);
26      private
27        OKPressed: Boolean;
28        PickupAt: string;
29      end;
30    
31    function ExecuteRefillOrders(SelectedList: TList): Boolean;
32    
33    implementation
34    
35    {$R *.DFM}
36    
37    uses rOrders, rMeds, uCore, uConst, rMisc;
38    
39    function ExecuteRefillOrders(SelectedList: TList): Boolean;
40    var
41      frmRefillOrders: TfrmRefillOrders;
42      AnOrder: TOrder;
43      OriginalID: string;
44      i: Integer;
45    begin
46      Result := False;
47      if SelectedList.Count = 0 then Exit;
48      frmRefillOrders := TfrmRefillOrders.Create(Application);
49      try
50        ResizeAnchoredFormToFont(frmRefillOrders);
51        frmRefillOrders.Left := (Screen.WorkAreaWidth - frmRefillOrders.Width) div 2;
52        frmRefillOrders.Top := (Screen.WorkAreaHeight - frmRefillOrders.Height) div 2;
53        with SelectedList do for i := 0 to Count - 1 do
54          frmRefillOrders.lstOrders.Items.Add(TOrder(Items[i]).Text);
55        frmRefillOrders.ShowModal;
56        if frmRefillOrders.OKPressed then
57        begin
58          StatusText('Requesting Refill...');
59          with SelectedList do for i := 0 to Count - 1 do
60          begin
61            AnOrder := TOrder(Items[i]);
62            OriginalID := AnOrder.ID;
63            Refill(OriginalID, frmRefillOrders.PickupAt);
64            AnOrder.ActionOn := OriginalID + '=RF';
65            SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(Items[i]));
66          end;
67          Result := True;
68          StatusText('');
69        end;
70      finally
71        with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
72        frmRefillOrders.Release;
73      end;
74    end;
75    
76    procedure TfrmRefillOrders.FormCreate(Sender: TObject);
77    begin
78      inherited;
79      OKPressed := False;
80      PickupAt := PickUpDefault;
81      if PickupAt = 'M' then
82        radMail.Checked := true
83      else
84      if PickupAt = 'C' then
85        radClinic.Checked := true
86      else
87      begin
88        PickupAt := 'W';
89        radWindow.Checked := true;
90      end;
91    end;
92    
93    procedure TfrmRefillOrders.cmdOKClick(Sender: TObject);
94    const
95      TX_LOCATION_REQ = 'A location for the refill must be selected.';
96      TC_LOCATION_REQ = 'Missing Refill Location';
97    begin
98      inherited;
99      if not (radWindow.Checked or radMail.Checked or radClinic.Checked) then
100     begin
101       InfoBox(TX_LOCATION_REQ, TC_LOCATION_REQ, MB_OK);
102       Exit;
103     end;
104     OKPressed := True;
105     if radWindow.Checked then PickupAt := 'W'
106     else if radMail.Checked then PickupAt := 'M'
107     else PickupAt := 'C';
108     Close;
109   end;
110   
111   procedure TfrmRefillOrders.cmdCancelClick(Sender: TObject);
112   begin
113     inherited;
114     Close;
115   end;
116   
117   procedure TfrmRefillOrders.FormClose(Sender: TObject;
118     var Action: TCloseAction);
119   begin
120     SaveUserBounds(Self);
121   end;
122   
123   procedure TfrmRefillOrders.FormShow(Sender: TObject);
124   begin
125     SetFormPosition(Self);
126   end;
127   
128   end.

Module Calls (2 levels)


fOrdersRefill
 ├fAutoSz
 │ └fBase508Form
 ├rOrders
 │ ├uCore
 │ ├rCore
 │ ├uConst
 │ ├UBAGlobals
 │ └UBACore
 ├rMeds
 │ ├uCore...
 │ └uConst
 ├uConst
 └rMisc
   └fOrders

Module Called-By (2 levels)


    fOrdersRefill
          fMeds┘ 
      uOrders┤   
       fFrame┤   
      fOrders┤   
fOptionsOther┘