source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersRenew.pas@ 1083

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

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