source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersRenew.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: 14.1 KB
Line 
1unit fOrdersRenew;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, ORFn, ComCtrls, uConst, rODMeds, uOrders, fOCAccept,
8 ExtCtrls, uODBase;
9
10type
11 TfrmRenewOrders = class(TfrmAutoSz)
12 lstOrders: TListBox;
13 hdrOrders: THeaderControl;
14 Panel1: TPanel;
15 cmdCancel: TButton;
16 cmdOK: TButton;
17 cmdChange: TButton;
18 procedure FormCreate(Sender: TObject);
19 procedure cmdOKClick(Sender: TObject);
20 procedure cmdCancelClick(Sender: TObject);
21 procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
22 var Height: Integer);
23 procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
24 Rect: TRect; State: TOwnerDrawState);
25 procedure lstOrdersClick(Sender: TObject);
26 procedure cmdChangeClick(Sender: TObject);
27 procedure FormClose(Sender: TObject; var Action: TCloseAction);
28 procedure FormShow(Sender: TObject);
29 private
30 OKPressed: Boolean;
31 OrderList: TList;
32 function MeasureColumnHeight(TheOrderText: string; Index: Integer; Column: integer):integer;
33 function AcceptOrderCheckOnRenew(const AnOrderID: string; var OCList: TStringList): boolean;
34 end;
35
36function ExecuteRenewOrders(var SelectedList: TList): Boolean;
37
38implementation
39
40{$R *.DFM}
41
42uses rOrders, fDateRange, fRenewOutMed, uCore, rCore, rMisc, UBAGlobals;
43
44const
45 TEXT_COLUMN = 0;
46 DATE_COLUMN = 1;
47 WORD_WRAPPED = True;
48
49 TC_START_STOP = 'Change Start/Stop Dates';
50 TX_START_STOP = 'Enter the start and stop times for this order. Stop time is optional.';
51 TX_LBL_START = 'Start Date/Time';
52 TX_LBL_STOP = 'Stop Date/Time';
53 TX_NO_DEA = 'Provider must have a DEA# or VA# to review this order';
54 TC_NO_DEA = 'DEA# Required';
55 TC_ORDERCHECKS = 'Order Checks';
56
57function PickupText(const x: string): string;
58begin
59 case CharAt(x, 1) of
60 'C': Result := ' (administered in Clinic)';
61 'M': Result := ' (deliver by Mail)';
62 'W': Result := ' (pick up at Window)';
63 else Result := '';
64 end;
65end;
66
67function ExecuteRenewOrders(var SelectedList: TList): Boolean;
68const
69 TC_IMO_ERROR = 'Inpatient medication order on outpatient authorization required';
70var
71 frmRenewOrders: TfrmRenewOrders;
72 RenewFields: TOrderRenewFields;
73 AnOrder, TheOrder: TOrder;
74 OriginalID, RNFillerID,x: string;
75 OrderableItemIen: integer;
76 TreatAsIMOOrder, IsAnIMOOrder: boolean;
77 PassDeaList: TList;
78 IsInpt: boolean;
79 i,j: Integer;
80 m: integer; //BAPHII 1.3.2
81 PkgInfo:string;
82 PlainText,RnErrMsg: string;
83 TD: TFMDateTime;
84 OrchkList: TStringList;
85
86 function OrderForInpatient: Boolean;
87 begin
88 Result := Patient.Inpatient;
89 end;
90begin
91 Result := False;
92 IsAnIMOOrder := False;
93 RnErrMsg := '';
94
95 if SelectedList.Count = 0 then Exit;
96
97 PassDeaList := TList.Create;
98 OrchkList := TStringList.Create;
99 frmRenewOrders := TfrmRenewOrders.Create(Application);
100
101 try
102 frmRenewOrders.OrderList := SelectedList;
103 ResizeFormToFont(TForm(frmRenewOrders));
104 IsInpt := OrderForInpatient;
105
106 with frmRenewOrders.OrderList do
107 for j := 0 to Count - 1 do
108 begin
109 TheOrder := TOrder(Items[j]);
110 PkgInfo := GetPackageByOrderID(TheOrder.ID);
111
112 if Pos('PS',PkgInfo)=1 then
113 begin
114 OrderableItemIen := GetOrderableIen(TheOrder.ID);
115
116 if DEACheckFailed(OrderableItemIen, IsInPt) then
117 begin
118 InfoBox(TX_NO_DEA + #13 + TheOrder.Text, TC_NO_DEA, MB_OK);
119 UnlockOrder(TheOrder.ID);
120 end
121 else PassDeaList.Add(frmRenewOrders.OrderList.Items[j]);
122 end
123 else
124 PassDeaList.Add(frmRenewOrders.OrderList.Items[j]);
125 end;
126
127 frmRenewOrders.OrderList.Clear;
128 frmRenewOrders.OrderList := PassDeaList;
129
130 for i := frmRenewOrders.OrderList.Count - 1 downto 0 do
131 begin
132 AnOrder := TOrder(frmRenewOrders.OrderList.Items[i]);
133 if not IMOActionValidation('RENEW^'+ AnOrder.ID,IsAnIMOOrder,RnErrMsg,'C') then
134 begin
135 frmRenewOrders.OrderList.Delete(i);
136 ShowMsgOn(Length(RnErrMsg) > 0, RnErrMsg, TC_IMO_ERROR);
137 end;
138 RnErrMsg := '';
139 end;
140
141 with frmRenewOrders.OrderList do
142 for i := 0 to Count - 1 do
143 begin
144 AnOrder := TOrder(Items[i]);
145 RenewFields := TOrderRenewFields.Create;
146 LoadRenewFields(RenewFields, AnOrder.ID);
147 RenewFields.NewText := AnOrder.Text + PickupText(RenewFields.Pickup);
148 AnOrder.LinkObject := RenewFields;
149 PlainText := '';
150
151 if RenewFields.NewText <> '' then
152 PlainText := PlainText + frmRenewOrders.hdrOrders.Sections[TEXT_COLUMN].Text + ': ' + RenewFields.NewText + CRLF;
153
154 if RenewFields.BaseType = OD_TEXTONLY then
155 with RenewFields do
156 PlainText := PlainText + 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime;
157
158 frmRenewOrders.lstOrders.Items.AddObject(PlainText, AnOrder);
159 end;
160
161 if frmRenewOrders.OrderList.Count < 1 then
162 frmRenewOrders.Close
163 else
164 frmRenewOrders.ShowModal;
165
166 if frmRenewOrders.OKPressed then
167 begin
168 with frmRenewOrders.OrderList do
169 for i := Count - 1 downto 0 do
170 begin
171 OrchkList.Clear;
172 AnOrder := TOrder(Items[i]);
173 OriginalID := AnOrder.ID;
174
175 //BAPHII 1.3.2 - Pick up source-order ID here
176 UBAGlobals.SourceOrderID := OriginalID; //BAPHII 1.3.2
177 UBAGlobals.CopyTreatmentFactorsDxsToRenewedOrder; //BAPHII 1.3.2
178
179 if CheckOrderGroup(OriginalID) = 1 then
180 RNFillerID := 'PSI'
181 else if CheckOrderGroup(OriginalID) = 2 then
182 RNFillerID := 'PSO';
183
184 if AddFillerAppID(RNFillerID) and OrderChecksEnabled then
185 begin
186 StatusText('Order Checking...');
187 x := OrderChecksOnDisplay(RNFillerID);
188 StatusText('');
189 if Length(x) > 0 then InfoBox(x, TC_ORDERCHECKS, MB_OK);
190 end;
191
192 TreatAsIMOOrder := False;
193
194 if not frmRenewOrders.AcceptOrderCheckOnRenew(AnOrder.ID,OrchkList) then
195 begin
196 frmRenewOrders.OrderList.Delete(i);
197 Continue;
198 end;
199
200 if IsIMOOrder(OriginalID) then //IMO
201 begin
202 TD := FMToday;
203 if IsValidIMOLoc(Encounter.Location, Patient.DFN) and (Encounter.DateTime > TD) then
204 TreatAsIMOOrder := True;
205 if Patient.Inpatient then TreatAsIMOOrder := True;
206 end;
207
208 RenewFields := TOrderRenewFields(AnOrder.LinkObject);
209
210 //PSI-COMPLEX Start
211 if IsComplexOrder(OriginalID) then
212 begin
213 if TreatAsIMOOrder then
214 RenewOrder(AnOrder, RenewFields,1,Encounter.DateTime,OrchkList)
215 else
216 RenewOrder(AnOrder, RenewFields,1,0,OrchkList);
217
218 AnOrder.ActionOn := OriginalID + '=RN';
219 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_CPLXRN, Integer(AnOrder));
220 end
221 //PSI-COMPLEX End
222 else
223 begin
224 if TreatAsIMOOrder then
225 RenewOrder(AnOrder, RenewFields,0,Encounter.DateTime,OrchkList)
226 else
227 RenewOrder(AnOrder, RenewFields,0,0,OrchkList);
228
229 AnOrder.ActionOn := OriginalID + '=RN';
230 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(AnOrder));
231 end;
232 end;
233
234 Result := True;
235
236 end
237
238 else
239 with frmRenewOrders.OrderList do
240 for i := 0 to Count - 1 do
241 UnlockOrder(TOrder(Items[i]).ID);
242 finally
243 // free all the TOrderRenewFields that were created
244 SelectedList := frmRenewOrders.OrderList;
245
246 with frmRenewOrders.OrderList do for i := 0 to Count - 1 do
247 begin
248 AnOrder := TOrder(Items[i]);
249 RenewFields := TOrderRenewFields(AnOrder.LinkObject);
250 RenewFields.Free;
251 AnOrder.LinkObject := nil;
252 end;
253
254 frmRenewOrders.Release;
255 end;
256
257
258
259end;
260
261procedure TfrmRenewOrders.FormCreate(Sender: TObject);
262begin
263 inherited;
264 lstOrders.Color := ReadOnlyColor;
265 OKPressed := False;
266end;
267
268procedure TfrmRenewOrders.lstOrdersMeasureItem(Control: TWinControl;
269 Index: Integer; var Height: Integer);
270var
271 x: string;
272 DateHeight, TextHeight: Integer;
273 AnOrder: TOrder;
274 RenewFields: TOrderRenewFields;
275begin
276 inherited;
277 AnOrder := TOrder(OrderList.Items[Index]);
278 if AnOrder <> nil then
279 begin
280 RenewFields := TOrderRenewFields(AnOrder.LinkObject);
281 with RenewFields do x := 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime;
282 TextHeight := MeasureColumnHeight(RenewFields.NewText,Index,TEXT_COLUMN);
283 DateHeight := MeasureColumnHeight(x, Index, DATE_COLUMN);
284 Height := HigherOf(TextHeight, DateHeight);
285 end
286end;
287
288procedure TfrmRenewOrders.lstOrdersDrawItem(Control: TWinControl;
289 Index: Integer; Rect: TRect; State: TOwnerDrawState);
290var
291 x: string;
292 AnOrder: TOrder;
293 RenewFields: TOrderRenewFields;
294begin
295 inherited;
296 AnOrder := TOrder(lstOrders.Items.Objects[Index]);
297 if AnOrder <> nil then with AnOrder do
298 begin
299 RenewFields := TOrderRenewFields(AnOrder.LinkObject);
300 if RenewFields.BaseType = OD_TEXTONLY
301 then with RenewFields do x := 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime
302 else x := '';
303 ListGridDrawLines(lstOrders, hdrOrders, Index, State);
304 ListGridDrawCell(lstOrders, hdrOrders, Index, TEXT_COLUMN, RenewFields.NewText, WORD_WRAPPED);
305 ListGridDrawCell(lstOrders, hdrOrders, Index, DATE_COLUMN, x, WORD_WRAPPED);
306 end;
307end;
308
309procedure TfrmRenewOrders.lstOrdersClick(Sender: TObject);
310var
311 RenewFields: TOrderRenewFields;
312begin
313 inherited;
314 with lstOrders do
315 begin
316 if ItemIndex < 0 then Exit;
317 RenewFields := TOrderRenewFields(TOrder(Items.Objects[ItemIndex]).LinkObject);
318 case RenewFields.BaseType of
319 OD_MEDOUTPT: cmdChange.Caption := 'Change Refills/Pick Up...';
320 OD_TEXTONLY: cmdChange.Caption := 'Change Start/Stop...';
321 else cmdChange.Caption := 'Change...';
322 end;
323 with RenewFields do if (BaseType = OD_MEDOUTPT) or (BaseType = OD_TEXTONLY)
324 then cmdChange.Enabled := True
325 else cmdChange.Enabled := False;
326 end;
327end;
328
329procedure TfrmRenewOrders.cmdChangeClick(Sender: TObject);
330var
331 StartPos: Integer;
332 x, NewComment, OldComment, OldRefills, OldPickup: string;
333 AnOrder: TOrder;
334 RenewFields: TOrderRenewFields;
335begin
336 inherited;
337 with lstOrders do
338 begin
339 if ItemIndex < 0 then Exit;
340 AnOrder := TOrder(Items.Objects[ItemIndex]);
341 RenewFields := TOrderRenewFields(AnOrder.LinkObject);
342 case RenewFields.BaseType of
343 OD_MEDOUTPT: with RenewFields do begin
344 OldRefills := IntToStr(Refills) + ' refills';
345 { reverse string to make sure getting last matching comment }
346 OldComment := UpperCase(ReverseStr(Comments));
347 OldPickup := PickupText(Pickup);
348 ExecuteRenewOutMed(Refills, Comments, Pickup, AnOrder);
349 NewComment := UpperCase(ReverseStr(Comments));
350 x := ReverseStr(NewText);
351 StartPos := Pos(OldComment, UpperCase(x));
352 if StartPos > 0
353 then x := Copy(x, 1, StartPos - 1) + NewComment +
354 Copy(x, StartPos + Length(OldComment), Length(x))
355 else x := NewComment + x;
356 NewText := ReverseStr(x);
357 x := NewText;
358 StartPos := Pos(OldRefills, x);
359 if StartPos > 0
360 then x := Copy(x, 1, StartPos - 1) + IntToStr(Refills) + ' refills' +
361 Copy(x, StartPos + Length(OldRefills), Length(x))
362 else x := x + ' ' + IntToStr(Refills) + ' refills';
363 StartPos := Pos(OldPickup, x);
364 if StartPos > 0
365 then x := Copy(x, 1, StartPos - 1) + PickupText(Pickup) +
366 Copy(x, StartPos + Length(OldPickup), Length(x))
367 else x := x + PickupText(Pickup);
368 NewText := x;
369 end;
370 OD_TEXTONLY: with RenewFields do ExecuteDateRange(StartTime, StopTime, DT_FUTURE+DT_TIMEOPT,
371 TC_START_STOP, TX_START_STOP, TX_LBL_START, TX_LBL_STOP);
372 end;
373 end;
374 lstOrders.Invalidate;
375end;
376
377procedure TfrmRenewOrders.cmdOKClick(Sender: TObject);
378begin
379 inherited;
380 OKPressed := True;
381 Close;
382end;
383
384procedure TfrmRenewOrders.cmdCancelClick(Sender: TObject);
385begin
386 inherited;
387 Close;
388end;
389
390function TfrmRenewOrders.MeasureColumnHeight(TheOrderText: string; Index,
391 Column: integer): integer;
392var
393 ARect: TRect;
394begin
395 ARect.Left := 0;
396 ARect.Top := 0;
397 ARect.Bottom := 0;
398 ARect.Right := hdrOrders.Sections[Column].Width -6;
399 Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,TheOrderText,ARect);
400end;
401
402function TfrmRenewOrders.AcceptOrderCheckOnRenew(const AnOrderID: string;
403 var OCList: TStringList): boolean;
404var
405 OIInfo,FillerID: string;
406 AnOIList: TStringList;
407begin
408 AnOIList := TStringList.Create;
409 OIInfo := DataForOrderCheck(AnOrderID);
410 FillerID := Piece(OIInfo,'^',2);
411 AnOIList.Add(OIInfo);
412 OrderChecksOnAccept(OCList, FillerID, '', AnOIList, AnOrderID);
413 Result := AcceptOrderWithChecks(OCList);
414end;
415
416procedure TfrmRenewOrders.FormClose(Sender: TObject;
417 var Action: TCloseAction);
418begin
419 inherited;
420 SaveUserBounds(Self);
421end;
422
423procedure TfrmRenewOrders.FormShow(Sender: TObject);
424begin
425 inherited;
426 SetFormPosition(Self);
427end;
428
429end.
Note: See TracBrowser for help on using the repository browser.