Context Navigation

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

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

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

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

Download in other formats: