source: cprs/trunk/CPRS-Chart/Orders/fOrdersRelease.pas@ 1545

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

Upgrade to version 27
File size: 9.4 KB
Line 
1unit fOrdersRelease;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, UBACore, UBAGlobals,
8 VA508AccessibilityManager;
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, rODLab;
46
47const
48 TX_SAVERR1 = 'The error, ';
49 TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF;
50 TC_SAVERR = 'Error Saving Order';
51 TX_ES_REQ = 'Enter your electronic signature to release these orders.';
52 TC_ES_REQ = 'Electronic Signature';
53 TX_NO_REL = CRLF + CRLF + '- cannot be released to the service(s).' + CRLF + CRLF + 'Reason: ';
54 TC_NO_REL = 'Unable to Release Orders';
55
56function ExecuteReleaseOrders(SelectedList: TList): Boolean;
57var
58 frmReleaseOrders: TfrmReleaseOrders;
59 i, PrintLoc: Integer;
60 SignList: TStringList;
61 OrderText: string;
62 AnOrder: TOrder;
63 AList: TStringList;
64
65 function FindOrderText(const AnID: string): string;
66 var
67 i: Integer;
68 begin
69 Result := '';
70 with SelectedList do for i := 0 to Count - 1 do
71 with TOrder(Items[i]) do if ID = AnID then
72 begin
73 Result := Text;
74 Break;
75 end;
76 end;
77
78 function SignNotRequired: Boolean;
79 var
80 i: Integer;
81 begin
82 Result := True;
83 with SelectedList do for i := 0 to Pred(Count) do
84 begin
85 with TOrder(Items[i]) do if Signature <> OSS_NOT_REQUIRE then Result := False;
86 end;
87 end;
88
89
90begin
91 Result := False;
92 PrintLoc := 0;
93 if SelectedList.Count = 0 then Exit;
94 frmReleaseOrders := TfrmReleaseOrders.Create(Application);
95 try
96 ResizeFormToFont(TForm(frmReleaseOrders));
97 frmReleaseOrders.FOrderList := SelectedList;
98 with SelectedList do for i := 0 to Count - 1 do
99 frmReleaseOrders.lstOrders.Items.Add(TOrder(Items[i]).Text);
100 if SignNotRequired then frmReleaseOrders.grpRelease.Visible := False;
101 frmReleaseOrders.ShowModal;
102 if frmReleaseOrders.OKPressed then
103 begin
104 Result := True;
105 SignList := TStringList.Create;
106 try
107 with SelectedList, frmReleaseOrders do
108 for i := 0 to Count - 1 do
109 begin
110 AnOrder := TOrder(Items[i]);
111 SignList.Add(AnOrder.ID + U + FSigSts + U + RS_RELEASE + U + FNature);
112 end;
113 StatusText('Sending Orders to Service(s)...');
114 if SignList.Count > 0 then SendOrders(SignList, frmReleaseOrders.ESCode);
115
116 if (not frmFrame.TimedOut) then
117 begin
118 if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
119 frmClinicWardMeds.ClinicOrWardLocation(SignList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc)
120 else
121 if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
122 frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
123 end;
124 uCore.TempEncounterLoc := 0;
125 uCore.TempEncounterLocName := '';
126
127 //hds7591 Clinic/Ward movement.
128
129
130 with SignList do if Count > 0 then for i := 0 to Count - 1 do
131 begin
132 if Pos('E', Piece(SignList[i], U, 2)) > 0 then
133 begin
134 OrderText := FindOrderText(Piece(SignList[i], U, 1));
135 if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
136 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
137 'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.',
138 TC_SAVERR, MB_OK)
139 else
140 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
141 TC_SAVERR, MB_OK);
142 end;
143 if Pos('R', Piece(SignList[i], U, 2)) > 0 then
144 NotifyOtherApps(NAE_ORDER, 'RL' + U + Piece(SignList[i], U, 1));
145 end;
146 StatusText('');
147 // CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
148 AList := TStringList.Create;
149 try
150 CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
151 if AList.Text <> '' then
152 ReportBox(AList, 'Changed Orders', TRUE);
153 finally
154 AList.Free;
155 end;
156 PrintOrdersOnSignRelease(SignList, frmReleaseOrders.FNature, PrintLoc);
157// SetupOrdersPrint(SignList, DeviceInfo, frmReleaseOrders.FNature, False, PrintIt); //*KCM*
158// if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo); //*KCM*
159 finally
160 SignList.Free;
161 end;
162 {BillingAware}
163 // HDS6435
164 // HDS00005143 - if cidc master sw is on and BANurseConsultOrders.Count > 0 then
165 // save those orders with selected DX enteries. Resulting in dx populated for provider.
166 if rpcGetBAMasterSwStatus then
167 begin
168 if BANurseConsultOrders.Count > 0 then
169 begin
170 rpcSaveNurseConsultOrder(BANurseConsultOrders);
171 BANurseConsultOrders.Clear;
172 end;
173 end;
174{BillingAware}
175// HDS6435
176 end; {if frmReleaseOrders.OKPressed}
177 finally
178 frmReleaseOrders.Release;
179 with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
180 end;
181end;
182
183procedure TfrmReleaseOrders.FormCreate(Sender: TObject);
184begin
185 inherited;
186 OKPressed := False;
187 ESCode := '';
188 if Encounter.Provider = User.DUZ then
189 begin
190 FNature := NO_POLICY;
191 radPolicy.Checked := True;
192 end else
193 begin
194 FNature := NO_VERBAL;
195 radVerbal.Checked := True;
196 end;
197 FSigSts := SS_UNSIGNED;
198end;
199
200procedure TfrmReleaseOrders.cmdOKClick(Sender: TObject);
201var
202 i: Integer;
203 AnErrMsg: string;
204 AnOrder: TOrder;
205begin
206 inherited;
207 // set up nature, signature status
208 if radPhone.Checked then FNature := NO_PHONE
209 else if radPolicy.Checked then FNature := NO_POLICY
210 else FNature := NO_VERBAL;
211 FSigSts := SS_UNSIGNED;
212 if not grpRelease.Visible then
213 begin
214 FNature := NO_PROVIDER;
215 FSigSts := SS_NOTREQD;
216 end;
217 if FNature = NO_POLICY then FSigSts := SS_ESIGNED;
218 // validate release of the orders with this nature of order
219 StatusText('Validating Release...');
220 AnErrMsg := '';
221 with FOrderList do for i := 0 to Count - 1 do
222 begin
223 AnOrder := TOrder(Items[i]);
224 ValidateOrderActionNature(AnOrder.ID, OA_RELEASE, FNature, AnErrMsg);
225 if Length(AnErrMsg) > 0 then
226 begin
227 if IsInvalidActionWarning(AnOrder.Text, AnOrder.ID) then Break;
228 InfoBox(AnOrder.Text + TX_NO_REL + AnErrMsg, TC_NO_REL, MB_OK);
229 Break;
230 end;
231 end;
232 StatusText('');
233 if Length(AnErrMsg) > 0 then Exit;
234 // get the signature code for releasing the orders
235 if grpRelease.Visible then
236 begin
237 SignatureForItem(Font.Size, TX_ES_REQ, TC_ES_REQ, ESCode);
238 if ESCode = '' then Exit;
239 end;
240 OKPressed := True;
241 Close;
242end;
243
244procedure TfrmReleaseOrders.cmdCancelClick(Sender: TObject);
245begin
246 inherited;
247 Close;
248end;
249
250procedure TfrmReleaseOrders.lstOrdersDrawItem(Control: TWinControl;
251 Index: Integer; Rect: TRect; State: TOwnerDrawState);
252var
253 x: string;
254 ARect: TRect;
255 SaveColor: TColor;
256begin
257 inherited;
258 with lstOrders do
259 begin
260 ARect := Rect;
261 ARect.Left := ARect.Left + 2;
262 Canvas.FillRect(ARect);
263 Canvas.Pen.Color := Get508CompliantColor(clSilver);
264 SaveColor := Canvas.Brush.Color;
265 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
266 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
267 if Index < Items.Count then
268 begin
269 x := FilteredString(Items[Index]);
270 DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
271 Canvas.Brush.Color := SaveColor;
272 ARect.Right := ARect.Right + 4;
273 end;
274 end;
275end;
276
277procedure TfrmReleaseOrders.lstOrdersMeasureItem(Control: TWinControl;
278 Index: Integer; var AHeight: Integer);
279var
280 x: string;
281 ARect: TRect;
282begin
283 inherited;
284 with lstOrders do if Index < Items.Count then
285 begin
286 ARect := ItemRect(Index);
287 Canvas.FillRect(ARect);
288 x := FilteredString(Items[Index]);
289 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
290 if AHeight < 13 then AHeight := 15;
291 end;
292end;
293
294procedure TfrmReleaseOrders.Panel1Resize(Sender: TObject);
295begin
296 inherited;
297 lstOrders.Invalidate;
298end;
299
300end.
Note: See TracBrowser for help on using the repository browser.