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

Last change on this file since 1722 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28
File size: 9.7 KB
RevLine 
[456]1unit fOrdersRelease;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
[829]7 fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, UBACore, UBAGlobals,
8 VA508AccessibilityManager;
[456]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,
[829]45 fFrame, fClinicWardMeds, rODLab;
[456]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;
[829]63 AList: TStringList;
[456]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
[1679]130 //CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
[456]131 with SignList do if Count > 0 then for i := 0 to Count - 1 do
132 begin
133 if Pos('E', Piece(SignList[i], U, 2)) > 0 then
134 begin
135 OrderText := FindOrderText(Piece(SignList[i], U, 1));
[1679]136 if Piece(SignList[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
[829]137 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
[1679]138 TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
139 else if Piece(SignList[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
140 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
141 TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
[829]142 else
143 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
144 TC_SAVERR, MB_OK);
[456]145 end;
146 if Pos('R', Piece(SignList[i], U, 2)) > 0 then
147 NotifyOtherApps(NAE_ORDER, 'RL' + U + Piece(SignList[i], U, 1));
148 end;
149 StatusText('');
[829]150 // CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
151 AList := TStringList.Create;
152 try
153 CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
154 if AList.Text <> '' then
155 ReportBox(AList, 'Changed Orders', TRUE);
156 finally
157 AList.Free;
158 end;
[456]159 PrintOrdersOnSignRelease(SignList, frmReleaseOrders.FNature, PrintLoc);
160// SetupOrdersPrint(SignList, DeviceInfo, frmReleaseOrders.FNature, False, PrintIt); //*KCM*
161// if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo); //*KCM*
162 finally
163 SignList.Free;
164 end;
165 {BillingAware}
166 // HDS6435
167 // HDS00005143 - if cidc master sw is on and BANurseConsultOrders.Count > 0 then
168 // save those orders with selected DX enteries. Resulting in dx populated for provider.
169 if rpcGetBAMasterSwStatus then
170 begin
171 if BANurseConsultOrders.Count > 0 then
172 begin
173 rpcSaveNurseConsultOrder(BANurseConsultOrders);
174 BANurseConsultOrders.Clear;
175 end;
176 end;
177{BillingAware}
178// HDS6435
179 end; {if frmReleaseOrders.OKPressed}
180 finally
181 frmReleaseOrders.Release;
182 with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
183 end;
184end;
185
186procedure TfrmReleaseOrders.FormCreate(Sender: TObject);
187begin
188 inherited;
189 OKPressed := False;
190 ESCode := '';
191 if Encounter.Provider = User.DUZ then
192 begin
193 FNature := NO_POLICY;
194 radPolicy.Checked := True;
195 end else
196 begin
197 FNature := NO_VERBAL;
198 radVerbal.Checked := True;
199 end;
200 FSigSts := SS_UNSIGNED;
201end;
202
203procedure TfrmReleaseOrders.cmdOKClick(Sender: TObject);
204var
205 i: Integer;
206 AnErrMsg: string;
207 AnOrder: TOrder;
208begin
209 inherited;
210 // set up nature, signature status
211 if radPhone.Checked then FNature := NO_PHONE
212 else if radPolicy.Checked then FNature := NO_POLICY
213 else FNature := NO_VERBAL;
214 FSigSts := SS_UNSIGNED;
215 if not grpRelease.Visible then
216 begin
217 FNature := NO_PROVIDER;
218 FSigSts := SS_NOTREQD;
219 end;
220 if FNature = NO_POLICY then FSigSts := SS_ESIGNED;
221 // validate release of the orders with this nature of order
222 StatusText('Validating Release...');
223 AnErrMsg := '';
224 with FOrderList do for i := 0 to Count - 1 do
225 begin
226 AnOrder := TOrder(Items[i]);
227 ValidateOrderActionNature(AnOrder.ID, OA_RELEASE, FNature, AnErrMsg);
228 if Length(AnErrMsg) > 0 then
229 begin
230 if IsInvalidActionWarning(AnOrder.Text, AnOrder.ID) then Break;
231 InfoBox(AnOrder.Text + TX_NO_REL + AnErrMsg, TC_NO_REL, MB_OK);
232 Break;
233 end;
234 end;
235 StatusText('');
236 if Length(AnErrMsg) > 0 then Exit;
237 // get the signature code for releasing the orders
238 if grpRelease.Visible then
239 begin
240 SignatureForItem(Font.Size, TX_ES_REQ, TC_ES_REQ, ESCode);
241 if ESCode = '' then Exit;
242 end;
243 OKPressed := True;
244 Close;
245end;
246
247procedure TfrmReleaseOrders.cmdCancelClick(Sender: TObject);
248begin
249 inherited;
250 Close;
251end;
252
253procedure TfrmReleaseOrders.lstOrdersDrawItem(Control: TWinControl;
254 Index: Integer; Rect: TRect; State: TOwnerDrawState);
255var
256 x: string;
257 ARect: TRect;
258 SaveColor: TColor;
259begin
260 inherited;
261 with lstOrders do
262 begin
263 ARect := Rect;
264 ARect.Left := ARect.Left + 2;
265 Canvas.FillRect(ARect);
[829]266 Canvas.Pen.Color := Get508CompliantColor(clSilver);
[456]267 SaveColor := Canvas.Brush.Color;
268 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
269 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
270 if Index < Items.Count then
271 begin
272 x := FilteredString(Items[Index]);
273 DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
274 Canvas.Brush.Color := SaveColor;
275 ARect.Right := ARect.Right + 4;
276 end;
277 end;
278end;
279
280procedure TfrmReleaseOrders.lstOrdersMeasureItem(Control: TWinControl;
281 Index: Integer; var AHeight: Integer);
282var
283 x: string;
284 ARect: TRect;
285begin
286 inherited;
287 with lstOrders do if Index < Items.Count then
288 begin
289 ARect := ItemRect(Index);
290 Canvas.FillRect(ARect);
291 x := FilteredString(Items[Index]);
292 AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
293 if AHeight < 13 then AHeight := 15;
294 end;
295end;
296
297procedure TfrmReleaseOrders.Panel1Resize(Sender: TObject);
298begin
299 inherited;
300 lstOrders.Invalidate;
301end;
302
303end.
Note: See TracBrowser for help on using the repository browser.