Context Navigation

rOrders.pas@ 1440

Last change on this file since 1440 was 460, checked in by Kevin Toppenberg, 17 years ago
Uploading from OR_30_258
File size: 75.8 KB

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

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

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/Orders/rOrders.pas@ 1440

Download in other formats: