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

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

Updating the working copy to CPRS version 28

File size: 76.2 KB
RevLine 
[456]1unit uOrders;
2
3interface
4
5uses
[1679]6 Windows, Messages, SysUtils, Classes, Controls, Forms, uConst, rConsults,
7 rOrders, ORFn, Dialogs, ORCtrls, stdCtrls, strUtils, fODBase, fODMedOIFA,
8 VA508AccessibilityRouter;
[456]9
10type
11 EOrderDlgFail = class(Exception);
12
[829]13 //FQOAltOI = record
14 //OI: integer;
15 //end;
16
[456]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;
[829]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 = '');
[456]67procedure SetFontSize( FontSize: integer);
68procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
[829]69//function GetQOAltOI: integer;
[456]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;
[1679]75function IMOTimeFrame: TFMDateTime;
[456]76
77
78var
79uAutoAc: Boolean;
80InptDisp : Integer;
81OutptDisp: Integer;
82MedsDisp : Integer;
83ClinDisp : Integer; //IMO
84NurDisp : Integer;
85IVDisp : Integer;
86CsltDisp : Integer;
87ProcDisp : Integer;
88ImgDisp : Integer;
[829]89DietDisp : Integer;
[456]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;
[829]103PassDrugTstCall: boolean;
[456]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,
[829]112 UBAGlobals, fClinicWardMeds, uTemplateFields, VAUtils;
[456]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;
[829]125 //QOALTOI: FQOAltOI;
[456]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
[1679]294 UpdateEncounter(NPF_PROVIDER, 0, 0, True);
[456]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(' ');
[829]466 FastAddStrings(TStrings(AnErrLst), tmpList);
[456]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');
[829]485 DietDisp := DisplayGroupByName('DO');
[456]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
[1679]497function CanCloseDialog(dialog : TfrmODBase) : Boolean;
498begin
499 if uOrderDialog.FillerID = 'GMRC' then
500 result := fODConsult.CanFreeConsultDialog(dialog)
501 or fODProc.CanFreeProcDialog(dialog);
502end;
503
[456]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
[1679]761 begin
762// DialogClass := TfrmARTAllergy;
763 EnterEditAllergy(0, TRUE, FALSE, AnOwner, ARefNum);
764 Result := True;
765// uOrderMenu.Close;
766 Exit;
767 end
[456]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
[829]790 //Show508Message('Order Dialogs of type "Action" are available in List Manager only.');
[456]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';
[829]801 TX_EVTDEL_DIET_CONFLICT = 'Have you done either of the above?';
802 TC_EVTDEL_DIET_CONFLICT = 'Possible delayed order conflict';
[1679]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';
[456]809var
810 ResolvedDialog: TOrderDialogResolved;
[829]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;
[456]816 tmpResp: TResponse;
[829]817 CxMsg: string;
818 AButton: TButton;
[1679]819 SvcIEN: string;
820 //CsltFrmID: integer;
[456]821begin
822 IsPsoSupply := False;
823 Result := False;
824 IsDischargeOrPass := False;
825 IsAnIMOOrder := False;
826 ForIMO := False;
[829]827 IsNewOrder := True;
828 PassDrugTstCall := False;
829 DrugCheck := false;
830 DrugTestDlgType := false;
831 //QOAltOI.OI := 0;
[1679]832 Application.ProcessMessages;
[456]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
[829]838 IsNewOrder := False;
839 // if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit;
[456]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;
[829]848 DrugCheck := true;
[456]849 end;
850 if CharAt(AnID, 1) = 'C' then
851 begin
[829]852 IsNewOrder := False;
853 //if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit;
[456]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;
[829]857 if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY) then Exit;
858 DrugCheck := true;
[456]859 end;
860 if CharAt(AnID, 1) = 'T' then
861 begin
[829]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;
[456]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);
[1679]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;
[456]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);
[829]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;
[456]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
[829]937 if (NssErr <> 'OTHER') and (NssErr <> 'schedule is not defined.') then
938 ShowMsg('The order contains invalid non-standard schedule.');
[456]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
[829]949 ShowMsg('The order contains invalid non-standard schedule.');
[456]950 NSSchedule := True;
951 end;
952 end;
953 if NSSchedule then ResolvedDialog.QuickLevel := 0;
954 end;
[829]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;
[456]972 with ResolvedDialog do if (QuickLevel = QL_VERIFY) and (HasTemplateField(ShowText)) then QuickLevel := QL_DIALOG;
[829]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
[456]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);
[1679]996 if QuickLevel = QL_AUTO then
997 begin
998 //CsltFrmID := FormID;
999 FormID := OD_AUTOACK;
1000 end;
[456]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);
[1679]1079 {if ((ResolvedDialog.DisplayGroup = CsltDisp)
1080 and (ResolvedDialog.QuickLevel = QL_AUTO)) then
1081 TfrmODCslt.SetupDialog(ORDER_QUICK, ResolvedDialog.ResponseID);}
[456]1082 end;
1083 end;
1084
1085 if Assigned(uOrderDialog) then
[1679]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;
[456]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
[829]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;
[1679]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;
[456]1211 cmdAcceptClick(Application); // auto-accept order
1212 Result := uOrderDialog.AcceptOK;
[1679]1213 if (result = true) and (ScreenReaderActive) then
1214 GetScreenReader.Speak('Auto Accept Quick Order '+ Responses.DialogDisplayName + ' placed.');
[456]1215
1216 //BAPHII 1.3.2
[829]1217 //Show508Message('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()');
[456]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);
[829]1239 //QOAltOI.OI := 0;
[456]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;
[829]1290 FastAssign(uOrderHTML.SetList, ASetList);
[456]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;
[1679]1369 i: integer;
1370 str: string;
[456]1371begin
1372 InitialCall := False;
[1679]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;
[456]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;
[1679]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
[456]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
[829]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;
[456]1908
[829]1909procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = '');
[456]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;
[829]1930 end;
1931 //else
1932 //Encounter.Location := PrintLoc;
[1679]1933 if (PrintLoc = 0) and (Encounter.Location > 0) then PrintLoc := Encounter.Location;
[829]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);
[456]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
[829]1976(*function GetQOAltOI: integer;
1977begin
1978 Result := QOAltOI.OI;
1979end; *)
1980
[456]1981function IsIMODialog(DlgID: integer): boolean; //IMO
1982var
1983 IsInptDlg, IsIMOLocation: boolean;
1984 Td: TFMDateTime;
1985begin
1986 result := False;
1987 IsInptDlg := False;
[1679]1988 //CQ #15188 - allow IMO functionality 23 hours after encounter date/time - TDP
1989 //Td := FMToday;
1990 Td := IMOTimeFrame;
[456]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
[1679]2010 //CQ #15188 - allow IMO functionality 23 hours after encounter date/time - TDP
2011 //Td := FMToday;
2012 Td := IMOTimeFrame;
[456]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
[1679]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
[456]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.