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

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

Adding foia-cprs branch

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