Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

uOrders.pas@ 895

Last change on this file since 895 was 453, checked in by Kevin Toppenberg, 16 years ago
Initial upload of TMG-CPRS 1.0.26.69
File size: 81.3 KB

Rev	Line
[453]	1	//kt -- Modified with SourceScanner on 8/8/2007
	2	unit uOrders;
	3
	4	interface
	5
	6	uses
	7	Windows, Messages, SysUtils, Classes, Controls, Forms, uConst, rOrders, ORFn,
	8	Dialogs, ORCtrls, stdCtrls, strUtils, fODBase;
	9
	10	type
	11	EOrderDlgFail = class(Exception);
	12
	13	{ Ordering Environment }
	14	function AuthorizedUser: Boolean;
	15	function AuthorizedToVerify: Boolean;
	16	function EncounterPresent: Boolean;
	17	function EncounterPresentEDO: Boolean;
	18	function LockedForOrdering: Boolean;
	19	function IsValidActionOnComplexOrder(AnOrderID, AnAction: string;
	20	AListBox: TListBox; var CheckedList: TStringList; var ErrMsg: string; var ParentOrderID: string): boolean; //PSI-COMPLEX
	21	procedure UnlockIfAble;
	22	function OrderCanBeLocked(OrderID: string): Boolean;
	23	procedure UnlockOrderIfAble(OrderID: string);
	24	procedure AddSelectedToChanges(AList: TList);
	25	procedure ResetDialogProperties(const AnID: string; AnEvent: TOrderDelayEvent; var ResolvedDialog: TOrderDialogResolved);
	26	function IsInvalidActionWarning(const AnOrderText,AnOrderID: String): boolean;
	27	procedure InitialOrderVariables;
	28
	29	{ Write Orders }
	30	function ActivateAction(const AnID: string; AnOwner: TComponent; ARefNum: Integer): Boolean;
	31	function ActivateOrderDialog(const AnID: string; AnEvent: TOrderDelayEvent;
	32	AnOwner: TComponent; ARefNum: Integer; ANeedVerify: boolean = True): Boolean;
	33	function RetrieveOrderText(AnOrderID: string): string;
	34	function ActivateOrderHTML(const AnID: string; AnEvent: TOrderDelayEvent;
	35	AnOwner: TComponent; ARefNum: Integer): Boolean;
	36	function ActivateOrderMenu(const AnID: string; AnEvent: TOrderDelayEvent;
	37	AnOwner: TComponent; ARefNum: Integer): Boolean;
	38	function ActivateOrderSet(const AnID: string; AnEvent: TOrderDelayEvent;
	39	AnOwner: TComponent; ARefNum: Integer): Boolean;
	40	function ActivateOrderList(AList: TStringList; AnEvent: TOrderDelayEvent;
	41	AnOwner: TComponent; ARefNum: Integer; const KeyVarStr, ACaption: string): Boolean;
	42	function ActiveOrdering: Boolean;
	43	function CloseOrdering: Boolean;
	44	function ReadyForNewOrder(AnEvent: TOrderDelayEvent): Boolean;
	45	function ReadyForNewOrder1(AnEvent: TOrderDelayEvent): Boolean;
	46	function ChangeOrdersEvt(AnOrderID: string; AnEvent: TOrderDelayEvent): boolean;
	47	function CopyOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
	48	function TransferOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
	49	procedure SetConfirmEventDelay;
	50	procedure ChangeOrders(AList: TStringList; AnEvent: TOrderDelayEvent);
	51	procedure DestroyingOrderAction;
	52	procedure DestroyingOrderDialog;
	53	procedure DestroyingOrderHTML;
	54	procedure DestroyingOrderMenu;
	55	procedure DestroyingOrderSet;
	56	function OrderIsLocked(const AnOrderID, AnAction: string): Boolean;
	57	procedure PopLastMenu;
	58	procedure QuickOrderSave;
	59	procedure QuickOrderListEdit;
	60	function RefNumFor(AnOwner: TComponent): Integer;
	61	procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0);
	62	procedure SetFontSize( FontSize: integer);
	63	procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
	64
	65	{ Inpatient medication for Outpatient}
	66	function IsIMODialog(DlgID: integer): boolean;
	67	function AllowActionOnIMO(AnEvtTyp: char): boolean;
	68	function IMOActionValidation(AnId: string; var IsIMOOD: boolean; var x: string; AnEventType: char): boolean;
	69
	70
	71	var
	72	uAutoAc: Boolean;
	73	InptDisp : Integer;
	74	OutptDisp: Integer;
	75	MedsDisp : Integer;
	76	ClinDisp : Integer; //IMO
	77	NurDisp : Integer;
	78	IVDisp : Integer;
	79	CsltDisp : Integer;
	80	ProcDisp : Integer;
	81	ImgDisp : Integer;
	82	NonVADisp: Integer;
	83	MedsInDlgIen : Integer;
	84	MedsOutDlgIen : Integer;
	85	MedsNVADlgIen : Integer;
	86	MedsInDlgFormId : Integer;
	87	MedsOutDlgFormId : Integer;
	88	MedsNVADlgFormID : Integer;
	89	MedsIVDlgIen: Integer;
	90	MedsIVDlgFormID: Integer;
	91	NSSchedule: boolean;
	92	OriginalMedsOutHeight: Integer;
	93	OriginalMedsInHeight: Integer;
	94	OriginalNonVAMedsHeight: Integer;
	95
	96	implementation
	97
	98	uses 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
	107	var
	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
	119	const
	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
	166	var
	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
	207	procedure SetupVars;
	208	//kt Added entire function to replace constant declarations 8/8/2007
	209	begin
	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');
	253	end;
	254
	255	function 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 }
	257	type
	258	TDialogClass = class of TfrmODBase;
	259	var
	260	DialogClass: TDialogClass;
	261	begin
	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);
	313	end;
	314
	315	function AuthorizedUser: Boolean;
	316	begin
	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;
	325	end;
	326
	327	function AuthorizedToVerify: Boolean;
	328	begin
	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;
	337	end;
	338
	339	function EncounterPresent: Boolean;
	340	{ make sure a location and provider are selected, returns false if not }
	341	begin
	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;
	367	end;
	368
	369	function EncounterPresentEDO: Boolean;
	370	begin
	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;
	391	end;
	392
	393	function LockedForOrdering: Boolean;
	394	var
	395	ErrMsg: string;
	396	begin
	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;
	412	end;
	413
	414	procedure UnlockIfAble;
	415	begin
	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;
	422	end;
	423
	424	function OrderCanBeLocked(OrderID: string): Boolean;
	425	var
	426	ErrMsg: string;
	427	begin
	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;
	439	end;
	440
	441	procedure UnlockOrderIfAble(OrderID: string);
	442	begin
	443	UnlockOrder(OrderID);
	444	frmFrame.stsArea.Panels.Items[4].Text := '';
	445	end;
	446
	447	procedure AddSelectedToChanges(AList: TList);
	448	{ update Changes with orders that were created by taking actions }
	449	var
	450	i, CanSign: Integer;
	451	AnOrder: TOrder;
	452	begin
	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;
	464	end;
	465
	466	procedure ResetDialogProperties(const AnID: string; AnEvent: TOrderDelayEvent; var ResolvedDialog: TOrderDialogResolved);
	467	begin
	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}
	536	end;
	537
	538	function IsInvalidActionWarning(const AnOrderText,AnOrderID: String): boolean;
	539	var
	540	AnErrLst, tmpList: TStringList;
	541	begin
	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;
	560	end;
	561
	562	procedure InitialOrderVariables;
	563	begin
	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);
	582	end;
	583
	584	function 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
	618	var
	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
	703	begin
	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;
	874	end;
	875
	876	{ Write New Orders }
	877
	878	function ActivateAction(const AnID: string; AnOwner: TComponent; ARefNum: Integer): Boolean;
	879	// AnID: DlgIEN {;FormID;DGroup}
	880	type
	881	TDialogClass = class of TfrmOMAction;
	882	var
	883	DialogClass: TDialogClass;
	884	AFormID: Integer;
	885	begin
	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;
	918	end;
	919
	920	function 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
	926	var
	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;
	937	begin
	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
	1224	end;
	1225
	1226	function RetrieveOrderText(AnOrderID: string): string;
	1227	var
	1228	OrdList: TList;
	1229	theOrder: TOrder;
	1230	// i: integer;
	1231	begin
	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
	1245	end;
	1246
	1247	function ActivateOrderHTML(const AnID: string; AnEvent: TOrderDelayEvent;
	1248	AnOwner: TComponent; ARefNum: Integer): Boolean;
	1249	var
	1250	DialogIEN: Integer;
	1251	x: string;
	1252	ASetList: TStringList;
	1253	begin
	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, '', '');
	1279	end;
	1280
	1281	function ActivateOrderMenu(const AnID: string; AnEvent: TOrderDelayEvent;
	1282	AnOwner: TComponent; ARefNum: Integer): Boolean;
	1283	var
	1284	MenuIEN: Integer;
	1285	x: string;
	1286	begin
	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;
	1306	end;
	1307
	1308	function ActivateOrderSet(const AnID: string; AnEvent: TOrderDelayEvent;
	1309	AnOwner: TComponent; ARefNum: Integer): Boolean;
	1310	var
	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
	1331	begin
	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;
	1350	end;
	1351
	1352	function ActivateOrderList(AList: TStringList; AnEvent: TOrderDelayEvent;
	1353	AnOwner: TComponent; ARefNum: Integer; const KeyVarStr, ACaption: string): Boolean;
	1354	var
	1355	InitialCall: Boolean;
	1356	begin
	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;
	1375	end;
	1376
	1377	function ActiveOrdering: Boolean;
	1378	begin
	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;
	1383	end;
	1384
	1385	function CloseOrdering: Boolean;
	1386	begin
	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;
	1422	end;
	1423
	1424	function ReadyForNewOrder(AnEvent: TOrderDelayEvent): Boolean;
	1425	var
	1426	x,tmpPtEvt: string;
	1427	begin
	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;
	1464	end;
	1465
	1466	function ReadyForNewOrder1(AnEvent: TOrderDelayEvent): Boolean;
	1467	var
	1468	x: string;
	1469	begin
	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;
	1499	end;
	1500
	1501	procedure SetConfirmEventDelay;
	1502	begin
	1503	uLastConfirm := '';
	1504	end;
	1505
	1506	procedure ChangeOrders(AList: TStringList; AnEvent: TOrderDelayEvent);
	1507	var
	1508	i,txtOrder: Integer;
	1509	FieldsForEditRenewOrder: TOrderRenewFields;
	1510	param1, param2 : string;
	1511	OrSts: integer;
	1512	AnOrder: TOrder;
	1513	begin
	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;
	1567	end;
	1568
	1569	function ChangeOrdersEvt(AnOrderID: string; AnEvent: TOrderDelayEvent): boolean;
	1570	begin
	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;
	1582	end;
	1583
	1584	function CopyOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
	1585	var
	1586	i: Integer;
	1587	xx: string;
	1588	IsIMOOD,ForIVAlso: boolean;
	1589	begin
	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;
	1644	end;
	1645
	1646	function TransferOrders(AList: TStringList; AnEvent: TOrderDelayEvent; var DoesEventOccur: boolean; ANeedVerify: boolean = True): boolean;
	1647	var
	1648	i, CountOfTfOrders: Integer;
	1649	xx: string;
	1650	//DoesEventOccur: boolean;
	1651	//OccuredEvtID: integer;
	1652	//OccuredEvtName: string;
	1653	begin
	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
	1709	end;
	1710
	1711	procedure DestroyingOrderAction;
	1712	begin
	1713	uOrderAction := nil;
	1714	if not ActiveOrdering then
	1715	begin
	1716	ClearOrderRecall;
	1717	UnlockIfAble;
	1718	end;
	1719	end;
	1720
	1721	procedure DestroyingOrderDialog;
	1722	begin
	1723	uOrderDialog := nil;
	1724	if not ActiveOrdering then
	1725	begin
	1726	ClearOrderRecall;
	1727	UnlockIfAble;
	1728	end;
	1729	end;
	1730
	1731	procedure DestroyingOrderHTML;
	1732	begin
	1733	uOrderHTML := nil;
	1734	if not ActiveOrdering then
	1735	begin
	1736	ClearOrderRecall;
	1737	UnlockIfAble;
	1738	end;
	1739	end;
	1740
	1741	procedure DestroyingOrderMenu;
	1742	begin
	1743	uOrderMenu := nil;
	1744	if not ActiveOrdering then
	1745	begin
	1746	ClearOrderRecall;
	1747	UnlockIfAble;
	1748	end;
	1749	end;
	1750
	1751	procedure DestroyingOrderSet;
	1752	begin
	1753	uOrderSet := nil;
	1754	uOrderSetTime := 0;
	1755	if not ActiveOrdering then
	1756	begin
	1757	ClearOrderRecall;
	1758	UnlockIfAble;
	1759	end;
	1760	end;
	1761
	1762	function OrderIsLocked(const AnOrderID, AnAction: string): Boolean;
	1763	var
	1764	ErrorMsg: string;
	1765	begin
	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;
	1779	end;
	1780
	1781	procedure PopLastMenu;
	1782	{ always called from fOMSet }
	1783	begin
	1784	if uOrderMenu <> nil then uOrderMenu.cmdDoneClick(uOrderSet);
	1785	end;
	1786
	1787	procedure QuickOrderSave;
	1788	begin
	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;
	1810	end;
	1811
	1812	procedure QuickOrderListEdit;
	1813	begin
	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;
	1830	end;
	1831
	1832	function RefNumFor(AnOwner: TComponent): Integer;
	1833	begin
	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;
	1843	end;
	1844
	1845
	1846	procedure 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
	1854	var
	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
	1864	begin
	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);
	1899	end;
	1900
	1901	procedure SetFontSize( FontSize: integer);
	1902	begin
	1903	if uOrderDialog <> nil then
	1904	uOrderDialog.SetFontSize( FontSize);
	1905	if uOrderMenu <> nil then
	1906	uOrderMenu.ResizeFont;
	1907	end;
	1908
	1909	procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
	1910	begin
	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;
	1918	end;
	1919
	1920	function IsIMODialog(DlgID: integer): boolean; //IMO
	1921	var
	1922	IsInptDlg, IsIMOLocation: boolean;
	1923	Td: TFMDateTime;
	1924	begin
	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;
	1932	end;
	1933
	1934	function AllowActionOnIMO(AnEvtTyp: char): boolean;
	1935	var
	1936	Td: TFMDateTime;
	1937	begin
	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;
	1953	end;
	1954
	1955	function IMOActionValidation(AnId: string; var IsIMOOD: boolean; var x: string; AnEventType: char): boolean;
	1956	var
	1957	actName: string;
	1958	begin
	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;
	2023	end;
	2024
	2025	initialization
	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
	2041	end.

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: