Context Navigation

source: cprs/trunk/CPRS-Chart/Orders/rOrders.pas@ 836

Last change on this file since 836 was 829, checked in by Kevin Toppenberg, 14 years ago
Upgrade to version 27
File size: 77.6 KB

Rev	Line
[456]	1	unit rOrders;
	2	{$OPTIMIZATION OFF}
	3	interface
	4
	5	uses SysUtils, Classes, ORFn, ORNet, uCore, Dialogs, Controls;
	6
	7	type
	8	TOrder = class
	9	public
	10	ICD9Code: string;
	11	ID: string;
	12	DGroup: Integer;
	13	OrderTime: TFMDateTime;
	14	StartTime: string;
	15	StopTime: string;
	16	Status: Integer;
	17	Signature: Integer;
	18	VerNurse: string;
	19	VerClerk: string;
	20	ChartRev: string;
	21	Provider: Int64;
	22	ProviderName: string;
	23	ProviderDEA: string;
	24	ProviderVa: string;
	25	DigSigReq: string;
	26	XMLText: string;
	27	Text: string;
	28	DGroupSeq: Integer;
	29	DGroupName: string;
	30	Flagged: Boolean;
	31	Retrieved: Boolean;
	32	EditOf: string;
	33	ActionOn: string;
	34	EventPtr: string; //ptr to #100.2
	35	EventName: string; //Event name in #100.5
	36	OrderLocIEN: string; //imo
	37	OrderLocName: string; //imo
	38	ParentID : string;
	39	LinkObject: TObject;
	40	EnteredInError: Integer; //AGP Changes 26.12 PSI-04-053
[829]	41	DCOriginalOrder: boolean;
[456]	42	procedure Assign(Source: TOrder);
	43	procedure Clear;
	44	end;
	45
	46	TParentEvent = class
	47	public
	48	ParentIFN: integer;
	49	ParentName: string;
	50	ParentType: Char;
	51	ParentDlg: string;
	52	constructor Create;
	53	procedure Assign(AnEvtID: string);
	54	end;
	55
	56	TOrderDelayEvent = record
	57	EventType: Char; // A=admit, T=transfer, D=discharge, C=current
	58	TheParent: TParentEvent; // Parent Event
	59	EventIFN : Integer; // Pointer to OE/RR EVENTS file (#100.5)
	60	EventName: String; // Event name from OR/RR EVENTS file (#100.5)
	61	PtEventIFN: Integer; // Patient event IFN ptr to #100.2
	62	Specialty: Integer; // pointer to facility treating specialty file
	63	Effective: TFMDateTime; // effective date/time (estimated start time)
	64	IsNewEvent: Boolean; // is new event for an patient
	65	end;
	66
	67	TOrderDialogResolved = record
	68	InputID: string; // can be dialog IEN or '#ORIFN'
	69	QuickLevel: Integer; // 0=dialog,1=auto,2=verify,8=reject,9=cancel
	70	ResponseID: string; // DialogID + ';' + $H
	71	DialogIEN: Integer; // pointer to 101.41 for dialog (may be quick order IEN)
	72	DialogType: Char; // type of dialog (Q or D)
	73	FormID: Integer; // windows form to display
	74	DisplayGroup: Integer; // pointer to 100.98, display group for dialog
	75	ShowText: string; // text to show for verify or rejection
	76	QOKeyVars: string; // from entry action of quick order
	77	end;
	78
	79	TNextMoveRec = record
	80	NextStep: Integer;
	81	LastIndex: Integer;
	82	end;
	83
	84	TOrderMenu = class
	85	IEN: Integer;
	86	NumCols: Integer;
	87	Title: string;
	88	KeyVars: string;
	89	MenuItems: TList; {of TOrderMenuItem}
	90	end;
	91
	92	TOrderMenuItem = class
	93	IEN: Integer;
	94	Row: Integer;
	95	Col: Integer;
	96	DlgType: Char;
	97	FormID: Integer;
	98	AutoAck: Boolean;
	99	ItemText: string;
	100	Mnemonic: string;
	101	Display: Integer;
	102	Selected: Boolean;
	103	end;
	104
	105	TSelectedOrder = class
	106	public
	107	Position: Integer;
	108	Order: TOrder;
	109	end;
	110
	111	TOrderRenewFields = class
	112	public
	113	BaseType: Integer;
	114	StartTime: string;
	115	StopTime: string;
	116	Refills: Integer;
	117	Pickup: string;
	118	Comments: string;
	119	NewText: string;
	120	end;
	121
	122	TPrintParams = record
	123	PromptForChartCopy : char;
	124	ChartCopyDevice : string;
	125	PromptForLabels : char;
	126	LabelDevice : string;
	127	PromptForRequisitions : char;
	128	RequisitionDevice : string;
	129	PromptForWorkCopy : char;
	130	WorkCopyDevice : string;
	131	AnyPrompts : boolean;
	132	// OrdersToPrint : TStringList; {KCM}
	133	end;
	134
	135	TOrderView = class
	136	Changed: Boolean; // true when view has been modified
	137	DGroup: Integer; // display group (pointer value)
	138	Filter: Integer; // FLGS parameter passed to ORQ
	139	InvChrono: Boolean; // true for inverse chronological order
	140	ByService: Boolean; // true for grouping orders by service
	141	TimeFrom: TFMDateTime; // beginning time for orders in list
	142	TimeThru: TFMDateTime; // ending time for orders in list
	143	CtxtTime: TFMDateTime; // set by server, context hours begin time
	144	TextView: Integer; // set by server, 0 if mult views of same order
	145	ViewName: string; // display name for the view
	146	EventDelay: TOrderDelayEvent; // fields for event delay view
	147	public
	148	procedure Assign(Src: TOrderView);
	149
	150	end;
	151
	152	{ Order List functions }
	153	function DetailOrder(const ID: string): TStrings;
	154	function ResultOrder(const ID: string): TStrings;
	155	function ResultOrderHistory(const ID: string): TStrings;
	156	function NameOfStatus(IEN: Integer): string;
	157	function GetOrderStatus(AnOrderId: string): integer;
	158	function ExpiredOrdersStartDT: TFMDateTime;
	159	procedure ClearOrders(AList: TList);
	160	procedure LoadOrders(Dest: TList; Filter, Groups: Integer);
	161	procedure LoadOrdersAbbr(Dest: TList; AView: TOrderView; APtEvtID: string); overload;
	162	procedure LoadOrdersAbbr(DestDC,DestRL: TList; AView: TOrderView; APtEvtID: string); overload;
	163	procedure LoadOrderSheets(Dest: TStrings);
	164	procedure LoadOrderSheetsED(Dest: TStrings);
	165	procedure LoadOrderViewDefault(AView: TOrderView);
	166	procedure LoadUnsignedOrders(IDList, HaveList: TStrings);
	167	procedure SaveOrderViewDefault(AView: TOrderView);
	168	procedure RetrieveOrderFields(OrderList: TList; ATextView: Integer; ACtxtTime: TFMDateTime);
	169	procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string);
	170	procedure SetOrderFromResults(AnOrder: TOrder);
	171	procedure SortOrders(AList: TList; ByGroup, InvChron: Boolean);
	172
	173	{ Display Group & List functions }
	174	function DGroupAll: Integer;
	175	function DGroupIEN(AName: string): Integer;
	176	procedure ListDGroupAll(Dest: TStrings);
	177	procedure ListSpecialties(Dest: TStrings);
	178	procedure ListSpecialtiesED(AType: Char; Dest: TStrings);
	179	procedure ListOrderFilters(Dest: TStrings);
	180	procedure ListOrderFiltersAll(Dest: TStrings);
	181	function NameOfDGroup(IEN: Integer): string;
	182	function ShortNameOfDGroup(IEN: Integer): string;
	183	function SeqOfDGroup(IEN: Integer): Integer;
	184	function CheckOrderGroup(AOrderID: string): integer;
	185	function CheckQOGroup(AQOId:string): Boolean;
	186
	187	{ Write Orders }
	188	procedure BuildResponses(var ResolvedDialog: TOrderDialogResolved; const KeyVars: string;
	189	AnEvent: TOrderDelayEvent; ForIMO: boolean = False);
	190	procedure ClearOrderRecall;
	191	function CommonLocationForOrders(OrderList: TStringList): Integer;
	192	function FormIDForDialog(IEN: Integer): Integer;
	193	function DlgIENForName(DlgName: string): Integer;
	194	procedure LoadOrderMenu(AnOrderMenu: TOrderMenu; AMenuIEN: Integer);
	195	procedure LoadOrderSet(SetItems: TStrings; AnIEN: Integer; var KeyVars, ACaption: string);
	196	procedure LoadWriteOrders(Dest: TStrings);
	197	procedure LoadWriteOrdersED(Dest: TStrings; EvtID: string);
	198	function OrderDisabledMessage(DlgIEN: Integer): string;
	199	procedure SendOrders(OrderList: TStringList; const ESCode: string);
	200	procedure SendReleaseOrders(OrderList: TStringList);
	201	procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string);
	202	procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string);
[829]	203	procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0); {KCM}
	204	procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0); {REV}
	205	procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0); {KCM}
[456]	206	function UseNewMedDialogs: Boolean;
	207
	208	{ Order Actions }
	209	function DialogForOrder(const ID: string): Integer;
	210	procedure LockPatient(var ErrMsg: string);
	211	procedure UnlockPatient;
	212	procedure LockOrder(OrderID: string; var ErrMsg: string);
	213	procedure UnlockOrder(OrderID: string);
	214	function FormIDForOrder(const ID: string): Integer;
	215	procedure ValidateOrderAction(const ID, Action: string; var ErrMsg: string);
	216	procedure ValidateOrderActionNature(const ID, Action, Nature: string; var ErrMsg: string);
	217	procedure IsLatestAction(const ID: string; var ErrList: TStringList);
	218	procedure ChangeOrder(AnOrder: TOrder; ResponseList: TList);
	219	procedure RenewOrder(AnOrder: TOrder; RenewFields: TOrderRenewFields; IsComplex: integer;
	220	AnIMOOrderAppt: double; OCList: TStringList);
	221	procedure HoldOrder(AnOrder: TOrder);
	222	procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
	223	function GetREQReason: Integer;
[829]	224	procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer);
[456]	225	procedure ReleaseOrderHold(AnOrder: TOrder);
	226	procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64);
	227	procedure FlagOrder(AnOrder: TOrder; const FlagReason: string; AlertRecip: Int64);
	228	procedure UnflagOrder(AnOrder: TOrder; const AComment: string);
	229	procedure LoadFlagReason(Dest: TStrings; const ID: string);
	230	procedure LoadWardComments(Dest: TStrings; const ID: string);
	231	procedure PutWardComments(Src: TStrings; const ID: string; var ErrMsg: string);
	232	procedure CompleteOrder(AnOrder: TOrder; const ESCode: string);
	233	procedure VerifyOrder(AnOrder: TOrder; const ESCode: string);
	234	procedure VerifyOrderChartReview(AnOrder: TOrder; const ESCode: string);
	235	function GetOrderableIen(AnOrderId:string): integer;
	236	procedure StoreDigitalSig(AID, AHash: string; AProvider: Int64; ASig, ACrlUrl: string; var AError: string);
	237	procedure UpdateOrderDGIfNeeded(AnID: string);
	238	function CanEditSuchRenewedOrder(AnID: string; IsTxtOrder: integer): boolean;
	239	function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean;
	240	procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer);
[829]	241	function DoesOrderStatusMatch(OrderArray: TStringList): boolean;
[456]	242	//function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams;
	243
	244	{ Order Information }
	245	procedure LoadRenewFields(RenewFields: TOrderRenewFields; const ID: string);
	246	procedure GetChildrenOfComplexOrder(AnParentID,CurrAct: string; var ChildList: TStringList); //PSI-COMPLEX
	247	procedure LESValidationForChangedLabOrder(var RejectedReason: TStringList; AnOrderInfo: string);
	248	procedure ValidateComplexOrderAct(AnOrderID: string; var ErrMsg: string); //PSI-COMPLEX
	249	function IsRenewableComplexOrder(AnParentID: string): boolean; //PSI-COMPLEX
	250	function IsComplexOrder(AnOrderID: string): boolean; //PSI-COMPLEX
	251	function GetDlgData(ADlgID: string): string;
	252	function OrderIsReleased(const ID: string): Boolean;
	253	function TextForOrder(const ID: string): string;
	254	function GetConsultOrderNumber(ConsultIEN: string): string;
	255	function GetOrderByIFN(const ID: string): TOrder;
	256	function GetPackageByOrderID(const OrderID: string): string;
	257	function AnyOrdersRequireSignature(OrderList: TStringList): Boolean;
	258	function OrderRequiresSignature(const ID: string): Boolean;
	259	function OrderRequiresDigitalSignature(const ID: string): Boolean;
	260	function GetDrugSchedule(const ID: string): string;
	261	function GetExternalText(const ID: string): string;
	262	function SetExternalText(const ID: string; ADrugSch: string; AUser: Int64): string;
	263	function GetDEA(const ID: string): string;
	264	function GetDigitalSignature(const ID: string): string;
	265	function GetPKIUse: Boolean;
	266	function GetPKISite: Boolean;
	267	function DoesOIPIInSigForQO(AnQOID: integer): integer;
	268	function GetDispGroupForLES: string;
	269	function GetOrderPtEvtID(AnOrderID: string): string;
	270	function VerbTelPolicyOrder(AnOrderID: string): boolean;
	271	function ForIVandUD(AnOrderID: string): boolean;
	272
	273	{Event Delay Enhancement}
	274	function DeleteEmptyEvt(APtEvntID: string; var APtEvntName: string; Ask: boolean = True): boolean;
	275	function DispOrdersForEvent(AEvtId: string): boolean;
	276	function EventInfo(APtEvtID: string): string; // ptr to #100.2
	277	function EventInfo1(AnEvtID: string): string; // ptr to #100.5
	278	function EventExist(APtDFN:string; AEvt: integer): integer;
	279	function CompleteEvt(APtEvntID: string; APtEvntName: string; Ask: boolean = True): boolean;
	280	function PtEvtEmpty(APtEvtID: string): Boolean;
	281	function GetEventIFN(const AEvntID: string): string;
	282	function GetEventName(const AEvntID: string): string;
	283	function GetEventLoc(const APtEvntID: string): string;
	284	function GetEventLoc1(const AnEvntID: string): string;
	285	function GetEventDiv(const APtEvntID: string): string;
	286	function GetEventDiv1(const AnEvntID: string): string;
	287	function GetCurrentSpec(const APtIFN: string): string;
	288	function GetDefaultEvt(const AProviderIFN: string): string;
	289	function isExistedEvent(const APtDFN: string; const AEvtID: string; var APtEvtID: string): Boolean;
	290	function TypeOfExistedEvent(APtDFN: string; AEvtID: Integer): Integer;
	291	function isMatchedEvent(const APtDFN: string; const AEvtID: string; var ATs: string): Boolean;
	292	function isDCedOrder(const AnOrderID: string): Boolean;
	293	function isOnholdMedOrder(AnOrderID: string): Boolean;
	294	function SetDefaultEvent(var AErrMsg: string; EvtID: string): Boolean;
	295	function GetEventPromptID: integer;
	296	function GetDefaultTSForEvt(AnEvtID: integer): string;
	297	function GetPromptIDs: string;
	298	function GetEventDefaultDlg(AEvtID: integer): string;
	299	function CanManualRelease: boolean;
	300	function TheParentPtEvt(APtEvt: string): string;
	301	function IsCompletedPtEvt(APtEvtID: integer): boolean;
	302	function IsPassEvt(APtEvtID: integer; APtEvtType: char): boolean;
	303	function IsPassEvt1(AnEvtID: integer; AnEvtType: char): boolean;
	304	procedure DeleteDefaultEvt;
	305	procedure TerminatePtEvt(APtEvtID: integer);
	306	procedure ChangeEvent(AnOrderList: TStringList; APtEvtId: string);
	307	procedure DeletePtEvent(APtEvtID: string);
	308	procedure SaveEvtForOrder(APtDFN: string; AEvt: integer; AnOrderID: string);
	309	procedure SetPtEvtList(Dest: TStrings; APtDFN: string; var ATotal: integer);
	310	procedure GetTSListForEvt(Dest: TStrings; AnEvtID:integer);
	311	procedure GetChildEvent(var AChildList: TStringList; APtEvtID: string);
	312
	313	{ Order Checking }
	314	function FillerIDForDialog(IEN: Integer): string;
	315	function OrderChecksEnabled: Boolean;
	316	function OrderChecksOnDisplay(const FillerID: string): string;
	317	procedure OrderChecksOnAccept(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
	318	OIList: TStringList; DupORIFN: string);
	319	procedure OrderChecksOnDelay(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
	320	OIList: TStringList);
	321	procedure OrderChecksForSession(ListOfChecks, OrderList: TStringList);
	322	procedure SaveOrderChecksForSession(const AReason: string; ListOfChecks: TStringList);
	323	function DeleteCheckedOrder(const OrderID: string): Boolean;
	324	function DataForOrderCheck(const OrderID: string): string;
	325
	326	{ Copay }
	327	procedure GetCoPay4Orders;
	328	procedure SaveCoPayStatus(AList: TStrings);
	329
	330	{IMO: inpatient medication for outpatient}
	331	function IsValidIMOLoc(LocID: integer; PatientID: string): boolean; //IMO
	332	function IsIMOOrder(OrderID: string): boolean;
	333	function IsInptQO(DlgID: integer): boolean;
	334	function IsIVQO(DlgID: integer): boolean;
	335	function IsClinicLoc(ALoc: integer): boolean;
	336
	337	{None-standard Schedule} //nss
	338	function IsValidSchedule(AnOrderID: string): boolean; //NSS
	339	function IsValidQOSch(QOID: string): string; //NSS
	340	function IsValidSchStr(ASchStr: string): boolean;
	341
	342	implementation
	343
[829]	344	uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore, VAUtils;
[456]	345
	346	var
	347	uDGroupMap: TStringList; // each string is DGroupIEN=Sequence^TopName^Name
	348	uDGroupAll: Integer;
	349	uOrderChecksOn: Char;
	350
	351	{ TOrderView methods }
	352
	353	procedure TOrderView.Assign(Src: TOrderView);
	354	begin
	355	Self.Changed := Src.Changed;
	356	Self.DGroup := Src.DGroup;
	357	Self.Filter := Src.Filter;
	358	Self.InvChrono := Src.InvChrono;
	359	Self.ByService := Src.ByService;
	360	Self.TimeFrom := Src.TimeFrom;
	361	Self.TimeThru := Src.TimeThru;
	362	Self.CtxtTime := Src.CtxtTime;
	363	Self.TextView := Src.TextView;
	364	Self.ViewName := Src.ViewName;
	365	Self.EventDelay.EventIFN := Src.EventDelay.EventIFN;
	366	Self.EventDelay.EventName := Src.EventDelay.EventName;
	367	Self.EventDelay.EventType := Src.EventDelay.EventType;
	368	Self.EventDelay.Specialty := Src.EventDelay.Specialty;
	369	Self.EventDelay.Effective := Src.EventDelay.Effective;
	370	end;
	371
	372	{ TOrder methods }
	373
	374	procedure TOrder.Assign(Source: TOrder);
	375	begin
	376	ID := Source.ID;
	377	DGroup := Source.DGroup;
	378	OrderTime := Source.OrderTime;
	379	StartTime := Source.StartTime;
	380	StopTime := Source.StopTime;
	381	Status := Source.Status;
	382	Signature := Source.Signature;
	383	VerNurse := Source.VerNurse;
	384	VerClerk := Source.VerClerk;
	385	ChartRev := Source.ChartRev;
	386	Provider := Source.Provider;
	387	ProviderName := Source.ProviderName;
	388	ProviderDEA := Source.ProviderDEA;
	389	ProviderVA := Source.ProviderVA;
	390	DigSigReq := Source.DigSigReq;
	391	XMLText := Source.XMLText;
	392	Text := Source.Text;
	393	DGroupSeq := Source.DGroupSeq;
	394	DGroupName := Source.DGroupName;
	395	Flagged := Source.Flagged;
	396	Retrieved := Source.Retrieved;
	397	EditOf := Source.EditOf;
	398	ActionOn := Source.ActionOn;
	399	EventPtr := Source.EventPtr;
	400	EventName := Source.EventName;
	401	OrderLocIEN := Source.OrderLocIEN;
	402	OrderLocName := Source.OrderLocName;
	403	ParentID := Source.ParentID;
	404	LinkObject := Source.LinkObject;
	405	end;
	406
	407	procedure TOrder.Clear;
	408	begin
	409	ID := '';
	410	DGroup := 0;
	411	OrderTime := 0;
	412	StartTime := '';
	413	StopTime := '';
	414	Status := 0;
	415	Signature := 0;
	416	VerNurse := '';
	417	VerClerk := '';
	418	ChartRev := '';
	419	Provider := 0;
	420	ProviderName := '';
	421	ProviderDEA := '';
	422	ProviderVA :='';
	423	DigSigReq :='';
	424	XMLText := '';
	425	Text := '';
	426	DGroupSeq := 0;
	427	DGroupName := '';
	428	Flagged := False;
	429	Retrieved := False;
	430	EditOf := '';
	431	ActionOn := '';
	432	OrderLocIEN := ''; //imo
	433	OrderLocName := ''; //imo
	434	ParentID := '';
	435	LinkObject := nil;
	436	end;
	437
	438	{ Order List functions }
	439
	440	function DetailOrder(const ID: string): TStrings;
	441	begin
	442	CallV('ORQOR DETAIL', [ID, Patient.DFN]);
	443	Result := RPCBrokerV.Results;
	444	end;
	445
	446	function ResultOrder(const ID: string): TStrings;
	447	begin
	448	CallV('ORWOR RESULT', [Patient.DFN,ID,ID]);
	449	Result := RPCBrokerV.Results;
	450	end;
	451
	452	function ResultOrderHistory(const ID: string): TStrings;
	453	begin
	454	CallV('ORWOR RESULT HISTORY', [Patient.DFN,ID,ID]);
	455	Result := RPCBrokerV.Results;
	456	end;
	457
	458	procedure LoadDGroupMap;
	459	begin
	460	if uDGroupMap = nil then
	461	begin
	462	uDGroupMap := TStringList.Create;
	463	tCallV(uDGroupMap, 'ORWORDG MAPSEQ', [nil]);
	464	end;
	465	end;
	466
	467	function NameOfStatus(IEN: Integer): string;
	468	begin
	469	case IEN of
	470	0: Result := 'error';
	471	1: Result := 'discontinued';
	472	2: Result := 'complete';
	473	3: Result := 'hold';
	474	4: Result := 'flagged';
	475	5: Result := 'pending';
	476	6: Result := 'active';
	477	7: Result := 'expired';
	478	8: Result := 'scheduled';
	479	9: Result := 'partial results';
	480	10: Result := 'delayed';
	481	11: Result := 'unreleased';
	482	12: Result := 'dc/edit';
	483	13: Result := 'cancelled';
	484	14: Result := 'lapsed';
	485	15: Result := 'renewed';
	486	97: Result := ''; { null status, used for 'No Orders Found.' }
	487	98: Result := 'new';
	488	99: Result := 'no status';
	489	end;
	490	end;
	491
	492	function GetOrderStatus(AnOrderId: string): integer;
	493	begin
	494	Result := StrToIntDef(SCallV('OREVNTX1 GETSTS',[AnOrderId]),0);
	495	end;
	496
	497	function ExpiredOrdersStartDT: TFMDateTime;
	498	//Return FM date/time to begin search for expired orders
	499	begin
	500	Result := MakeFMDateTime(sCallV('ORWOR EXPIRED', [nil]));
	501	end;
	502
	503	function DispOrdersForEvent(AEvtId: string): boolean;
	504	var
	505	theResult: integer;
	506	begin
	507	Result := False;
	508	theResult := StrToIntDef(SCallV('OREVNTX1 CPACT',[AEvtId]),0);
	509	if theResult > 0 then
	510	Result := True;
	511	end;
	512
	513	function EventInfo(APtEvtID: string): string;
	514	begin
	515	Result := SCallV('OREVNTX1 GTEVT', [APtEvtID]);
	516	end;
	517
	518	function EventInfo1(AnEvtID: string): string;
	519	begin
	520	Result := SCallV('OREVNTX1 GTEVT1', [AnEvtID]);
	521	end;
	522
	523	function NameOfDGroup(IEN: Integer): string;
	524	begin
	525	if uDGroupMap = nil then LoadDGroupMap;
	526	Result := uDGroupMap.Values[IntToStr(IEN)];
	527	Result := Piece(Result, U, 3);
	528	end;
	529
	530	function ShortNameOfDGroup(IEN: Integer): string;
	531	begin
	532	if uDGroupMap = nil then LoadDGroupMap;
	533	Result := uDGroupMap.Values[IntToStr(IEN)];
	534	Result := Piece(Result, U, 4);
	535	end;
	536
	537	function SeqOfDGroup(IEN: Integer): Integer;
	538	var
	539	x: string;
	540	begin
	541	if uDGroupMap = nil then LoadDGroupMap;
	542	x := uDGroupMap.Values[IntToStr(IEN)];
	543	Result := StrToIntDef(Piece(x, U, 1), 0);
	544	end;
	545
	546	function CheckOrderGroup(AOrderID: string): integer;
	547	begin
	548	// Result = 1 Inpatient Medication Display Group;
	549	// Result = 2 OutPatient Medication Display Group;
	550	// Result = 0 None of In or Out patient display group;
	551	Result := StrToInt(SCallV('ORWDPS2 CHKGRP',[AOrderID]));
	552	end;
	553
	554	function CheckQOGroup(AQOId:string): Boolean;
	555	var
	556	rst: integer;
	557	begin
	558	rst := StrToInt(SCallV('ORWDPS2 QOGRP',[AQOId]));
	559	Result := False;
	560	if rst > 0 then
	561	Result := True;
	562	end;
	563
	564	function TopNameOfDGroup(IEN: Integer): string;
	565	begin
	566	if uDGroupMap = nil then LoadDGroupMap;
	567	Result := uDGroupMap.Values[IntToStr(IEN)];
	568	Result := Piece(Result, U, 2);
	569	end;
	570
	571	procedure ClearOrders(AList: TList);
	572	var
	573	i: Integer;
	574	begin
	575	with AList do for i := 0 to Count - 1 do with TOrder(Items[i]) do Free;
	576	AList.Clear;
	577	end;
	578
	579	procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string);
[829]	580	{ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
	581	{ Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig^IMO^DCOrigOrder}
[456]	582	begin
	583	with AnOrder do
	584	begin
	585	Clear;
	586	ID := Copy(Piece(x, U, 1), 2, Length(Piece(x, U, 1)));
	587	DGroup := StrToIntDef(Piece(x, U, 2), 0);
	588	OrderTime := MakeFMDateTime(Piece(x, U, 3));
	589	StartTime := Piece(x, U, 4);
	590	StopTime := Piece(x, U, 5);
	591	Status := StrToIntDef(Piece(x, U, 6), 0);
	592	Signature := StrToIntDef(Piece(x, U, 7), 0);
	593	VerNurse := Piece(x, U, 8);
	594	VerClerk := Piece(x, U, 9);
	595	ChartRev := Piece(x, U, 15);
	596	Provider := StrToInt64Def(Piece(x, U, 10), 0);
	597	ProviderName := Piece(x, U, 11);
	598	ProviderDEA := Piece(x, U, 16);
	599	ProviderVA := Piece(x, U, 17);
	600	DigSigReq := Piece(x, U, 18);
	601	Flagged := Piece(x, U, 13) = '1';
	602	Retrieved := True;
	603	OrderLocIEN := Piece(Piece(x,U,19),':',2); //imo
[829]	604	if Piece(Piece(x,U,19),':',1) = '0;SC(' then OrderLocName := 'Unknown'
	605	else OrderLocName := Piece(Piece(x,U,19),':',1); //imo
[456]	606	Text := y;
	607	XMLText := z;
	608	DGroupSeq := SeqOfDGroup(DGroup);
	609	DGroupName := TopNameOfDGroup(DGroup);
	610	//AGP Changes 26.15 PSI-04-063
	611	if (pos('Entered in error',Text)>0) then AnOrder.EnteredInError := 1
	612	else AnOrder.EnteredInError := 0;
	613	//if DGroupName = 'Non-VA Meds' then Text := 'Non-VA ' + Text;
[829]	614	if Piece(x,U,20) = '1' then DCOriginalOrder := True
	615	else DCOriginalOrder := False;
[456]	616	end;
	617	end;
	618
	619	procedure LoadOrders(Dest: TList; Filter, Groups: Integer);
	620	var
	621	x, y, z: string;
	622	AnOrder: TOrder;
	623	begin
	624	ClearOrders(Dest);
	625	if uDGroupMap = nil then LoadDGroupMap; // to make sure broker not called while looping thru Results
	626	CallV('ORWORR GET', [Patient.DFN, Filter, Groups]);
	627	with RPCBrokerV do while Results.Count > 0 do
	628	begin
	629	x := Results[0];
	630	Results.Delete(0);
	631	if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch
	632	y := '';
	633	while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '\|') do
	634	begin
	635	y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
	636	Results.Delete(0);
	637	end;
	638	if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
	639	z := '';
	640	if (Results.Count > 0) and (Results[0] = '\|') then
	641	begin
	642	Results.Delete(0);
	643	while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '\|') do
	644	begin
	645	z := z + Copy(Results[0], 2, Length(Results[0]));
	646	Results.Delete(0);
	647	end;
	648	end;
	649	AnOrder := TOrder.Create;
	650	SetOrderFields(AnOrder, x, y, z);
	651	Dest.Add(AnOrder);
	652	end;
	653	end;
	654
	655	procedure LoadOrdersAbbr(Dest: TList; AView: TOrderView; APtEvtID: string);
	656	//Filter, Specialty, Groups: Integer; var TextView: Integer;
	657	// var CtxtTime: TFMDateTime);
	658	var
	659	i: Integer;
	660	AnOrder: TOrder;
	661	FilterTS: string;
[829]	662	AlertedUserOnly: boolean;
[456]	663	begin
	664	ClearOrders(Dest);
	665	if uDGroupMap = nil then LoadDGroupMap; // to make sure broker not called while looping thru Results
	666	FilterTS := IntToStr(AView.Filter) + U + IntToStr(AView.EventDelay.Specialty);
[829]	667	AlertedUserOnly := (Notifications.Active and (AView.Filter = 12));
	668	CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID, AlertedUserOnly]);
[456]	669	if ((Piece(RPCBrokerV.Results[0], U, 1) = '0') or (Piece(RPCBrokerV.Results[0], U, 1) = '')) and (AView.Filter = 5) then // if no expiring orders found display expired orders)
	670	begin
	671	CallV('ORWORR AGET', [Patient.DFN, '27^0', AView.DGroup, ExpiredOrdersStartDT, FMNow, APtEvtID]);
	672	AView.ViewName := 'Recently Expired Orders (No Expiring Orders Found) -' + Piece(AView.ViewName, '-', 2);
	673	end;
	674	{if (Piece(RPCBrokerV.Results[0], U, 1) = '0') or (Piece(RPCBrokerV.Results[0], U, 1) = '') then // if no orders found (0 element is count)
	675	begin
	676	AnOrder := TOrder.Create;
	677	with AnOrder do
	678	begin
	679	ID := '0';
	680	DGroup := 0;
	681	OrderTime := FMNow;
	682	Status := 97;
	683	Text := 'No orders found.';
	684	Retrieved := True;
	685	end;
	686	Dest.Add(AnOrder);
	687	Exit;
	688	end;}
	689	AView.TextView := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0);
	690	AView.CtxtTime := MakeFMDateTime(Piece(RPCBrokerV.Results[0], U, 3));
	691	with RPCBrokerV do for i := 1 to Results.Count - 1 do // if orders found (skip 0 element)
	692	begin
	693	if (Piece(RPCBrokerV.Results[i], U, 1) = '0') or (Piece(RPCBrokerV.Results[i], U, 1) = '') then Continue;
	694	if (DelimCount(Results[i],U) = 2) then Continue;
	695	AnOrder := TOrder.Create;
	696	with AnOrder do
	697	begin
	698	ID := Piece(Results[i], U, 1);
	699	DGroup := StrToIntDef(Piece(Results[i], U, 2), 0);
	700	OrderTime := MakeFMDateTime(Piece(Results[i], U, 3));
	701	EventPtr := Piece(Results[i],U,4);
	702	EventName := Piece(Results[i],U,5);
	703	DGroupSeq := SeqOfDGroup(DGroup);
	704	end;
	705	Dest.Add(AnOrder);
	706	end;
	707	end;
	708
	709	procedure LoadOrdersAbbr(DestDC,DestRL: TList; AView: TOrderView; APtEvtID: string);
	710	var
	711	i: Integer;
	712	AnOrder: TOrder;
	713	FilterTS: string;
	714	DCStart: boolean;
	715	begin
	716	DCStart := False;
	717	if uDGroupMap = nil then LoadDGroupMap;
	718	FilterTS := IntToStr(AView.Filter) + U + IntToStr(AView.EventDelay.Specialty);
	719	CallV('ORWORR RGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID]);
	720	if RPCBrokerV.Results[0] = '0' then // if no orders found (0 element is count)
	721	begin
	722	AnOrder := TOrder.Create;
	723	with AnOrder do
	724	begin
	725	ID := '0';
	726	DGroup := 0;
	727	OrderTime := FMNow;
	728	Status := 97;
	729	Text := 'No orders found.';
	730	Retrieved := True;
	731	end;
	732	DestDC.Add(AnOrder);
	733	Exit;
	734	end;
	735	AView.TextView := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0);
	736	AView.CtxtTime := MakeFMDateTime(Piece(RPCBrokerV.Results[0], U, 3));
	737	with RPCBrokerV do for i := 1 to Results.Count - 1 do // if orders found (skip 0 element)
	738	begin
	739	if AnsiCompareText('DC START', Results[i]) = 0 then
	740	begin
	741	DCStart := True;
	742	Continue;
	743	end;
	744	AnOrder := TOrder.Create;
	745	with AnOrder do
	746	begin
	747	ID := Piece(Results[i], U, 1);
	748	DGroup := StrToIntDef(Piece(Results[i], U, 2), 0);
	749	OrderTime := MakeFMDateTime(Piece(Results[i], U, 3));
	750	EventPtr := Piece(Results[i],U,4);
	751	EventName := Piece(Results[i],U,5);
	752	DGroupSeq := SeqOfDGroup(DGroup);
	753	end;
	754	if DCStart then
	755	DestDC.Add(AnOrder)
	756	else
	757	DestRL.Add(AnOrder);
	758	end;
	759	end;
	760
	761	procedure LoadOrderSheets(Dest: TStrings);
	762	begin
	763	CallV('ORWOR SHEETS', [Patient.DFN]);
	764	MixedCaseByPiece(RPCBrokerV.Results, U, 2);
[829]	765	FastAssign(RPCBrokerV.Results, Dest);
	766	end;
[456]	767
	768	procedure LoadOrderSheetsED(Dest: TStrings);
	769	var
	770	i: integer;
	771	begin
	772	CallV('OREVNTX PAT', [Patient.DFN]);
	773	MixedCaseByPiece(RPCBrokerV.Results, U, 2);
	774	Dest.Add('C;O^Current View');
	775	if RPCBrokerV.Results.Count > 1 then
	776	begin
	777	RPCBrokerV.Results.Delete(0);
	778	for i := 0 to RPCbrokerV.Results.Count - 1 do
	779	RPCBrokerV.Results[i] := RPCBrokerV.Results[i] + ' Orders';
[829]	780	FastAddStrings(RPCBrokerV.Results, Dest);
[456]	781	end;
	782	end;
	783
	784	procedure LoadOrderViewDefault(AView: TOrderView);
	785	var
	786	x: string;
	787	begin
	788	x := sCallV('ORWOR VWGET', [nil]);
	789	with AView do
	790	begin
	791	Changed := False;
	792	DGroup := StrToIntDef(Piece(x, ';', 4), 0);
	793	Filter := StrToIntDef(Piece(x, ';', 3), 0);
	794	InvChrono := Piece(x, ';', 6) = 'R';
	795	ByService := Piece(x, ';', 7) = '1';
	796	TimeFrom := StrToFloat(Piece(x, ';', 1));
	797	TimeThru := StrToFloat(Piece(x, ';', 2));
	798	CtxtTime := 0;
	799	TextView := 0;
	800	ViewName := Piece(x, ';', 8);
	801	EventDelay.EventType := 'C';
	802	EventDelay.Specialty := 0;
	803	EventDelay.Effective := 0;
	804	end;
	805	end;
	806
	807	procedure LoadUnsignedOrders(IDList, HaveList: TStrings);
	808	var
	809	i: Integer;
	810	begin
	811	with RPCBrokerV do
	812	begin
	813	ClearParameters := True;
	814	RemoteProcedure := 'ORWOR UNSIGN';
	815	Param[0].PType := literal;
	816	Param[0].Value := Patient.DFN;
	817	Param[1].PType := list;
	818	Param[1].Mult['0'] := ''; // (to prevent broker from hanging if empty list)
	819	for i := 0 to Pred(HaveList.Count) do Param[1].Mult['"' + HaveList[i] + '"'] := '';
	820	CallBroker;
[829]	821	FastAssign(RPCBrokerV.Results,IDList);
[456]	822	end;
	823	end;
	824
	825	procedure RetrieveOrderFields(OrderList: TList; ATextView: Integer; ACtxtTime: TFMDateTime);
	826	var
	827	i, OrderIndex: Integer;
	828	x, y, z: string;
	829	AnOrder: TOrder;
	830	IDList: TStringList;
	831	begin
	832	IDList := TStringList.Create;
	833	try
	834	with OrderList do for i := 0 to Count - 1 do IDList.Add(TOrder(Items[i]).ID);
	835	CallV('ORWORR GET4LST', [ATextView, ACtxtTime, IDList]);
	836	finally
	837	IDList.Free;
	838	end;
	839	OrderIndex := -1;
	840	with RPCBrokerV do while Results.Count > 0 do
	841	begin
	842	Inc(OrderIndex);
	843	if (OrderIndex >= OrderList.Count) then
	844	begin
	845	Results.Delete(0);
	846	Continue;
	847	end;
	848	AnOrder := TOrder(OrderList.Items[OrderIndex]);
	849	x := Results[0];
	850	Results.Delete(0);
	851	if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch
	852	if Piece(x, U, 1) <> '~' + AnOrder.ID then Continue; // only happens if out of synch
	853	y := '';
	854	while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '\|') do
	855	begin
	856	y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
	857	Results.Delete(0);
	858	end;
	859	if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
	860	z := '';
	861	if (Results.Count > 0) and (Results[0] = '\|') then
	862	begin
	863	Results.Delete(0);
	864	while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '\|') do
	865	begin
	866	z := z + Copy(Results[0], 2, Length(Results[0]));
	867	Results.Delete(0);
	868	end;
	869	end;
	870	SetOrderFields(AnOrder, x, y, z);
	871	end;
	872	end;
	873
	874	procedure SaveOrderViewDefault(AView: TOrderView);
	875	var
	876	x: string;
	877	begin
	878	with AView do
	879	begin
	880	x := MakeRelativeDateTime(TimeFrom) + ';' + // 1
	881	MakeRelativeDateTime(TimeThru) + ';' + // 2
	882	IntToStr(Filter) + ';' + // 3
	883	IntToStr(DGroup) + ';;'; // 4, skip 5
	884	if InvChrono then x := x + 'R;' else x := x + 'F;'; // 6
	885	if ByService then x := x + '1' else x := x + '0'; // 7
	886	CallV('ORWOR VWSET', [x]);
	887	end;
	888	end;
	889
	890	{ MOVE THESE FUNCTIONS INTO UORDERS??? }
	891
	892	{ < 0 if Item1 is less and Item2, 0 if they are equal and > 0 if Item1 is greater than Item2 }
	893	function InverseByGroup(Item1, Item2: Pointer): Integer;
	894	var
	895	Order1, Order2: TOrder;
	896	DSeq1, DSeq2, IFN1, IFN2: Integer;
	897	begin
	898	Order1 := TOrder(Item1);
	899	Order2 := TOrder(Item2);
	900	if ( (Piece(Order1.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order1.ID)) )
	901	and ( StrToIntDef(Order1.EventPtr,0) = 0 ) then
	902	DSeq1 := 0
	903	else DSeq1 := Order1.DGroupSeq;
	904	if ((Piece(Order2.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order2.ID)))
	905	and ( StrToIntDef(Order1.EventPtr,0) = 0 ) then
	906	DSeq2 := 0
	907	else DSeq2 := Order2.DGroupSeq;
	908	if DSeq1 = DSeq2 then
	909	begin
	910	if Order1.OrderTime > Order2.OrderTime then Result := -1
	911	else if Order1.OrderTime < Order2.OrderTime then Result := 1
	912	else Result := 0;
	913	if Result = 0 then
	914	begin
	915	IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0);
	916	IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0);
	917	if IFN1 < IFN2 then Result := -1;
	918	if IFN1 > IFN2 then Result := 1;
	919	end;
	920	end
	921	else if DSeq1 < DSeq2 then Result := -1
	922	else Result := 1;
	923	end;
	924
	925	function ForwardByGroup(Item1, Item2: Pointer): Integer;
	926	var
	927	Order1, Order2: TOrder;
	928	DSeq1, DSeq2, IFN1, IFN2: Integer;
	929	begin
	930	Order1 := TOrder(Item1);
	931	Order2 := TOrder(Item2);
	932	if (Piece(Order1.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order1.ID))
	933	then DSeq1 := 0
	934	else DSeq1 := Order1.DGroupSeq;
	935	if (Piece(Order2.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order2.ID))
	936	then DSeq2 := 0
	937	else DSeq2 := Order2.DGroupSeq;
	938	if DSeq1 = DSeq2 then
	939	begin
	940	if Order1.OrderTime < Order2.OrderTime then Result := -1
	941	else if Order1.OrderTime > Order2.OrderTime then Result := 1
	942	else Result := 0;
	943	if Result = 0 then
	944	begin
	945	IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0);
	946	IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0);
	947	if IFN1 < IFN2 then Result := -1;
	948	if IFN1 > IFN2 then Result := 1;
	949	end;
	950	end
	951	else if DSeq1 < DSeq2 then Result := -1
	952	else Result := 1;
	953	end;
	954
	955	function InverseChrono(Item1, Item2: Pointer): Integer;
	956	var
	957	Order1, Order2: TOrder;
	958	IFN1, IFN2: Integer;
	959	begin
	960	Order1 := TOrder(Item1);
	961	Order2 := TOrder(Item2);
	962	if Order1.OrderTime > Order2.OrderTime then Result := -1
	963	else if Order1.OrderTime < Order2.OrderTime then Result := 1
	964	else Result := 0;
	965	if Result = 0 then
	966	begin
	967	IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0);
	968	IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0);
	969	if IFN1 < IFN2 then Result := -1;
	970	if IFN1 > IFN2 then Result := 1;
	971	end;
	972	end;
	973
	974	function ForwardChrono(Item1, Item2: Pointer): Integer;
	975	var
	976	Order1, Order2: TOrder;
	977	IFN1, IFN2: Integer;
	978	begin
	979	Order1 := TOrder(Item1);
	980	Order2 := TOrder(Item2);
	981	if Order1.OrderTime < Order2.OrderTime then Result := -1
	982	else if Order1.OrderTime > Order2.OrderTime then Result := 1
	983	else Result := 0;
	984	if Result = 0 then
	985	begin
	986	IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0);
	987	IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0);
	988	if IFN1 < IFN2 then Result := -1;
	989	if IFN1 > IFN2 then Result := 1;
	990	end;
	991	end;
	992
	993	procedure SortOrders(AList: TList; ByGroup, InvChron: Boolean);
	994	begin
	995	if ByGroup then
	996	begin
	997	if InvChron then AList.Sort(InverseByGroup) else AList.Sort(ForwardByGroup);
	998	end else
	999	begin
	1000	if InvChron then AList.Sort(InverseChrono) else AList.Sort(ForwardChrono);
	1001	end;
	1002	end;
	1003
	1004	function DGroupAll: Integer;
	1005	var
	1006	x: string;
	1007	begin
	1008	if uDGroupAll = 0 then
	1009	begin
	1010	x := sCallV('ORWORDG IEN', ['ALL']);
	1011	uDGroupAll := StrToIntDef(x, 1);
	1012	end;
	1013	Result := uDGroupAll;
	1014	end;
	1015
	1016	function DGroupIEN(AName: string): Integer;
	1017	begin
	1018	Result := StrToIntDef(sCallV('ORWORDG IEN', [AName]), 0);
	1019	end;
	1020
	1021	procedure ListDGroupAll(Dest: TStrings);
	1022	begin
	1023	CallV('ORWORDG ALLTREE', [nil]);
[829]	1024	FastAssign(RPCBrokerV.Results, Dest);
[456]	1025	end;
	1026
	1027	procedure ListSpecialties(Dest: TStrings);
	1028	begin
	1029	CallV('ORWOR TSALL', [nil]);
	1030	MixedCaseList(RPCBrokerV.Results);
[829]	1031	FastAssign(RPCBrokerV.Results, Dest);
[456]	1032	end;
	1033
	1034	procedure ListSpecialtiesED(AType: Char; Dest: TStrings);
	1035	var
	1036	i :integer;
	1037	Currloc: integer;
	1038	admitEvts: TStringList;
	1039	otherEvts: TStringList;
	1040	commonList: TStringList;
[829]	1041	IsObservation: boolean;
[456]	1042	begin
	1043	if Encounter <> nil then
	1044	Currloc := Encounter.Location
	1045	else
	1046	Currloc := 0;
[829]	1047	IsObservation := (Piece(GetCurrentSpec(Patient.DFN), U, 3) = '1');
[456]	1048	commonList := TStringList.Create;
	1049	CallV('OREVNTX1 CMEVTS',[Currloc]);
	1050	//MixedCaseList(RPCBrokerV.Results);
	1051	if RPCBrokerV.Results.Count > 0 then with RPCBrokerV do for i := 0 to Results.Count - 1 do
	1052	begin
	1053	if AType = 'D' then
	1054	begin
	1055	if AType = Piece(Results[i],'^',3) then
	1056	commonList.Add(Results[i]);
	1057	end
	1058	else if AType = 'A' then
	1059	begin
	1060	if (Piece(Results[i],'^',3) = 'T') or (Piece(Results[i],'^',3) = 'D') then
	1061	Continue;
	1062	commonList.Add(Results[i]);
	1063	end
[829]	1064	else if IsObservation then
	1065	begin
	1066	if (Piece(Results[i],'^',3) = 'T') then
	1067	Continue;
	1068	commonList.Add(Results[i]);
	1069	end
[456]	1070	else
	1071	begin
	1072	if Length(Results[i])> 0 then
	1073	commonList.Add(Results[i]);
	1074	end;
	1075	end;
	1076	if commonList.Count > 0 then
	1077	begin
[829]	1078	FastAddStrings(TStrings(commonList), Dest);
[456]	1079	Dest.Add('^^^^^^^^___________________________________________________________________________________________');
	1080	Dest.Add(LLS_SPACE);
	1081	end;
	1082	if AType = #0 then
	1083	begin
	1084	admitEvts := TStringList.Create;
	1085	otherEvts := TSTringList.Create;
	1086	CallV('OREVNTX ACTIVE',['A']);
	1087	//MixedCaseList(RPCBrokerV.Results);
	1088	if RPCBrokerV.Results.Count > 0 then
	1089	begin
	1090	RPCBrokerV.Results.Delete(0);
[829]	1091	FastAddStrings(RPCBrokerV.Results, admitEvts);
[456]	1092	end;
[829]	1093	if IsObservation then
	1094	CallV('OREVNTX ACTIVE',['O^M^D'])
	1095	else
	1096	CallV('OREVNTX ACTIVE',['T^O^M^D']);
[456]	1097	//MixedCaseList(RPCBrokerV.Results);
	1098	if RPCBrokerV.Results.Count > 0 then
	1099	begin
	1100	RPCBrokerV.Results.Delete(0);
[829]	1101	FastAddStrings(RPCBrokerV.Results, otherEvts);
[456]	1102	end;
[829]	1103	FastAddStrings(TStrings(otherEvts), Dest);
[456]	1104	Dest.Add('^^^^^^^^_____________________________________________________________________________________________');
	1105	Dest.Add(LLS_SPACE);
[829]	1106	FastAddStrings(TStrings(admitEvts), Dest);
[456]	1107	admitEvts.Free;
	1108	otherEvts.Free;
	1109	end
	1110	else if AType = 'A' then
	1111	begin
	1112	CallV('OREVNTX ACTIVE',['A^O^M']);
	1113	//MixedCaseList(RPCBrokerV.Results);
	1114	if RPCBrokerV.Results.Count > 0 then
	1115	RPCBrokerV.Results.Delete(0);
[829]	1116	FastAddStrings(RPCBrokerV.Results, Dest);
[456]	1117	end
	1118	else
	1119	begin
	1120	CallV('OREVNTX ACTIVE',[AType]);
	1121	//MixedCaseList(RPCBrokerV.Results);
	1122	if RPCBrokerV.Results.Count > 0 then
	1123	RPCBrokerV.Results.Delete(0);
[829]	1124	FastAddStrings(RPCBrokerV.Results, Dest);
[456]	1125	end;
	1126	end;
	1127
	1128	procedure ListOrderFilters(Dest: TStrings);
	1129	begin
	1130	CallV('ORWORDG REVSTS', [nil]);
[829]	1131	FastAssign(RPCBrokerV.Results, Dest);
[456]	1132	end;
	1133
	1134
	1135	procedure ListOrderFiltersAll(Dest: TStrings);
	1136	begin
	1137	CallV('ORWORDG REVSTS', [nil]);
[829]	1138	FastAssign(RPCBrokerV.Results, Dest);
[456]	1139	end;
	1140
	1141	{ Write Orders }
	1142
	1143	procedure BuildResponses(var ResolvedDialog: TOrderDialogResolved; const KeyVars: string;
	1144	AnEvent: TOrderDelayEvent; ForIMO: boolean);
	1145	const
	1146	BoolChars: array[Boolean] of Char = ('0', '1');
	1147	RESERVED_PIECE = '';
	1148	var
	1149	DelayEvent, x, TheOrder: string;
	1150	Idx, tmpOrderGroup, PickupIdx, ForIMOResponses: integer;
	1151	IfUDGrp: Boolean;
	1152	IfUDGrpForQO: Boolean;
	1153	temp: string;
	1154	begin
	1155	ForIMOResponses := 0;
	1156	tmpOrderGroup := 0;
	1157	temp := '';
	1158	if ForIMO then ForIMOResponses := 1;
	1159	PickupIdx := 0;
	1160	IfUDGrp := False;
	1161	TheOrder := ResolvedDialog.InputID;
	1162	IfUDGrpForQO := CheckQOGroup(TheOrder);
	1163	if (CharAt(TheOrder,1) in ['C','T']) then
	1164	begin
	1165	Delete(TheOrder,1,1);
	1166	tmpOrderGroup := CheckOrderGroup(TheOrder);
	1167	if tmpOrderGroup = 1 then IfUDGrp := True else IfUDGrp := False;
	1168	end;
	1169	if (not IfUDGrp) and (AnEvent.EventType in ['A','T']) then
	1170	IfUDGrp := True;
	1171	//FLDS=DFN^LOC^ORNP^INPT^SEX^AGE^EVENT^SC%^^^Key Variables
	1172	if (Patient.Inpatient = true) and (tmpOrderGroup = 2) then temp := '0';
	1173	if temp <> '0' then temp := BoolChars[Patient.Inpatient];
	1174	with AnEvent do
	1175	begin
	1176	if isNewEvent then
	1177	DelayEvent := '0;'+ EventType + ';' + IntToStr(Specialty) + ';' + FloatToStr(Effective)
	1178	else
	1179	DelayEvent := IntToStr(AnEvent.PtEventIFN) + ';' + EventType + ';' + IntToStr(Specialty) + ';' + FloatToStr(Effective);
	1180	end;
	1181	x := Patient.DFN + U + // 1
	1182	IntToStr(Encounter.Location) + U + // 2
	1183	IntToStr(Encounter.Provider) + U + // 3
	1184	BoolChars[Patient.Inpatient] + U + // 4
	1185	Patient.Sex + U + // 5
	1186	IntToStr(Patient.Age) + U + // 6
	1187	DelayEvent + U + // 7 (for OREVENT)
	1188	IntToStr(Patient.SCPercent) + U + // 8
	1189	RESERVED_PIECE + U + // 9
	1190	RESERVED_PIECE + U + // 10
	1191	KeyVars;
[829]	1192	CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses, Encounter.Location]);
[456]	1193	// LST(0)=QuickLevel^ResponseID(ORIT;$H)^Dialog^Type^FormID^DGrp
	1194	with RPCBrokerV do
	1195	begin
	1196	x := Results[0];
	1197	with ResolvedDialog do
	1198	begin
	1199	QuickLevel := StrToIntDef(Piece(x, U, 1), 0);
	1200	ResponseID := Piece(x, U, 2);
	1201	DialogIEN := StrToIntDef(Piece(x, U, 3), 0);
	1202	DialogType := CharAt(Piece(x, U, 4), 1);
	1203	FormID := StrToIntDef(Piece(x, U, 5), 0);
	1204	DisplayGroup := StrToIntDef(Piece(x, U, 6), 0);
	1205	QOKeyVars := Pieces(x, U, 7, 7 + MAX_KEYVARS);
	1206	Results.Delete(0);
	1207	if Results.Count > 0 then
	1208	begin
	1209	if (IfUDGrp) or (IfUDGrpForQO) then
	1210	begin
	1211	for Idx := 0 to Results.Count - 1 do
	1212	begin
	1213	if(Pos('PICK UP',UpperCase(Results[idx])) > 0) or (Pos('PICK-UP',UpperCase(Results[idx])) > 0) then
	1214	begin
	1215	PickupIdx := Idx;
	1216	Break;
	1217	end;
	1218	end;
	1219	end;
	1220	if PickupIdx > 0 then
	1221	Results.Delete(PickupIdx);
	1222	SetString(ShowText, Results.GetText, StrLen(Results.GetText));
	1223	end;
	1224	end;
	1225	end;
	1226	end;
	1227
	1228	procedure ClearOrderRecall;
	1229	begin
	1230	CallV('ORWDXM2 CLRRCL', [nil]);
	1231	end;
	1232
	1233	function CommonLocationForOrders(OrderList: TStringList): Integer;
	1234	begin
	1235	Result := StrToIntDef(sCallV('ORWD1 COMLOC', [OrderList]), 0);
	1236	end;
	1237
	1238	function FormIDForDialog(IEN: Integer): Integer;
	1239	begin
	1240	Result := StrToIntDef(sCallV('ORWDXM FORMID', [IEN]), 0);
	1241	end;
	1242
	1243	function DlgIENForName(DlgName: string): Integer;
	1244	begin
	1245	Result := StrToIntDef(sCallV('OREVNTX1 DLGIEN',[DlgName]),0);
	1246	end;
	1247
	1248	procedure LoadOrderMenu(AnOrderMenu: TOrderMenu; AMenuIEN: Integer);
	1249	var
	1250	OrderMenuItem: TOrderMenuItem;
	1251	i: Integer;
	1252	begin
	1253	CallV('ORWDXM MENU', [AMenuIEN]);
	1254	with RPCBrokerV do if Results.Count > 0 then
	1255	begin
	1256	// Results[0] = Name^Cols^PathSwitch^^^LRFZX^LRFSAMP^LRFSPEC^LRFDATE^LRFURG^LRFSCH^PSJNPOC^
	1257	// GMRCNOPD^GMRCNOAT^GMRCREAF^^^^^
	1258	AnOrderMenu.Title := Piece(Results[0], U, 1);
	1259	AnOrderMenu.NumCols := StrToIntDef(Piece(Results[0], U, 2), 1);
	1260	AnOrderMenu.KeyVars := Pieces(Results[0], U, 6, 6 + MAX_KEYVARS);
	1261	for i := 1 to Results.Count - 1 do
	1262	begin
	1263	OrderMenuItem := TOrderMenuItem.Create;
	1264	with OrderMenuItem do
	1265	begin
	1266	Col := StrToIntDef(Piece(Results[i], U, 1), 0) - 1;
	1267	Row := StrToIntDef(Piece(Results[i], U, 2), 0) - 1;
	1268	DlgType := CharAt(Piece(Results[i], U, 3), 1);
	1269	IEN := StrToIntDef(Piece(Results[i], U, 4), 0);
	1270	FormID := StrToIntDef(Piece(Results[i], U, 5), 0);
	1271	AutoAck := Piece(Results[i], U, 6) = '1';
	1272	ItemText := Piece(Results[i], U, 7);
	1273	Mnemonic := Piece(Results[i], U, 8);
	1274	Display := StrToIntDef(Piece(Results[i], U, 9), 0);
	1275	end; {with OrderItem}
	1276	AnOrderMenu.MenuItems.Add(OrderMenuItem);
	1277	end; {for i}
	1278	end; {with RPCBrokerV}
	1279	end;
	1280
	1281	procedure LoadOrderSet(SetItems: TStrings; AnIEN: Integer; var KeyVars, ACaption: string);
	1282	var
	1283	x: string;
	1284	begin
	1285	CallV('ORWDXM LOADSET', [AnIEN]);
	1286	KeyVars := '';
	1287	ACaption := '';
	1288	if RPCBrokerV.Results.Count > 0 then
	1289	begin
	1290	x := RPCBrokerV.Results[0];
	1291	ACaption := Piece(x, U, 1);
	1292	KeyVars := Copy(x, Pos(U, x) + 1, Length(x));
	1293	RPCBrokerV.Results.Delete(0);
	1294	end;
[829]	1295	FastAssign(RPCBrokerV.Results, SetItems);
[456]	1296	end;
	1297
	1298	procedure LoadWriteOrders(Dest: TStrings);
	1299	begin
	1300	CallV('ORWDX WRLST', [Encounter.Location]);
[829]	1301	FastAssign(RPCBrokerV.Results, Dest);
[456]	1302	end;
	1303
	1304	procedure LoadWriteOrdersED(Dest: TStrings; EvtID: string);
	1305	begin
	1306	CallV('OREVNTX1 WRLSTED', [Encounter.Location,EvtID]);
	1307	if RPCBrokerV.Results.count > 0 then
	1308	begin
	1309	Dest.Clear;
[829]	1310	FastAssign(RPCBrokerV.Results, Dest);
[456]	1311	end
	1312	end;
	1313
	1314	function OrderDisabledMessage(DlgIEN: Integer): string;
	1315	begin
	1316	Result := sCallV('ORWDX DISMSG', [DlgIEN]);
	1317	end;
	1318
	1319	procedure SendOrders(OrderList: TStringList; const ESCode: string);
	1320	var
	1321	i: Integer;
	1322	begin
	1323	{ prepending the space to ESCode is temporary way to keep broker from crashing }
	1324	CallV('ORWDX SEND', [Patient.DFN, Encounter.Provider, Encounter.Location, ' ' + ESCode, OrderList]);
	1325	{ this is a stop gap way to prevent an undesired error message when user chooses not to sign }
	1326	with RPCBrokerV do for i := 0 to Results.Count - 1 do
	1327	if Piece(Results[i], U, 4) = 'This order requires a signature.'
	1328	then Results[i] := Piece(Results[i], U, 1);
	1329	OrderList.Clear;
[829]	1330	FastAssign(RPCBrokerV.Results, OrderList);
[456]	1331	end;
	1332
	1333	procedure SendReleaseOrders(OrderList: TStringList);
	1334	var
	1335	loc: string;
	1336	CurrTS: Integer;
	1337	PtTS: string;
	1338	begin
	1339	PtTS := Piece(GetCurrentSpec(Patient.DFN),'^',2);
	1340	CurrTS := StrToIntDef(PtTS,0);
	1341	Loc := IntToStr(Encounter.Location);
	1342	CallV('ORWDX SENDED',[OrderList,CurrTS,Loc]);
	1343	OrderList.Clear;
[829]	1344	FastAssign(RPCBrokerV.Results, OrderList);
[456]	1345	end;
	1346
	1347	procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string);
	1348	var
	1349	i: Integer;
	1350	begin
	1351	{ prepending the space to ESCode is temporary way to keep broker from crashing }
	1352	CallV('ORWDX SENDP', [Patient.DFN, Encounter.Provider, Encounter.Location, ' ' + ESCode, DeviceInfo, OrderList]);
	1353	{ this is a stop gap way to prevent an undesired error message when user chooses not to sign }
	1354	with RPCBrokerV do for i := 0 to Results.Count - 1 do
	1355	if Piece(Results[i], U, 3) <> 'This order requires a signature.'
	1356	then ErrList.Add(Results[i]);
	1357	end;
	1358
[829]	1359	procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0);
	1360	var
	1361	Loc: Integer;
[456]	1362	begin
[829]	1363	if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc
	1364	else Loc := Encounter.Location;
	1365	CallV('ORWD1 RVPRINT', [Loc, DeviceInfo, OrderList]);
[456]	1366	end;
	1367
[829]	1368	procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0); {REV}
	1369	var
	1370	Loc: Integer;
[456]	1371	begin
[829]	1372	if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc
	1373	else Loc := Encounter.Location;
	1374	CallV('ORWD1 SVONLY', [Loc, OrderList]);
[456]	1375	end;
	1376
	1377	procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string);
	1378	begin
	1379	CallV('ORWD1 PRINTGUI', [Encounter.Location, DeviceInfo, SelectedList]);
	1380	end;
	1381
	1382	{ Order Actions }
	1383
	1384	function DialogForOrder(const ID: string): Integer;
	1385	begin
	1386	Result := StrToIntDef(sCallV('ORWDX DLGID', [ID]), 0);
	1387	end;
	1388
	1389	function FormIDForOrder(const ID: string): Integer;
	1390	begin
	1391	Result := StrToIntDef(sCallV('ORWDX FORMID', [ID]), 0);
	1392	end;
	1393
	1394	procedure SetOrderFromResults(AnOrder: TOrder);
	1395	var
	1396	x, y, z: string;
	1397	begin
	1398	with RPCBrokerV do while Results.Count > 0 do
	1399	begin
	1400	x := Results[0];
	1401	Results.Delete(0);
	1402	if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch
	1403	y := '';
	1404	while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '\|') do
	1405	begin
	1406	y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
	1407	Results.Delete(0);
	1408	end;
	1409	if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
	1410	z := '';
	1411	if (Results.Count > 0) and (Results[0] = '\|') then
	1412	begin
	1413	Results.Delete(0);
	1414	while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '\|') do
	1415	begin
	1416	z := z + Copy(Results[0], 2, Length(Results[0])); //PKI Change
	1417	Results.Delete(0);
	1418	end;
	1419	end;
	1420	SetOrderFields(AnOrder, x, y, z);
	1421	end;
	1422	end;
	1423
	1424	procedure LockPatient(var ErrMsg: string);
	1425	begin
	1426	ErrMsg := sCallV('ORWDX LOCK', [Patient.DFN]);
	1427	if Piece(ErrMsg, U, 1) = '1' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
	1428	end;
	1429
	1430	procedure UnlockPatient;
	1431	begin
	1432	sCallV('ORWDX UNLOCK', [Patient.DFN]);
	1433	end;
	1434
	1435	procedure LockOrder(OrderID: string; var ErrMsg: string);
	1436	begin
	1437	ErrMsg := sCallV('ORWDX LOCK ORDER', [OrderID]);
	1438	if Piece(ErrMsg, U, 1) = '1' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
	1439	end;
	1440
	1441	procedure UnlockOrder(OrderID: string);
	1442	begin
	1443	sCallV('ORWDX UNLOCK ORDER', [OrderID]);
	1444	end;
	1445
	1446	procedure ValidateOrderAction(const ID, Action: string; var ErrMsg: string);
	1447	begin
	1448	ErrMsg := sCallV('ORWDXA VALID', [ID, Action, Encounter.Provider]);
	1449	end;
	1450
	1451	procedure ValidateOrderActionNature(const ID, Action, Nature: string; var ErrMsg: string);
	1452	begin
	1453	ErrMsg := sCallV('ORWDXA VALID', [ID, Action, Encounter.Provider, Nature]);
	1454	end;
	1455
	1456	procedure IsLatestAction(const ID: string; var ErrList: TStringList);
	1457	begin
	1458	CallV('ORWOR ACTION TEXT',[ID]);
	1459	if RPCBrokerV.Results.Count > 0 then
[829]	1460	FastAssign(RPCBrokerV.Results, Errlist);
[456]	1461	end;
	1462
	1463	procedure ChangeOrder(AnOrder: TOrder; ResponseList: TList);
	1464	begin
	1465	end;
	1466
	1467	procedure RenewOrder(AnOrder: TOrder; RenewFields: TOrderRenewFields; IsComplex: integer; AnIMOOrderAppt: double; OCList: TStringList);
	1468	{ put RenewFields into tmplst[0]=BaseType^Start^Stop^Refills^Pickup, tmplst[n]=comments }
	1469	var
	1470	tmplst: TStringList;
	1471	i: integer;
	1472	y: string;
	1473	begin
	1474
	1475	tmplst := TStringList.Create;
	1476
	1477	{Begin Billing Aware}
	1478	UBAGlobals.SourceOrderID := AnOrder.ID;
	1479	{End Billing Aware}
	1480
	1481	try
	1482	with RenewFields do
	1483	begin
	1484	tmplst.SetText(PChar(Comments));
	1485	tmplst.Insert(0, IntToStr(BaseType) + U + StartTime + U + StopTime + U + IntToStr(Refills) + U + Pickup);
	1486	end;
	1487
	1488	with RPCBrokerV do
	1489	begin
	1490	ClearParameters := True;
	1491	RemoteProcedure := 'ORWDXR RENEW';
	1492	Param[0].PType := literal;
	1493	Param[0].Value := AnOrder.ID;
	1494	Param[1].PType := literal;
	1495	Param[1].Value := Patient.DFN;
	1496	Param[2].PType := literal;
	1497	Param[2].Value := IntToStr(Encounter.Provider);
	1498	Param[3].PType := literal;
	1499	Param[3].Value := IntToStr(Encounter.Location);
	1500	Param[4].PType := list;
	1501	for i := 0 to tmplst.Count - 1 do
	1502	Param[4].Mult[IntToStr(i+1)] := tmplst[i];
	1503	Param[4].Mult['"ORCHECK"'] := IntToStr(OCList.Count);
	1504	for i := 0 to OCList.Count - 1 do
	1505	begin
	1506	// put quotes around everything to prevent broker from choking
	1507	y := '"ORCHECK","' + Piece(OCList[i], U, 1) + '","' + Piece(OCList[i], U, 3) +
	1508	'","' + IntToStr(i+1) + '"';
	1509	Param[4].Mult[y] := Pieces(OCList[i], U, 2, 4);
	1510	end;
	1511	Param[5].PType := literal;
	1512	Param[5].Value := IntToStr(IsComplex);
	1513	Param[6].PType := literal;
	1514	Param[6].Value := FloatToStr(AnIMOOrderAppt);
	1515	CallBroker;
	1516	SetOrderFromResults(AnOrder);
	1517
	1518	{Begin Billing Aware}
	1519	UBAGlobals.TargetOrderID := AnOrder.ID; //the ID of the renewed order
	1520	UBAGlobals.CopyTreatmentFactorsDxsToRenewedOrder;
	1521	{End Billing Aware}
	1522
	1523	end;
	1524	finally
	1525	tmplst.Free;
	1526	end;
	1527	end;
	1528
	1529	procedure HoldOrder(AnOrder: TOrder);
	1530	begin
	1531	CallV('ORWDXA HOLD', [AnOrder.ID, Encounter.Provider]);
	1532	SetOrderFromResults(AnOrder);
	1533	end;
	1534
	1535	procedure ReleaseOrderHold(AnOrder: TOrder);
	1536	begin
	1537	CallV('ORWDXA UNHOLD', [AnOrder.ID, Encounter.Provider]);
	1538	SetOrderFromResults(AnOrder);
	1539	end;
	1540
	1541	procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
	1542	begin
[829]	1543	CallV('ORWDX2 DCREASON', [nil]);
[456]	1544	ExtractItems(Dest, RPCBrokerV.Results, 'DCReason');
	1545	//AGP Change 26.15 for PSI-04-63
	1546	//DefaultIEN := StrToIntDef(Piece(ExtractDefault(RPCBrokerV.Results, 'DCReason'), U, 1), 0);
	1547	end;
	1548
	1549	function GetREQReason: Integer;
	1550	begin
	1551	Result := StrToIntDef(sCallV('ORWDXA DCREQIEN', [nil]), 0);
	1552	end;
	1553
[829]	1554	procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer);
[456]	1555	var
[829]	1556	AParentID, DCOrigOrder: string;
[456]	1557	begin
	1558	AParentID := AnOrder.ParentID;
[829]	1559	if AnOrder.DCOriginalOrder = true then DCOrigOrder := '1'
	1560	else DCOrigOrder := '0';
	1561	CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason, DCOrigOrder, NewOrder]);
[456]	1562	UBACore.DeleteDCOrdersFromCopiedList(AnOrder.ID);
	1563	DCType := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 14), 0);
	1564	SetOrderFromResults(AnOrder);
	1565	AnOrder.ParentID := AParentID;
	1566	end;
	1567
	1568	procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64);
	1569	begin
	1570	CallV('ORWDXA ALERT', [AnOrder.ID, AlertRecip]);
	1571	// don't worry about results
	1572	end;
	1573
	1574	procedure FlagOrder(AnOrder: TOrder; const FlagReason: string; AlertRecip: Int64);
	1575	begin
	1576	CallV('ORWDXA FLAG', [AnOrder.ID, FlagReason, AlertRecip]);
	1577	SetOrderFromResults(AnOrder);
	1578	end;
	1579
	1580	procedure LoadFlagReason(Dest: TStrings; const ID: string);
	1581	begin
	1582	CallV('ORWDXA FLAGTXT', [ID]);
[829]	1583	FastAssign(RPCBrokerV.Results, Dest);
[456]	1584	end;
	1585
	1586	procedure UnflagOrder(AnOrder: TOrder; const AComment: string);
	1587	begin
	1588	CallV('ORWDXA UNFLAG', [AnOrder.ID, AComment]);
	1589	SetOrderFromResults(AnOrder);
	1590	end;
	1591
	1592	procedure LoadWardComments(Dest: TStrings; const ID: string);
	1593	begin
	1594	CallV('ORWDXA WCGET', [ID]);
[829]	1595	FastAssign(RPCBrokerV.Results, Dest);
[456]	1596	end;
	1597
	1598	procedure PutWardComments(Src: TStrings; const ID: string; var ErrMsg: string);
	1599	begin
	1600	ErrMsg := sCallV('ORWDXA WCPUT', [ID, Src]);
	1601	end;
	1602
	1603	procedure CompleteOrder(AnOrder: TOrder; const ESCode: string);
	1604	begin
	1605	CallV('ORWDXA COMPLETE', [AnOrder.ID, ESCode]);
	1606	SetOrderFromResults(AnOrder);
	1607	end;
	1608
	1609	procedure VerifyOrder(AnOrder: TOrder; const ESCode: string);
	1610	begin
	1611	CallV('ORWDXA VERIFY', [AnOrder.ID, ESCode]);
	1612	SetOrderFromResults(AnOrder);
	1613	end;
	1614
	1615	procedure VerifyOrderChartReview(AnOrder: TOrder; const ESCode: string);
	1616	begin
	1617	CallV('ORWDXA VERIFY', [AnOrder.ID, ESCode, 'R']);
	1618	SetOrderFromResults(AnOrder);
	1619	end;
	1620
	1621	function GetOrderableIen(AnOrderId:string): integer;
	1622	begin
	1623	Result := StrToIntDef(sCallV('ORWDXR GTORITM', [AnOrderId]),0);
	1624	end;
	1625
	1626	procedure StoreDigitalSig(AID, AHash: string; AProvider: Int64; ASig, ACrlUrl: string; var AError: string);
	1627	var
	1628	len, ix: integer;
	1629	ASigAray: TStringList;
	1630	begin
	1631	ASigAray := TStringList.Create;
	1632	ix := 1;
	1633	len := length(ASig);
	1634	while len >= ix do
	1635	begin
	1636	ASigAray.Add(copy(ASig, ix, 240));
	1637	inc(ix, 240);
	1638	end; //while
	1639	try
	1640	CallV('ORWOR1 SIG', [AID, AHash, len, '100', AProvider, ASigAray, ACrlUrl]);
	1641	with RPCBrokerV do
	1642	if piece(Results[0],'^',1) = '-1' then
	1643	begin
[829]	1644	ShowMsg('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF +
[456]	1645	'This error will prevent this order from being sent to the service for processing. Please cancel the order and try again.' + CRLF + CRLF +
	1646	'If this problem persists, then there is a problem in the CPRS PKI interface, and it needs to be reported through the proper channels, to the developer Cary Malmrose.');
	1647	AError := '1';
	1648	end;
	1649	finally
	1650	ASigAray.Free;
	1651	end;
	1652	end;
	1653
	1654	procedure UpdateOrderDGIfNeeded(AnID: string);
	1655	var
	1656	NeedUpdate: boolean;
	1657	tmpDFN: string;
	1658	begin
	1659	tmpDFN := Patient.DFN;
	1660	Patient.Clear;
	1661	Patient.DFN := tmpDFN;
	1662	NeedUpdate := SCallV('ORWDPS4 IPOD4OP', [AnID]) = '1';
	1663	if Patient.Inpatient and needUpdate then
	1664	SCallV('ORWDPS4 UPDTDG',[AnID]);
	1665	end;
	1666
	1667	function CanEditSuchRenewedOrder(AnID: string; IsTxtOrder: integer): boolean;
	1668	begin
	1669	Result := SCallV('ORWDXR01 CANCHG',[AnID,IsTxtOrder]) = '1';
	1670	end;
	1671
	1672	function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean;
	1673	begin
	1674	Result := SCallV('ORWDXR01 ISSPLY',[DlgID,QODlg])='1';
	1675	end;
	1676
	1677	procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer);
	1678	begin
	1679	SCallV('ORWDXR01 SAVCHG',[AnID,TheRefills,ThePickup,IsTxtOrder]);
	1680	SetOrderFromResults(AnOrder);
	1681	end;
	1682
[829]	1683	function DoesOrderStatusMatch(OrderArray: TStringList): boolean;
	1684	begin
	1685	Result := StrtoIntDef(SCallV('ORWDX1 ORDMATCH',[Patient.DFN, OrderArray]),0)=1;
	1686	end;
	1687
[456]	1688	{ Order Information }
	1689
	1690	function OrderIsReleased(const ID: string): Boolean;
	1691	begin
	1692	Result := sCallV('ORWDXR ISREL', [ID]) = '1';
	1693	end;
	1694
	1695	procedure LoadRenewFields(RenewFields: TOrderRenewFields; const ID: string);
	1696	var
	1697	i: Integer;
	1698	begin
	1699	CallV('ORWDXR RNWFLDS', [ID]);
	1700	with RPCBrokerV, RenewFields do
	1701	begin
	1702	BaseType := StrToIntDef(Piece(Results[0], U, 1), 0);
	1703	StartTime := Piece(Results[0], U, 2);
	1704	StopTime := Piece(Results[0], U, 3);
	1705	Refills := StrToIntDef(Piece(Results[0], U, 4), 0);
	1706	Pickup := Piece(Results[0], U, 5);
	1707	Comments := '';
	1708	for i := 1 to Results.Count - 1 do Comments := Comments + CRLF + Results[i];
	1709	if Copy(Comments, 1, 2) = CRLF then Delete(Comments, 1, 2);
	1710	end;
	1711	end;
	1712
	1713	procedure GetChildrenOfComplexOrder(AnParentID,CurrAct: string; var ChildList: TStringList); //PSI-COMPLEX
	1714	var
	1715	i: integer;
	1716	begin
	1717	CallV('ORWDXR ORCPLX',[AnParentID,CurrAct]);
	1718	if RPCBrokerV.Results.Count = 0 then Exit;
	1719	With RPCBrokerV do
	1720	begin
	1721	for i := 0 to Results.Count - 1 do
	1722	begin
	1723	if (Piece(Results[i],'^',1) <> 'E') and (Length(Results[i])>0) then
	1724	ChildList.Add(Results[i]);
	1725	end;
	1726	end;
	1727	end;
	1728
	1729	procedure LESValidationForChangedLabOrder(var RejectedReason: TStringList; AnOrderInfo: string);
	1730	begin
	1731	CallV('ORWDPS5 LESAPI',[AnOrderInfo]);
	1732	if RPCBrokerV.Results.Count > 0 then
[829]	1733	FastAssign(RPCBrokerV.Results, RejectedReason);
[456]	1734	end;
	1735
	1736	procedure ChangeEvent(AnOrderList: TStringList; APtEvtId: string);
	1737	begin
	1738	SCallV('OREVNTX1 CHGEVT', [APtEvtId,AnOrderList]);
	1739	end;
	1740
	1741	procedure DeletePtEvent(APtEvtID: string);
	1742	begin
	1743	SCallV('OREVNTX1 DELPTEVT',[APtEvtID]);
	1744	end;
	1745
	1746	function IsRenewableComplexOrder(AnParentID: string): boolean; //PSI-COMPLEX
	1747	var
	1748	rst: integer;
	1749	begin
	1750	Result := False;
	1751	rst := StrToIntDef(SCallV('ORWDXR CANRN',[AnParentID]),0);
	1752	if rst>0 then
	1753	Result := True;
	1754	end;
	1755
	1756	function IsComplexOrder(AnOrderID: string): boolean; //PSI-COMPLEX
	1757	var
	1758	rst: integer;
	1759	begin
	1760	Result := False;
	1761	rst := StrToIntDef(SCallV('ORWDXR ISCPLX',[AnOrderID]),0);
	1762	if rst > 0 then
	1763	Result := True;
	1764	end;
	1765
	1766	procedure ValidateComplexOrderAct(AnOrderID: string; var ErrMsg: string); //PSI-COMPLEX
	1767	begin
	1768	ErrMsg := SCallV('ORWDXA OFCPLX',[AnOrderID]);
	1769	end;
	1770
	1771	function GetDlgData(ADlgID: string): string;
	1772	begin
	1773	Result := SCallV('OREVNTX1 GETDLG',[ADlgID]);
	1774	end;
	1775
	1776	function PtEvtEmpty(APtEvtID: string): Boolean;
	1777	begin
	1778	Result := False;
	1779	if StrToIntDef(SCallV('OREVNTX1 EMPTY',[APtEvtID]),0)>0 then
	1780	Result := True;
	1781	end;
	1782
	1783
	1784	function TextForOrder(const ID: string): string;
	1785	begin
	1786	CallV('ORWORR GETTXT', [ID]);
	1787	Result := RPCBrokerV.Results.Text;
	1788	end;
	1789
	1790	function GetConsultOrderNumber(ConsultIEN: string): string;
	1791	begin
	1792	Result := sCallv('ORQQCN GET ORDER NUMBER',[ConsultIEN]);
	1793	end;
	1794
	1795	function GetOrderByIFN(const ID: string): TOrder;
	1796	var
	1797	x, y, z: string;
	1798	AnOrder: TOrder;
	1799	begin
	1800	AnOrder := TOrder.Create;
	1801	CallV('ORWORR GETBYIFN', [ID]);
	1802	with RPCBrokerV do while Results.Count > 0 do
	1803	begin
	1804	x := Results[0];
	1805	Results.Delete(0);
	1806	if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch
	1807	y := '';
	1808	while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '\|') do
	1809	begin
	1810	y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
	1811	Results.Delete(0);
	1812	end;
	1813	if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
	1814	z := '';
	1815	if (Results.Count > 0) and (Results[0] = '\|') then
	1816	begin
	1817	Results.Delete(0);
	1818	while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '\|') do
	1819	begin
	1820	z := z + Copy(Results[0], 2, Length(Results[0])); //PKI Change
	1821	Results.Delete(0);
	1822	end;
	1823	end;
	1824	SetOrderFields(AnOrder, x, y, z);
	1825	end;
	1826	Result := AnOrder;
	1827	end;
	1828
	1829	function GetPackageByOrderID(const OrderID: string): string;
	1830	begin
	1831	Result := SCallV('ORWDXR GETPKG',[OrderID]);
	1832	end;
	1833
	1834	function AnyOrdersRequireSignature(OrderList: TStringList): Boolean;
	1835	begin
	1836	Result := sCallV('ORWD1 SIG4ANY', [OrderList]) = '1';
	1837	end;
	1838
	1839	function OrderRequiresSignature(const ID: string): Boolean;
	1840	begin
	1841	Result := sCallV('ORWD1 SIG4ONE', [ID]) = '1';
	1842	end;
	1843
	1844	function OrderRequiresDigitalSignature(const ID: string): Boolean;
	1845	begin
	1846	Result := sCallV('ORWOR1 CHKDIG', [ID]) = '1';
	1847	end;
	1848
	1849	function GetDrugSchedule(const ID: string): string;
	1850	begin
	1851	Result := sCallV('ORWOR1 GETDSCH', [ID]);
	1852	end;
	1853
	1854	function GetExternalText(const ID: string): string;
	1855	var
	1856	x,y: string;
	1857	begin
	1858	CallV('ORWOR1 GETDTEXT', [ID]);
	1859	y := '';
	1860	with RPCBrokerV do while Results.Count > 0 do
	1861	begin
	1862	x := Results[0];
	1863	Results.Delete(0);
	1864	y := y + x;
	1865	end;
	1866	Result := y;
	1867	end;
	1868
	1869	function SetExternalText(const ID: string; ADrugSch: string; AUser: Int64): string;
	1870	var
	1871	x,y: string;
	1872	begin
	1873	CallV('ORWOR1 SETDTEXT', [ID, ADrugSch, AUser]);
	1874	y := '';
	1875	with RPCBrokerV do while Results.Count > 0 do
	1876	begin
	1877	x := Results[0];
	1878	Results.Delete(0);
	1879	y := y + x;
	1880	end;
	1881	Result := y;
	1882	end;
	1883
	1884	function GetDigitalSignature(const ID: string): string;
	1885	begin
	1886	CallV('ORWORR GETDSIG', [ID]);
	1887	Result := RPCBrokerV.Results.Text;
	1888	end;
	1889
	1890	function GetDEA(const ID: string): string;
	1891	begin
	1892	CallV('ORWORR GETDEA', [ID]);
	1893	Result := RPCBrokerV.Results.Text;
	1894	end;
	1895
	1896	function GetPKISite: Boolean;
	1897	begin
	1898	Result := sCallV('ORWOR PKISITE', [nil]) = '1';
	1899	end;
	1900
	1901	function GetPKIUse: Boolean;
	1902	begin
	1903	Result := sCallV('ORWOR PKIUSE', [nil]) = '1';
	1904	end;
	1905
	1906	function DoesOIPIInSigForQO(AnQOID: integer): integer;
	1907	begin
	1908	Result := StrToIntDef(SCallV('ORWDPS1 HASOIPI',[AnQOID]),0);
	1909	end;
	1910
	1911	function GetDispGroupForLES: string;
	1912	begin
	1913	Result := SCallV('ORWDPS5 LESGRP',[nil]);
	1914	end;
	1915
	1916	function GetOrderPtEvtID(AnOrderID: string): string;
	1917	begin
	1918	Result := SCallV('OREVNTX1 ODPTEVID',[AnOrderID]);
	1919	end;
	1920
	1921	function VerbTelPolicyOrder(AnOrderID: string): boolean;
	1922	begin
	1923	Result := SCallV('ORWDPS5 ISVTP',[AnOrderID]) = '1';
	1924	end;
	1925
	1926	function ForIVandUD(AnOrderID: string): boolean;
	1927	begin
	1928	Result := SCallV('ORWDPS4 ISUDIV',[AnOrderID]) = '1';
	1929	end;
	1930
	1931	function GetEventIFN(const AEvntID: string): string;
	1932	begin
	1933	Result := sCallV('OREVNTX1 EVT',[AEvntID]);
	1934	end;
	1935
	1936	function GetEventName(const AEvntID: string): string;
	1937	begin
	1938	Result := sCallV('OREVNTX1 NAME',[AEvntID]);
	1939	end;
	1940
	1941	function GetEventLoc(const APtEvntID: string): string;
	1942	begin
	1943	Result := SCallV('OREVNTX1 LOC', [APtEvntID]);
	1944	end;
	1945
	1946	function GetEventLoc1(const AnEvntID: string): string;
	1947	begin
	1948	Result := SCallV('OREVNTX1 LOC1', [AnEvntID]);
	1949	end;
	1950
	1951	function GetEventDiv(const APtEvntID: string): string;
	1952	begin
	1953	Result := SCallV('OREVNTX1 DIV',[APtEvntID]);
	1954	end;
	1955
	1956	function GetEventDiv1(const AnEvntID: string): string;
	1957	begin
	1958	Result := SCallV('OREVNTX1 DIV1',[AnEvntID]);
	1959	end;
	1960
	1961	function GetCurrentSpec(const APtIFN: string): string;
	1962	begin
	1963	Result := SCallV('OREVNTX1 CURSPE', [APtIFN]);
	1964	end;
	1965
	1966	function GetDefaultEvt(const AProviderIFN: string): string;
	1967	begin
	1968	Result := SCallV('OREVNTX1 DFLTEVT',[AProviderIFN]);
	1969	end;
	1970
	1971	procedure DeleteDefaultEvt;
	1972	begin
	1973	SCallV('OREVNTX1 DELDFLT',[User.DUZ]);
	1974	end;
	1975
	1976	function isExistedEvent(const APtDFN: string; const AEvtID: string; var APtEvtID: string): Boolean;
	1977	begin
	1978	Result := False;
	1979	APtEvtID := SCallV('OREVNTX1 EXISTS', [APtDFN,AEvtID]);
	1980	if StrToIntDef(APtEvtID,0) > 0 then
	1981	Result := True;
	1982	end;
	1983
	1984	function TypeOfExistedEvent(APtDFN: string; AEvtID: Integer): Integer;
	1985	begin
	1986	Result := StrToIntDef(SCallV('OREVNTX1 TYPEXT', [APtDFN,AEvtID]),0);
	1987	end;
	1988
	1989	function isMatchedEvent(const APtDFN: string; const AEvtID: string; var ATs:string): Boolean;
	1990	var
	1991	rst: string;
	1992	begin
	1993	Result := False;
	1994	rst := SCallV('OREVNTX1 MATCH',[APtDFN,AEvtID]);
	1995	if StrToIntDef(Piece(rst,'^',1),0)>0 then
	1996	begin
	1997	ATs := Piece(rst,'^',2);
	1998	Result := True;
	1999	end;
	2000	end;
	2001
	2002	function isDCedOrder(const AnOrderID: string): Boolean;
	2003	var
	2004	rst: string;
	2005	begin
	2006	Result := False;
	2007	rst := SCAllV('OREVNTX1 ISDCOD',[AnOrderID]);
	2008	if STrToIntDef(rst,0)>0 then
	2009	Result := True;
	2010	end;
	2011
	2012	function isOnholdMedOrder(AnOrderID: string): Boolean;
	2013	var
	2014	rst: string;
	2015	begin
	2016	Result := False;
	2017	rst := SCAllV('OREVNTX1 ISHDORD',[AnOrderID]);
	2018	if StrToIntDef(rst,0)>0 then
	2019	Result := True;
	2020	end;
	2021
	2022	function SetDefaultEvent(var AErrMsg: string; EvtID: string): Boolean;
	2023	begin
	2024	AErrMsg := SCallV('OREVNTX1 SETDFLT',[EvtID]);
	2025	Result := True;
	2026	end;
	2027
	2028	function GetEventPromptID: integer;
	2029	var
	2030	evtPrompt: string;
	2031	begin
	2032	evtPrompt := SCallV('OREVNTX1 PRMPTID',[nil]);
	2033	Result := StrToIntDef(evtPrompt,0);
	2034	end;
	2035
	2036	function GetDefaultTSForEvt(AnEvtID: integer): string;
	2037	begin
	2038	Result := SCallV('OREVNTX1 DEFLTS',[AnEvtID]);
	2039	end;
	2040
	2041	function GetPromptIDs: string;
	2042	begin
	2043	Result := SCallV('OREVNTX1 PROMPT IDS',[nil]);
	2044	end;
	2045
	2046	function GetEventDefaultDlg(AEvtID: integer): string;
	2047	begin
	2048	Result := SCallV('OREVNTX1 DFLTDLG',[AEvtID]);
	2049	end;
	2050
	2051	function CanManualRelease: boolean;
	2052	var
	2053	rst: integer;
	2054	begin
	2055	Result := False;
	2056	rst := StrToIntDef(SCallV('OREVNTX1 AUTHMREL',[nil]),0);
	2057	if rst > 0 then
	2058	Result := True;
	2059	end;
	2060
	2061	function TheParentPtEvt(APtEvt: string): string;
	2062	begin
	2063	Result := SCallV('OREVNTX1 HAVEPRT',[APtEvt]);
	2064	end;
	2065
	2066	function IsCompletedPtEvt(APtEvtID: integer): boolean;
	2067	var
	2068	rst : integer;
	2069	begin
	2070	Result := False;
	2071	rst := StrToIntDef(SCallV('OREVNTX1 COMP',[APtEvtID]),0);
	2072	if rst > 0 then
	2073	Result := True;
	2074	end;
	2075
	2076	function IsPassEvt(APtEvtID: integer; APtEvtType: char): boolean;
	2077	var
	2078	rst: integer;
	2079	begin
	2080	Result := False;
	2081	rst := StrToIntDef(SCallV('OREVNTX1 ISPASS',[APtEvtID, APtEvtType]),0);
	2082	if rst = 1 then
	2083	Result := True;
	2084	end;
	2085
	2086	function IsPassEvt1(AnEvtID: integer; AnEvtType: char): boolean;
	2087	var
	2088	rst: integer;
	2089	begin
	2090	Result := False;
	2091	rst := StrToIntDef(SCallV('OREVNTX1 ISPASS1',[AnEvtID, AnEvtType]),0);
	2092	if rst = 1 then
	2093	Result := True;
	2094	end;
	2095
	2096	procedure TerminatePtEvt(APtEvtID: integer);
	2097	begin
	2098	SCallV('OREVNTX1 DONE',[APtEvtID]);
	2099	end;
	2100
	2101	procedure SetPtEvtList(Dest: TStrings; APtDFN: string; var ATotal: Integer);
	2102	begin
	2103	CallV('OREVNTX LIST',[APtDFN]);
	2104	if RPCBrokerV.Results.Count > 0 then
	2105	begin
	2106	ATotal := StrToIntDef(RPCBrokerV.Results[0],0);
	2107	if ATotal > 0 then
	2108	begin
	2109	MixedCaseList( RPCBrokerV.Results );
	2110	RPCBrokerV.Results.Delete(0);
[829]	2111	FastAssign(RPCBrokerV.Results, Dest);
[456]	2112	end;
	2113	end;
	2114	end;
	2115
	2116	procedure GetTSListForEvt(Dest: TStrings; AnEvtID:integer);
	2117	begin
	2118	CallV('OREVNTX1 MULTS',[AnEvtID]);
	2119	if RPCBrokerV.Results.Count > 0 then
	2120	begin
	2121	SortByPiece(TStringList(RPCBrokerV.Results),'^',2);
[829]	2122	FastAssign(RPCBrokerV.Results, Dest);
[456]	2123	end;
	2124	end;
	2125
	2126	procedure GetChildEvent(var AChildList: TStringList; APtEvtID: string);
	2127	begin
	2128	//
	2129	end;
	2130
	2131	function DeleteEmptyEvt(APtEvntID: string; var APtEvntName: string; Ask: boolean): boolean;
	2132	const
	2133	TX_EVTDEL1 = 'There are no orders tied to ';
	2134	TX_EVTDEL2 = ', Would you like to cancel it?';
	2135	begin
	2136	Result := false;
	2137	if APtEvntID = '0' then
	2138	begin
	2139	Result := True;
	2140	Exit;
	2141	end;
	2142	if PtEvtEmpty(APtEvntID) then
	2143	begin
	2144	if Length(APtEvntName)=0 then
	2145	APtEvntName := GetEventName(APtEvntID);
	2146	if Ask then
	2147	begin
	2148	if InfoBox(TX_EVTDEL1 + APtEvntName + TX_EVTDEL2, 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
	2149	begin
	2150	DeletePtEvent(APtEvntID);
	2151	Result := True;
	2152	end;
	2153	end;
	2154	if not Ask then
	2155	begin
	2156	DeletePtEvent(APtEvntID);
	2157	Result := True;
	2158	end;
	2159
	2160	end;
	2161	end;
	2162
	2163	function CompleteEvt(APtEvntID: string; APtEvntName: string; Ask: boolean): boolean;
	2164	const
	2165	TX_EVTFIN1 = 'All of the orders tied to ';
	2166	TX_EVTFIN2 = ' have been released to a service, ' + #13 + 'Would you like to terminate this event?';
	2167	var
	2168	ThePtEvtName: string;
	2169	begin
	2170	Result := false;
	2171	if APtEvntID = '0' then
	2172	begin
	2173	Result := True;
	2174	Exit;
	2175	end;
	2176	if PtEvtEmpty(APtEvntID) then
	2177	begin
	2178	if Length(APtEvntName)=0 then
	2179	ThePtEvtName := GetEventName(APtEvntID)
	2180	else
	2181	ThePtEvtName := APtEvntName;
	2182	if Ask then
	2183	begin
	2184	if InfoBox(TX_EVTFIN1 + ThePtEvtName + TX_EVTFIN2, 'Confirmation', MB_OKCANCEL or MB_ICONQUESTION) = IDOK then
	2185	begin
	2186	SCallV('OREVNTX1 DONE',[APtEvntID]);
	2187	Result := True;
	2188	end;
	2189	end else
	2190	begin
	2191	SCallV('OREVNTX1 DONE',[APtEvntID]);
	2192	Result := True;
	2193	end;
	2194	end;
	2195	end;
	2196
	2197	{ Order Checking }
	2198
	2199	function FillerIDForDialog(IEN: Integer): string;
	2200	begin
	2201	Result := sCallV('ORWDXC FILLID', [IEN]);
	2202	end;
	2203
	2204	function OrderChecksEnabled: Boolean;
	2205	begin
	2206	if uOrderChecksOn = #0 then uOrderChecksOn := CharAt(sCallV('ORWDXC ON', [nil]), 1);
	2207	Result := uOrderChecksOn = 'E';
	2208	end;
	2209
	2210	function OrderChecksOnDisplay(const FillerID: string): string;
	2211	begin
	2212	CallV('ORWDXC DISPLAY', [Patient.DFN, FillerID]);
	2213	with RPCBrokerV.Results do SetString(Result, GetText, Length(Text));
	2214	end;
	2215
	2216	procedure OrderChecksOnAccept(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
	2217	OIList: TStringList; DupORIFN: string);
	2218	begin
	2219	// don't pass OIList if no items, since broker pauses 5 seconds per order
	2220	if OIList.Count > 0
	2221	then CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList, DupORIFN])
	2222	else CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
[829]	2223	FastAssign(RPCBrokerV.Results, ListOfChecks);
[456]	2224	end;
	2225
	2226	procedure OrderChecksOnDelay(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
	2227	OIList: TStringList);
	2228	begin
	2229	// don't pass OIList if no items, since broker pauses 5 seconds per order
	2230	if OIList.Count > 0
	2231	then CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList])
	2232	else CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
[829]	2233	FastAssign(RPCBrokerV.Results, ListOfChecks);
[456]	2234	end;
	2235
	2236	procedure OrderChecksForSession(ListOfChecks, OrderList: TStringList);
	2237	begin
	2238	CallV('ORWDXC SESSION', [Patient.DFN, OrderList]);
[829]	2239	FastAssign(RPCBrokerV.Results, ListOfChecks);
[456]	2240	end;
	2241
	2242	procedure SaveOrderChecksForSession(const AReason: string; ListOfChecks: TStringList);
	2243	begin
	2244	CallV('ORWDXC SAVECHK', [Patient.DFN, AReason, ListOfChecks]);
	2245	{ no result used currently }
	2246	end;
	2247
	2248	function DeleteCheckedOrder(const OrderID: string): Boolean;
	2249	begin
	2250	Result := sCallV('ORWDXC DELORD', [OrderID]) = '1';
	2251	end;
	2252
	2253	function DataForOrderCheck(const OrderID: string): string;
	2254	begin
	2255	Result := sCallV('ORWDXR01 OXDATA',[OrderID]);
	2256	end;
	2257
	2258	(*
	2259	TEMPORARILY COMMENTED OUT WHILE TESTING
	2260	function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams;
	2261	var
	2262	TempParams: TPrintParams;
	2263	x: string;
	2264	begin
	2265	tempParams.OrdersToPrint := TStringList.Create;
	2266	try
	2267	CallV('ORWD1 PARAM', [Location, Nature, OrderList]);
	2268	x := RPCBrokerV.Results[0];
	2269	with TempParams do
	2270	begin
	2271	PromptForChartCopy := CharAt(Piece(x, U, 1),1);
	2272	if Piece(x, U, 5) <> '' then
	2273	ChartCopyDevice := Piece(Piece(x, U, 5),';',1) + '^' + Piece(Piece(x, U, 5),';',2);
	2274	PromptForLabels := CharAt(Piece(x, U, 2),1);
	2275	if Piece(x, U, 6) <> '' then
	2276	LabelDevice := Piece(Piece(x, U, 6),';',1) + '^' + Piece(Piece(x, U, 6),';',2);
	2277	PromptForRequisitions := CharAt(Piece(x, U, 3),1);
	2278	if Piece(x, U, 7) <> '' then
	2279	RequisitionDevice := Piece(Piece(x, U, 7),';',1) + '^' + Piece(Piece(x, U, 7),';',2);
	2280	PromptForWorkCopy := CharAt(Piece(x, U, 4),1);
	2281	if Piece(x, U, 8) <> '' then
	2282	WorkCopyDevice := Piece(Piece(x, U, 8),';',1) + '^' + Piece(Piece(x, U, 8),';',2);
	2283	AnyPrompts := ((PromptForChartCopy in ['1','2']) or
	2284	(PromptForLabels in ['1','2']) or
	2285	(PromptForRequisitions in ['1','2']) or
	2286	(PromptForWorkCopy in ['1','2']));
	2287	RPCBrokerV.Results.Delete(0);
[829]	2288	FastAssign(RPCBrokerV.Results, OrdersToPrint);
[456]	2289	end;
	2290	Result := TempParams;
	2291	finally
	2292	tempParams.OrdersToPrint.Free;
	2293	end;
	2294	end;
	2295	*)
	2296
[829]	2297	procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0);
[456]	2298	var
	2299	x: string;
	2300	begin
	2301	if Nature <> #0 then
[829]	2302	begin
	2303	if PrintLoc > 0 then CallV('ORWD2 DEVINFO', [PrintLoc, Nature, OrderList])
	2304	else CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList]);
	2305	end
[456]	2306	else
[829]	2307	begin
	2308	if PrintLoc > 0 then CallV('ORWD2 MANUAL', [PrintLoc, OrderList])
	2309	else CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]);
	2310	end;
[456]	2311	x := RPCBrokerV.Results[0];
	2312	FillChar(PrintParams, SizeOf(PrintParams), #0);
	2313	with PrintParams do
	2314	begin
	2315	PromptForChartCopy := CharAt(Piece(x, U, 1),1);
	2316	if Piece(x, U, 5) <> '' then
	2317	ChartCopyDevice := Piece(Piece(x, U, 5),';',1) + '^' + Piece(Piece(x, U, 5),';',2);
	2318	PromptForLabels := CharAt(Piece(x, U, 2),1);
	2319	if Piece(x, U, 6) <> '' then
	2320	LabelDevice := Piece(Piece(x, U, 6),';',1) + '^' + Piece(Piece(x, U, 6),';',2);
	2321	PromptForRequisitions := CharAt(Piece(x, U, 3),1);
	2322	if Piece(x, U, 7) <> '' then
	2323	RequisitionDevice := Piece(Piece(x, U, 7),';',1) + '^' + Piece(Piece(x, U, 7),';',2);
	2324	PromptForWorkCopy := CharAt(Piece(x, U, 4),1);
	2325	if Piece(x, U, 8) <> '' then
	2326	WorkCopyDevice := Piece(Piece(x, U, 8),';',1) + '^' + Piece(Piece(x, U, 8),';',2);
	2327	AnyPrompts := ((PromptForChartCopy in ['1','2']) or
	2328	(PromptForLabels in ['1','2']) or
	2329	(PromptForRequisitions in ['1','2']) or
	2330	(PromptForWorkCopy in ['1','2']));
	2331	end;
	2332	if Nature <> #0 then
	2333	begin
	2334	RPCBrokerV.Results.Delete(0);
	2335	OrderList.Clear;
[829]	2336	FastAssign(RPCBrokerV.Results, OrderList);
[456]	2337	end;
	2338	end;
	2339
	2340	procedure SaveEvtForOrder(APtDFN: string; AEvt: integer; AnOrderID: string);
	2341	var
	2342	TheEventID: string;
	2343	begin
	2344	TheEventID := SCallV('OREVNTX1 PUTEVNT',[APtDFN,IntToStr(AEvt),AnOrderID]);
	2345	end;
	2346
	2347	function EventExist(APtDFN:string; AEvt: integer): integer;
	2348	var
	2349	AOutCome: string;
	2350	begin
	2351	AOutCome := SCallV('OREVNTX1 EXISTS', [APtDFN,IntToStr(AEvt)]);
	2352	if AOutCome = '' then
	2353	Result := 0
	2354	else
	2355	Result := StrToInt(AOutCome);
	2356	end;
	2357
	2358	function UseNewMedDialogs: Boolean;
	2359	begin
	2360	Result := sCallV('ORWDPS1 CHK94', [nil]) = '1';
	2361	end;
	2362
	2363	{ Copay }
	2364	procedure GetCoPay4Orders;
	2365	begin
	2366	RPCBrokerV.RemoteProcedure := 'ORWDPS4 CPLST';
	2367	RPCBrokerV.Param[0].PType := literal;
	2368	RPCBrokerV.Param[0].Value := Patient.DFN;
	2369	CallBroker;
	2370	end;
	2371
	2372	procedure SaveCoPayStatus(AList: TStrings);
	2373	var
	2374	i: integer;
	2375
	2376	begin
	2377	if AList.Count > 0 then
	2378	begin
	2379	RPCBrokerV.ClearParameters := True;
	2380	RPCBrokerV.RemoteProcedure := 'ORWDPS4 CPINFO';
	2381	RPCBrokerV.Param[0].PType := list;
	2382	for i := 0 to AList.Count-1 do
	2383	RPCBrokerV.Param[0].Mult[IntToStr(i+1)] := AList[i];
	2384	CallBroker;
	2385	end;
	2386	end;
	2387
	2388
	2389
	2390	function IsValidIMOLoc(LocID: integer; PatientID: string): boolean; //IMO
	2391	var
	2392	rst: string;
	2393	begin
	2394	rst := SCallV('ORIMO IMOLOC',[LocID, PatientID]);
	2395	Result := StrToIntDef(rst,-1) > -1;
	2396	end;
	2397
	2398	function IsIMOOrder(OrderID: string): boolean; //IMO
	2399	begin
	2400	Result := SCallV('ORIMO IMOOD',[OrderId])='1';
	2401	end;
	2402
	2403	function IsInptQO(DlgID: integer): boolean;
	2404	begin
	2405	Result := SCallV('ORWDXM3 ISUDQO', [DlgID]) = '1';
	2406	end;
	2407
	2408	function IsIVQO(DlgID: integer): boolean;
	2409	begin
	2410	Result := SCallV('ORIMO ISIVQO', [DlgID]) = '1';
	2411	end;
	2412
	2413	function IsClinicLoc(ALoc: integer): boolean;
	2414	begin
	2415	Result := SCallV('ORIMO ISCLOC', [ALoc]) = '1';
	2416	end;
	2417
	2418	function IsValidSchedule(AnOrderID: string): boolean; //nss
	2419	begin
	2420	result := SCallV('ORWNSS VALSCH', [AnOrderID]) = '1';
	2421	end;
	2422
	2423	function IsValidQOSch(QOID: string): string; //nss
	2424	begin
	2425	Result := SCallV('ORWNSS QOSCH',[QOID]);
	2426	end;
	2427
	2428	function IsValidSchStr(ASchStr: string): boolean;
	2429	begin
	2430	Result := SCallV('ORWNSS CHKSCH',[ASchStr]) = '1';
	2431	end;
	2432
	2433	{ TParentEvent }
	2434
	2435	procedure TParentEvent.Assign(AnEvtID: string);
	2436	var
	2437	evtInfo: string;
	2438	begin
	2439	// ORY = EVTTYPE_U_EVT_U_EVTNAME_U_EVTDISP_U_EVTDLG
	2440	evtInfo := EventInfo1(AnEvtID);
	2441	ParentIFN := StrToInt(AnEvtID);
	2442	if Length(Piece(evtInfo,'^',4)) < 1 then
	2443	ParentName := Piece(evtInfo,'^',3)
	2444	else
	2445	ParentName := Piece(evtInfo,'^',4);
	2446	ParentType := CharAt(Piece(evtInfo,'^',1),1);
	2447	ParentDlg := Piece(evtInfo,'^',5);
	2448	end;
	2449
	2450	constructor TParentEvent.Create;
	2451	begin
	2452	ParentIFN := 0;
	2453	ParentName := '';
	2454	ParentType := #0;
	2455	ParentDlg := '0';
	2456	end;
	2457
	2458	initialization
	2459	uDGroupAll := 0;
	2460	uOrderChecksOn := #0;
	2461
	2462	finalization
	2463	if uDGroupMap <> nil then uDGroupMap.Free;
	2464
	2465	end.
	2466

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

Download in other formats: