source: cprs/trunk/CPRS-Chart/fActivateDeactivate.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: 5.8 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;
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 BuildForm(Str1: String);
23 function PromptForm(Text: String): String;
24 public
25 { Public declarations }
26
27 procedure fActivateDeactive(OrderID: TStringList); overload;
28 procedure fActivateDeactive(OrderID: TStringList; AList: TListBox); overload;
29 end;
30
31var
32 frmActivateDeactive: TfrmActivateDeactive;
33 Act: Boolean;
34 Deact: Boolean;
35 CancelProcess: Boolean;
36
37implementation
38
39{$R *.dfm}
40
41{ TfrmActivateDeactive }
42
43procedure TfrmActivateDeactive.BuildForm(Str1: String);
44var
45 str: string;
46begin
47 with frmActivateDeactive do
48 begin
49 str := 'This order ' + str1 +' is currently in a pending status. ';
50 str := str + CRLF + 'If this order is discontinued, the original order status will be changed to active, unless it is discontinued.';
51 str := str + CRLF + CRLF + 'Click:';
52 str := str + CRLF + ' "Yes" to discontinue the original order';
53 str := str + CRLF + ' "No" to change the status to active';
54 str := str + CRLF + ' "Cancel" to stop the discontinue process for this order';
55 Memo1.ReadOnly := False;
56 Memo1.Text := str;
57 Memo1.ReadOnly := True;
58 end;
59 ResizeAnchoredFormToFont(frmActivateDeactive);
60 frmActivateDeactive.ShowModal;
61 frmActivateDeactive.Release;
62end;
63
64procedure TfrmActivateDeactive.fActivateDeactive(OrderID: TStringList);
65var
66i,j,Pos: integer;
67tmpArr: TORStringList;
68ActDeact: string;
69AnOrder,AnOrder1: TOrder;
70begin
71 //called from order tab
72 tmpArr := TORStringList.Create;
73 GetOriginalOrders(OrderID,tmpArr);
74 with forders.frmOrders.lstOrders do for i := 0 to items.Count-1 do if Selected[i] then
75 begin
76 AnOrder := TOrder(Items.Objects[i]);
77 Pos := tmpArr.IndexOfPiece(AnOrder.ID,U,1);
78 if Pos > -1 then
79 begin
80 ActDeact := PromptForm(AnOrder.Text);
81 if ActDeact = 'D' then
82 begin
83 for j := 0 to forders.frmOrders.lstOrders.Items.Count-1 do
84 begin
85 AnOrder1 := TOrder(forders.frmOrders.lstOrders.Items.Objects[j]);
86 if AnOrder1.ID = Piece(tmpArr.Strings[Pos],U,2) then
87 forders.frmOrders.lstOrders.Selected[j] := True;
88 end;
89 end;
90 if ActDeact = 'C' then Selected[i] := False;
91 end;
92 end;
93end;
94
95procedure TfrmActivateDeactive.fActivateDeactive(OrderID: TStringList; AList: TListBox);
96var
97i,j,Pos: integer;
98tmpArr: TORStringList;
99ActDeact: String;
100AMed,AMed1: TMedListRec;
101begin
102 //called from Med tab
103 tmpArr := TORStringList.Create;
104 GetOriginalOrders(OrderID,tmpArr);
105 with AList do for i := 0 to items.Count-1 do if Selected[i] then
106 begin
107 AMed := TMedListRec(Items.Objects[i]);
108 Pos := tmpArr.IndexOfPiece(AMed.OrderID,U,1);
109 if Pos > -1 then
110 begin
111 ActDeact := PromptForm(Alist.Items.Strings[i]);
112 if ActDeact = 'D' then
113 begin
114 for j := 0 to Alist.Items.Count-1 do
115 begin
116 AMed1 := TMedListRec(Alist.Items.Objects[j]);
117 if AMed1.OrderID = Piece(tmpArr.Strings[Pos],U,2) then
118 begin
119 Alist.Selected[j] := True;
120 break;
121 end;
122 //some med orders may not have an action defined tends to be renew order of orders that were renew from another
123 //order and outpatient orders
124 if (AMed1.OrderID = Piece(Piece(tmpArr.Strings[Pos],U,2),';',1)) then
125 begin
126 Alist.Selected[j] := True;
127 break;
128 end;
129
130 end;
131 end;
132 if ActDeact = 'C' then Selected[i] := False;
133 end;
134 end;
135end;
136
137procedure TfrmActivateDeactive.GetOriginalOrders(OrderID: TStringList; var OriginalOrder: TORStringList);
138var
139i: integer;
140begin
141 CallV('ORWDX1 DCREN', [OrderID]);
142 for i := 0 to RPCBrokerV.Results.Count-1 do
143 OriginalOrder.Add(RPCBrokerV.Results.Strings[i]);
144end;
145
146function TfrmActivateDeactive.PromptForm(Text: String): String;
147begin
148 frmActivateDeactive := TfrmActivateDeactive.create(Application);
149 BuildForm(Text);
150 if Deact = True then Result := 'D';
151 if Act = True then Result := 'A';
152 if CancelProcess = True then Result := 'C';
153end;
154
155procedure TfrmActivateDeactive.TActivateClick(Sender: TObject);
156begin
157 inherited;
158 Act := True;
159 Deact := False;
160 CancelProcess := False;
161 frmActivateDeactive.Close;
162end;
163
164procedure TfrmActivateDeactive.TDeactiveClick(Sender: TObject);
165begin
166 inherited;
167 Act := False;
168 Deact := True;
169 CancelProcess := False;
170 frmActivateDeactive.Close;
171end;
172
173procedure TfrmActivateDeactive.TCancelClick(Sender: TObject);
174begin
175 inherited;
176 Act := False;
177 Deact := False;
178 CancelProcess := True;
179 frmActivateDeactive.Close;
180end;
181
182end.
Note: See TracBrowser for help on using the repository browser.