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

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

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