Context Navigation

rOrders.pas@ 1679

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

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

Context Navigation

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

Download in other formats: