source: cprs/trunk/CPRS-Chart/Orders/fOrdersRefill.pas@ 730

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

Initial Upload of Official WV CPRS 1.0.26.76

File size: 3.3 KB
RevLine 
[456]1unit fOrdersRefill;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
8
9type
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
31function ExecuteRefillOrders(SelectedList: TList): Boolean;
32
33implementation
34
35{$R *.DFM}
36
37uses rOrders, rMeds, uCore, uConst, rMisc;
38
39function ExecuteRefillOrders(SelectedList: TList): Boolean;
40var
41 frmRefillOrders: TfrmRefillOrders;
42 AnOrder: TOrder;
43 OriginalID: string;
44 i: Integer;
45begin
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;
74end;
75
76procedure TfrmRefillOrders.FormCreate(Sender: TObject);
77begin
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;
91end;
92
93procedure TfrmRefillOrders.cmdOKClick(Sender: TObject);
94const
95 TX_LOCATION_REQ = 'A location for the refill must be selected.';
96 TC_LOCATION_REQ = 'Missing Refill Location';
97begin
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;
109end;
110
111procedure TfrmRefillOrders.cmdCancelClick(Sender: TObject);
112begin
113 inherited;
114 Close;
115end;
116
117procedure TfrmRefillOrders.FormClose(Sender: TObject;
118 var Action: TCloseAction);
119begin
120 SaveUserBounds(Self);
121end;
122
123procedure TfrmRefillOrders.FormShow(Sender: TObject);
124begin
125 SetFormPosition(Self);
126end;
127
128end.
Note: See TracBrowser for help on using the repository browser.