source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fActivateDeactivate.pas@ 1704

Last change on this file since 1704 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 5.2 KB
Line 
1unit fActivateDeactivate;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, StrUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, fAutoSz, StdCtrls, ExtCtrls, ORCtrls,ORFn, rCore, uCore, oRNet, Math, fOrders, ORClasses, rOrders,
8 fMeds, rMeds, VA508AccessibilityManager;
9
10type
11 TfrmActivateDeactive = class(TfrmAutoSz)
12 TActivate: TButton;
13 TDeactive: TButton;
14 Memo1: TMemo;
15 TCancel: TButton;
16 procedure TActivateClick(Sender: TObject);
17 procedure TDeactiveClick(Sender: TObject);
18 procedure TCancelClick(Sender: TObject);
19 private
20 { Private declarations }
21 procedure GetOriginalOrders(OrderID: TStringList; var OriginalOrder: TORStringList);
22 procedure DCOriginalOrder(OrderID: string);
23 procedure BuildForm(Str1: String);
24 function PromptForm(Text: String): String;
25 public
26 { Public declarations }
27
28 procedure fActivateDeactive(OrderID: TStringList); overload;
29 procedure fActivateDeactive(OrderID: TStringList; AList: TListBox); overload;
30 end;
31
32var
33 frmActivateDeactive: TfrmActivateDeactive;
34 Act: Boolean;
35 Deact: Boolean;
36 CancelProcess: Boolean;
37
38implementation
39
40{$R *.dfm}
41
42{ TfrmActivateDeactive }
43
44procedure TfrmActivateDeactive.BuildForm(Str1: String);
45var
46 str: string;
47begin
48 with frmActivateDeactive do
49 begin
50 str := 'This order is in a pending status. If this pending order is discontinued, the original order will still be active.';
51 str := str + CRLF + CRLF + str1;
52 str := str + CRLF + CRLF + 'Click:';
53 str := str + CRLF + ' "DC BOTH" to discontinue both orders ';
54 str := str + CRLF + ' "DC Pending Order" to discontinue only the pending order and return the original order back to an active status ';
55 str := str + CRLF + ' "Cancel - No Action Taken" to stop the discontinue process ';
56 Memo1.ReadOnly := False;
57 Memo1.Text := str;
58 Memo1.ReadOnly := True;
59 end;
60 ResizeAnchoredFormToFont(frmActivateDeactive);
61 frmActivateDeactive.ShowModal;
62 frmActivateDeactive.Release;
63end;
64
65procedure TfrmActivateDeactive.fActivateDeactive(OrderID: TStringList);
66var
67i,Pos: integer;
68tmpArr: TORStringList;
69ActDeact: string;
70AnOrder: TOrder;
71begin
72 //called from order tab
73 tmpArr := TORStringList.Create;
74 GetOriginalOrders(OrderID,tmpArr);
75 with forders.frmOrders.lstOrders do for i := 0 to items.Count-1 do if Selected[i] then
76 begin
77 AnOrder := TOrder(Items.Objects[i]);
78 Pos := tmpArr.IndexOfPiece(AnOrder.ID,U,1);
79 if Pos > -1 then
80 begin
81 ActDeact := PromptForm(AnOrder.Text);
82 if ActDeact = 'D' then AnOrder.DCOriginalOrder := True;
83 if ActDeact = 'A' then AnOrder.DCOriginalOrder := False;
84 if ActDeact = 'C' then Selected[i] := False;
85 end;
86 end;
87end;
88
89procedure TfrmActivateDeactive.fActivateDeactive(OrderID: TStringList; AList: TListBox);
90var
91i,Pos: integer;
92tmpArr: TORStringList;
93ActDeact: String;
94AMed: TMedListRec;
95AnOrder: TOrder;
96begin
97 //called from Med tab
98 tmpArr := TORStringList.Create;
99 GetOriginalOrders(OrderID,tmpArr);
100 AnOrder := TOrder.Create;
101 with AList do for i := 0 to items.Count-1 do if Selected[i] then
102 begin
103 AMed := TMedListRec(Items.Objects[i]);
104 if AMed = nil then Continue;
105 Pos := tmpArr.IndexOfPiece(AMed.OrderID,U,1);
106 if Pos > -1 then
107 begin
108 ActDeact := PromptForm(Alist.Items.Strings[i]);
109 if ActDeact = 'D' then
110 begin
111 AnOrder := GetOrderByIFN(Piece(tmpArr.Strings[Pos],U,1));
112 DCOriginalOrder(AnOrder.ID);
113 //AnOrder.DCOriginalOrder := True;
114 end;
115 if ActDeact = 'A' then AnOrder.DCOriginalOrder := False;
116 if ActDeact = 'C' then Selected[i] := False;
117 end;
118 end;
119end;
120
121procedure TfrmActivateDeactive.GetOriginalOrders(OrderID: TStringList; var OriginalOrder: TORStringList);
122var
123i: integer;
124begin
125 CallV('ORWDX1 DCREN', [OrderID]);
126 for i := 0 to RPCBrokerV.Results.Count-1 do
127 OriginalOrder.Add(RPCBrokerV.Results.Strings[i]);
128end;
129
130function TfrmActivateDeactive.PromptForm(Text: String): String;
131begin
132 frmActivateDeactive := TfrmActivateDeactive.create(Application);
133 BuildForm(Text);
134 if Deact = True then Result := 'D';
135 if Act = True then Result := 'A';
136 if CancelProcess = True then Result := 'C';
137end;
138
139procedure TfrmActivateDeactive.TActivateClick(Sender: TObject);
140begin
141 inherited;
142 Act := True;
143 Deact := False;
144 CancelProcess := False;
145 frmActivateDeactive.Close;
146end;
147
148procedure TfrmActivateDeactive.TDeactiveClick(Sender: TObject);
149begin
150 inherited;
151 Act := False;
152 Deact := True;
153 CancelProcess := False;
154 frmActivateDeactive.Close;
155end;
156
157procedure TfrmActivateDeactive.TCancelClick(Sender: TObject);
158begin
159 inherited;
160 Act := False;
161 Deact := False;
162 CancelProcess := True;
163 frmActivateDeactive.Close;
164end;
165
166procedure TfrmActivateDeactive.DCOriginalOrder(OrderID: string);
167begin
168 CallV('ORWDX1 DCORIG', [OrderID]);
169end;
170
171end.
Note: See TracBrowser for help on using the repository browser.