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

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 81.3 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
860 frmOrders.ParentComplexOrderID := ParentOrderID;
861 if (AListBox.Name = 'lstMedsOut' ) or (AListBox.Name = 'lstMedsIn') then
862 frmMeds.ParentComplexOrderID := ParentOrderID;
863 end;
864 DeselectChild(ChildIdxList);
865 end;
866 end;
867 end;
868 ErrMsg := '';
869 ChildtxtList.Free;
870 ChildList.Clear;
871 ChildList.Free;
872 end;
873 CategoryList.Clear;
874end;
875
876{ Write New Orders }
877
878function ActivateAction(const AnID: string; AnOwner: TComponent; ARefNum: Integer): Boolean;
879// AnID: DlgIEN {;FormID;DGroup}
880type
881 TDialogClass = class of TfrmOMAction;
882var
883 DialogClass: TDialogClass;
884 AFormID: Integer;
885begin
886 Result := False;
887 AFormID := FormIDForDialog(StrToIntDef(Piece(AnID, ';', 1), 0));
888 if AFormID > 0 then
889 begin
890 case AFormID of
891 OM_ALLERGY: if ARTPatchInstalled then
892 DialogClass := TfrmARTAllergy
893 else
894 begin
895 Result := False;
896 Exit;
897 end;
898 OM_HTML: DialogClass := TfrmOMHTML;
899 999999: DialogClass := TfrmOMAction; // for testing!!!
900 else
901 Exit;
902 end;
903 if AnOwner = nil then AnOwner := Application;
904 uOrderAction := DialogClass.Create(AnOwner);
905 if (uOrderAction <> nil) (*and (not uOrderAction.AbortAction) *)then
906 begin
907 uOrderAction.CallOnExit := DestroyingOrderAction;
908 uOrderAction.RefNum := ARefNum;
909 uOrderAction.OrderDialog := StrToIntDef(Piece(AnID, ';', 1), 0);
910 Result := True;
911 if (not uOrderAction.AbortAction) then uOrderAction.ShowModal;
912 end;
913 end else
914 begin
915 //ShowMessage('Order Dialogs of type "Action" are available in List Manager only.');
916 Result := False;
917 end;
918end;
919
920function ActivateOrderDialog(const AnID: string; AnEvent: TOrderDelayEvent;
921 AnOwner: TComponent; ARefNum: Integer; ANeedVerify: boolean = True): Boolean;
922//const
923//TX_NO_DEA = 'Provider must have a DEA# or VA# to change this order'; <-- original line. //kt 8/8/2007
924//TC_NO_DEA = 'DEA# Required'; <-- original line. //kt 8/8/2007
925//TC_IMO_ERROR = 'Inpatient medication order on outpatient authorization required'; <-- original line. //kt 8/8/2007
926var
927 TX_NO_DEA : string; //KT
928 TC_NO_DEA : string; //KT
929 TC_IMO_ERROR : string; //KT
930
931 ResolvedDialog: TOrderDialogResolved;
932 x, EditedOrder, chkCopay, OrderID, PkgInfo,OrderPtEvtID,OrderEvtID,NssErr: string;
933 ODItem: integer;
934 IsInpatient, IsAnIMOOrder: boolean;
935 IsPsoSupply,IsDischargeOrPass,IsPharmacyOrder,IsConsultOrder,ForIMO: boolean;
936 tmpResp: TResponse;
937begin
938 TX_NO_DEA := DKLangConstW('uOrders_Provider_must_have_a_DEAx_or_VAx_to_change_this_order'); //kt added 8/8/2007
939 TC_NO_DEA := DKLangConstW('uOrders_DEAx_Required'); //kt added 8/8/2007
940 TC_IMO_ERROR := DKLangConstW('uOrders_Inpatient_medication_order_on_outpatient_authorization_required'); //kt added 8/8/2007
941 SetupVars; //kt added 8/8/2007 to replace constants with vars.
942 IsPsoSupply := False;
943 Result := False;
944 IsDischargeOrPass := False;
945 IsAnIMOOrder := False;
946 ForIMO := False;
947 // double check environment before continuing with order
948 if uOrderDialog <> nil then uOrderDialog.Close; // then x := uOrderDialog.Name else x := '';
949 //if ShowMsgOn(uOrderDialog <> nil, TX_DLG_ERR + CRLF + x, TC_DLG_ERR) then Exit;
950 if CharAt(AnID, 1) = 'X' then
951 begin
952 ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_CHANGE, x);
953 if ( Length(x)<1 ) and not (AnEvent.EventIFN > 0) then
954 ValidateComplexOrderAct(Copy(AnID, 2, Length(AnID)),x);
955 if (Pos('COMPLEX-PSI',x)>0) then
956 x := TX_COMPLEX;
957 if Length(x) > 0 then
958 x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
959 if ShowMsgOn(Length(x) > 0, x, TC_NO_CHANGE) then Exit;
960 end;
961 if CharAt(AnID, 1) = 'C' then
962 begin
963 ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_COPY, x);
964 if Length(x) > 0 then
965 x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
966 if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY) then Exit;
967 end;
968 if CharAt(AnID, 1) = 'T' then
969 begin
970 ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_TRANSFER, x);
971 if Length(x) > 0 then
972 x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
973 if ShowMsgOn(Length(x) > 0, x, TC_NO_XFER) then Exit;
974 end;
975 if not IMOActionValidation(AnID, IsAnIMOOrder, x, AnEvent.EventType) then
976 begin
977 ShowMsgOn(Length(x) > 0, x, TC_IMO_ERROR);
978 Exit;
979 end;
980 if ( (StrToIntDef(AnId,0)>0) and (AnEvent.EventIFN <= 0) ) then
981 ForIMO := IsIMODialog(StrToInt(AnId))
982 else if ( (IsAnIMOOrder) and (AnEvent.EventIFN <= 0) ) then
983 ForIMO := True;
984
985 OrderPtEvtID := GetOrderPtEvtID(Copy(AnID, 2, Length(AnID)));
986 OrderEvtID := Piece(EventInfo(OrderPtEvtID),'^',2);
987 // evaluate order dialog, build response list & see what form should be presented
988 FillChar(ResolvedDialog, SizeOf(ResolvedDialog), #0);
989 ResolvedDialog.InputID := AnID;
990 BuildResponses(ResolvedDialog, GetKeyVars, AnEvent, ForIMO);
991 if (ForIMO and ( (ResolvedDialog.DialogIEN = MedsInDlgIen)
992 or (ResolvedDialog.DialogIEN = MedsIVDlgIen)) ) then
993 ResolvedDialog.DisplayGroup := ClinDisp;
994 ResetDialogProperties(AnID, AnEvent, ResolvedDialog);
995 {* AGP CHANGE 26.20 Remove restriction to allowed for ordering of inpatient medication for an inpatient from an outpatient location
996 //jd imo change
997 if (ResolvedDialog.DisplayGroup = InptDisp) and (Patient.Inpatient) and (AnEvent.EventIFN < 1) then
998 begin
999 if IsClinicLoc(Encounter.Location) then
1000 begin
1001 MessageDlg(TX_NOINPT, mtWarning, [mbOK], 0);
1002 Exit;
1003 end;
1004 end;
1005 //jd imo change end *}
1006 if (ResolvedDialog.DisplayGroup = InptDisp) or
1007 (ResolvedDialog.DisplayGroup = OutptDisp) or
1008 (ResolvedDialog.DisplayGroup = MedsDisp) or
1009 (ResolvedDialog.DisplayGroup = IVDisp) or
1010 (ResolvedDialog.DisplayGroup = NonVADisp) or
1011 (ResolvedDialog.DisplayGroup = ClinDisp) then IsPharmacyOrder := True
1012 else
1013 IsPharmacyOrder := False;
1014 (* IsPharmacyOrder := ResolvedDialog.DisplayGroup in [InptDisp, OutptDisp,
1015 MedsDisp,IVDisp, NonVADisp, ClinDisp];*) //v25.27 range check error - RV
1016 IsConsultOrder := ResolvedDialog.DisplayGroup in [CsltDisp,ProcDisp];
1017 if (uAutoAC) and (not (ResolvedDialog.QuickLevel in [QL_REJECT,QL_CANCEL]))
1018 and (not IsPharmacyOrder) and (not IsConsultOrder) then
1019 ResolvedDialog.QuickLevel := QL_AUTO;
1020 if (ResolvedDialog.DialogType = 'Q')
1021 and (ResolvedDialog.DisplayGroup = InptDisp) then
1022 begin
1023 NssErr := IsValidQOSch(ResolvedDialog.InputID);
1024 if (Length(NssErr) > 1) then
1025 begin
1026 if (NssErr <> 'OTHER') then
1027// ShowMessage('The order contains invalid non-standard schedule.'); <-- original line. //kt 8/8/2007
1028 ShowMessage(DKLangConstW('uOrders_The_order_contains_invalid_nonxstandard_schedulex')); //kt added 8/8/2007
1029 NSSchedule := True;
1030 ResolvedDialog.QuickLevel := 0;
1031 end;
1032 end;
1033 if ResolvedDialog.DisplayGroup = InptDisp then //nss
1034 begin
1035 if (CharAt(AnID, 1) = 'C') or (CharAt(AnID, 1) = 'T') or (CharAt(AnID, 1) = 'X') then
1036 begin
1037 if not IsValidSchedule(Copy(AnID, 2, Length(AnID))) then
1038 begin
1039// ShowMessage('The order contains invalid non-standard schedule.'); <-- original line. //kt 8/8/2007
1040 ShowMessage(DKLangConstW('uOrders_The_order_contains_invalid_nonxstandard_schedulex')); //kt added 8/8/2007
1041 NSSchedule := True;
1042 end;
1043 end;
1044 if NSSchedule then ResolvedDialog.QuickLevel := 0;
1045 end;
1046 with ResolvedDialog do if (QuickLevel = QL_VERIFY) and (HasTemplateField(ShowText)) then QuickLevel := QL_DIALOG;
1047 with ResolvedDialog do
1048 begin
1049 if QuickLevel = QL_REJECT then InfoBox(ShowText, TC_DLG_REJECT, MB_OK);
1050 if (QuickLevel = QL_VERIFY) and (IsPharmacyOrder or ANeedVerify) then ShowVerifyText(QuickLevel, ShowText, DisplayGroup=InptDisp);
1051 if QuickLevel = QL_AUTO then FormID := OD_AUTOACK;
1052 if (QuickLevel = QL_REJECT) or (QuickLevel = QL_CANCEL) then Exit;
1053 PushKeyVars(ResolvedDialog.QOKeyVars);
1054 end;
1055 if ShowMsgOn(not (ResolvedDialog.FormID > 0), TX_NOFORM, TC_NOFORM) then Exit;
1056 with ResolvedDialog do if DialogType = 'X' then
1057 begin
1058 EditedOrder := Copy(Piece(ResponseID, '-', 1), 2, Length(ResponseID));
1059 end
1060 else EditedOrder := '';
1061 if XfInToOutNow then
1062 begin
1063 //if Transfer an order to outpatient and release immediately
1064 // then changing the Eventtype to 'C' instead of 'D'
1065 IsDischargeOrPass := True;
1066 AnEvent.EventType := 'C';
1067 AnEvent.Effective := 0;
1068 end;
1069 uOrderDialog := CreateOrderDialog(AnOwner, ResolvedDialog.FormID, AnEvent, StrToIntDef(OrderEvtID,0));
1070 uOrderDialog.IsSupply := IsPsoSupply;
1071
1072 {For copy, change, transfer actions on an None-IMO order, the new order should not be treated as IMO order
1073 although the IMO criteria could be met. }
1074 //if (uOrderDialog.IsIMO) and (CharAt(AnID, 1) in ['X','C','T']) then
1075 if not uOrderDialog.IsIMO then
1076 uOrderDialog.IsIMO := ForIMO;
1077
1078 if (ResolvedDialog.DialogType = 'Q') and (ResolvedDialog.DisplayGroup in [MedsDisp, OutptDisp, InptDisp]) then
1079 begin
1080 if DoesOIPIInSigForQO(StrToInt(ResolvedDialog.InputID))=1 then
1081 uOrderDialog.IncludeOIPI := True
1082 else
1083 uOrderDialog.IncludeOIPI := False;
1084 end;
1085
1086 if (uOrderDialog <> nil) and not uOrderDialog.Closing then with uOrderDialog do
1087 begin
1088 SetKeyVariables(GetKeyVars);
1089
1090 if IsDischargeOrPass then
1091 EvtForPassDischarge := 'D'
1092 else
1093 EvtForPassDischarge := #0;
1094
1095 Responses.SetEventDelay(AnEvent);
1096 Responses.LogTime := uOrderSetTime;
1097 DisplayGroup := ResolvedDialog.DisplayGroup; // used to pass ORTO
1098 DialogIEN := ResolvedDialog.DialogIEN; // used to pass ORIT
1099 RefNum := ARefNum;
1100
1101 case ResolvedDialog.DialogType of
1102 'C': SetupDialog(ORDER_COPY, ResolvedDialog.ResponseID);
1103 'D': SetupDialog(ORDER_NEW, '');
1104 'X':
1105 begin
1106 SetupDialog(ORDER_EDIT, ResolvedDialog.ResponseID);
1107 OrderID := Copy(ResolvedDialog.ResponseID,2,Length(ResolvedDialog.ResponseID));
1108 IsInpatient := OrderForInpatient;
1109 ODItem := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
1110 PkgInfo := '';
1111 if Length(OrderID)>0 then
1112 PkgInfo := GetPackageByOrderID(OrderID);
1113 if Pos('PS',PkgInfo)=1 then
1114 begin
1115 if DEACheckFailed(ODItem, IsInPatient) and (uOrderDialog.FillerID <> 'PSH') then
1116 begin
1117 InfoBox(TX_NO_DEA + #13 + Responses.OrderText, TC_NO_DEA, MB_OK);
1118 if (ResolvedDialog.DialogType = 'X') and not Changes.ExistForOrder(EditedOrder)
1119 then UnlockOrder(EditedOrder);
1120 uOrderDialog.Close;
1121 Exit;
1122 end;
1123 end;
1124 end;
1125 'Q':
1126 begin
1127 if IsPSOSupplyDlg(ResolvedDialog.DialogIEN,1) then
1128 uOrderDialog.IsSupply := True;
1129 SetupDialog(ORDER_QUICK, ResolvedDialog.ResponseID);
1130 end;
1131 end;
1132
1133 if Assigned(uOrderDialog) then
1134 with uOrderDialog do if AbortOrder then
1135 begin
1136 Close;
1137 Exit;
1138 end;
1139
1140 if CharAt(AnID, 1) = 'T' then
1141 begin
1142 if ARefNum = -2 then
1143 Responses.TransferOrder := '';
1144 if ARefNum = -1 then
1145 Responses.TransferOrder := AnID;
1146 end;
1147
1148 if CharAt(AnID,1) = 'C' then ////////////////////////////////////////////////////////////////////////
1149 begin
1150 chkCopay := Copy(AnID,2,length(AnID)); //STRIP prepended C, T, or X from first position in order ID.
1151 SetDefaultCoPay(chkCopay);
1152 end; ////////////////////////////////////////////////////////////////////////'
1153
1154 if IsConsultOrder and (CharAt(AnID,1) = 'C') then
1155 begin
1156 tmpResp := uOrderDialog.Responses.FindResponseByName('CODE', 1);
1157 if (tmpResp <> nil) then
1158 begin
1159 if IsActiveICDCode(tmpResp.EValue) then
1160 ResolvedDialog.QuickLevel := QL_AUTO
1161 else
1162 ResolvedDialog.QuickLevel := QL_DIALOG;
1163 end
1164 else
1165 ResolvedDialog.QuickLevel := QL_AUTO
1166 end;
1167
1168 if ResolvedDialog.QuickLevel <> QL_AUTO then
1169 begin
1170 if CharAt(AnID, 1) in ['C','T','X'] then
1171 begin
1172 Position := poScreenCenter;
1173 FormStyle := fsNormal;
1174 ShowModal;
1175 Result := uOrderDialog.AcceptOK;
1176 end
1177 else
1178 begin
1179 SetBounds(frmFrame.Left + 112, frmFrame.Top + frmFrame.Height - Height, Width, Height);
1180 SetFormPosition(uOrderDialog);
1181 FormStyle := fsStayOnTop;
1182 if frmOrders.NeedShowModal then
1183 begin
1184 ShowModal;
1185 Result := uOrderDialog.AcceptOK;
1186 uOrderDialog.Destroy;
1187 end
1188 else
1189 begin
1190 Show;
1191 Result := True;
1192 end;
1193 end;
1194 end
1195 else
1196 begin
1197 cmdAcceptClick(Application); // auto-accept order
1198 Result := uOrderDialog.AcceptOK;
1199
1200 //BAPHII 1.3.2
1201 //showmessage('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()');
1202
1203 //End BAPHII 1.3.2
1204
1205 if Assigned(uOrderDialog) then
1206 uOrderDialog.Destroy;
1207 end;
1208
1209 end
1210 else
1211 begin
1212 uOrderDialog.Release;
1213 Result := False;
1214 //Application.ProcessMessages; // to allow dialog to finish closing
1215 //Exit; // so result is not returned true
1216 end;
1217
1218 if NSSchedule then
1219 NSSchedule := False;
1220
1221 if (ResolvedDialog.DialogType = 'X') and not Changes.ExistForOrder(EditedOrder)
1222 then UnlockOrder(EditedOrder);
1223
1224end;
1225
1226function RetrieveOrderText(AnOrderID: string): string;
1227var
1228 OrdList: TList;
1229 theOrder: TOrder;
1230 // i: integer;
1231begin
1232 // if Assigned(OrdList) then
1233 // begin
1234 // for i := 0 to pred(OrdList.Count) do
1235 // TObject(OrdList[i]).Free;
1236 // UBAGlobals.tempDxList := nil;
1237 // end;
1238 OrdList := TList.Create;
1239 theOrder := TOrder.Create;
1240 theOrder.ID := AnOrderID;
1241 OrdList.Add(theOrder);
1242 RetrieveOrderFields(OrdList, 0, 0);
1243 Result := TOrder(OrdList.Items[0]).Text;
1244 if Assigned(OrdList) then OrdList.Free; //CQ:7554
1245end;
1246
1247function ActivateOrderHTML(const AnID: string; AnEvent: TOrderDelayEvent;
1248 AnOwner: TComponent; ARefNum: Integer): Boolean;
1249var
1250 DialogIEN: Integer;
1251 x: string;
1252 ASetList: TStringList;
1253begin
1254 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1255 Result := False;
1256 DialogIEN := StrToIntDef(AnID, 0);
1257 x := OrderDisabledMessage(DialogIEN);
1258 if ShowMsgOn(Length(x) > 0, x, TC_DISABLED) then Exit;
1259 if uOrderHTML = nil then
1260 begin
1261 uOrderHTML := TfrmOMHTML.Create(AnOwner);
1262 with uOrderHTML do
1263 begin
1264 SetBounds(frmFrame.Left + 112, frmFrame.Top + frmFrame.Height - Height, Width, Height);
1265 SetFormPosition(uOrderHTML);
1266 FormStyle := fsStayOnTop;
1267 SetEventDelay(AnEvent);
1268 end;
1269 end;
1270 uOrderHTML.Dialog := DialogIEN;
1271 uOrderHTML.RefNum := ARefNum;
1272 uOrderHTML.OwnedBy := AnOwner;
1273 uOrderHTML.ShowModal;
1274 ASetList := TStringList.Create;
1275 ASetList.Assign(uOrderHTML.SetList);
1276 uOrderHTML.Release;
1277 if ASetList.Count = 0 then Exit;
1278 Result := ActivateOrderList(ASetList, AnEvent, AnOwner, ARefNum, '', '');
1279end;
1280
1281function ActivateOrderMenu(const AnID: string; AnEvent: TOrderDelayEvent;
1282 AnOwner: TComponent; ARefNum: Integer): Boolean;
1283var
1284 MenuIEN: Integer;
1285 x: string;
1286begin
1287 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1288 Result := False;
1289 MenuIEN := StrToIntDef(AnID, 0);
1290 x := OrderDisabledMessage(MenuIEN);
1291 if ShowMsgOn(Length(x) > 0, x, TC_DISABLED) then Exit;
1292 if uOrderMenu = nil then
1293 begin
1294 uOrderMenu := TfrmOMNavA.Create(AnOwner);
1295 with uOrderMenu do
1296 begin
1297 SetBounds(frmFrame.Left + 112, frmFrame.Top + frmFrame.Height - Height, Width, Height);
1298 SetFormPosition(uOrderMenu);
1299 FormStyle := fsStayOnTop;
1300 SetEventDelay(AnEvent);
1301 end;
1302 end;
1303 uOrderMenu.SetNewMenu(MenuIEN, AnOwner, ARefNum);
1304 if not uOrderMenu.Showing then uOrderMenu.Show else uOrderMenu.BringToFront;
1305 Result := True;
1306end;
1307
1308function ActivateOrderSet(const AnID: string; AnEvent: TOrderDelayEvent;
1309 AnOwner: TComponent; ARefNum: Integer): Boolean;
1310var
1311 x, ACaption, KeyVarStr: string;
1312 SetList: TStringList;
1313 EvtDefaultDlg, PtEvtID: string;
1314
1315 function TakeoutDuplicateDlg(var AdlgList: TStringList; ANeedle: string): boolean;
1316 var
1317 i: integer;
1318 begin
1319 Result := False;
1320 for i := 0 to AdlgList.Count - 1 do
1321 begin
1322 if Piece(AdlgList[i],'^',1)=ANeedle then
1323 begin
1324 ADlgList.Delete(i);
1325 Result := True;
1326 Break;
1327 end;
1328 end;
1329 end;
1330
1331begin
1332 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1333 Result := False;
1334 x := OrderDisabledMessage(StrToIntDef(AnID, 0));
1335 if ShowMsgOn(Length(x) > 0, x, TC_DISABLED) then Exit;
1336 SetList := TStringList.Create;
1337 try
1338 if uOrderSetTime = 0 then uOrderSetTime := FMNow;
1339 LoadOrderSet(SetList, StrToIntDef(AnID, 0), KeyVarStr, ACaption);
1340 if (AnEvent.EventIFN>0) and isExistedEvent(Patient.DFN, IntToStr(AnEvent.EventIFN), PtEvtID) then
1341 begin
1342 EvtDefaultDlg := GetEventDefaultDlg(AnEvent.EventIFN);
1343 while TakeoutDuplicateDlg(SetList,EvtDefaultDlg) do
1344 TakeoutDuplicateDlg(SetList,EvtDefaultDlg);
1345 end;
1346 Result := ActivateOrderList(SetList, AnEvent, AnOwner, ARefNum, KeyVarStr, ACaption);
1347 finally
1348 SetList.Free;
1349 end;
1350end;
1351
1352function ActivateOrderList(AList: TStringList; AnEvent: TOrderDelayEvent;
1353 AnOwner: TComponent; ARefNum: Integer; const KeyVarStr, ACaption: string): Boolean;
1354var
1355 InitialCall: Boolean;
1356begin
1357 InitialCall := False;
1358 if uOrderSet = nil then
1359 begin
1360 uOrderSet := TfrmOMSet.Create(AnOwner);
1361 uOrderSet.SetEventDelay(AnEvent);
1362 uOrderSet.RefNum := ARefNum;
1363 InitialCall := True;
1364 end;
1365 if InitialCall then with uOrderSet do
1366 begin
1367 if Length(ACaption) > 0 then Caption := ACaption;
1368 SetBounds(frmFrame.Left, frmFrame.Top + frmFrame.Height - Height, Width, Height);
1369 SetFormPosition(uOrderSet);
1370 Show;
1371 end;
1372 uOrderSet.InsertList(AList, AnOwner, ARefNum, KeyVarStr, AnEvent.EventType);
1373 Application.ProcessMessages;
1374 Result := uOrderSet <> nil;
1375end;
1376
1377function ActiveOrdering: Boolean;
1378begin
1379 if (uOrderDialog = nil) and (uOrderMenu = nil) and (uOrderSet = nil) and
1380 (uOrderAction = nil) and (uOrderHTML = nil)
1381 then Result := False
1382 else Result := True;
1383end;
1384
1385function CloseOrdering: Boolean;
1386begin
1387 Result := False;
1388 { if an order set is being processed, see if want to interupt }
1389 if uOrderSet <> nil then
1390 begin
1391 uOrderSet.Close;
1392 Application.ProcessMessages;
1393 if uOrderSet <> nil then Exit;
1394 end;
1395 { if another ordering dialog is showing, make sure it is closed first }
1396 if uOrderDialog <> nil then
1397 begin
1398 uOrderDialog.Close;
1399 Application.ProcessMessages; // allow close to finish
1400 if uOrderDialog <> nil then Exit;
1401 end;
1402 if uOrderHTML <> nil then
1403 begin
1404 uOrderHTML.Close;
1405 Application.ProcessMessages; // allow browser to close
1406 Assert(uOrderHTML = nil);
1407 end;
1408 { close any open ordering menu }
1409 if uOrderMenu <> nil then
1410 begin
1411 uOrderMenu.Close;
1412 Application.ProcessMessages; // allow menu to close
1413 Assert(uOrderMenu = nil);
1414 end;
1415 if uOrderAction <> nil then
1416 begin
1417 uOrderAction.Close;
1418 Application.ProcessMessages;
1419 if uOrderAction <> nil then Exit;
1420 end;
1421 Result := True;
1422end;
1423
1424function ReadyForNewOrder(AnEvent: TOrderDelayEvent): Boolean;
1425var
1426 x,tmpPtEvt: string;
1427begin
1428 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1429 Result := False;
1430 { make sure a location and provider are selected before ordering }
1431 if not AuthorizedUser then Exit;
1432 if (not Patient.Inpatient) and (AnEvent.EventIFN > 0 ) then x := ''
1433 else
1434 begin
1435 if not EncounterPresent then Exit;
1436 end;
1437 { then try to lock the patient (provider & encounter checked first to not leave lock) }
1438 if not LockedForOrdering then Exit;
1439 { make sure any current ordering process has completed, but don't drop patient lock }
1440 uKeepLock := True;
1441 if not CloseOrdering then Exit;
1442 uKeepLock := False;
1443 { get the delay event for this order (if applicable) }
1444 if AnEvent.EventType in ['A','D','T','M','O'] then
1445 begin
1446 if (AnEvent.EventName = '') and (AnEvent.EventType <> 'D') then
1447 Exit;
1448 x := AnEvent.EventType + IntToStr(AnEvent.Specialty);
1449 if (uLastConfirm <> x ) and (not XfInToOutNow) then
1450 begin
1451 uLastConfirm := x;
1452 case AnEvent.EventType of
1453 'A','M','O','T': x := AnEvent.EventName;
1454// 'D': x := 'Discharge'; <-- original line. //kt 8/8/2007
1455 'D': x := DKLangConstW('uOrders_Discharge'); //kt added 8/8/2007
1456 end;
1457 if isExistedEvent(Patient.DFN,IntToStr(AnEvent.EventIFN),tmpPtEvt) then
1458 if PtEvtEmpty(tmpPtEvt)then
1459 InfoBox(TX_DELAY + x + TX_DELAY1, TC_DELAY, MB_OK or MB_ICONWARNING);
1460 end;
1461 end
1462 else uLastConfirm := '';
1463 Result := True;
1464end;
1465
1466function ReadyForNewOrder1(AnEvent: TOrderDelayEvent): Boolean;
1467var
1468 x: string;
1469begin
1470 Result := False;
1471 { make sure a location and provider are selected before ordering }
1472 if not AuthorizedUser then Exit;
1473 if (not Patient.Inpatient) and (AnEvent.EventIFN > 0 ) then x := ''
1474 else
1475 begin
1476 if not EncounterPresent then Exit;
1477 end;
1478 { then try to lock the patient (provider & encounter checked first to not leave lock) }
1479 if not LockedForOrdering then Exit;
1480 { make sure any current ordering process has completed, but don't drop patient lock }
1481 uKeepLock := True;
1482 if not CloseOrdering then Exit;
1483 uKeepLock := False;
1484 { get the delay event for this order (if applicable) }
1485 if AnEvent.EventType in ['A','D','T','M','O'] then
1486 begin
1487 x := AnEvent.EventType + IntToStr(AnEvent.Specialty);
1488 if (uLastConfirm <> x ) and (not XfInToOutNow) then
1489 begin
1490 uLastConfirm := x;
1491 case AnEvent.EventType of
1492 'A','M','T','O': x := AnEvent.EventName;
1493 'D': x := AnEvent.EventName; //'D': x := 'Discharge';
1494 end;
1495 end;
1496 end
1497 else uLastConfirm := '';
1498 Result := True;
1499end;
1500
1501procedure SetConfirmEventDelay;
1502begin
1503 uLastConfirm := '';
1504end;
1505
1506procedure ChangeOrders(AList: TStringList; AnEvent: TOrderDelayEvent);
1507var
1508 i,txtOrder: Integer;
1509 FieldsForEditRenewOrder: TOrderRenewFields;
1510 param1, param2 : string;
1511 OrSts: integer;
1512 AnOrder: TOrder;
1513begin
1514 if uOrderDialog <> nil then
1515 begin
1516 uOrderDialog.Close;
1517 Application.ProcessMessages; // allow close to finish
1518 end;
1519
1520 if not ActiveOrdering then // allow change while entering new
1521 if not ReadyForNewOrder(AnEvent) then Exit;
1522 for i := 0 to AList.Count - 1 do
1523 begin
1524 //if it's for unreleased renewed orders, then go to fODChangeUnreleasedRenew and continue
1525 txtOrder := 0;
1526 FieldsForEditRenewOrder := TOrderRenewFields.Create;
1527 LoadRenewFields(FieldsForEditRenewOrder, AList[i]);
1528 if FieldsForEditRenewOrder.BaseType = OD_TEXTONLY then
1529 txtOrder := 1;
1530 if CanEditSuchRenewedOrder(AList[i], txtOrder) then
1531 begin
1532 param1 := '0';
1533 if txtOrder = 0 then
1534 begin
1535 param1 := IntToStr(FieldsForEditRenewOrder.Refills);
1536 param2 := FieldsForEditRenewOrder.Pickup;
1537 end else if txtOrder = 1 then
1538 begin
1539 param1 := FieldsForEditRenewOrder.StartTime;
1540 param2 := FieldsForEditRenewOrder.StopTime;
1541 end;
1542 UBAGlobals.SourceOrderID := AList[i]; //hds6265 added
1543 ExecuteChangeRenewedOrder(AList[i], param1, param2, txtOrder);
1544 AnOrder := TOrder.Create;
1545 SaveChangesOnRenewOrder(AnOrder, AList[i], param1, param2, txtOrder);
1546 AnOrder.ActionOn := AnOrder.ID + '=RN';
1547 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(AnOrder));
1548 Application.ProcessMessages;
1549 Continue;
1550 end else FieldsForEditRenewOrder.Free;
1551
1552 OrSts := GetOrderStatus(AList[i]);
1553// if ( AnsiCompareText(NameOfStatus(OrSts),'active') = 0 ) and (AnEvent.PtEventIFN > 0) then <-- original line. //kt 8/8/2007
1554 if ( AnsiCompareText(NameOfStatus(OrSts),DKLangConstW('uOrders_active')) = 0 ) and (AnEvent.PtEventIFN > 0) then //kt added 8/8/2007
1555 EventDefaultOD := 1;
1556 ActivateOrderDialog('X' + AList[i], AnEvent, Application, -1); // X + ORIFN for change
1557 if EventDefaultOD = 1 then
1558 EventDefaultOD := 0;
1559 Application.ProcessMessages; // give uOrderDialog a chance to go back to nil
1560 if BILLING_AWARE then //hds6265
1561 begin //hds6265
1562 UBAGlobals.SourceOrderID := AList[i]; //hds6265
1563 UBAGlobals.CopyTreatmentFactorsDxsToCopiedOrder(UBAGlobals.SourceOrderID,UBAGLobals.TargetOrderID); //hds6265
1564 end;
1565 end;
1566 UnlockIfAble;
1567end;
1568
1569function ChangeOrdersEvt(AnOrderID: string; AnEvent: TOrderDelayEvent): boolean;
1570begin
1571 Result := False;
1572 if uOrderDialog <> nil then
1573 begin
1574 uOrderDialog.Close;
1575 Application.ProcessMessages;
1576 end;
1577 if not ActiveOrdering then
1578 if not ReadyForNewOrder(AnEvent) then Exit;
1579 Result := ActivateOrderDialog('X' + AnOrderID, AnEvent, Application, -1);
1580 Application.ProcessMessages;
1581 UnlockIfAble;
1582end;
1583
1584function CopyOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
1585var
1586 i: Integer;
1587 xx: string;
1588 IsIMOOD,ForIVAlso: boolean;
1589begin
1590 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1591 Result := False;
1592 if not ReadyForNewOrder(AnEvent) then Exit; // no copy while entering new
1593 for i := 0 to AList.Count - 1 do
1594 begin
1595 if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
1596 begin
1597 DoesEventOccur := True;
1598 AnEvent.EventType := #0;
1599 AnEvent.TheParent := TParentEvent.Create;
1600 AnEvent.EventIFN := 0;
1601 AnEvent.EventName := '';
1602 AnEvent.PtEventIFN := 0;
1603 end;
1604
1605 if CheckOrderGroup(AList[i])=1 then IsUDGroup := True
1606 else IsUDGroup := False;
1607
1608 if (AnEvent.EventIFN>0) and isOnholdMedOrder(AList[i]) then
1609 begin
1610 xx := RetrieveOrderText(AList[i]);
1611// if InfoBox(TX_ONHOLD+#13#13+xx, 'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then <-- original line. //kt 8/8/2007
1612 if InfoBox(TX_ONHOLD+#13#13+xx, DKLangConstW('uOrders_Warning'), MB_YESNO or MB_ICONWARNING) = IDNO then //kt added 8/8/2007
1613 Continue;
1614 end;
1615
1616 DEASig := GetDrugSchedule(AList[i]);
1617 ForIVAlso := ForIVandUD(AList[i]);
1618 IsIMOOD := IsIMOOrder(AList[i]);
1619 if (IsUDGroup) and (ImmdCopyAct) and (not Patient.Inpatient) and (AnEvent.EventType = 'C') and (not IsIMOOD) and (not ForIVAlso) then
1620 XfInToOutNow := True;
1621
1622 OrderSource := 'C';
1623
1624 if ActivateOrderDialog('C' + AList[i], AnEvent, Application, -1, ANeedVerify) then
1625 Result := True;
1626
1627 Application.ProcessMessages; // give uOrderDialog a chance to go back to nil
1628 OrderSource := '';
1629
1630 if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
1631 DoesEventOccur := True;
1632
1633 if IsUDGroup then IsUDGroup := False;
1634 if XfInToOutNOw then XfInToOutNow := False;
1635
1636 if BILLING_AWARE then
1637 begin
1638 UBAGlobals.SourceOrderID := AList[i]; //BAPHII 1.3.2
1639 UBAGlobals.CopyTreatmentFactorsDxsToCopiedOrder(UBAGlobals.SourceOrderID,UBAGLobals.TargetOrderID);
1640 end;
1641 end; //for
1642
1643 UnlockIfAble;
1644end;
1645
1646function TransferOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
1647var
1648 i, CountOfTfOrders: Integer;
1649 xx: string;
1650 //DoesEventOccur: boolean;
1651 //OccuredEvtID: integer;
1652 //OccuredEvtName: string;
1653begin
1654 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1655 //DoesEventOccur := False;
1656 //OccuredEvtID := 0;
1657 Result := False;
1658 if not ReadyForNewOrder(AnEvent) then Exit; // no xfer while entering new
1659 CountOfTfOrders := AList.Count;
1660 for i := 0 to CountOfTfOrders - 1 do
1661 begin
1662 if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
1663 begin
1664 DoesEventOccur := True;
1665 //OccuredEvtID := AnEvent.PtEventIFN;
1666 //OccuredEvtName := AnEvent.EventName;
1667 AnEvent.EventType := #0;
1668 AnEvent.TheParent := TParentEvent.Create;
1669 AnEvent.EventIFN := 0;
1670 AnEvent.EventName := '';
1671 AnEvent.PtEventIFN := 0;
1672 end;
1673 if i = CountOfTfOrders - 1 then
1674 begin
1675 if (AnEvent.EventIFN>0) and isOnholdMedOrder(AList[i]) then
1676 begin
1677 xx := RetrieveOrderText(AList[i]);
1678// if InfoBox(TX_ONHOLD+#13#13+xx, 'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then <-- original line. //kt 8/8/2007
1679 if InfoBox(TX_ONHOLD+#13#13+xx, DKLangConstW('uOrders_Warning'), MB_YESNO or MB_ICONWARNING) = IDNO then //kt added 8/8/2007
1680 Continue;
1681 end;
1682 OrderSource := 'X';
1683 if ActivateOrderDialog('T' + AList[i], AnEvent, Application, -2, ANeedVerify) then
1684 Result := True;
1685 end else
1686 begin
1687 if (AnEvent.EventIFN>0) and isOnholdMedOrder(AList[i]) then
1688 begin
1689 xx := RetrieveOrderText(AList[i]);
1690// if InfoBox(TX_ONHOLD+#13#13+xx, 'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then <-- original line. //kt 8/8/2007
1691 if InfoBox(TX_ONHOLD+#13#13+xx, DKLangConstW('uOrders_Warning'), MB_YESNO or MB_ICONWARNING) = IDNO then //kt added 8/8/2007
1692 Continue;
1693 end;
1694 OrderSource := 'X';
1695 if ActivateOrderDialog('T' + AList[i], AnEvent, Application, -1, ANeedVerify) then
1696 Result := True;
1697 end;
1698 Application.ProcessMessages; // give uOrderDialog a chance to go back to nil
1699 OrderSource := '';
1700 if (not DoesEventOccur) and (AnEvent.PtEventIFN>0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
1701 DoesEventOccur := True;
1702
1703 UBAGlobals.SourceOrderID := AList[i];
1704 UBAGlobals.CopyTreatmentFactorsDxsToCopiedOrder(UBAGlobals.SourceOrderID, UBAGLobals.TargetOrderID);
1705
1706 end;
1707 UnlockIfAble;
1708
1709end;
1710
1711procedure DestroyingOrderAction;
1712begin
1713 uOrderAction := nil;
1714 if not ActiveOrdering then
1715 begin
1716 ClearOrderRecall;
1717 UnlockIfAble;
1718 end;
1719end;
1720
1721procedure DestroyingOrderDialog;
1722begin
1723 uOrderDialog := nil;
1724 if not ActiveOrdering then
1725 begin
1726 ClearOrderRecall;
1727 UnlockIfAble;
1728 end;
1729end;
1730
1731procedure DestroyingOrderHTML;
1732begin
1733 uOrderHTML := nil;
1734 if not ActiveOrdering then
1735 begin
1736 ClearOrderRecall;
1737 UnlockIfAble;
1738 end;
1739end;
1740
1741procedure DestroyingOrderMenu;
1742begin
1743 uOrderMenu := nil;
1744 if not ActiveOrdering then
1745 begin
1746 ClearOrderRecall;
1747 UnlockIfAble;
1748 end;
1749end;
1750
1751procedure DestroyingOrderSet;
1752begin
1753 uOrderSet := nil;
1754 uOrderSetTime := 0;
1755 if not ActiveOrdering then
1756 begin
1757 ClearOrderRecall;
1758 UnlockIfAble;
1759 end;
1760end;
1761
1762function OrderIsLocked(const AnOrderID, AnAction: string): Boolean;
1763var
1764 ErrorMsg: string;
1765begin
1766 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1767 Result := True;
1768 if (AnAction = OA_COPY) then
1769 Exit;
1770 if ((AnAction = OA_HOLD) or (AnAction = OA_UNHOLD) or (AnAction = OA_RENEW) or
1771 (AnAction = OA_DC) or (AnAction = OA_CHANGE)) and Changes.ExistForOrder(AnOrderID)
1772 then Exit;
1773 LockOrder(AnOrderID, ErrorMsg);
1774 if Length(ErrorMsg) > 0 then
1775 begin
1776 Result := False;
1777 InfoBox(ErrorMsg + CRLF + CRLF + TextForOrder(AnOrderID), TC_NOLOCK, MB_OK);
1778 end;
1779end;
1780
1781procedure PopLastMenu;
1782{ always called from fOMSet }
1783begin
1784 if uOrderMenu <> nil then uOrderMenu.cmdDoneClick(uOrderSet);
1785end;
1786
1787procedure QuickOrderSave;
1788begin
1789 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1790 // would be better to prompt for dialog
1791 if uOrderDialog = nil then
1792 begin
1793 InfoBox(TX_NO_SAVE_QO, TC_NO_SAVE_QO, MB_OK);
1794 Exit;
1795 end;
1796 with uOrderDialog do
1797 begin
1798 if not AllowQuickOrder then
1799 begin
1800 InfoBox(TX_NO_QUICK, TC_NO_QUICK, MB_OK);
1801 Exit;
1802 end;
1803 if Responses.OrderContainsObjects then
1804 begin
1805 InfoBox(TX_CANT_SAVE_QO, TC_NO_QUICK, MB_ICONERROR or MB_OK);
1806 Exit;
1807 end;
1808 SaveAsQuickOrder(Responses);
1809 end;
1810end;
1811
1812procedure QuickOrderListEdit;
1813begin
1814 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1815 // would be better to prompt for dialog
1816 if uOrderDialog = nil then
1817 begin
1818 InfoBox(TX_NO_EDIT_QO, TC_NO_EDIT_QO, MB_OK);
1819 Exit;
1820 end;
1821 with uOrderDialog do
1822 begin
1823 if not AllowQuickOrder then
1824 begin
1825 InfoBox(TX_NO_QUICK, TC_NO_QUICK, MB_OK);
1826 Exit;
1827 end;
1828 EditCommonList(DisplayGroup);
1829 end;
1830end;
1831
1832function RefNumFor(AnOwner: TComponent): Integer;
1833begin
1834 if (uOrderDialog <> nil) and (uOrderDialog.Owner = AnOwner)
1835 then Result := uOrderDialog.RefNum
1836 else if (uOrderMenu <> nil) and (uOrderMenu.Owner = AnOwner)
1837 then Result := uOrderMenu.RefNum
1838 else if (uOrderHTML <> nil) and (uOrderHTML.Owner = AnOwner)
1839 then Result := uOrderHTML.RefNum
1840 else if (uOrderSet <> nil) and (uOrderSet.Owner = AnOwner)
1841 then Result := uOrderSet.RefNum
1842 else Result := -1;
1843end;
1844
1845
1846procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0);
1847//const
1848//TX_NEW_LOC1 = 'The patient''s location has changed to '; <-- original line. //kt 8/8/2007
1849//TX_NEW_LOC2 = '.' + CRLF + 'Should the orders be printed using the new location?'; <-- original line. //kt 8/8/2007
1850//TC_NEW_LOC = 'New Patient Location'; <-- original line. //kt 8/8/2007
1851//TX_SIGN_LOC = 'No location was selected. Orders could not be printed!'; <-- original line. //kt 8/8/2007
1852//TC_REQ_LOC = 'Orders Not Printed'; <-- original line. //kt 8/8/2007
1853//TX_LOC_PRINT = 'The selected location will be used to determine where orders are printed.'; <-- original line. //kt 8/8/2007
1854var
1855 ALocation: Integer;
1856 AName, ASvc, DeviceInfo: string;
1857 PrintIt: Boolean;
1858 TX_NEW_LOC1 : string; //kt
1859 TX_NEW_LOC2 : string; //kt
1860 TC_NEW_LOC : string; //kt
1861 TX_SIGN_LOC : string; //kt
1862 TC_REQ_LOC : string; //kt
1863 TX_LOC_PRINT : string; //kt
1864begin
1865 TX_NEW_LOC1 := DKLangConstW('uOrders_The_patientxxs_location_has_changed_to'); //kt added 8/8/2007
1866 TX_NEW_LOC2 := '.' + CRLF + DKLangConstW('uOrders_Should_the_orders_be_printed_using_the_new_locationx'); //kt added 8/8/2007
1867 TC_NEW_LOC := DKLangConstW('uOrders_New_Patient_Location'); //kt added 8/8/2007
1868 TX_SIGN_LOC := DKLangConstW('uOrders_No_location_was_selectedx__Orders_could_not_be_printedx'); //kt added 8/8/2007
1869 TC_REQ_LOC := DKLangConstW('uOrders_Orders_Not_Printed'); //kt added 8/8/2007
1870 TX_LOC_PRINT := DKLangConstW('uOrders_The_selected_location_will_be_used_to_determine_where_orders_are_printedx'); //kt added 8/8/2007
1871 if PrintLoc = 0 then
1872 begin
1873 CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc);
1874 if (ALocation > 0) and (ALocation <> Encounter.Location) then
1875 begin
1876 if InfoBox(TX_NEW_LOC1 + AName + TX_NEW_LOC2, TC_NEW_LOC, MB_YESNO) = IDYES
1877 then Encounter.Location := ALocation;
1878 end;
1879 end
1880 else
1881 Encounter.Location := PrintLoc;
1882 if Encounter.Location = 0
1883 then Encounter.Location := CommonLocationForOrders(OrderList);
1884 if Encounter.Location = 0 then // location required for DEVINFO
1885 begin
1886 LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
1887 if ALocation > 0 then Encounter.Location := ALocation;
1888 end;
1889 frmFrame.DisplayEncounterText;
1890 if Encounter.Location <> 0 then
1891 begin
1892 SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt);
1893 if PrintIt then
1894 PrintOrdersOnReview(OrderList, DeviceInfo)
1895 else
1896 PrintServiceCopies(OrderList);
1897 end
1898 else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
1899end;
1900
1901procedure SetFontSize( FontSize: integer);
1902begin
1903 if uOrderDialog <> nil then
1904 uOrderDialog.SetFontSize( FontSize);
1905 if uOrderMenu <> nil then
1906 uOrderMenu.ResizeFont;
1907end;
1908
1909procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
1910begin
1911 if LastIndex = 0 then
1912 LastIndex := NewIndex;
1913 if (LastIndex - NewIndex) <= 0 then
1914 NMRec.NextStep := STEP_FORWARD
1915 else
1916 NMRec.NextStep := STEP_BACK;
1917 NMRec.LastIndex := NewIndex;
1918end;
1919
1920function IsIMODialog(DlgID: integer): boolean; //IMO
1921var
1922 IsInptDlg, IsIMOLocation: boolean;
1923 Td: TFMDateTime;
1924begin
1925 result := False;
1926 IsInptDlg := False;
1927 Td := FMToday;
1928 if ( (DlgID = MedsInDlgIen) or (DlgID = MedsIVDlgIen) or (IsInptQO(dlgId)) or (IsIVQO(dlgId))) then IsInptDlg := TRUE;
1929 IsIMOLocation := IsValidIMOLoc(Encounter.Location,Patient.DFN);
1930 if (IsInptDlg or IsInptQO(DlgID)) and (not Patient.Inpatient) and IsIMOLocation and (Encounter.DateTime > Td) then
1931 result := True;
1932end;
1933
1934function AllowActionOnIMO(AnEvtTyp: char): boolean;
1935var
1936 Td: TFMDateTime;
1937begin
1938 Result := False;
1939 if (Patient.Inpatient) then
1940 begin
1941 Td := FMToday;
1942 if IsValidIMOLoc(Encounter.Location,Patient.DFN) and (Encounter.DateTime > Td) then
1943 Result := True;
1944 end
1945 else
1946 begin
1947 Td := FMToday;
1948 if IsValidIMOLoc(Encounter.Location,Patient.DFN) and (Encounter.DateTime > Td) then
1949 Result := True
1950 else if AnEvtTyp in ['A','T'] then
1951 Result := True;
1952 end;
1953end;
1954
1955function IMOActionValidation(AnId: string; var IsIMOOD: boolean; var x: string; AnEventType: char): boolean;
1956var
1957 actName: string;
1958begin
1959 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1960 // jd imo change
1961 Result := True;
1962 if CharAt(AnID, 1) in ['X','C'] then // transfer IMO order doesn't need check
1963 begin
1964 IsIMOOD := IsIMOOrder(Copy(AnID, 2, Length(AnID)));
1965 If IsIMOOD then
1966 begin
1967 if (not AllowActionOnIMO(AnEventType)) then
1968 begin
1969// if CharAt(AnID,1) = 'X' then actName := 'change'; <-- original line. //kt 8/8/2007
1970 if CharAt(AnID,1) = 'X' then actName := DKLangConstW('uOrders_change'); //kt added 8/8/2007
1971// if CharAt(AnID,1) = 'C' then actName := 'copy'; <-- original line. //kt 8/8/2007
1972 if CharAt(AnID,1) = 'C' then actName := DKLangConstW('uOrders_copy'); //kt added 8/8/2007
1973// x := 'You cannot ' + actName + ' the clinical medication order.'; <-- original line. //kt 8/8/2007
1974 x := DKLangConstW('uOrders_You_cannot')+' ' + actName + DKLangConstW('uOrders_the_clinical_medication_orderx'); //kt added 8/8/2007
1975 x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#13#10 + x;
1976 UnlockOrder(Copy(AnID, 2, Length(AnID)));
1977 result := False;
1978 end
1979 else
1980 begin
1981 if patient.Inpatient then
1982 begin
1983// if CharAt(AnID,1) = 'X' then actName := 'changing'; <-- original line. //kt 8/8/2007
1984 if CharAt(AnID,1) = 'X' then actName := DKLangConstW('uOrders_changing'); //kt added 8/8/2007
1985// if CharAt(AnID,1) = 'C' then actName := 'copying'; <-- original line. //kt 8/8/2007
1986 if CharAt(AnID,1) = 'C' then actName := DKLangConstW('uOrders_copying'); //kt added 8/8/2007
1987 if MessageDlg(TX_IMO_WARNING1 + actName + TX_IMO_WARNING2 + #13#13#10 + x, mtWarning,[mbOK,mbCancel],0) = mrCancel then
1988 begin
1989 UnlockOrder(Copy(AnID, 2, Length(AnID)));
1990 result := False;
1991 end;
1992 end;
1993 end;
1994 end;
1995 end;
1996 if Piece(AnId,'^',1)='RENEW' then
1997 begin
1998 IsIMOOD := IsIMOOrder(Piece(AnID,'^',2));
1999 If IsIMOOD then
2000 begin
2001 if (not AllowActionOnIMO(AnEventType)) then
2002 begin
2003// x := 'You cannot renew the clinical medication order.'; <-- original line. //kt 8/8/2007
2004 x := DKLangConstW('uOrders_You_cannot_renew_the_clinical_medication_orderx'); //kt added 8/8/2007
2005 x := RetrieveOrderText(Piece(AnID,'^',2)) + #13#13#10 + x;
2006 UnlockOrder(Piece(AnID,'^',2));
2007 result := False;
2008 end
2009 else
2010 begin
2011 if Patient.Inpatient then
2012 begin
2013// if MessageDlg(TX_IMO_WARNING1 + 'renewing' + TX_IMO_WARNING2, mtWarning,[mbOK,mbCancel],0) = mrCancel then <-- original line. //kt 8/8/2007
2014 if MessageDlg(TX_IMO_WARNING1 + DKLangConstW('uOrders_renewing') + TX_IMO_WARNING2, mtWarning,[mbOK,mbCancel],0) = mrCancel then //kt added 8/8/2007
2015 begin
2016 UnlockOrder(Copy(AnID, 2, Length(AnID)));
2017 result := False;
2018 end;
2019 end;
2020 end;
2021 end;
2022 end;
2023end;
2024
2025initialization
2026 uPatientLocked := False;
2027 uKeepLock := False;
2028 uLastConfirm := '';
2029 uOrderSetTime := 0;
2030 uNewMedDialog := 0;
2031 uOrderAction := nil;
2032 uOrderDialog := nil;
2033 uOrderHTML := nil;
2034 uOrderMenu := nil;
2035 uOrderSet := nil;
2036 NSSchedule := False;
2037 OriginalMedsOutHeight := 0;
2038 OriginalMedsInHeight := 0;
2039 OriginalNonVAMedsHeight := 0;
2040
2041end.
Note: See TracBrowser for help on using the repository browser.