close Warning: Can't use blame annotator: 
svn blame failed on cprs/trunk/CPRS-Chart/Orders/uOrders.pas: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

Last change on this file since 908 was 829, checked in by Kevin Toppenberg, 14 years ago

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