Context Navigation

rOrders.pas@ 1033

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

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

Context Navigation

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

Download in other formats: