source: cprs/branches/foia-cprs/CPRS-Chart/Orders/uOrders.pas@ 459

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

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