source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrdersRefill.pas@ 1682

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

Initial upload of TMG-CPRS 1.0.26.69

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