Context Navigation

rOrders.pas@ 1797

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

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

Context Navigation

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

Download in other formats: