source: cprs/trunk/CPRS-Chart/Orders/uOrders.pas@ 1679

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

Updating the working copy to CPRS version 28
File size: 76.2 KB
Line 
1unit uOrders;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Controls, Forms, uConst, rConsults,
7 rOrders, ORFn, Dialogs, ORCtrls, stdCtrls, strUtils, fODBase, fODMedOIFA,
8 VA508AccessibilityRouter;
9
10type
11 EOrderDlgFail = class(Exception);
12
13 //FQOAltOI = record
14 //OI: integer;
15 //end;
16
17{ Ordering Environment }
18function AuthorizedUser: Boolean;
19function AuthorizedToVerify: Boolean;
20function EncounterPresent: Boolean;
21function EncounterPresentEDO: Boolean;
22function LockedForOrdering: Boolean;
23function IsValidActionOnComplexOrder(AnOrderID, AnAction: string;
24 AListBox: TListBox; var CheckedList: TStringList; var ErrMsg: string; var ParentOrderID: string): boolean; //PSI-COMPLEX
25procedure UnlockIfAble;
26function OrderCanBeLocked(OrderID: string): Boolean;
27procedure UnlockOrderIfAble(OrderID: string);
28procedure AddSelectedToChanges(AList: TList);
29procedure ResetDialogProperties(const AnID: string; AnEvent: TOrderDelayEvent; var ResolvedDialog: TOrderDialogResolved);
30function IsInvalidActionWarning(const AnOrderText,AnOrderID: String): boolean;
31procedure InitialOrderVariables;
32
33{ Write Orders }
34function ActivateAction(const AnID: string; AnOwner: TComponent; ARefNum: Integer): Boolean;
35function ActivateOrderDialog(const AnID: string; AnEvent: TOrderDelayEvent;
36 AnOwner: TComponent; ARefNum: Integer; ANeedVerify: boolean = True): Boolean;
37function RetrieveOrderText(AnOrderID: string): string;
38function ActivateOrderHTML(const AnID: string; AnEvent: TOrderDelayEvent;
39 AnOwner: TComponent; ARefNum: Integer): Boolean;
40function ActivateOrderMenu(const AnID: string; AnEvent: TOrderDelayEvent;
41 AnOwner: TComponent; ARefNum: Integer): Boolean;
42function ActivateOrderSet(const AnID: string; AnEvent: TOrderDelayEvent;
43 AnOwner: TComponent; ARefNum: Integer): Boolean;
44function ActivateOrderList(AList: TStringList; AnEvent: TOrderDelayEvent;
45 AnOwner: TComponent; ARefNum: Integer; const KeyVarStr, ACaption: string): Boolean;
46function ActiveOrdering: Boolean;
47function CloseOrdering: Boolean;
48function ReadyForNewOrder(AnEvent: TOrderDelayEvent): Boolean;
49function ReadyForNewOrder1(AnEvent: TOrderDelayEvent): Boolean;
50function ChangeOrdersEvt(AnOrderID: string; AnEvent: TOrderDelayEvent): boolean;
51function CopyOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
52function TransferOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
53procedure SetConfirmEventDelay;
54procedure ChangeOrders(AList: TStringList; AnEvent: TOrderDelayEvent);
55procedure DestroyingOrderAction;
56procedure DestroyingOrderDialog;
57procedure DestroyingOrderHTML;
58procedure DestroyingOrderMenu;
59procedure DestroyingOrderSet;
60function OrderIsLocked(const AnOrderID, AnAction: string): Boolean;
61procedure PopLastMenu;
62procedure QuickOrderSave;
63procedure QuickOrderListEdit;
64function RefNumFor(AnOwner: TComponent): Integer;
65procedure PrintOrdersOnSignReleaseMult(OrderList, ClinicLst, WardLst: TStringList; Nature: Char; EncLoc, WardLoc: integer; EncLocName, WardLocName: string);
66procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = '');
67procedure SetFontSize( FontSize: integer);
68procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
69//function GetQOAltOI: integer;
70
71{ Inpatient medication for Outpatient}
72function IsIMODialog(DlgID: integer): boolean;
73function AllowActionOnIMO(AnEvtTyp: char): boolean;
74function IMOActionValidation(AnId: string; var IsIMOOD: boolean; var x: string; AnEventType: char): boolean;
75function IMOTimeFrame: TFMDateTime;
76
77
78var
79uAutoAc: Boolean;
80InptDisp : Integer;
81OutptDisp: Integer;
82MedsDisp : Integer;
83ClinDisp : Integer; //IMO
84NurDisp : Integer;
85IVDisp : Integer;
86CsltDisp : Integer;
87ProcDisp : Integer;
88ImgDisp : Integer;
89DietDisp : Integer;
90NonVADisp: Integer;
91MedsInDlgIen : Integer;
92MedsOutDlgIen : Integer;
93MedsNVADlgIen : Integer;
94MedsInDlgFormId : Integer;
95MedsOutDlgFormId : Integer;
96MedsNVADlgFormID : Integer;
97MedsIVDlgIen: Integer;
98MedsIVDlgFormID: Integer;
99NSSchedule: boolean;
100OriginalMedsOutHeight: Integer;
101OriginalMedsInHeight: Integer;
102OriginalNonVAMedsHeight: Integer;
103PassDrugTstCall: boolean;
104
105implementation
106
107uses fODDiet, fODMisc, fODGen, fODMedIn, fODMedOut, fODText, fODConsult, fODProc, fODRad,
108 fODLab, fodBBank, fODMeds, fODMedIV, fODVitals, fODAuto, (*fODAllgy,*) fOMNavA, rCore, uCore, fFrame,
109 fEncnt, fEffectDate, fOMVerify, fOrderSaveQuick, fOMSet, rMisc, uODBase, rODMeds,
110 fLkUpLocation, fOrdersPrint, fOMAction, fARTAllgy, fOMHTML, fOrders, rODBase,
111 fODChild, fMeds, rMeds, rPCE, frptBox, fODMedNVA, fODChangeUnreleasedRenew, rODAllergy,
112 UBAGlobals, fClinicWardMeds, uTemplateFields, VAUtils;
113
114var
115 uPatientLocked: Boolean;
116 uKeepLock: Boolean;
117 uOrderAction: TfrmOMAction;
118 uOrderDialog: TfrmODBase;
119 uOrderHTML: TfrmOMHTML;
120 uOrderMenu: TfrmOMNavA;
121 uOrderSet: TfrmOMSet;
122 uLastConfirm: string;
123 uOrderSetTime: TFMDateTime;
124 uNewMedDialog: Integer;
125 //QOALTOI: FQOAltOI;
126
127const
128 TX_PROV_LOC = 'A provider and location must be selected before entering orders.';
129 TC_PROV_LOC = 'Incomplete Information';
130 TX_PROV_KEY = 'The provider selected for this encounter must' + CRLF +
131 'hold the PROVIDER key to enter orders.';
132 TC_PROV_KEY = 'PROVIDER Key Required';
133 TX_NOKEY = 'You do not have the keys required to take this action.';
134 TC_NOKEY = 'Insufficient Authority';
135 TX_BADKEYS = 'You have mutually exclusive order entry keys (ORES, ORELSE, or OREMAS).' +
136 CRLF + 'This must be resolved before you can take actions on orders.';
137 TC_BADKEYS = 'Multiple Keys';
138 TC_NO_LOCK = 'Unable to Lock';
139 TC_DISABLED = 'Item Disabled';
140 TX_DELAY = 'Now writing orders for ';
141 TX_DELAY1 = CRLF + CRLF + '(To write orders for current release rather than delayed release,' + CRLF +
142 'close the next window and select Active Orders from the View Orders pane.)';
143 TC_DELAY = 'Ordering Information';
144 TX_STOP_SET = 'Do you want to stop entering the current set of orders?';
145 TC_STOP_SET = 'Interupt order set';
146 TC_DLG_REJECT = 'Unable to Order';
147 TX_NOFORM = 'This selection does not have an associated windows form.';
148 TC_NOFORM = 'Missing Form ID';
149 TX_DLG_ERR = 'Error in activating order dialog.';
150 TC_DLG_ERR = 'Dialog Error';
151 TX_NO_SAVE_QO = 'An ordering dialog must be active to use this action.';
152 TC_NO_SAVE_QO = 'Save as Quick Order';
153 TX_NO_EDIT_QO = 'An ordering dialog must be active to use this action.';
154 TC_NO_EDIT_QO = 'Edit Common List';
155 TX_NO_QUICK = 'This ordering dialog does not support quick orders.';
156 TC_NO_QUICK = 'Save/Edit Quick Orders';
157 TX_CANT_SAVE_QO = 'This order contains TIU objects, which may result in patient-specific' + CRLF +
158 'information being included in the order. For this reason, it may not' + CRLF +
159 'be saved as a personal quick order for later reuse.';
160 TX_NO_COPY = CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: ';
161 TC_NO_COPY = 'Unable to Copy Order';
162 TX_NO_CHANGE = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
163 TC_NO_CHANGE = 'Unable to Change Order';
164 TC_NO_XFER = 'Unable to Transfer Order';
165 TC_NOLOCK = 'Unable to Lock Order';
166 TX_ONHOLD = 'The following order has been put on-hold, do you still want to continue?';
167 TX_COMPLEX = 'You can not take this action on a complex medication.' + #13 + 'You must enter a new order.';
168 STEP_FORWARD = 1;
169 STEP_BACK = -1;
170 TX_NOINPT = ': You cannot place inpatient medication orders from a clinic location for selected patient.';
171 TX_IMO_WARNING1 = 'You are ';
172 TX_IMO_WARNING2 = ' Clinic Orders. The New orders will be saved as Clinic Orders and MAY NOT be available in BCMA';
173
174
175function CreateOrderDialog(Sender: TComponent; FormID: integer; AnEvent: TOrderDelayEvent; ODEvtID: integer = 0): TfrmODBase;
176{ creates an order dialog based on the FormID and returns a pointer to it }
177type
178 TDialogClass = class of TfrmODBase;
179var
180 DialogClass: TDialogClass;
181begin
182 Result := nil;
183 // allows the FormCreate to check event under which dialog is created
184 if AnEvent.EventType in ['A','D','T','M','O'] then
185 begin
186 SetOrderEventTypeOnCreate(AnEvent.EventType);
187 SetOrderEventIDOnCreate(AnEvent.EventIFN);
188 end else
189 begin
190 SetOrderEventTypeOnCreate(#0);
191 SetOrderEventIDOnCreate(0);
192 end;
193 SetOrderFormIDOnCreate(FormID);
194 // check to see if we should use the new med dialogs
195 if uNewMedDialog = 0 then
196 begin
197 if UseNewMedDialogs then uNewMedDialog := 1 else uNewMedDialog := -1;
198 end;
199 if (uNewMedDialog > 0) and ((FormID = OD_MEDOUTPT) or (FormID = OD_MEDINPT)) then
200 FormID := OD_MEDS;
201 // create the form for a given ordering dialog
202 case FormID of
203 OD_MEDIV: DialogClass := TfrmODMedIV;
204 OD_MEDINPT: DialogClass := TfrmODMedIn;
205 OD_MEDS: DialogClass := TfrmODMeds;
206 OD_MEDOUTPT: DialogClass := TfrmODMedOut;
207 OD_MEDNONVA: DialogClass := TfrmODMedNVA;
208 OD_MISC: DialogClass := TfrmODMisc;
209 OD_GENERIC:
210 begin
211 if ODEvtID>0 then
212 SetOrderEventIDOnCreate(ODEvtID);
213 DialogClass := TfrmODGen;
214 end;
215 OD_IMAGING: DialogClass := TfrmODRad;
216 OD_DIET: DialogClass := TfrmODDiet;
217 OD_LAB: DialogClass := TfrmODLab;
218 OD_BB: DialogClass := TfrmODBBank;
219 OD_CONSULT: DialogClass := TfrmODCslt;
220 OD_PROCEDURE: DialogClass := TfrmODProc;
221 OD_TEXTONLY: DialogClass := TfrmODText;
222 OD_VITALS: DialogClass := TfrmODVitals;
223 //OD_ALLERGY: DialogClass := TfrmODAllergy;
224 OD_AUTOACK: DialogClass := TfrmODAuto;
225 else Exit;
226 end;
227 if Sender = nil then Sender := Application;
228 Result := DialogClass.Create(Sender);
229 if Result <> nil then Result.CallOnExit := DestroyingOrderDialog;
230 SetOrderEventTypeOnCreate(#0);
231 SetOrderEventIDOnCreate(0);
232 SetOrderFormIDOnCreate(0);
233end;
234
235function AuthorizedUser: Boolean;
236begin
237 Result := True;
238 if User.NoOrdering then Result := False;
239 if User.OrderRole = OR_BADKEYS then
240 begin
241 InfoBox(TX_BADKEYS, TC_BADKEYS, MB_OK);
242 Result := False;
243 end;
244end;
245
246function AuthorizedToVerify: Boolean;
247begin
248 Result := True;
249 if not User.EnableVerify then Result := False;
250 if User.OrderRole = OR_BADKEYS then
251 begin
252 InfoBox(TX_BADKEYS, TC_BADKEYS, MB_OK);
253 Result := False;
254 end;
255end;
256
257function EncounterPresent: Boolean;
258{ make sure a location and provider are selected, returns false if not }
259begin
260 Result := True;
261 if (Encounter.Provider > 0) and not PersonHasKey(Encounter.Provider, 'PROVIDER')
262 then InfoBox(TX_PROV_KEY, TC_PROV_KEY, MB_OK);
263 if (Encounter.Provider = 0) or (Encounter.Location = 0) or
264 ((Encounter.Provider > 0) and (not PersonHasKey(Encounter.Provider, 'PROVIDER'))) then
265 begin
266 // don't prompt provider if current user has ORES and is the provider
267 if (User.OrderRole = OR_PHYSICIAN) and (Encounter.Provider = User.DUZ) and (User.IsProvider)
268 then UpdateEncounter(NPF_SUPPRESS)
269 else UpdateEncounter(NPF_PROVIDER);
270 frmFrame.DisplayEncounterText;
271 end;
272 if (Encounter.Provider = 0) or (Encounter.Location = 0) then
273 begin
274 if not frmFrame.CCOWDrivedChange then //jdccow
275 InfoBox(TX_PROV_LOC, TC_PROV_LOC, MB_OK or MB_ICONWARNING); {!!!}
276 Result := False;
277 end;
278 if (Encounter.Provider > 0) and not PersonHasKey(Encounter.Provider, 'PROVIDER') then
279 begin
280 if not frmFrame.CCOWDrivedChange then //jdccow
281 InfoBox(TX_PROV_KEY, TC_PROV_KEY, MB_OK);
282 Result := False;
283 end;
284end;
285
286function EncounterPresentEDO: Boolean;
287begin
288 Result := True;
289 if (Encounter.Provider > 0) and not PersonHasKey(Encounter.Provider, 'PROVIDER')
290 then InfoBox(TX_PROV_KEY, TC_PROV_KEY, MB_OK);
291 if (Encounter.Provider = 0) or
292 ((Encounter.Provider > 0) and (not PersonHasKey(Encounter.Provider, 'PROVIDER'))) then
293 begin
294 UpdateEncounter(NPF_PROVIDER, 0, 0, True);
295 frmFrame.DisplayEncounterText;
296 end;
297 if (Encounter.Provider = 0) then
298 begin
299 InfoBox(TX_PROV_LOC, TC_PROV_LOC, MB_OK or MB_ICONWARNING); {!!!}
300 Result := False;
301 end;
302 if (Encounter.Provider > 0) and not PersonHasKey(Encounter.Provider, 'PROVIDER') then
303 begin
304 InfoBox(TX_PROV_KEY, TC_PROV_KEY, MB_OK);
305 Result := False;
306 end;
307end;
308
309function LockedForOrdering: Boolean;
310var
311 ErrMsg: string;
312begin
313 if uPatientLocked then Result := True else
314 begin
315 LockPatient(ErrMsg);
316 if ErrMsg = '' then
317 begin
318 Result := True;
319 uPatientLocked := True;
320 frmFrame.stsArea.Panels.Items[4].Text := 'LOCK';
321 end else
322 begin
323 Result := False;
324 InfoBox(ErrMsg, TC_NO_LOCK, MB_OK);
325 end;
326 end;
327end;
328
329procedure UnlockIfAble;
330begin
331 if (Changes.Orders.Count = 0) and not uKeepLock then
332 begin
333 UnlockPatient;
334 uPatientLocked := False;
335 frmFrame.stsArea.Panels.Items[4].Text := '';
336 end;
337end;
338
339function OrderCanBeLocked(OrderID: string): Boolean;
340var
341 ErrMsg: string;
342begin
343 LockOrder(OrderID, ErrMsg);
344 if ErrMsg = '' then
345 begin
346 Result := True;
347 frmFrame.stsArea.Panels.Items[4].Text := 'LOCK';
348 end else
349 begin
350 Result := False;
351 InfoBox(ErrMsg, TC_NO_LOCK, MB_OK);
352 end;
353end;
354
355procedure UnlockOrderIfAble(OrderID: string);
356begin
357 UnlockOrder(OrderID);
358 frmFrame.stsArea.Panels.Items[4].Text := '';
359end;
360
361procedure AddSelectedToChanges(AList: TList);
362{ update Changes with orders that were created by taking actions }
363var
364 i, CanSign: Integer;
365 AnOrder: TOrder;
366begin
367 if (Encounter.Provider = User.DUZ) and User.CanSignOrders
368 then CanSign := CH_SIGN_YES
369 else CanSign := CH_SIGN_NA;
370 with AList do for i := 0 to Count - 1 do
371 begin
372 AnOrder := TOrder(Items[i]);
373 with AnOrder do Changes.Add(CH_ORD, ID, Text, '', CanSign);
374 if (Length(AnOrder.ActionOn) > 0)
375 and not Changes.ExistForOrder(Piece(AnOrder.ActionOn, ';', 1))
376 then UnlockOrder(AnOrder.ActionOn);
377 end;
378end;
379
380procedure ResetDialogProperties(const AnID: string; AnEvent: TOrderDelayEvent; var ResolvedDialog: TOrderDialogResolved);
381begin
382 if StrToIntDef(AnID,0)>0 then
383 Exit;
384 if XfInToOutNow then
385 begin
386 ResolvedDialog.DisplayGroup := OutptDisp;
387 ResolvedDialog.DialogIEN := MedsOutDlgIen;
388 ResolvedDialog.FormID := MedsOutDlgFormID;
389 ResolvedDialog.QuickLevel := 0;
390 Exit;
391 end;
392 //if ResolvedDialog.DisplayGroup in [MedsDisp, OutptDisp, InptDisp, NonVADisp, ClinDisp] then
393 if (ResolvedDialog.DisplayGroup = InptDisp) or
394 (ResolvedDialog.DisplayGroup = OutptDisp) or
395 (ResolvedDialog.DisplayGroup = MedsDisp) or
396 (ResolvedDialog.DisplayGroup = NonVADisp) or
397 (ResolvedDialog.DisplayGroup = ClinDisp) then
398 begin
399 if (AnEvent.EventType <> 'D') and (AnEvent.EventIFN > 0) then
400 begin
401 if (AnEvent.EventType = 'T') and IsPassEvt(AnEvent.PtEventIFN,'T') then
402 begin
403 ResolvedDialog.DisplayGroup := OutptDisp;
404 ResolvedDialog.DialogIEN := MedsOutDlgIen;
405 ResolvedDialog.FormID := MedsOutDlgFormID;
406 ResolvedDialog.QuickLevel := 0;
407 end
408 else
409 begin
410 //AGP changes to handle IMO INV Dialog opening the unit dose dialog.
411 if (ResolvedDialog.DisplayGroup = ClinDisp) and (Resolveddialog.DialogIEN = MedsIVDlgIEN) and (ResolvedDialog.FormID = MedsIVDlgFormId) then
412 begin
413 ResolvedDialog.DisplayGroup := IVDisp;
414 ResolvedDialog.DialogIEN := MedsIVDlgIen;
415 ResolvedDialog.FormID := MedsIVDlgFormId;
416 end
417 else
418 begin
419 ResolvedDialog.DisplayGroup := InptDisp;
420 ResolvedDialog.DialogIEN := MedsInDlgIen;
421 ResolvedDialog.FormID := MedsInDlgFormId;
422 end;
423 if Length(ResolvedDialog.ShowText)>0 then
424 ResolvedDialog.QuickLevel := 2;
425 end;
426 end
427 else if (AnEvent.EventType = 'D') and (AnEvent.EventIFN > 0) then
428 begin
429 ResolvedDialog.DisplayGroup := OutptDisp;
430 ResolvedDialog.DialogIEN := MedsOutDlgIen;
431 ResolvedDialog.FormID := MedsOutDlgFormID;
432 ResolvedDialog.QuickLevel := 0;
433 end;
434
435 if XferOutToInOnMeds then
436 begin
437 ResolvedDialog.DisplayGroup := InptDisp;
438 ResolvedDialog.DialogIEN := MedsInDlgIen;
439 ResolvedDialog.FormID := MedsInDlgFormId;
440 ResolvedDialog.QuickLevel := 0;
441 end;
442 end;
443 if ResolvedDialog.DisplayGroup = IVDisp then
444 begin
445 if Length(ResolvedDialog.ShowText)>0 then
446 ResolvedDialog.QuickLevel := 2;
447 end;
448 if (CharAt(AnID,1) = 'C') and (ResolvedDialog.DisplayGroup in [CsltDisp, ProcDisp]) then
449 ResolvedDialog.QuickLevel := 0; // CSV - force dialog, to validate ICD code being copied into new order {RV}
450end;
451
452function IsInvalidActionWarning(const AnOrderText,AnOrderID: String): boolean;
453var
454 AnErrLst, tmpList: TStringList;
455begin
456 Result := False;
457 AnErrlst := TStringList.Create;
458 IsLatestAction(AnOrderID,AnErrLst);
459 if AnErrLst.Count > 0 then
460 begin
461 tmpList := TStringList.Create;
462 PiecesToList(AnsiReplaceStr(AnOrderText,'#D#A','^'),'^',tmpList);
463 tmpList.Add(' ');
464 tmpList.Add('Cannot be released to service(s) because of the following happened action(s):');
465 tmpList.Add(' ');
466 FastAddStrings(TStrings(AnErrLst), tmpList);
467 ReportBox(tmpList,'Cannot be released to service(s)',False);
468 tmpList.Free;
469 AnErrLst.Free;
470 Result := True;
471 end;
472end;
473
474procedure InitialOrderVariables;
475begin
476 InptDisp := DisplayGroupByName('UD RX');
477 OutptDisp := DisplayGroupByName('O RX');
478 MedsDisp := DisplayGroupByName('RX');
479 IVDisp := DisplayGroupByName('IV RX');
480 ClinDisp := DisplayGroupByName('C RX');
481 NurDisp := DisplayGroupByName('NURS');
482 CsltDisp := DisplayGroupByName('CSLT');
483 ProcDisp := DisplayGroupByName('PROC');
484 ImgDisp := DisplayGroupByName('XRAY');
485 DietDisp := DisplayGroupByName('DO');
486 NonVADisp := DisplayGroupByName('NV RX');
487 MedsInDlgIen := DlgIENForName('PSJ OR PAT OE');
488 MedsOutDlgIen := DlgIENForName('PSO OERR');
489 MedsNVADlgIen := DlgIENForName('PSH OERR');
490 MedsIVDlgIen := DlgIENForName('PSJI OR PAT FLUID OE');
491 MedsInDlgFormId := FormIDForDialog(MedsInDlgIen);
492 MedsOutDlgFormId := FormIDForDialog(MedsOutDlgIen);
493 MedsNVADlgFormID := FormIDForDialog(MedsNVADlgIen);
494 MedsIVDlgFormID := FormIDForDialog(MedsIVDlgIen);
495end;
496
497function CanCloseDialog(dialog : TfrmODBase) : Boolean;
498begin
499 if uOrderDialog.FillerID = 'GMRC' then
500 result := fODConsult.CanFreeConsultDialog(dialog)
501 or fODProc.CanFreeProcDialog(dialog);
502end;
503
504function IsValidActionOnComplexOrder(AnOrderID, AnAction: string;
505 AListBox: TListBox; var CheckedList: TStringList; var ErrMsg: string; var ParentOrderID: string): boolean; //PSI-COMPLEX
506const
507 COMPLEX_SIGN = 'You have requested to sign a medication order which was entered as part of a complex order.' +
508 'The following are the orders associated with the same complex order.';
509 COMPLEX_SIGN1 = ' Do you want to sign all of these orders?';
510
511 COMPLEX_DC = 'You have requested to discontinue a medication order which was entered as part of a complex order.' +
512 ' The following are all of the associated orders.';
513 COMPLEX_DC1 =' Do you want to dicscontinue all of them?';
514
515 COMPLEX_HD = 'You have requested to hold a medication order which was entered as part of a complex order.' +
516 ' The following are all of the associated orders.';
517 COMPLEX_HD1 = ' Do you want to hold all of them?';
518
519 COMPLEX_UNHD = 'You have requested to release the hold of a medication order which was entered as part of a complex order.' +
520 ' The following are all of the associated orders.';
521 COMPLEX_UNHD1 = ' Do you want to release all of them?';
522
523 COMPLEX_RENEW = 'You can not take the renew action on a complex medication which has the following associated orders.';
524 COMPLEX_RENEW1 = ' You must enter a new order.';
525
526 COMPLEX_VERIFY ='You have requested to verify a medication order which was entered as part of a complex order.' +
527 ' The following are all of the associated orders.';
528 COMPLEX_VERIFY1 =' Do you want to verify all of them?';
529
530 COMPLEX_OTHER = 'You can not take this action on a complex medication which has the following associated orders.'
531 + ' You must enter a new order.';
532
533 COMPLEX_CANRENEW1 = 'The selected order for renew: ';
534 COMPLEX_CANRENEW2 = ' is a part of a complex order.';
535 COMPLEX_CANRENEW3 = 'The following whole complex order will be renewed.';
536var
537 CurrentActID, POrderTxt, AChildOrderTxt, CplxOrderMsg: string;
538 ChildList,ChildIdxList,ChildTxtList, CategoryList: TStringList;
539 ShowCancelButton: boolean;
540 procedure RetrieveOrderTextPSI(AOrderList: TStringList; var AODTextList, AnIdxList: TStringList;
541 TheAction: string; AParentID: string = '');
542 var
543 ix,jx: integer;
544 tempid: string;
545 begin
546 for ix := 0 to AOrderList.count - 1 do
547 begin
548 if AListBox.Name = 'lstOrders' then with AListBox do
549 begin
550 for jx := 0 to Items.Count - 1 do
551 if TOrder(Items.Objects[jx]).ID = AOrderList[ix] then
552 begin
553 TOrder(Items.Objects[jx]).ParentID := AParentID;
554 if CategoryList.IndexOf(TheAction)>-1 then
555 Selected[jx] := True;
556 AODTextList.Add(TOrder(Items.Objects[jx]).ID + '^' + TOrder(Items.Objects[jx]).Text);
557 if AnIdxList.IndexOf(IntToStr(jx)) > -1 then
558 continue;
559 AnIdxList.Add(IntToStr(jx));
560 end;
561 end
562 else if (AListBox.Name = 'lstMedsOut' ) or (AListBox.Name = 'lstMedsIn')
563 or (AListBox.Name = 'lstMedsNonVA') then with AListBox do
564 begin
565 for jx := 0 to Items.Count - 1 do
566 begin
567 tempid := TMedListRec(AListBox.Items.Objects[jx]).OrderID;
568 if tempid = AOrderList[ix] then
569 begin
570 if CategoryList.IndexOf(TheAction)>-1 then
571 Selected[jx] := True;
572 AODTextList.Add(tempid + '^' + Items[jx]);
573 AnIdxList.Add(IntToStr(jx));
574 end;
575 end;
576 end;
577 end;
578 end;
579
580 procedure DeselectChild(AnIdxList: TStringList);
581 var
582 dix: integer;
583 begin
584 for dix := 0 to AnIdxList.Count - 1 do
585 begin
586 try
587 if StrToInt(AnIdxList[dix]) < AListBox.Items.Count then
588 AListBox.Selected[StrToInt(AnIdxList[dix])] := False;
589 except
590 // do nothing
591 end;
592 end;
593 end;
594
595 function MakeMessage(ErrMsg1,ErrMsg2,ErrMsg3: string): string;
596 begin
597 if Length(ErrMsg1)>0 then
598 Result := ErrMsg1 + ErrMsg2
599 else
600 Result := ErrMsg2 + ErrMsg3;
601 end;
602
603begin
604 Result := True;
605 if AnAction = OA_COPY then Exit;
606 CurrentActID := Piece(AnOrderID,';',2);
607 CplxOrderMsg := '';
608 CategoryList := TStringList.Create;
609 CategoryList.Add('DC');
610 CategoryList.Add('HD');
611 CategoryList.Add('RL');
612 CategoryList.Add('VR');
613 CategoryList.Add('ES');
614 ShowCancelButton := False;
615
616 if Length(ErrMsg)>0 then ErrMsg := ErrMsg + #13#13;
617 ValidateComplexOrderAct(AnOrderID,CplxOrderMsg);
618 if Pos('COMPLEX-PSI',CplxOrderMsg)>0 then
619 begin
620 ParentOrderID := Piece(CplxOrderMsg,'^',2);
621 if CheckedList.IndexOf(ParentOrderID) >= 0 then
622 begin
623 ErrMsg := '';
624 Exit;
625 end;
626 if CheckedList.Count = 0 then
627 CheckedList.Add(ParentOrderID)
628 else
629 begin
630 if CheckedList.IndexOf(ParentOrderID) < 0 then
631 CheckedList.Add(ParentOrderID);
632 end;
633 ChildList := TStringList.Create;
634 GetChildrenOfComplexOrder(ParentOrderID,CurrentActID,ChildList);
635 ChildtxtList := TStringList.Create;
636 ChildIdxList := TStringList.Create;
637 RetrieveOrderTextPSI(ChildList,ChildtxtList,ChildIdxList,AnAction,ParentOrderID);
638 if ChildtxtList.Count > 0 then
639 begin
640 if (AnAction = 'RN') or (AnAction = 'EV') then
641 begin
642 if not IsValidSchedule(ParentOrderID) then
643 begin
644 POrderTxt := RetrieveOrderText(ParentOrderID);
645 if CharAt(POrderTxt,1)='+' then
646 POrderTxt := Copy(POrderTxt,2,Length(POrderTxt));
647 if Pos('First Dose NOW',POrderTxt)>1 then
648 Delete(POrderTxt, Pos('First Dose NOW',POrderTxt), Length('First Dose Now'));
649 InfoBox('Invalid schedule!' + #13#13 + 'The selected order is a part of a complex order:' + #13
650 + POrderTxt + #13#13 + ' It contains an invalid schedule.',
651 'Warning', MB_OK or MB_ICONWARNING);
652 DeselectChild(ChildIdxList);
653 Result := False;
654 ErrMsg := '';
655 ChildtxtList.Free;
656 ChildList.Clear;
657 ChildList.Free;
658 CategoryList.Clear;
659 Exit;
660 end;
661 end;
662 if AnAction = OA_DC then
663 begin
664 if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_DC,COMPLEX_DC1),True) then
665 begin
666 DeselectChild(ChildIdxList);
667 Result := False;
668 end;
669 end
670 else if AnAction = OA_SIGN then
671 begin
672 if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_SIGN,COMPLEX_SIGN1),True) then
673 begin
674 DeselectChild(ChildIdxList);
675 Result := False;
676 end;
677 end
678 else if AnAction = OA_HOLD then
679 begin
680 if Length(ErrMsg) < 1 then ShowCancelButton := True;
681 if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_HD,COMPLEX_HD1),ShowCancelButton) then
682 begin
683 DeselectChild(ChildIdxList);
684 Result := False;
685 end;
686 end
687 else if AnAction = OA_UNHOLD then
688 begin
689 if Length(ErrMsg) < 1 then ShowCancelButton := True;
690 if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_UNHD,COMPLEX_UNHD1),ShowCancelButton) then
691 begin
692 DeselectChild(ChildIdxList);
693 Result := False;
694 end;
695 end
696 else if AnAction = OA_VERIFY then
697 begin
698 if Length(ErrMsg) < 1 then ShowCancelButton := True;
699 if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_VERIFY,COMPLEX_VERIFY1),ShowCancelButton) then
700 begin
701 DeselectChild(ChildIdxList);
702 Result := False;
703 end;
704 end
705 else if AnAction = OA_RENEW then
706 begin
707 if not IsRenewableComplexOrder(ParentOrderID) then
708 begin
709 if not ActionOnComplexOrder(ChildtxtList,MakeMessage(ErrMsg,COMPLEX_RENEW,COMPLEX_RENEW1),False) then
710 begin
711 DeselectChild(ChildIdxList);
712 Result := False;
713 end;
714 end
715 else
716 begin
717 POrderTxt := RetrieveOrderText(ParentOrderID);
718 if CharAt(POrderTxt,1)='+' then
719 POrderTxt := Copy(POrderTxt,2,Length(POrderTxt));
720 if Pos('First Dose NOW',POrderTxt)>1 then
721 Delete(POrderTxt, Pos('First Dose NOW',POrderTxt), Length('First Dose Now'));
722 AChildOrderTxt := RetrieveOrderText(AnOrderID);
723 if InfoBox(COMPLEX_CANRENEW1 + #13 + AChildOrderTxt
724 + COMPLEX_CANRENEW2 + #13#13
725 + COMPLEX_CANRENEW3 + #13 + POrderTxt,
726 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDOK then
727 begin
728 if AListBox.Name = 'lstOrders' then
729 frmOrders.ParentComplexOrderID := ParentOrderID;
730 if (AListBox.Name = 'lstMedsOut' ) or (AListBox.Name = 'lstMedsIn') then
731 frmMeds.ParentComplexOrderID := ParentOrderID;
732 end;
733 DeselectChild(ChildIdxList);
734 end;
735 end;
736 end;
737 ErrMsg := '';
738 ChildtxtList.Free;
739 ChildList.Clear;
740 ChildList.Free;
741 end;
742 CategoryList.Clear;
743end;
744
745{ Write New Orders }
746
747function ActivateAction(const AnID: string; AnOwner: TComponent; ARefNum: Integer): Boolean;
748// AnID: DlgIEN {;FormID;DGroup}
749type
750 TDialogClass = class of TfrmOMAction;
751var
752 DialogClass: TDialogClass;
753 AFormID: Integer;
754begin
755 Result := False;
756 AFormID := FormIDForDialog(StrToIntDef(Piece(AnID, ';', 1), 0));
757 if AFormID > 0 then
758 begin
759 case AFormID of
760 OM_ALLERGY: if ARTPatchInstalled then
761 begin
762// DialogClass := TfrmARTAllergy;
763 EnterEditAllergy(0, TRUE, FALSE, AnOwner, ARefNum);
764 Result := True;
765// uOrderMenu.Close;
766 Exit;
767 end
768 else
769 begin
770 Result := False;
771 Exit;
772 end;
773 OM_HTML: DialogClass := TfrmOMHTML;
774 999999: DialogClass := TfrmOMAction; // for testing!!!
775 else
776 Exit;
777 end;
778 if AnOwner = nil then AnOwner := Application;
779 uOrderAction := DialogClass.Create(AnOwner);
780 if (uOrderAction <> nil) (*and (not uOrderAction.AbortAction) *)then
781 begin
782 uOrderAction.CallOnExit := DestroyingOrderAction;
783 uOrderAction.RefNum := ARefNum;
784 uOrderAction.OrderDialog := StrToIntDef(Piece(AnID, ';', 1), 0);
785 Result := True;
786 if (not uOrderAction.AbortAction) then uOrderAction.ShowModal;
787 end;
788 end else
789 begin
790 //Show508Message('Order Dialogs of type "Action" are available in List Manager only.');
791 Result := False;
792 end;
793end;
794
795function ActivateOrderDialog(const AnID: string; AnEvent: TOrderDelayEvent;
796 AnOwner: TComponent; ARefNum: Integer; ANeedVerify: boolean = True): Boolean;
797const
798 TX_NO_DEA = 'Provider must have a DEA# or VA# to change this order';
799 TC_NO_DEA = 'DEA# Required';
800 TC_IMO_ERROR = 'Inpatient medication order on outpatient authorization required';
801 TX_EVTDEL_DIET_CONFLICT = 'Have you done either of the above?';
802 TC_EVTDEL_DIET_CONFLICT = 'Possible delayed order conflict';
803 TX_INACTIVE_SVC = 'This consult service is currently inactive and not receiving requests.' + CRLF +
804 'Please contact your Clinical Coordinator/IRM staff to fix this order.';
805 TX_INACTIVE_SVC_CAP = 'Inactive Service';
806 TX_NO_SVC = 'The order or quick order you have selected does not specify a consult service.' + CRLF +
807 'Please contact your Clinical Coordinator/IRM staff to fix this order.';
808 TC_NO_SVC = 'No service specified';
809var
810 ResolvedDialog: TOrderDialogResolved;
811 x, EditedOrder, chkCopay, OrderID, PkgInfo,OrderPtEvtID,OrderEvtID,NssErr, tempUnit, tempSupply, tempDrug, tempSch: string;
812 temp,tempDur,tempQuantity, tempRefills: string;
813 i, ODItem, tempOI, ALTOI: integer;
814 DrugCheck, IsInpatient, IsAnIMOOrder, DrugTestDlgType: boolean;
815 IsPsoSupply,IsDischargeOrPass,IsPharmacyOrder,IsConsultOrder,ForIMO, IsNewOrder: boolean;
816 tmpResp: TResponse;
817 CxMsg: string;
818 AButton: TButton;
819 SvcIEN: string;
820 //CsltFrmID: integer;
821begin
822 IsPsoSupply := False;
823 Result := False;
824 IsDischargeOrPass := False;
825 IsAnIMOOrder := False;
826 ForIMO := False;
827 IsNewOrder := True;
828 PassDrugTstCall := False;
829 DrugCheck := false;
830 DrugTestDlgType := false;
831 //QOAltOI.OI := 0;
832 Application.ProcessMessages;
833 // double check environment before continuing with order
834 if uOrderDialog <> nil then uOrderDialog.Close; // then x := uOrderDialog.Name else x := '';
835 //if ShowMsgOn(uOrderDialog <> nil, TX_DLG_ERR + CRLF + x, TC_DLG_ERR) then Exit;
836 if CharAt(AnID, 1) = 'X' then
837 begin
838 IsNewOrder := False;
839 // if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit;
840 ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_CHANGE, x);
841 if ( Length(x)<1 ) and not (AnEvent.EventIFN > 0) then
842 ValidateComplexOrderAct(Copy(AnID, 2, Length(AnID)),x);
843 if (Pos('COMPLEX-PSI',x)>0) then
844 x := TX_COMPLEX;
845 if Length(x) > 0 then
846 x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
847 if ShowMsgOn(Length(x) > 0, x, TC_NO_CHANGE) then Exit;
848 DrugCheck := true;
849 end;
850 if CharAt(AnID, 1) = 'C' then
851 begin
852 IsNewOrder := False;
853 //if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit;
854 ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_COPY, x);
855 if Length(x) > 0 then
856 x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
857 if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY) then Exit;
858 DrugCheck := true;
859 end;
860 if CharAt(AnID, 1) = 'T' then
861 begin
862 IsNewOrder := False;
863 if (XfInToOutNow = true) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', false)=false) then Exit;
864 if (XfInToOutNow = false) then
865 begin
866 if (XferOuttoInOnMeds = True) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', true)=false) then Exit;
867 if (XferOuttoInOnMeds = False) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', False)=false) then Exit;
868 end;
869 ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_TRANSFER, x);
870 if Length(x) > 0 then
871 x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
872 if ShowMsgOn(Length(x) > 0, x, TC_NO_XFER) then Exit;
873 end;
874 if not IMOActionValidation(AnID, IsAnIMOOrder, x, AnEvent.EventType) then
875 begin
876 ShowMsgOn(Length(x) > 0, x, TC_IMO_ERROR);
877 Exit;
878 end;
879 if ( (StrToIntDef(AnId,0)>0) and (AnEvent.EventIFN <= 0) ) then
880 ForIMO := IsIMODialog(StrToInt(AnId))
881 else if ( (IsAnIMOOrder) and (AnEvent.EventIFN <= 0) ) then
882 ForIMO := True;
883 OrderPtEvtID := GetOrderPtEvtID(Copy(AnID, 2, Length(AnID)));
884 OrderEvtID := Piece(EventInfo(OrderPtEvtID),'^',2);
885 //CQ 18660 Orders for events should be modal. Orders for non-event should not be modal
886 if AnEvent.EventIFN > 0 then frmOrders.NeedShowModal := true
887 else frmOrders.NeedShowModal := false;
888 // evaluate order dialog, build response list & see what form should be presented
889 FillChar(ResolvedDialog, SizeOf(ResolvedDialog), #0);
890 ResolvedDialog.InputID := AnID;
891 BuildResponses(ResolvedDialog, GetKeyVars, AnEvent, ForIMO);
892 if (ResolvedDialog.DisplayGroup = InPtDisp) or (ResolvedDialog.DisplayGroup = ClinDisp) then DrugTestDlgType := true;
893 if (DrugCheck = true) and (ResolvedDialog.DisplayGroup = OutPtDisp) and
894 (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', false)=false) then Exit;
895 if (DrugCheck = true) and (DrugTestDlgType = true) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', true)=false) then Exit;
896 if (IsNewOrder = True) and (ResolvedDialog.DialogType = 'Q') and
897 ((ResolvedDialog.DisplayGroup = OutptDisp) or (DrugTestDlgType = true)) then
898 begin
899 if (PassDrugTest(ResolvedDialog.DialogIEN, 'Q', DrugTestDlgType)=false) then Exit
900 else PassDrugTstCall := True;
901 end;
902 if (ForIMO and ( (ResolvedDialog.DialogIEN = MedsInDlgIen)
903 or (ResolvedDialog.DialogIEN = MedsIVDlgIen)) ) then
904 ResolvedDialog.DisplayGroup := ClinDisp;
905 ResetDialogProperties(AnID, AnEvent, ResolvedDialog);
906 {* AGP CHANGE 26.20 Remove restriction to allowed for ordering of inpatient medication for an inpatient from an outpatient location
907 //jd imo change
908 if (ResolvedDialog.DisplayGroup = InptDisp) and (Patient.Inpatient) and (AnEvent.EventIFN < 1) then
909 begin
910 if IsClinicLoc(Encounter.Location) then
911 begin
912 MessageDlg(TX_NOINPT, mtWarning, [mbOK], 0);
913 Exit;
914 end;
915 end;
916 //jd imo change end *}
917 if (ResolvedDialog.DisplayGroup = InptDisp) or
918 (ResolvedDialog.DisplayGroup = OutptDisp) or
919 (ResolvedDialog.DisplayGroup = MedsDisp) or
920 (ResolvedDialog.DisplayGroup = IVDisp) or
921 (ResolvedDialog.DisplayGroup = NonVADisp) or
922 (ResolvedDialog.DisplayGroup = ClinDisp) then IsPharmacyOrder := True
923 else
924 IsPharmacyOrder := False;
925 (* IsPharmacyOrder := ResolvedDialog.DisplayGroup in [InptDisp, OutptDisp,
926 MedsDisp,IVDisp, NonVADisp, ClinDisp];*) //v25.27 range check error - RV
927 IsConsultOrder := ResolvedDialog.DisplayGroup in [CsltDisp,ProcDisp];
928 if (uAutoAC) and (not (ResolvedDialog.QuickLevel in [QL_REJECT,QL_CANCEL]))
929 and (not IsPharmacyOrder) and (not IsConsultOrder) then
930 ResolvedDialog.QuickLevel := QL_AUTO;
931 if (ResolvedDialog.DialogType = 'Q')
932 and (ResolvedDialog.DisplayGroup = InptDisp) then
933 begin
934 NssErr := IsValidQOSch(ResolvedDialog.InputID);
935 if (Length(NssErr) > 1) then
936 begin
937 if (NssErr <> 'OTHER') and (NssErr <> 'schedule is not defined.') then
938 ShowMsg('The order contains invalid non-standard schedule.');
939 NSSchedule := True;
940 ResolvedDialog.QuickLevel := 0;
941 end;
942 end;
943 if ResolvedDialog.DisplayGroup = InptDisp then //nss
944 begin
945 if (CharAt(AnID, 1) = 'C') or (CharAt(AnID, 1) = 'T') or (CharAt(AnID, 1) = 'X') then
946 begin
947 if not IsValidSchedule(Copy(AnID, 2, Length(AnID))) then
948 begin
949 ShowMsg('The order contains invalid non-standard schedule.');
950 NSSchedule := True;
951 end;
952 end;
953 if NSSchedule then ResolvedDialog.QuickLevel := 0;
954 end;
955 (* if (ResolvedDialog.DialogType = 'Q') and ((ResolvedDialog.FormID = OD_MEDINPT) or (ResolvedDialog.FormID = OD_MEDOUTPT)) then
956 begin
957 temp := '';
958 tempOI := GetQOOrderableItem(ResolvedDialog.InputID);
959 if tempOI >0 then
960 begin
961 ALTOI := tempOI;
962 CheckFormularyOI(AltOI,temp,True);
963 if ALTOI <> tempOI then
964 begin
965 ResolvedDialog.QuickLevel := 0;
966 QOAltOI.OI := ALTOI;
967 end;
968 end;
969 end; *)
970 // ((ResolvedDialog.DisplayGroup = InptDisp) or (ResolvedDialog.DisplayGroup = OutptDisp) or (ResolvedDialog.DisplayGroup = MedsDisp)) then
971 // ResolvedDialog.QuickLevel := 0;
972 with ResolvedDialog do if (QuickLevel = QL_VERIFY) and (HasTemplateField(ShowText)) then QuickLevel := QL_DIALOG;
973
974 // Check for potential conflicting auto-accept delayed-release diet orders (CQ #10946 - v27.36 - RV)
975 with ResolvedDialog do if (QuickLevel = QL_AUTO) and (DisplayGroup = DietDisp) and (AnEvent.EventType <> 'C') then
976 begin
977 AButton := TButton.Create(Application);
978 try
979 CheckForAutoDCDietOrders(AnEvent.EventIFN, DisplayGroup, '', CxMsg, AButton);
980 if CxMsg <> '' then
981 begin
982 if InfoBox(CxMsg + CRLF + CRLF + TX_EVTDEL_DIET_CONFLICT,
983 TC_EVTDEL_DIET_CONFLICT,
984 MB_ICONWARNING or MB_YESNO) = ID_NO
985 then QuickLevel := QL_DIALOG;
986 end;
987 finally
988 AButton.Free;
989 end;
990 end;
991
992 with ResolvedDialog do
993 begin
994 if QuickLevel = QL_REJECT then InfoBox(ShowText, TC_DLG_REJECT, MB_OK);
995 if (QuickLevel = QL_VERIFY) and (IsPharmacyOrder or ANeedVerify) then ShowVerifyText(QuickLevel, ShowText, DisplayGroup=InptDisp);
996 if QuickLevel = QL_AUTO then
997 begin
998 //CsltFrmID := FormID;
999 FormID := OD_AUTOACK;
1000 end;
1001 if (QuickLevel = QL_REJECT) or (QuickLevel = QL_CANCEL) then Exit;
1002 PushKeyVars(ResolvedDialog.QOKeyVars);
1003 end;
1004 if ShowMsgOn(not (ResolvedDialog.FormID > 0), TX_NOFORM, TC_NOFORM) then Exit;
1005 with ResolvedDialog do if DialogType = 'X' then
1006 begin
1007 EditedOrder := Copy(Piece(ResponseID, '-', 1), 2, Length(ResponseID));
1008 end
1009 else EditedOrder := '';
1010 if XfInToOutNow then
1011 begin
1012 //if Transfer an order to outpatient and release immediately
1013 // then changing the Eventtype to 'C' instead of 'D'
1014 IsDischargeOrPass := True;
1015 AnEvent.EventType := 'C';
1016 AnEvent.Effective := 0;
1017 end;
1018 uOrderDialog := CreateOrderDialog(AnOwner, ResolvedDialog.FormID, AnEvent, StrToIntDef(OrderEvtID,0));
1019 uOrderDialog.IsSupply := IsPsoSupply;
1020
1021 {For copy, change, transfer actions on an None-IMO order, the new order should not be treated as IMO order
1022 although the IMO criteria could be met. }
1023 //if (uOrderDialog.IsIMO) and (CharAt(AnID, 1) in ['X','C','T']) then
1024 if not uOrderDialog.IsIMO then
1025 uOrderDialog.IsIMO := ForIMO;
1026
1027 if (ResolvedDialog.DialogType = 'Q') and (ResolvedDialog.DisplayGroup in [MedsDisp, OutptDisp, InptDisp]) then
1028 begin
1029 if DoesOIPIInSigForQO(StrToInt(ResolvedDialog.InputID))=1 then
1030 uOrderDialog.IncludeOIPI := True
1031 else
1032 uOrderDialog.IncludeOIPI := False;
1033 end;
1034
1035 if (uOrderDialog <> nil) and not uOrderDialog.Closing then with uOrderDialog do
1036 begin
1037 SetKeyVariables(GetKeyVars);
1038
1039 if IsDischargeOrPass then
1040 EvtForPassDischarge := 'D'
1041 else
1042 EvtForPassDischarge := #0;
1043
1044 Responses.SetEventDelay(AnEvent);
1045 Responses.LogTime := uOrderSetTime;
1046 DisplayGroup := ResolvedDialog.DisplayGroup; // used to pass ORTO
1047 DialogIEN := ResolvedDialog.DialogIEN; // used to pass ORIT
1048 RefNum := ARefNum;
1049
1050 case ResolvedDialog.DialogType of
1051 'C': SetupDialog(ORDER_COPY, ResolvedDialog.ResponseID);
1052 'D': SetupDialog(ORDER_NEW, '');
1053 'X':
1054 begin
1055 SetupDialog(ORDER_EDIT, ResolvedDialog.ResponseID);
1056 OrderID := Copy(ResolvedDialog.ResponseID,2,Length(ResolvedDialog.ResponseID));
1057 IsInpatient := OrderForInpatient;
1058 ODItem := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
1059 PkgInfo := '';
1060 if Length(OrderID)>0 then
1061 PkgInfo := GetPackageByOrderID(OrderID);
1062 if Pos('PS',PkgInfo)=1 then
1063 begin
1064 if DEACheckFailed(ODItem, IsInPatient) and (uOrderDialog.FillerID <> 'PSH') then
1065 begin
1066 InfoBox(TX_NO_DEA + #13 + Responses.OrderText, TC_NO_DEA, MB_OK);
1067 if (ResolvedDialog.DialogType = 'X') and not Changes.ExistForOrder(EditedOrder)
1068 then UnlockOrder(EditedOrder);
1069 uOrderDialog.Close;
1070 Exit;
1071 end;
1072 end;
1073 end;
1074 'Q':
1075 begin
1076 if IsPSOSupplyDlg(ResolvedDialog.DialogIEN,1) then
1077 uOrderDialog.IsSupply := True;
1078 SetupDialog(ORDER_QUICK, ResolvedDialog.ResponseID);
1079 {if ((ResolvedDialog.DisplayGroup = CsltDisp)
1080 and (ResolvedDialog.QuickLevel = QL_AUTO)) then
1081 TfrmODCslt.SetupDialog(ORDER_QUICK, ResolvedDialog.ResponseID);}
1082 end;
1083 end;
1084
1085 if Assigned(uOrderDialog) then
1086 with uOrderDialog do
1087 if AbortOrder and CanCloseDialog(uOrderDialog) then
1088 begin
1089 Close;
1090 if Assigned(uOrderDialog) then
1091 uOrderDialog.Destroy;
1092 Exit;
1093 end;
1094
1095 if CharAt(AnID, 1) = 'T' then
1096 begin
1097 if ARefNum = -2 then
1098 Responses.TransferOrder := '';
1099 if ARefNum = -1 then
1100 Responses.TransferOrder := AnID;
1101 end;
1102
1103 if CharAt(AnID,1) = 'C' then ////////////////////////////////////////////////////////////////////////
1104 begin
1105 chkCopay := Copy(AnID,2,length(AnID)); //STRIP prepended C, T, or X from first position in order ID.
1106 SetDefaultCoPay(chkCopay);
1107 end; ////////////////////////////////////////////////////////////////////////'
1108
1109 if IsConsultOrder and (CharAt(AnID,1) = 'C') then
1110 begin
1111 tmpResp := uOrderDialog.Responses.FindResponseByName('CODE', 1);
1112 if (tmpResp <> nil) then
1113 begin
1114 if IsActiveICDCode(tmpResp.EValue) then
1115 ResolvedDialog.QuickLevel := QL_AUTO
1116 else
1117 ResolvedDialog.QuickLevel := QL_DIALOG;
1118 end
1119 else
1120 ResolvedDialog.QuickLevel := QL_AUTO
1121 end;
1122
1123 if ResolvedDialog.QuickLevel <> QL_AUTO then
1124 begin
1125 if CharAt(AnID, 1) in ['C','T','X'] then
1126 begin
1127 Position := poScreenCenter;
1128 FormStyle := fsNormal;
1129 ShowModal;
1130 Result := uOrderDialog.AcceptOK;
1131 end
1132 else
1133 begin
1134 SetBounds(frmFrame.Left + 112, frmFrame.Top + frmFrame.Height - Height, Width, Height);
1135 SetFormPosition(uOrderDialog);
1136 FormStyle := fsStayOnTop;
1137 if frmOrders.NeedShowModal then
1138 begin
1139 ShowModal;
1140 Result := uOrderDialog.AcceptOK;
1141 uOrderDialog.Destroy;
1142 end
1143 else
1144 begin
1145 Show;
1146 Result := True;
1147 end;
1148 end;
1149 end
1150 else
1151 begin
1152 if uOrderDialog.DisplayGroup = OutptDisp then
1153 begin
1154 tempUnit := '';
1155 tempSupply := '';
1156 tempDrug := '';
1157 tempSch := '';
1158 tempDur := '';
1159 tmpResp := uOrderDialog.Responses.FindResponseByName('SUPPLY', 1);
1160 if tmpResp = nil then tempSupply := '0'
1161 else tempSupply := tmpResp.EValue;
1162 tmpResp := uOrderDialog.Responses.FindResponseByName('QTY', 1);
1163 if tmpResp = nil then tempQuantity := '0'
1164 else tempQuantity := tmpResp.EValue;
1165 tmpResp := uOrderDialog.Responses.FindResponseByName('REFILLS', 1);
1166 if tmpResp = nil then tempRefills := '0'
1167 else tempRefills := tmpResp.EValue;
1168 tmpResp := uOrderDialog.Responses.FindResponseByName('ORDERABLE', 1);
1169 tempOI := StrToIntDef(tmpResp.IValue,0);
1170 i := uORderDialog.Responses.NextInstance('DOSE',0);
1171 while i > 0 do
1172 begin
1173 x := Piece(uOrderDialog.Responses.IValueFor('DOSE',i), '&', 3);
1174 tempUnit := tempUnit + X + U;
1175 x := uOrderDialog.Responses.IValueFor('SCHEDULE',i);
1176 tempSch := tempSch + x + U;
1177 x := uOrderDialog.Responses.IValueFor('DRUG', i);
1178 tempDrug := Piece(x, U, 1);
1179 i := Responses.NextInstance('DOSE', i);
1180 x := UORderDialog.Responses.IValueFor('DAYS', i);
1181 tempDur := tempDur + x + '~';
1182 x := uOrderDialog.Responses.IValueFor('CONJ', i);
1183 tempDur := tempDur + x + U;
1184 end;
1185 if ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur, tempOI, StrtoInt(tempSupply), StrtoInt(tempQuantity), StrtoInt(tempRefills)) = false then Exit;
1186 end;
1187 if ((ResolvedDialog.DisplayGroup = CsltDisp) and (ResolvedDialog.QuickLevel = QL_AUTO)) then
1188 begin
1189 with Responses do
1190 begin
1191 Changing := True;
1192 tmpResp := TResponse(FindResponseByName('ORDERABLE',1));
1193 if tmpResp <> nil then
1194 SvcIEN := GetServiceIEN(tmpResp.IValue)
1195 else
1196 begin
1197 InfoBox(TX_NO_SVC, TC_NO_SVC, MB_ICONERROR or MB_OK);
1198 //AbortOrder := True;
1199 //Close;
1200 Exit;
1201 end;
1202 if SvcIEN = '-1' then
1203 begin
1204 InfoBox(TX_INACTIVE_SVC, TX_INACTIVE_SVC_CAP, MB_OK);
1205 //AbortOrder := True;
1206 //Close;
1207 Exit;
1208 end;
1209 end;
1210 end;
1211 cmdAcceptClick(Application); // auto-accept order
1212 Result := uOrderDialog.AcceptOK;
1213 if (result = true) and (ScreenReaderActive) then
1214 GetScreenReader.Speak('Auto Accept Quick Order '+ Responses.DialogDisplayName + ' placed.');
1215
1216 //BAPHII 1.3.2
1217 //Show508Message('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()');
1218
1219 //End BAPHII 1.3.2
1220
1221 if Assigned(uOrderDialog) then
1222 uOrderDialog.Destroy;
1223 end;
1224
1225 end
1226 else
1227 begin
1228 uOrderDialog.Release;
1229 Result := False;
1230 //Application.ProcessMessages; // to allow dialog to finish closing
1231 //Exit; // so result is not returned true
1232 end;
1233
1234 if NSSchedule then
1235 NSSchedule := False;
1236
1237 if (ResolvedDialog.DialogType = 'X') and not Changes.ExistForOrder(EditedOrder)
1238 then UnlockOrder(EditedOrder);
1239 //QOAltOI.OI := 0;
1240end;
1241
1242function RetrieveOrderText(AnOrderID: string): string;
1243var
1244 OrdList: TList;
1245 theOrder: TOrder;
1246 // i: integer;
1247begin
1248 // if Assigned(OrdList) then
1249 // begin
1250 // for i := 0 to pred(OrdList.Count) do
1251 // TObject(OrdList[i]).Free;
1252 // UBAGlobals.tempDxList := nil;
1253 // end;
1254 OrdList := TList.Create;
1255 theOrder := TOrder.Create;
1256 theOrder.ID := AnOrderID;
1257 OrdList.Add(theOrder);
1258 RetrieveOrderFields(OrdList, 0, 0);
1259 Result := TOrder(OrdList.Items[0]).Text;
1260 if Assigned(OrdList) then OrdList.Free; //CQ:7554
1261end;
1262
1263function ActivateOrderHTML(const AnID: string; AnEvent: TOrderDelayEvent;
1264 AnOwner: TComponent; ARefNum: Integer): Boolean;
1265var
1266 DialogIEN: Integer;
1267 x: string;
1268 ASetList: TStringList;
1269begin
1270 Result := False;
1271 DialogIEN := StrToIntDef(AnID, 0);
1272 x := OrderDisabledMessage(DialogIEN);
1273 if ShowMsgOn(Length(x) > 0, x, TC_DISABLED) then Exit;
1274 if uOrderHTML = nil then
1275 begin
1276 uOrderHTML := TfrmOMHTML.Create(AnOwner);
1277 with uOrderHTML do
1278 begin
1279 SetBounds(frmFrame.Left + 112, frmFrame.Top + frmFrame.Height - Height, Width, Height);
1280 SetFormPosition(uOrderHTML);
1281 FormStyle := fsStayOnTop;
1282 SetEventDelay(AnEvent);
1283 end;
1284 end;
1285 uOrderHTML.Dialog := DialogIEN;
1286 uOrderHTML.RefNum := ARefNum;
1287 uOrderHTML.OwnedBy := AnOwner;
1288 uOrderHTML.ShowModal;
1289 ASetList := TStringList.Create;
1290 FastAssign(uOrderHTML.SetList, ASetList);
1291 uOrderHTML.Release;
1292 if ASetList.Count = 0 then Exit;
1293 Result := ActivateOrderList(ASetList, AnEvent, AnOwner, ARefNum, '', '');
1294end;
1295
1296function ActivateOrderMenu(const AnID: string; AnEvent: TOrderDelayEvent;
1297 AnOwner: TComponent; ARefNum: Integer): Boolean;
1298var
1299 MenuIEN: Integer;
1300 x: string;
1301begin
1302 Result := False;
1303 MenuIEN := StrToIntDef(AnID, 0);
1304 x := OrderDisabledMessage(MenuIEN);
1305 if ShowMsgOn(Length(x) > 0, x, TC_DISABLED) then Exit;
1306 if uOrderMenu = nil then
1307 begin
1308 uOrderMenu := TfrmOMNavA.Create(AnOwner);
1309 with uOrderMenu do
1310 begin
1311 SetBounds(frmFrame.Left + 112, frmFrame.Top + frmFrame.Height - Height, Width, Height);
1312 SetFormPosition(uOrderMenu);
1313 FormStyle := fsStayOnTop;
1314 SetEventDelay(AnEvent);
1315 end;
1316 end;
1317 uOrderMenu.SetNewMenu(MenuIEN, AnOwner, ARefNum);
1318 if not uOrderMenu.Showing then uOrderMenu.Show else uOrderMenu.BringToFront;
1319 Result := True;
1320end;
1321
1322function ActivateOrderSet(const AnID: string; AnEvent: TOrderDelayEvent;
1323 AnOwner: TComponent; ARefNum: Integer): Boolean;
1324var
1325 x, ACaption, KeyVarStr: string;
1326 SetList: TStringList;
1327 EvtDefaultDlg, PtEvtID: string;
1328
1329 function TakeoutDuplicateDlg(var AdlgList: TStringList; ANeedle: string): boolean;
1330 var
1331 i: integer;
1332 begin
1333 Result := False;
1334 for i := 0 to AdlgList.Count - 1 do
1335 begin
1336 if Piece(AdlgList[i],'^',1)=ANeedle then
1337 begin
1338 ADlgList.Delete(i);
1339 Result := True;
1340 Break;
1341 end;
1342 end;
1343 end;
1344
1345begin
1346 Result := False;
1347 x := OrderDisabledMessage(StrToIntDef(AnID, 0));
1348 if ShowMsgOn(Length(x) > 0, x, TC_DISABLED) then Exit;
1349 SetList := TStringList.Create;
1350 try
1351 if uOrderSetTime = 0 then uOrderSetTime := FMNow;
1352 LoadOrderSet(SetList, StrToIntDef(AnID, 0), KeyVarStr, ACaption);
1353 if (AnEvent.EventIFN>0) and isExistedEvent(Patient.DFN, IntToStr(AnEvent.EventIFN), PtEvtID) then
1354 begin
1355 EvtDefaultDlg := GetEventDefaultDlg(AnEvent.EventIFN);
1356 while TakeoutDuplicateDlg(SetList,EvtDefaultDlg) do
1357 TakeoutDuplicateDlg(SetList,EvtDefaultDlg);
1358 end;
1359 Result := ActivateOrderList(SetList, AnEvent, AnOwner, ARefNum, KeyVarStr, ACaption);
1360 finally
1361 SetList.Free;
1362 end;
1363end;
1364
1365function ActivateOrderList(AList: TStringList; AnEvent: TOrderDelayEvent;
1366 AnOwner: TComponent; ARefNum: Integer; const KeyVarStr, ACaption: string): Boolean;
1367var
1368 InitialCall: Boolean;
1369 i: integer;
1370 str: string;
1371begin
1372 InitialCall := False;
1373 if ScreenReaderActive then
1374 begin
1375 for i := 0 to AList.Count - 1 do
1376 begin
1377 if Piece(Alist.Strings[i],U,2) = 'Q' then str := str + CRLF + 'Quick Order ' + Piece(Alist.Strings[i],U,3)
1378 else if Piece(Alist.Strings[i],U,2) = 'S' then str := str + CRLF + 'Order Set ' + Piece(Alist.Strings[i],U,3)
1379 else if Piece(Alist.Strings[i],U,2) = 'M' then str := str + CRLF + 'Order Menu ' + Piece(Alist.Strings[i],U,3)
1380 else if Piece(Alist.Strings[i],U,2) = 'A' then str := str + CRLF + 'Order Action ' + Piece(Alist.Strings[i],U,3)
1381 else str := str + CRLF + 'Order Dialog ' + Piece(Alist.Strings[i],U,3);
1382 end;
1383 if infoBox('This order set contains the following items:'+ CRLF + str + CRLF+ CRLF + 'Select the OK button to start this order set.' +
1384 'To stop the order set while it is in process, press “Alt +F6” to navigate to the order set dialog, and select the Stop Order Set Button.', 'Starting Order Set' ,MB_OKCANCEL) = IDCANCEL then
1385 begin
1386 Result := False;
1387 exit;
1388 end;
1389 end;
1390 if uOrderSet = nil then
1391 begin
1392 uOrderSet := TfrmOMSet.Create(AnOwner);
1393 uOrderSet.SetEventDelay(AnEvent);
1394 uOrderSet.RefNum := ARefNum;
1395 InitialCall := True;
1396 end;
1397 if InitialCall then with uOrderSet do
1398 begin
1399 if Length(ACaption) > 0 then Caption := ACaption;
1400 SetBounds(frmFrame.Left, frmFrame.Top + frmFrame.Height - Height, Width, Height);
1401 SetFormPosition(uOrderSet);
1402 Show;
1403 end;
1404 uOrderSet.InsertList(AList, AnOwner, ARefNum, KeyVarStr, AnEvent.EventType);
1405 Application.ProcessMessages;
1406 Result := uOrderSet <> nil;
1407end;
1408
1409function ActiveOrdering: Boolean;
1410begin
1411 if (uOrderDialog = nil) and (uOrderMenu = nil) and (uOrderSet = nil) and
1412 (uOrderAction = nil) and (uOrderHTML = nil)
1413 then Result := False
1414 else Result := True;
1415end;
1416
1417function CloseOrdering: Boolean;
1418begin
1419 Result := False;
1420 { if an order set is being processed, see if want to interupt }
1421 if uOrderSet <> nil then
1422 begin
1423 uOrderSet.Close;
1424 Application.ProcessMessages;
1425 if uOrderSet <> nil then Exit;
1426 end;
1427 { if another ordering dialog is showing, make sure it is closed first }
1428 if uOrderDialog <> nil then
1429 begin
1430 uOrderDialog.Close;
1431 Application.ProcessMessages; // allow close to finish
1432 if uOrderDialog <> nil then Exit;
1433 end;
1434 if uOrderHTML <> nil then
1435 begin
1436 uOrderHTML.Close;
1437 Application.ProcessMessages; // allow browser to close
1438 Assert(uOrderHTML = nil);
1439 end;
1440 { close any open ordering menu }
1441 if uOrderMenu <> nil then
1442 begin
1443 uOrderMenu.Close;
1444 Application.ProcessMessages; // allow menu to close
1445 Assert(uOrderMenu = nil);
1446 end;
1447 if uOrderAction <> nil then
1448 begin
1449 uOrderAction.Close;
1450 Application.ProcessMessages;
1451 if uOrderAction <> nil then Exit;
1452 end;
1453 Result := True;
1454end;
1455
1456function ReadyForNewOrder(AnEvent: TOrderDelayEvent): Boolean;
1457var
1458 x,tmpPtEvt: string;
1459begin
1460 Result := False;
1461 { make sure a location and provider are selected before ordering }
1462 if not AuthorizedUser then Exit;
1463 //Added to force users without the Provider or ORES key to select an a provider when adding new orders to existing delay orders
1464 if (not Patient.Inpatient) and (AnEvent.EventIFN > 0 ) then
1465 begin
1466 if (User.OrderRole = OR_PHYSICIAN) and (Encounter.Provider = User.DUZ) and (User.IsProvider) then
1467 x := ''
1468 else if not EncounterPresentEDO then Exit;
1469 x := '';
1470 end
1471 else
1472 begin
1473 if not EncounterPresent then Exit;
1474 end;
1475 { then try to lock the patient (provider & encounter checked first to not leave lock) }
1476 if not LockedForOrdering then Exit;
1477 { make sure any current ordering process has completed, but don't drop patient lock }
1478 uKeepLock := True;
1479 if not CloseOrdering then Exit;
1480 uKeepLock := False;
1481 { get the delay event for this order (if applicable) }
1482 if AnEvent.EventType in ['A','D','T','M','O'] then
1483 begin
1484 if (AnEvent.EventName = '') and (AnEvent.EventType <> 'D') then
1485 Exit;
1486 x := AnEvent.EventType + IntToStr(AnEvent.Specialty);
1487 if (uLastConfirm <> x ) and (not XfInToOutNow) then
1488 begin
1489 uLastConfirm := x;
1490 case AnEvent.EventType of
1491 'A','M','O','T': x := AnEvent.EventName;
1492 'D': x := 'Discharge';
1493 end;
1494 if isExistedEvent(Patient.DFN,IntToStr(AnEvent.EventIFN),tmpPtEvt) then
1495 if PtEvtEmpty(tmpPtEvt)then
1496 InfoBox(TX_DELAY + x + TX_DELAY1, TC_DELAY, MB_OK or MB_ICONWARNING);
1497 end;
1498 end
1499 else uLastConfirm := '';
1500 Result := True;
1501end;
1502
1503function ReadyForNewOrder1(AnEvent: TOrderDelayEvent): Boolean;
1504var
1505 x: string;
1506begin
1507 Result := False;
1508 { make sure a location and provider are selected before ordering }
1509 if not AuthorizedUser then Exit;
1510 if (not Patient.Inpatient) and (AnEvent.EventIFN > 0 ) then x := ''
1511 else
1512 begin
1513 if not EncounterPresent then Exit;
1514 end;
1515 { then try to lock the patient (provider & encounter checked first to not leave lock) }
1516 if not LockedForOrdering then Exit;
1517 { make sure any current ordering process has completed, but don't drop patient lock }
1518 uKeepLock := True;
1519 if not CloseOrdering then Exit;
1520 uKeepLock := False;
1521 { get the delay event for this order (if applicable) }
1522 if AnEvent.EventType in ['A','D','T','M','O'] then
1523 begin
1524 x := AnEvent.EventType + IntToStr(AnEvent.Specialty);
1525 if (uLastConfirm <> x ) and (not XfInToOutNow) then
1526 begin
1527 uLastConfirm := x;
1528 case AnEvent.EventType of
1529 'A','M','T','O': x := AnEvent.EventName;
1530 'D': x := AnEvent.EventName; //'D': x := 'Discharge';
1531 end;
1532 end;
1533 end
1534 else uLastConfirm := '';
1535 Result := True;
1536end;
1537
1538procedure SetConfirmEventDelay;
1539begin
1540 uLastConfirm := '';
1541end;
1542
1543procedure ChangeOrders(AList: TStringList; AnEvent: TOrderDelayEvent);
1544var
1545 i,txtOrder: Integer;
1546 FieldsForEditRenewOrder: TOrderRenewFields;
1547 param1, param2 : string;
1548 OrSts: integer;
1549 AnOrder: TOrder;
1550begin
1551 if uOrderDialog <> nil then
1552 begin
1553 uOrderDialog.Close;
1554 Application.ProcessMessages; // allow close to finish
1555 end;
1556
1557 if not ActiveOrdering then // allow change while entering new
1558 if not ReadyForNewOrder(AnEvent) then Exit;
1559 for i := 0 to AList.Count - 1 do
1560 begin
1561 //if it's for unreleased renewed orders, then go to fODChangeUnreleasedRenew and continue
1562 txtOrder := 0;
1563 FieldsForEditRenewOrder := TOrderRenewFields.Create;
1564 LoadRenewFields(FieldsForEditRenewOrder, AList[i]);
1565 if FieldsForEditRenewOrder.BaseType = OD_TEXTONLY then
1566 txtOrder := 1;
1567 if CanEditSuchRenewedOrder(AList[i], txtOrder) then
1568 begin
1569 param1 := '0';
1570 if txtOrder = 0 then
1571 begin
1572 param1 := IntToStr(FieldsForEditRenewOrder.Refills);
1573 param2 := FieldsForEditRenewOrder.Pickup;
1574 end else if txtOrder = 1 then
1575 begin
1576 param1 := FieldsForEditRenewOrder.StartTime;
1577 param2 := FieldsForEditRenewOrder.StopTime;
1578 end;
1579 UBAGlobals.SourceOrderID := AList[i]; //hds6265 added
1580 ExecuteChangeRenewedOrder(AList[i], param1, param2, txtOrder);
1581 AnOrder := TOrder.Create;
1582 SaveChangesOnRenewOrder(AnOrder, AList[i], param1, param2, txtOrder);
1583 AnOrder.ActionOn := AnOrder.ID + '=RN';
1584 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(AnOrder));
1585 Application.ProcessMessages;
1586 Continue;
1587 end else FieldsForEditRenewOrder.Free;
1588
1589 OrSts := GetOrderStatus(AList[i]);
1590 if ( AnsiCompareText(NameOfStatus(OrSts),'active') = 0 ) and (AnEvent.PtEventIFN > 0) then
1591 EventDefaultOD := 1;
1592 ActivateOrderDialog('X' + AList[i], AnEvent, Application, -1); // X + ORIFN for change
1593 if EventDefaultOD = 1 then
1594 EventDefaultOD := 0;
1595 Application.ProcessMessages; // give uOrderDialog a chance to go back to nil
1596 if BILLING_AWARE then //hds6265
1597 begin //hds6265
1598 UBAGlobals.SourceOrderID := AList[i]; //hds6265
1599 UBAGlobals.CopyTreatmentFactorsDxsToCopiedOrder(UBAGlobals.SourceOrderID,UBAGLobals.TargetOrderID); //hds6265
1600 end;
1601 end;
1602 UnlockIfAble;
1603end;
1604
1605function ChangeOrdersEvt(AnOrderID: string; AnEvent: TOrderDelayEvent): boolean;
1606begin
1607 Result := False;
1608 if uOrderDialog <> nil then
1609 begin
1610 uOrderDialog.Close;
1611 Application.ProcessMessages;
1612 end;
1613 if not ActiveOrdering then
1614 if not ReadyForNewOrder(AnEvent) then Exit;
1615 Result := ActivateOrderDialog('X' + AnOrderID, AnEvent, Application, -1);
1616 Application.ProcessMessages;
1617 UnlockIfAble;
1618end;
1619
1620function CopyOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
1621var
1622 i: Integer;
1623 xx: string;
1624 IsIMOOD,ForIVAlso: boolean;
1625begin
1626 Result := False;
1627 if not ReadyForNewOrder(AnEvent) then Exit; // no copy while entering new
1628 for i := 0 to AList.Count - 1 do
1629 begin
1630 if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
1631 begin
1632 DoesEventOccur := True;
1633 AnEvent.EventType := #0;
1634 AnEvent.TheParent := TParentEvent.Create;
1635 AnEvent.EventIFN := 0;
1636 AnEvent.EventName := '';
1637 AnEvent.PtEventIFN := 0;
1638 end;
1639
1640 if CheckOrderGroup(AList[i])=1 then IsUDGroup := True
1641 else IsUDGroup := False;
1642
1643 if (AnEvent.EventIFN>0) and isOnholdMedOrder(AList[i]) then
1644 begin
1645 xx := RetrieveOrderText(AList[i]);
1646 if InfoBox(TX_ONHOLD+#13#13+xx, 'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then
1647 Continue;
1648 end;
1649
1650 DEASig := GetDrugSchedule(AList[i]);
1651 ForIVAlso := ForIVandUD(AList[i]);
1652 IsIMOOD := IsIMOOrder(AList[i]);
1653 if (IsUDGroup) and (ImmdCopyAct) and (not Patient.Inpatient) and (AnEvent.EventType = 'C') and (not IsIMOOD) and (not ForIVAlso) then
1654 XfInToOutNow := True;
1655
1656 OrderSource := 'C';
1657
1658 if ActivateOrderDialog('C' + AList[i], AnEvent, Application, -1, ANeedVerify) then
1659 Result := True;
1660
1661 Application.ProcessMessages; // give uOrderDialog a chance to go back to nil
1662 OrderSource := '';
1663
1664 if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
1665 DoesEventOccur := True;
1666
1667 if IsUDGroup then IsUDGroup := False;
1668 if XfInToOutNOw then XfInToOutNow := False;
1669
1670 if BILLING_AWARE then
1671 begin
1672 UBAGlobals.SourceOrderID := AList[i]; //BAPHII 1.3.2
1673 UBAGlobals.CopyTreatmentFactorsDxsToCopiedOrder(UBAGlobals.SourceOrderID,UBAGLobals.TargetOrderID);
1674 end;
1675 end; //for
1676
1677 UnlockIfAble;
1678end;
1679
1680function TransferOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
1681var
1682 i, CountOfTfOrders: Integer;
1683 xx: string;
1684 //DoesEventOccur: boolean;
1685 //OccuredEvtID: integer;
1686 //OccuredEvtName: string;
1687begin
1688 //DoesEventOccur := False;
1689 //OccuredEvtID := 0;
1690 Result := False;
1691 if not ReadyForNewOrder(AnEvent) then Exit; // no xfer while entering new
1692 CountOfTfOrders := AList.Count;
1693 for i := 0 to CountOfTfOrders - 1 do
1694 begin
1695 if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
1696 begin
1697 DoesEventOccur := True;
1698 //OccuredEvtID := AnEvent.PtEventIFN;
1699 //OccuredEvtName := AnEvent.EventName;
1700 AnEvent.EventType := #0;
1701 AnEvent.TheParent := TParentEvent.Create;
1702 AnEvent.EventIFN := 0;
1703 AnEvent.EventName := '';
1704 AnEvent.PtEventIFN := 0;
1705 end;
1706 if i = CountOfTfOrders - 1 then
1707 begin
1708 if (AnEvent.EventIFN>0) and isOnholdMedOrder(AList[i]) then
1709 begin
1710 xx := RetrieveOrderText(AList[i]);
1711 if InfoBox(TX_ONHOLD+#13#13+xx, 'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then
1712 Continue;
1713 end;
1714 OrderSource := 'X';
1715 if ActivateOrderDialog('T' + AList[i], AnEvent, Application, -2, ANeedVerify) then
1716 Result := True;
1717 end else
1718 begin
1719 if (AnEvent.EventIFN>0) and isOnholdMedOrder(AList[i]) then
1720 begin
1721 xx := RetrieveOrderText(AList[i]);
1722 if InfoBox(TX_ONHOLD+#13#13+xx, 'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then
1723 Continue;
1724 end;
1725 OrderSource := 'X';
1726 if ActivateOrderDialog('T' + AList[i], AnEvent, Application, -1, ANeedVerify) then
1727 Result := True;
1728 end;
1729 Application.ProcessMessages; // give uOrderDialog a chance to go back to nil
1730 OrderSource := '';
1731 if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
1732 DoesEventOccur := True;
1733
1734 UBAGlobals.SourceOrderID := AList[i];
1735 UBAGlobals.CopyTreatmentFactorsDxsToCopiedOrder(UBAGlobals.SourceOrderID, UBAGLobals.TargetOrderID);
1736
1737 end;
1738 UnlockIfAble;
1739
1740end;
1741
1742procedure DestroyingOrderAction;
1743begin
1744 uOrderAction := nil;
1745 if not ActiveOrdering then
1746 begin
1747 ClearOrderRecall;
1748 UnlockIfAble;
1749 end;
1750end;
1751
1752procedure DestroyingOrderDialog;
1753begin
1754 uOrderDialog := nil;
1755 if not ActiveOrdering then
1756 begin
1757 ClearOrderRecall;
1758 UnlockIfAble;
1759 end;
1760end;
1761
1762procedure DestroyingOrderHTML;
1763begin
1764 uOrderHTML := nil;
1765 if not ActiveOrdering then
1766 begin
1767 ClearOrderRecall;
1768 UnlockIfAble;
1769 end;
1770end;
1771
1772procedure DestroyingOrderMenu;
1773begin
1774 uOrderMenu := nil;
1775 if not ActiveOrdering then
1776 begin
1777 ClearOrderRecall;
1778 UnlockIfAble;
1779 end;
1780end;
1781
1782procedure DestroyingOrderSet;
1783begin
1784 uOrderSet := nil;
1785 uOrderSetTime := 0;
1786 if not ActiveOrdering then
1787 begin
1788 ClearOrderRecall;
1789 UnlockIfAble;
1790 end;
1791end;
1792
1793function OrderIsLocked(const AnOrderID, AnAction: string): Boolean;
1794var
1795 ErrorMsg: string;
1796begin
1797 Result := True;
1798 if (AnAction = OA_COPY) then
1799 Exit;
1800 if ((AnAction = OA_HOLD) or (AnAction = OA_UNHOLD) or (AnAction = OA_RENEW) or
1801 (AnAction = OA_DC) or (AnAction = OA_CHANGE)) and Changes.ExistForOrder(AnOrderID)
1802 then Exit;
1803 LockOrder(AnOrderID, ErrorMsg);
1804 if Length(ErrorMsg) > 0 then
1805 begin
1806 Result := False;
1807 InfoBox(ErrorMsg + CRLF + CRLF + TextForOrder(AnOrderID), TC_NOLOCK, MB_OK);
1808 end;
1809end;
1810
1811procedure PopLastMenu;
1812{ always called from fOMSet }
1813begin
1814 if uOrderMenu <> nil then uOrderMenu.cmdDoneClick(uOrderSet);
1815end;
1816
1817procedure QuickOrderSave;
1818begin
1819 // would be better to prompt for dialog
1820 if uOrderDialog = nil then
1821 begin
1822 InfoBox(TX_NO_SAVE_QO, TC_NO_SAVE_QO, MB_OK);
1823 Exit;
1824 end;
1825 with uOrderDialog do
1826 begin
1827 if not AllowQuickOrder then
1828 begin
1829 InfoBox(TX_NO_QUICK, TC_NO_QUICK, MB_OK);
1830 Exit;
1831 end;
1832 if Responses.OrderContainsObjects then
1833 begin
1834 InfoBox(TX_CANT_SAVE_QO, TC_NO_QUICK, MB_ICONERROR or MB_OK);
1835 Exit;
1836 end;
1837 SaveAsQuickOrder(Responses);
1838 end;
1839end;
1840
1841procedure QuickOrderListEdit;
1842begin
1843 // would be better to prompt for dialog
1844 if uOrderDialog = nil then
1845 begin
1846 InfoBox(TX_NO_EDIT_QO, TC_NO_EDIT_QO, MB_OK);
1847 Exit;
1848 end;
1849 with uOrderDialog do
1850 begin
1851 if not AllowQuickOrder then
1852 begin
1853 InfoBox(TX_NO_QUICK, TC_NO_QUICK, MB_OK);
1854 Exit;
1855 end;
1856 EditCommonList(DisplayGroup);
1857 end;
1858end;
1859
1860function RefNumFor(AnOwner: TComponent): Integer;
1861begin
1862 if (uOrderDialog <> nil) and (uOrderDialog.Owner = AnOwner)
1863 then Result := uOrderDialog.RefNum
1864 else if (uOrderMenu <> nil) and (uOrderMenu.Owner = AnOwner)
1865 then Result := uOrderMenu.RefNum
1866 else if (uOrderHTML <> nil) and (uOrderHTML.Owner = AnOwner)
1867 then Result := uOrderHTML.RefNum
1868 else if (uOrderSet <> nil) and (uOrderSet.Owner = AnOwner)
1869 then Result := uOrderSet.RefNum
1870 else Result := -1;
1871end;
1872
1873procedure PrintOrdersOnSignReleaseMult(OrderList, ClinicLst, WardLst: TStringList; Nature: Char; EncLoc, WardLoc: integer;
1874EncLocName, WardLocName: string);
1875var
1876i,j: integer;
1877tempOrder: string;
1878tempOrderList: TStringList;
1879begin
1880 tempOrderList := TStringList.Create;
1881 if (ClinicLst <> nil) and (ClinicLst.Count > 0) then
1882 begin
1883 for i := 0 to ClinicLst.Count - 1 do
1884 begin
1885 tempOrder := ClinicLst.Strings[i];
1886 for j := 0 to OrderList.Count - 1 do
1887 if Piece(OrderList.Strings[j], U,1) = tempOrder then tempOrderList.Add(OrderList.Strings[j]);
1888 end;
1889 if tempOrderList.Count > 0 then PrintOrdersOnSignRelease(tempOrderList, Nature, EncLoc, EncLocName);
1890 end;
1891 if (WardLst <> nil) and (WardLst.Count > 0) then
1892 begin
1893 if tempOrderList.Count > 0 then
1894 begin
1895 tempOrderList.Free;
1896 tempOrderList := TStringList.Create;
1897 end;
1898 for i := 0 to WardLst.Count - 1 do
1899 begin
1900 tempOrder := WardLst.Strings[i];
1901 for j := 0 to OrderList.Count - 1 do
1902 if Piece(OrderList.Strings[j], U,1) = tempOrder then tempOrderList.Add(OrderList.Strings[j]);
1903 end;
1904 if tempOrderList.Count > 0 then PrintOrdersOnSignRelease(tempOrderList, Nature, WardLoc, WardLocName);
1905 end;
1906 tempOrderList.Free;
1907end;
1908
1909procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = '');
1910const
1911 TX_NEW_LOC1 = 'The patient''s location has changed to ';
1912 TX_NEW_LOC2 = '.' + CRLF + 'Should the orders be printed using the new location?';
1913 TC_NEW_LOC = 'New Patient Location';
1914 TX_SIGN_LOC = 'No location was selected. Orders could not be printed!';
1915 TC_REQ_LOC = 'Orders Not Printed';
1916 TX_LOC_PRINT = 'The selected location will be used to determine where orders are printed.';
1917var
1918 ALocation: Integer;
1919 AName, ASvc, DeviceInfo: string;
1920 PrintIt: Boolean;
1921begin
1922 if PrintLoc = 0 then
1923 begin
1924 CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc);
1925 if (ALocation > 0) and (ALocation <> Encounter.Location) then
1926 begin
1927 if InfoBox(TX_NEW_LOC1 + AName + TX_NEW_LOC2, TC_NEW_LOC, MB_YESNO) = IDYES
1928 then Encounter.Location := ALocation;
1929 end;
1930 end;
1931 //else
1932 //Encounter.Location := PrintLoc;
1933 if (PrintLoc = 0) and (Encounter.Location > 0) then PrintLoc := Encounter.Location;
1934 if PrintLoc = 0
1935 then PrintLoc := CommonLocationForOrders(OrderList);
1936 if PrintLoc = 0 then // location required for DEVINFO
1937 begin
1938 LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
1939 if ALocation > 0 then
1940 begin
1941 PrintLoc := ALocation;
1942 Encounter.Location := ALocation;
1943 end;
1944 end;
1945 if printLoc = 0 then frmFrame.DisplayEncounterText;
1946 if PrintLoc <> 0 then
1947 begin
1948 SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt, PrintName, PrintLoc);
1949 if PrintIt then
1950 PrintOrdersOnReview(OrderList, DeviceInfo, PrintLoc)
1951 else
1952 PrintServiceCopies(OrderList, PrintLoc);
1953 end
1954 else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
1955end;
1956
1957procedure SetFontSize( FontSize: integer);
1958begin
1959 if uOrderDialog <> nil then
1960 uOrderDialog.SetFontSize( FontSize);
1961 if uOrderMenu <> nil then
1962 uOrderMenu.ResizeFont;
1963end;
1964
1965procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
1966begin
1967 if LastIndex = 0 then
1968 LastIndex := NewIndex;
1969 if (LastIndex - NewIndex) <= 0 then
1970 NMRec.NextStep := STEP_FORWARD
1971 else
1972 NMRec.NextStep := STEP_BACK;
1973 NMRec.LastIndex := NewIndex;
1974end;
1975
1976(*function GetQOAltOI: integer;
1977begin
1978 Result := QOAltOI.OI;
1979end; *)
1980
1981function IsIMODialog(DlgID: integer): boolean; //IMO
1982var
1983 IsInptDlg, IsIMOLocation: boolean;
1984 Td: TFMDateTime;
1985begin
1986 result := False;
1987 IsInptDlg := False;
1988 //CQ #15188 - allow IMO functionality 23 hours after encounter date/time - TDP
1989 //Td := FMToday;
1990 Td := IMOTimeFrame;
1991 if ( (DlgID = MedsInDlgIen) or (DlgID = MedsIVDlgIen) or (IsInptQO(dlgId)) or (IsIVQO(dlgId))) then IsInptDlg := TRUE;
1992 IsIMOLocation := IsValidIMOLoc(Encounter.Location,Patient.DFN);
1993 if (IsInptDlg or IsInptQO(DlgID)) and (not Patient.Inpatient) and IsIMOLocation and (Encounter.DateTime > Td) then
1994 result := True;
1995end;
1996
1997function AllowActionOnIMO(AnEvtTyp: char): boolean;
1998var
1999 Td: TFMDateTime;
2000begin
2001 Result := False;
2002 if (Patient.Inpatient) then
2003 begin
2004 Td := FMToday;
2005 if IsValidIMOLoc(Encounter.Location,Patient.DFN) and (Encounter.DateTime > Td) then
2006 Result := True;
2007 end
2008 else
2009 begin
2010 //CQ #15188 - allow IMO functionality 23 hours after encounter date/time - TDP
2011 //Td := FMToday;
2012 Td := IMOTimeFrame;
2013 if IsValidIMOLoc(Encounter.Location,Patient.DFN) and (Encounter.DateTime > Td) then
2014 Result := True
2015 else if AnEvtTyp in ['A','T'] then
2016 Result := True;
2017 end;
2018end;
2019
2020function IMOActionValidation(AnId: string; var IsIMOOD: boolean; var x: string; AnEventType: char): boolean;
2021var
2022 actName: string;
2023begin
2024 // jd imo change
2025 Result := True;
2026 if CharAt(AnID, 1) in ['X','C'] then // transfer IMO order doesn't need check
2027 begin
2028 IsIMOOD := IsIMOOrder(Copy(AnID, 2, Length(AnID)));
2029 If IsIMOOD then
2030 begin
2031 if (not AllowActionOnIMO(AnEventType)) then
2032 begin
2033 if CharAt(AnID,1) = 'X' then actName := 'change';
2034 if CharAt(AnID,1) = 'C' then actName := 'copy';
2035 x := 'You cannot ' + actName + ' the clinical medication order.';
2036 x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#13#10 + x;
2037 UnlockOrder(Copy(AnID, 2, Length(AnID)));
2038 result := False;
2039 end
2040 else
2041 begin
2042 if patient.Inpatient then
2043 begin
2044 if CharAt(AnID,1) = 'X' then actName := 'changing';
2045 if CharAt(AnID,1) = 'C' then actName := 'copying';
2046 if MessageDlg(TX_IMO_WARNING1 + actName + TX_IMO_WARNING2 + #13#13#10 + x, mtWarning,[mbOK,mbCancel],0) = mrCancel then
2047 begin
2048 UnlockOrder(Copy(AnID, 2, Length(AnID)));
2049 result := False;
2050 end;
2051 end;
2052 end;
2053 end;
2054 end;
2055 if Piece(AnId,'^',1)='RENEW' then
2056 begin
2057 IsIMOOD := IsIMOOrder(Piece(AnID,'^',2));
2058 If IsIMOOD then
2059 begin
2060 if (not AllowActionOnIMO(AnEventType)) then
2061 begin
2062 x := 'You cannot renew the clinical medication order.';
2063 x := RetrieveOrderText(Piece(AnID,'^',2)) + #13#13#10 + x;
2064 UnlockOrder(Piece(AnID,'^',2));
2065 result := False;
2066 end
2067 else
2068 begin
2069 if Patient.Inpatient then
2070 begin
2071 if MessageDlg(TX_IMO_WARNING1 + 'renewing' + TX_IMO_WARNING2, mtWarning,[mbOK,mbCancel],0) = mrCancel then
2072 begin
2073 UnlockOrder(Copy(AnID, 2, Length(AnID)));
2074 result := False;
2075 end;
2076 end;
2077 end;
2078 end;
2079 end;
2080end;
2081
2082//CQ #15188 - New function to allow IMO functionality 23 hours after encounter date/time - TDP
2083function IMOTimeFrame: TFMDateTime;
2084begin
2085 Result := DateTimeToFMDateTime(FMDateTimeToDateTime(FMNow) - (23/24));
2086end;
2087
2088initialization
2089 uPatientLocked := False;
2090 uKeepLock := False;
2091 uLastConfirm := '';
2092 uOrderSetTime := 0;
2093 uNewMedDialog := 0;
2094 uOrderAction := nil;
2095 uOrderDialog := nil;
2096 uOrderHTML := nil;
2097 uOrderMenu := nil;
2098 uOrderSet := nil;
2099 NSSchedule := False;
2100 OriginalMedsOutHeight := 0;
2101 OriginalMedsInHeight := 0;
2102 OriginalNonVAMedsHeight := 0;
2103
2104end.
Note: See TracBrowser for help on using the repository browser.