Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

rOrders.pas@ 768

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

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

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

Context Navigation

source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/rOrders.pas@ 768

Download in other formats: