source: cprs/branches/tmg-cprs/CPRS-Chart/fActivateDeactivate.pas@ 1806

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

Initial upload of TMG-CPRS 1.0.26.69

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