close Warning: Can't use blame annotator: 
svn blame failed on cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrdersRelease.pas: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrdersRelease.pas@ 859

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 10.2 KB
RevLine 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOrdersRelease;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, UBACore, UBAGlobals, DKLang;
9
10type
11 TfrmReleaseOrders = class(TfrmAutoSz)
12 Panel1: TPanel;
13 lstOrders: TCaptionListBox;
14 Label1: TLabel;
15 Panel2: TPanel;
16 grpRelease: TGroupBox;
17 radVerbal: TRadioButton;
18 radPhone: TRadioButton;
19 radPolicy: TRadioButton;
20 cmdOK: TButton;
21 cmdCancel: TButton;
22 procedure FormCreate(Sender: TObject);
23 procedure cmdOKClick(Sender: TObject);
24 procedure cmdCancelClick(Sender: TObject);
25 procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
26 Rect: TRect; State: TOwnerDrawState);
27 procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
28 var AHeight: Integer);
29 procedure Panel1Resize(Sender: TObject);
30 private
31 FOrderList: TList;
32 FNature: Char;
33 FSigSts: Char;
34 OKPressed: Boolean;
35 ESCode: string;
36 end;
37
38function ExecuteReleaseOrders(SelectedList: TList): Boolean;
39
40implementation
41
42{$R *.DFM}
43
44uses Hash, rCore, rOrders, uConst, fSignItem, fOrdersPrint, uCore, uOrders, fRptBox,
45 fFrame, fClinicWardMeds;
46
47//const
48//TX_SAVERR1 = 'The error, '; <-- original line. //kt 8/8/2007
49//TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF; <-- original line. //kt 8/8/2007
50//TC_SAVERR = 'Error Saving Order'; <-- original line. //kt 8/8/2007
51//TX_ES_REQ = 'Enter your electronic signature to release these orders.'; <-- original line. //kt 8/8/2007
52//TC_ES_REQ = 'Electronic Signature'; <-- original line. //kt 8/8/2007
53//TX_NO_REL = CRLF + CRLF + '- cannot be released to the service(s).' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007
54//TC_NO_REL = 'Unable to Release Orders'; <-- original line. //kt 8/8/2007
55
56var
57 TX_SAVERR1 : string; //kt
58 TX_SAVERR2 : string; //kt
59 TC_SAVERR : string; //kt
60 TX_ES_REQ : string; //kt
61 TC_ES_REQ : string; //kt
62 TX_NO_REL : string; //kt
63 TC_NO_REL : string; //kt
64
65procedure SetupVars;
66//kt Added entire function to replace constant declarations 8/8/2007
67begin
68 TX_SAVERR1 := DKLangConstW('fOrdersRelease_The_errorx');
69 TX_SAVERR2 := DKLangConstW('fOrdersRelease_x_occurred_while_trying_to_savex') + CRLF + CRLF;
70 TC_SAVERR := DKLangConstW('fOrdersRelease_Error_Saving_Order');
71 TX_ES_REQ := DKLangConstW('fOrdersRelease_Enter_your_electronic_signature_to_release_these_ordersx');
72 TC_ES_REQ := DKLangConstW('fOrdersRelease_Electronic_Signature');
73 TX_NO_REL := CRLF + CRLF + DKLangConstW('fOrdersRelease_x_cannot_be_released_to_the_servicexsxx') + CRLF + CRLF + DKLangConstW('fOrdersRelease_Reasonx');
74 TC_NO_REL := DKLangConstW('fOrdersRelease_Unable_to_Release_Orders');
75end;
76
77function ExecuteReleaseOrders(SelectedList: TList): Boolean;
78var
79 frmReleaseOrders: TfrmReleaseOrders;
80 i, PrintLoc: Integer;
81 SignList: TStringList;
82 OrderText: string;
83 AnOrder: TOrder;
84
85 function FindOrderText(const AnID: string): string;
86 var
87 i: Integer;
88 begin
89 Result := '';
90 with SelectedList do for i := 0 to Count - 1 do
91 with TOrder(Items[i]) do if ID = AnID then
92 begin
93 Result := Text;
94 Break;
95 end;
96 end;
97
98 function SignNotRequired: Boolean;
99 var
100 i: Integer;
101 begin
102 Result := True;
103 with SelectedList do for i := 0 to Pred(Count) do
104 begin
105 with TOrder(Items[i]) do if Signature <> OSS_NOT_REQUIRE then Result := False;
106 end;
107 end;
108
109
110begin
111 SetupVars; //kt added 8/8/2007 to replace constants with vars.
112 Result := False;
113 PrintLoc := 0;
114 if SelectedList.Count = 0 then Exit;
115 frmReleaseOrders := TfrmReleaseOrders.Create(Application);
116 try
117 ResizeFormToFont(TForm(frmReleaseOrders));
118 frmReleaseOrders.FOrderList := SelectedList;
119 with SelectedList do for i := 0 to Count - 1 do
120 frmReleaseOrders.lstOrders.Items.Add(TOrder(Items[i]).Text);
121 if SignNotRequired then frmReleaseOrders.grpRelease.Visible := False;
122 frmReleaseOrders.ShowModal;
123 if frmReleaseOrders.OKPressed then
124 begin
125 Result := True;
126 SignList := TStringList.Create;
127 try
128 with SelectedList, frmReleaseOrders do
129 for i := 0 to Count - 1 do
130 begin
131 AnOrder := TOrder(Items[i]);
132 SignList.Add(AnOrder.ID + U + FSigSts + U + RS_RELEASE + U + FNature);
133 end;
134// StatusText('Sending Orders to Service(s)...'); <-- original line. //kt 8/8/2007
135 StatusText(DKLangConstW('fOrdersRelease_Sending_Orders_to_Servicexsxxxx')); //kt added 8/8/2007
136 if SignList.Count > 0 then SendOrders(SignList, frmReleaseOrders.ESCode);
137
138 if (not frmFrame.TimedOut) then
139 begin
140 if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
141 frmClinicWardMeds.ClinicOrWardLocation(SignList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc)
142 else
143 if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
144 frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
145 end;
146 uCore.TempEncounterLoc := 0;
147 uCore.TempEncounterLocName := '';
148
149 //hds7591 Clinic/Ward movement.
150
151
152 with SignList do if Count > 0 then for i := 0 to Count - 1 do
153 begin
154 if Pos('E', Piece(SignList[i], U, 2)) > 0 then
155 begin
156 OrderText := FindOrderText(Piece(SignList[i], U, 1));
157 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText, TC_SAVERR, MB_OK);
158 end;
159 if Pos('R', Piece(SignList[i], U, 2)) > 0 then
160 NotifyOtherApps(NAE_ORDER, 'RL' + U + Piece(SignList[i], U, 1));
161 end;
162 StatusText('');
163 PrintOrdersOnSignRelease(SignList, frmReleaseOrders.FNature, PrintLoc);
164// SetupOrdersPrint(SignList, DeviceInfo, frmReleaseOrders.FNature, False, PrintIt); //*KCM*
165// if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo); //*KCM*
166 finally
167 SignList.Free;
168 end;
169 {BillingAware}
170 // HDS6435
171 // HDS00005143 - if cidc master sw is on and BANurseConsultOrders.Count > 0 then
172 // save those orders with selected DX enteries. Resulting in dx populated for provider.
173 if rpcGetBAMasterSwStatus then
174 begin
175 if BANurseConsultOrders.Count > 0 then
176 begin
177 rpcSaveNurseConsultOrder(BANurseConsultOrders);
178 BANurseConsultOrders.Clear;
179 end;
180 end;
181{BillingAware}
182// HDS6435
183 end; {if frmReleaseOrders.OKPressed}
184 finally
185 frmReleaseOrders.Release;
186 with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
187 end;
188end;
189
190procedure TfrmReleaseOrders.FormCreate(Sender: TObject);
191begin
192 inherited;
193 OKPressed := False;
194 ESCode := '';
195 if Encounter.Provider = User.DUZ then
196 begin
197 FNature := NO_POLICY;
198 radPolicy.Checked := True;
199 end else
200 begin
201 FNature := NO_VERBAL;
202 radVerbal.Checked := True;
203 end;
204 FSigSts := SS_UNSIGNED;
205end;
206
207procedure TfrmReleaseOrders.cmdOKClick(Sender: TObject);
208var
209 i: Integer;
210 AnErrMsg: string;
211 AnOrder: TOrder;
212begin
213 SetupVars; //kt added 8/8/2007 to replace constants with vars.
214 inherited;
215 // set up nature, signature status
216 if radPhone.Checked then FNature := NO_PHONE
217 else if radPolicy.Checked then FNature := NO_POLICY
218 else FNature := NO_VERBAL;
219 FSigSts := SS_UNSIGNED;
220 if not grpRelease.Visible then
221 begin
222 FNature := NO_PROVIDER;
223 FSigSts := SS_NOTREQD;
224 end;
225 if FNature = NO_POLICY then FSigSts := SS_ESIGNED;
226 // validate release of the orders with this nature of order
227//StatusText('Validating Release...'); <-- original line. //kt 8/8/2007
228 StatusText(DKLangConstW('fOrdersRelease_Validating_Releasexxx')); //kt added 8/8/2007
229 AnErrMsg := '';
230 with FOrderList do for i := 0 to Count - 1 do
231 begin
232 AnOrder := TOrder(Items[i]);
233 ValidateOrderActionNature(AnOrder.ID, OA_RELEASE, FNature, AnErrMsg);
234 if Length(AnErrMsg) > 0 then
235 begin
236 if IsInvalidActionWarning(AnOrder.Text, AnOrder.ID) then Break;
237 InfoBox(AnOrder.Text + TX_NO_REL + AnErrMsg, TC_NO_REL, MB_OK);
238 Break;
239 end;
240 end;
241 StatusText('');
242 if Length(AnErrMsg) > 0 then Exit;
243 // get the signature code for releasing the orders
244 if grpRelease.Visible then
245 begin
246 SignatureForItem(Font.Size, TX_ES_REQ, TC_ES_REQ, ESCode);
247 if ESCode = '' then Exit;
248 end;
249 OKPressed := True;
250 Close;
251end;
252
253procedure TfrmReleaseOrders.cmdCancelClick(Sender: TObject);
254begin
255 inherited;
256 Close;
257end;
258
259procedure TfrmReleaseOrders.lstOrdersDrawItem(Control: TWinControl;
260 Index: Integer; Rect: TRect; State: TOwnerDrawState);
261var
262 x: string;
263 ARect: TRect;
264 SaveColor: TColor;
265begin
266 inherited;
267 with lstOrders do
268 begin
269 ARect := Rect;
270 ARect.Left := ARect.Left + 2;
271 Canvas.FillRect(ARect);
272 Canvas.Pen.Color := clSilver;
273 SaveColor := Canvas.Brush.Color;
274 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
275 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
276 if Index < Items.Count then
277 begin
278 x := FilteredString(Items[Index]);
279 DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
280 Canvas.Brush.Color := SaveColor;
281 ARect.Right := ARect.Right + 4;
282 end;
283 end;
284end;
285
286procedure TfrmReleaseOrders.lstOrdersMeasureItem(Control: TWinControl;
287 Index: Integer; var AHeight: Integer);
288var
289 x: string;
290 ARect: TRect;
291begin
292 inherited;
293 with lstOrders do if Index < Items.Count then
294 begin
295 ARect := ItemRect(Index);
296 Canvas.FillRect(ARect);
297 x := FilteredString(Items[Index]);
298 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
299 //if AHeight > 255 then AHeight := 255;
300 if AHeight < 13 then AHeight := 15;
301 end;
302end;
303
304procedure TfrmReleaseOrders.Panel1Resize(Sender: TObject);
305begin
306 inherited;
307 lstOrders.Invalidate;
308end;
309
310end.
Note: See TracBrowser for help on using the repository browser.