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

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

Upgrade to version 27

File size: 72.3 KB
RevLine 
[456]1unit uOrders;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Controls, Forms, uConst, rOrders, ORFn,
[829]7 Dialogs, ORCtrls, stdCtrls, strUtils, fODBase, fODMedOIFA;
[456]8
9type
10 EOrderDlgFail = class(Exception);
11
[829]12 //FQOAltOI = record
13 //OI: integer;
14 //end;
15
[456]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;
[829]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 = '');
[456]66procedure SetFontSize( FontSize: integer);
67procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
[829]68//function GetQOAltOI: integer;
[456]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;
[829]87DietDisp : Integer;
[456]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;
[829]101PassDrugTstCall: boolean;
[456]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,
[829]110 UBAGlobals, fClinicWardMeds, uTemplateFields, VAUtils;
[456]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;
[829]123 //QOALTOI: FQOAltOI;
[456]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(' ');
[829]464 FastAddStrings(TStrings(AnErrLst), tmpList);
[456]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');
[829]483 DietDisp := DisplayGroupByName('DO');
[456]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
[829]775 //Show508Message('Order Dialogs of type "Action" are available in List Manager only.');
[456]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';
[829]786 TX_EVTDEL_DIET_CONFLICT = 'Have you done either of the above?';
787 TC_EVTDEL_DIET_CONFLICT = 'Possible delayed order conflict';
[456]788var
789 ResolvedDialog: TOrderDialogResolved;
[829]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;
[456]795 tmpResp: TResponse;
[829]796 CxMsg: string;
797 AButton: TButton;
[456]798begin
799 IsPsoSupply := False;
800 Result := False;
801 IsDischargeOrPass := False;
802 IsAnIMOOrder := False;
803 ForIMO := False;
[829]804 IsNewOrder := True;
805 PassDrugTstCall := False;
806 DrugCheck := false;
807 DrugTestDlgType := false;
808 //QOAltOI.OI := 0;
[456]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
[829]814 IsNewOrder := False;
815 // if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit;
[456]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;
[829]824 DrugCheck := true;
[456]825 end;
826 if CharAt(AnID, 1) = 'C' then
827 begin
[829]828 IsNewOrder := False;
829 //if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit;
[456]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;
[829]833 if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY) then Exit;
834 DrugCheck := true;
[456]835 end;
836 if CharAt(AnID, 1) = 'T' then
837 begin
[829]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;
[456]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);
[829]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;
[456]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
[829]910 if (NssErr <> 'OTHER') and (NssErr <> 'schedule is not defined.') then
911 ShowMsg('The order contains invalid non-standard schedule.');
[456]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
[829]922 ShowMsg('The order contains invalid non-standard schedule.');
[456]923 NSSchedule := True;
924 end;
925 end;
926 if NSSchedule then ResolvedDialog.QuickLevel := 0;
927 end;
[829]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;
[456]945 with ResolvedDialog do if (QuickLevel = QL_VERIFY) and (HasTemplateField(ShowText)) then QuickLevel := QL_DIALOG;
[829]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
[456]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
[829]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;
[456]1150 cmdAcceptClick(Application); // auto-accept order
1151 Result := uOrderDialog.AcceptOK;
1152
1153 //BAPHII 1.3.2
[829]1154 //Show508Message('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()');
[456]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);
[829]1176 //QOAltOI.OI := 0;
[456]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;
[829]1227 FastAssign(uOrderHTML.SetList, ASetList);
[456]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
[829]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;
[456]1819
[829]1820procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = '');
[456]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;
[829]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;
[456]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;
[829]1875 if printLoc = 0 then frmFrame.DisplayEncounterText;
[456]1876 if Encounter.Location <> 0 then
1877 begin
[829]1878 SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt, PrintName);
[456]1879 if PrintIt then
1880 PrintOrdersOnReview(OrderList, DeviceInfo)
1881 else
1882 PrintServiceCopies(OrderList);
1883 end
[829]1884 else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING); *)
[456]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
[829]1906(*function GetQOAltOI: integer;
1907begin
1908 Result := QOAltOI.OI;
1909end; *)
1910
[456]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.