source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/uOrders.~pas@ 667

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

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