source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersRelease.pas@ 1008

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

Uploading from OR_30_258

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