Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

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

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

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

Download in other formats: