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

Last change on this file since 850 was 460, checked in by Kevin Toppenberg, 16 years ago

Uploading from OR_30_258

File size: 75.8 KB
RevLine 
[459]1unit rOrders;
2{$OPTIMIZATION OFF}
3interface
4
5uses SysUtils, Classes, ORFn, ORNet, uCore, Dialogs, Controls;
6
7type
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;
[460]40 EnteredInError: Integer; //AGP Changes 26.12 PSI-04-053
[459]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 }
152function DetailOrder(const ID: string): TStrings;
153function ResultOrder(const ID: string): TStrings;
154function ResultOrderHistory(const ID: string): TStrings;
155function NameOfStatus(IEN: Integer): string;
156function GetOrderStatus(AnOrderId: string): integer;
157function ExpiredOrdersStartDT: TFMDateTime;
158procedure ClearOrders(AList: TList);
159procedure LoadOrders(Dest: TList; Filter, Groups: Integer);
160procedure LoadOrdersAbbr(Dest: TList; AView: TOrderView; APtEvtID: string); overload;
161procedure LoadOrdersAbbr(DestDC,DestRL: TList; AView: TOrderView; APtEvtID: string); overload;
162procedure LoadOrderSheets(Dest: TStrings);
163procedure LoadOrderSheetsED(Dest: TStrings);
164procedure LoadOrderViewDefault(AView: TOrderView);
165procedure LoadUnsignedOrders(IDList, HaveList: TStrings);
166procedure SaveOrderViewDefault(AView: TOrderView);
167procedure RetrieveOrderFields(OrderList: TList; ATextView: Integer; ACtxtTime: TFMDateTime);
168procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string);
169procedure SetOrderFromResults(AnOrder: TOrder);
170procedure SortOrders(AList: TList; ByGroup, InvChron: Boolean);
171
172{ Display Group & List functions }
173function DGroupAll: Integer;
174function DGroupIEN(AName: string): Integer;
175procedure ListDGroupAll(Dest: TStrings);
176procedure ListSpecialties(Dest: TStrings);
177procedure ListSpecialtiesED(AType: Char; Dest: TStrings);
178procedure ListOrderFilters(Dest: TStrings);
179procedure ListOrderFiltersAll(Dest: TStrings);
180function NameOfDGroup(IEN: Integer): string;
181function ShortNameOfDGroup(IEN: Integer): string;
182function SeqOfDGroup(IEN: Integer): Integer;
183function CheckOrderGroup(AOrderID: string): integer;
184function CheckQOGroup(AQOId:string): Boolean;
185
186{ Write Orders }
187procedure BuildResponses(var ResolvedDialog: TOrderDialogResolved; const KeyVars: string;
188 AnEvent: TOrderDelayEvent; ForIMO: boolean = False);
189procedure ClearOrderRecall;
190function CommonLocationForOrders(OrderList: TStringList): Integer;
191function FormIDForDialog(IEN: Integer): Integer;
192function DlgIENForName(DlgName: string): Integer;
193procedure LoadOrderMenu(AnOrderMenu: TOrderMenu; AMenuIEN: Integer);
194procedure LoadOrderSet(SetItems: TStrings; AnIEN: Integer; var KeyVars, ACaption: string);
195procedure LoadWriteOrders(Dest: TStrings);
196procedure LoadWriteOrdersED(Dest: TStrings; EvtID: string);
197function OrderDisabledMessage(DlgIEN: Integer): string;
198procedure SendOrders(OrderList: TStringList; const ESCode: string);
199procedure SendReleaseOrders(OrderList: TStringList);
200procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string);
201procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string);
202procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string); {*KCM*}
203procedure PrintServiceCopies(OrderList: TStringList); {*REV*}
204procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char); {*KCM*}
205function UseNewMedDialogs: Boolean;
206
207{ Order Actions }
208function DialogForOrder(const ID: string): Integer;
209procedure LockPatient(var ErrMsg: string);
210procedure UnlockPatient;
211procedure LockOrder(OrderID: string; var ErrMsg: string);
212procedure UnlockOrder(OrderID: string);
213function FormIDForOrder(const ID: string): Integer;
214procedure ValidateOrderAction(const ID, Action: string; var ErrMsg: string);
215procedure ValidateOrderActionNature(const ID, Action, Nature: string; var ErrMsg: string);
216procedure IsLatestAction(const ID: string; var ErrList: TStringList);
217procedure ChangeOrder(AnOrder: TOrder; ResponseList: TList);
218procedure RenewOrder(AnOrder: TOrder; RenewFields: TOrderRenewFields; IsComplex: integer;
219 AnIMOOrderAppt: double; OCList: TStringList);
220procedure HoldOrder(AnOrder: TOrder);
221procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
222function GetREQReason: Integer;
223procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);
224procedure ReleaseOrderHold(AnOrder: TOrder);
225procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64);
226procedure FlagOrder(AnOrder: TOrder; const FlagReason: string; AlertRecip: Int64);
227procedure UnflagOrder(AnOrder: TOrder; const AComment: string);
228procedure LoadFlagReason(Dest: TStrings; const ID: string);
229procedure LoadWardComments(Dest: TStrings; const ID: string);
230procedure PutWardComments(Src: TStrings; const ID: string; var ErrMsg: string);
231procedure CompleteOrder(AnOrder: TOrder; const ESCode: string);
232procedure VerifyOrder(AnOrder: TOrder; const ESCode: string);
233procedure VerifyOrderChartReview(AnOrder: TOrder; const ESCode: string);
234function GetOrderableIen(AnOrderId:string): integer;
235procedure StoreDigitalSig(AID, AHash: string; AProvider: Int64; ASig, ACrlUrl: string; var AError: string);
236procedure UpdateOrderDGIfNeeded(AnID: string);
237function CanEditSuchRenewedOrder(AnID: string; IsTxtOrder: integer): boolean;
238function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean;
239procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer);
240//function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams;
241
242{ Order Information }
243procedure LoadRenewFields(RenewFields: TOrderRenewFields; const ID: string);
244procedure GetChildrenOfComplexOrder(AnParentID,CurrAct: string; var ChildList: TStringList); //PSI-COMPLEX
245procedure LESValidationForChangedLabOrder(var RejectedReason: TStringList; AnOrderInfo: string);
246procedure ValidateComplexOrderAct(AnOrderID: string; var ErrMsg: string); //PSI-COMPLEX
247function IsRenewableComplexOrder(AnParentID: string): boolean; //PSI-COMPLEX
248function IsComplexOrder(AnOrderID: string): boolean; //PSI-COMPLEX
249function GetDlgData(ADlgID: string): string;
250function OrderIsReleased(const ID: string): Boolean;
251function TextForOrder(const ID: string): string;
252function GetConsultOrderNumber(ConsultIEN: string): string;
253function GetOrderByIFN(const ID: string): TOrder;
254function GetPackageByOrderID(const OrderID: string): string;
255function AnyOrdersRequireSignature(OrderList: TStringList): Boolean;
256function OrderRequiresSignature(const ID: string): Boolean;
257function OrderRequiresDigitalSignature(const ID: string): Boolean;
258function GetDrugSchedule(const ID: string): string;
259function GetExternalText(const ID: string): string;
260function SetExternalText(const ID: string; ADrugSch: string; AUser: Int64): string;
261function GetDEA(const ID: string): string;
262function GetDigitalSignature(const ID: string): string;
263function GetPKIUse: Boolean;
264function GetPKISite: Boolean;
265function DoesOIPIInSigForQO(AnQOID: integer): integer;
266function GetDispGroupForLES: string;
267function GetOrderPtEvtID(AnOrderID: string): string;
268function VerbTelPolicyOrder(AnOrderID: string): boolean;
269function ForIVandUD(AnOrderID: string): boolean;
270
271{Event Delay Enhancement}
272function DeleteEmptyEvt(APtEvntID: string; var APtEvntName: string; Ask: boolean = True): boolean;
273function DispOrdersForEvent(AEvtId: string): boolean;
274function EventInfo(APtEvtID: string): string; // ptr to #100.2
275function EventInfo1(AnEvtID: string): string; // ptr to #100.5
276function EventExist(APtDFN:string; AEvt: integer): integer;
277function CompleteEvt(APtEvntID: string; APtEvntName: string; Ask: boolean = True): boolean;
278function PtEvtEmpty(APtEvtID: string): Boolean;
279function GetEventIFN(const AEvntID: string): string;
280function GetEventName(const AEvntID: string): string;
281function GetEventLoc(const APtEvntID: string): string;
282function GetEventLoc1(const AnEvntID: string): string;
283function GetEventDiv(const APtEvntID: string): string;
284function GetEventDiv1(const AnEvntID: string): string;
285function GetCurrentSpec(const APtIFN: string): string;
286function GetDefaultEvt(const AProviderIFN: string): string;
287function isExistedEvent(const APtDFN: string; const AEvtID: string; var APtEvtID: string): Boolean;
288function TypeOfExistedEvent(APtDFN: string; AEvtID: Integer): Integer;
289function isMatchedEvent(const APtDFN: string; const AEvtID: string; var ATs: string): Boolean;
290function isDCedOrder(const AnOrderID: string): Boolean;
291function isOnholdMedOrder(AnOrderID: string): Boolean;
292function SetDefaultEvent(var AErrMsg: string; EvtID: string): Boolean;
293function GetEventPromptID: integer;
294function GetDefaultTSForEvt(AnEvtID: integer): string;
295function GetPromptIDs: string;
296function GetEventDefaultDlg(AEvtID: integer): string;
297function CanManualRelease: boolean;
298function TheParentPtEvt(APtEvt: string): string;
299function IsCompletedPtEvt(APtEvtID: integer): boolean;
300function IsPassEvt(APtEvtID: integer; APtEvtType: char): boolean;
301function IsPassEvt1(AnEvtID: integer; AnEvtType: char): boolean;
302procedure DeleteDefaultEvt;
303procedure TerminatePtEvt(APtEvtID: integer);
304procedure ChangeEvent(AnOrderList: TStringList; APtEvtId: string);
305procedure DeletePtEvent(APtEvtID: string);
306procedure SaveEvtForOrder(APtDFN: string; AEvt: integer; AnOrderID: string);
307procedure SetPtEvtList(Dest: TStrings; APtDFN: string; var ATotal: integer);
308procedure GetTSListForEvt(Dest: TStrings; AnEvtID:integer);
309procedure GetChildEvent(var AChildList: TStringList; APtEvtID: string);
310
311{ Order Checking }
312function FillerIDForDialog(IEN: Integer): string;
313function OrderChecksEnabled: Boolean;
314function OrderChecksOnDisplay(const FillerID: string): string;
315procedure OrderChecksOnAccept(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
316 OIList: TStringList; DupORIFN: string);
317procedure OrderChecksOnDelay(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
318 OIList: TStringList);
319procedure OrderChecksForSession(ListOfChecks, OrderList: TStringList);
320procedure SaveOrderChecksForSession(const AReason: string; ListOfChecks: TStringList);
321function DeleteCheckedOrder(const OrderID: string): Boolean;
322function DataForOrderCheck(const OrderID: string): string;
323
324{ Copay }
325procedure GetCoPay4Orders;
326procedure SaveCoPayStatus(AList: TStrings);
327
328{IMO: inpatient medication for outpatient}
329function IsValidIMOLoc(LocID: integer; PatientID: string): boolean; //IMO
330function IsIMOOrder(OrderID: string): boolean;
331function IsInptQO(DlgID: integer): boolean;
332function IsIVQO(DlgID: integer): boolean;
333function IsClinicLoc(ALoc: integer): boolean;
334
335{None-standard Schedule} //nss
336function IsValidSchedule(AnOrderID: string): boolean; //NSS
337function IsValidQOSch(QOID: string): string; //NSS
338function IsValidSchStr(ASchStr: string): boolean;
339
340implementation
341
342uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore;
343
344var
345 uDGroupMap: TStringList; // each string is DGroupIEN=Sequence^TopName^Name
346 uDGroupAll: Integer;
347 uOrderChecksOn: Char;
348
349{ TOrderView methods }
350
351procedure TOrderView.Assign(Src: TOrderView);
352begin
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;
368end;
369
370{ TOrder methods }
371
372procedure TOrder.Assign(Source: TOrder);
373begin
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;
403end;
404
405procedure TOrder.Clear;
406begin
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;
434end;
435
436{ Order List functions }
437
438function DetailOrder(const ID: string): TStrings;
439begin
440 CallV('ORQOR DETAIL', [ID, Patient.DFN]);
441 Result := RPCBrokerV.Results;
442end;
443
444function ResultOrder(const ID: string): TStrings;
445begin
446 CallV('ORWOR RESULT', [Patient.DFN,ID,ID]);
447 Result := RPCBrokerV.Results;
448end;
449
450function ResultOrderHistory(const ID: string): TStrings;
451begin
452 CallV('ORWOR RESULT HISTORY', [Patient.DFN,ID,ID]);
453 Result := RPCBrokerV.Results;
454end;
455
456procedure LoadDGroupMap;
457begin
458 if uDGroupMap = nil then
459 begin
460 uDGroupMap := TStringList.Create;
461 tCallV(uDGroupMap, 'ORWORDG MAPSEQ', [nil]);
462 end;
463end;
464
465function NameOfStatus(IEN: Integer): string;
466begin
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;
488end;
489
490function GetOrderStatus(AnOrderId: string): integer;
491begin
492 Result := StrToIntDef(SCallV('OREVNTX1 GETSTS',[AnOrderId]),0);
493end;
494
495function ExpiredOrdersStartDT: TFMDateTime;
496//Return FM date/time to begin search for expired orders
497begin
498 Result := MakeFMDateTime(sCallV('ORWOR EXPIRED', [nil]));
499end;
500
501function DispOrdersForEvent(AEvtId: string): boolean;
502var
503 theResult: integer;
504begin
505 Result := False;
506 theResult := StrToIntDef(SCallV('OREVNTX1 CPACT',[AEvtId]),0);
507 if theResult > 0 then
508 Result := True;
509end;
510
511function EventInfo(APtEvtID: string): string;
512begin
513 Result := SCallV('OREVNTX1 GTEVT', [APtEvtID]);
514end;
515
516function EventInfo1(AnEvtID: string): string;
517begin
518 Result := SCallV('OREVNTX1 GTEVT1', [AnEvtID]);
519end;
520
521function NameOfDGroup(IEN: Integer): string;
522begin
523 if uDGroupMap = nil then LoadDGroupMap;
524 Result := uDGroupMap.Values[IntToStr(IEN)];
525 Result := Piece(Result, U, 3);
526end;
527
528function ShortNameOfDGroup(IEN: Integer): string;
529begin
530 if uDGroupMap = nil then LoadDGroupMap;
531 Result := uDGroupMap.Values[IntToStr(IEN)];
532 Result := Piece(Result, U, 4);
533end;
534
535function SeqOfDGroup(IEN: Integer): Integer;
536var
537 x: string;
538begin
539 if uDGroupMap = nil then LoadDGroupMap;
540 x := uDGroupMap.Values[IntToStr(IEN)];
541 Result := StrToIntDef(Piece(x, U, 1), 0);
542end;
543
544function CheckOrderGroup(AOrderID: string): integer;
545begin
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]));
550end;
551
552function CheckQOGroup(AQOId:string): Boolean;
553var
554 rst: integer;
555begin
556 rst := StrToInt(SCallV('ORWDPS2 QOGRP',[AQOId]));
557 Result := False;
558 if rst > 0 then
559 Result := True;
560end;
561
562function TopNameOfDGroup(IEN: Integer): string;
563begin
564 if uDGroupMap = nil then LoadDGroupMap;
565 Result := uDGroupMap.Values[IntToStr(IEN)];
566 Result := Piece(Result, U, 2);
567end;
568
569procedure ClearOrders(AList: TList);
570var
571 i: Integer;
572begin
573 with AList do for i := 0 to Count - 1 do with TOrder(Items[i]) do Free;
574 AList.Clear;
575end;
576
577procedure 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}
580begin
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);
[460]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;
[459]610 //if DGroupName = 'Non-VA Meds' then Text := 'Non-VA ' + Text;
611 end;
612end;
613
614procedure LoadOrders(Dest: TList; Filter, Groups: Integer);
615var
616 x, y, z: string;
617 AnOrder: TOrder;
618begin
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;
648end;
649
650procedure LoadOrdersAbbr(Dest: TList; AView: TOrderView; APtEvtID: string);
651//Filter, Specialty, Groups: Integer; var TextView: Integer;
652// var CtxtTime: TFMDateTime);
653var
654 i: Integer;
655 AnOrder: TOrder;
656 FilterTS: string;
657begin
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
[460]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;
[459]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;
700end;
701
702procedure LoadOrdersAbbr(DestDC,DestRL: TList; AView: TOrderView; APtEvtID: string);
703var
704 i: Integer;
705 AnOrder: TOrder;
706 FilterTS: string;
707 DCStart: boolean;
708begin
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;
752end;
753
754procedure LoadOrderSheets(Dest: TStrings);
755begin
756 CallV('ORWOR SHEETS', [Patient.DFN]);
757 MixedCaseByPiece(RPCBrokerV.Results, U, 2);
758 Dest.Assign(RPCBrokerV.Results);
759end;
760
761procedure LoadOrderSheetsED(Dest: TStrings);
762var
763 i: integer;
764begin
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;
775end;
776
777procedure LoadOrderViewDefault(AView: TOrderView);
778var
779 x: string;
780begin
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;
798end;
799
800procedure LoadUnsignedOrders(IDList, HaveList: TStrings);
801var
802 i: Integer;
803begin
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;
816end;
817
818procedure RetrieveOrderFields(OrderList: TList; ATextView: Integer; ACtxtTime: TFMDateTime);
819var
820 i, OrderIndex: Integer;
821 x, y, z: string;
822 AnOrder: TOrder;
823 IDList: TStringList;
824begin
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;
865end;
866
867procedure SaveOrderViewDefault(AView: TOrderView);
868var
869 x: string;
870begin
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;
881end;
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 }
886function InverseByGroup(Item1, Item2: Pointer): Integer;
887var
888 Order1, Order2: TOrder;
889 DSeq1, DSeq2, IFN1, IFN2: Integer;
890begin
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;
916end;
917
918function ForwardByGroup(Item1, Item2: Pointer): Integer;
919var
920 Order1, Order2: TOrder;
921 DSeq1, DSeq2, IFN1, IFN2: Integer;
922begin
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;
946end;
947
948function InverseChrono(Item1, Item2: Pointer): Integer;
949var
950 Order1, Order2: TOrder;
951 IFN1, IFN2: Integer;
952begin
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;
965end;
966
967function ForwardChrono(Item1, Item2: Pointer): Integer;
968var
969 Order1, Order2: TOrder;
970 IFN1, IFN2: Integer;
971begin
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;
984end;
985
986procedure SortOrders(AList: TList; ByGroup, InvChron: Boolean);
987begin
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;
995end;
996
997function DGroupAll: Integer;
998var
999 x: string;
1000begin
1001 if uDGroupAll = 0 then
1002 begin
1003 x := sCallV('ORWORDG IEN', ['ALL']);
1004 uDGroupAll := StrToIntDef(x, 1);
1005 end;
1006 Result := uDGroupAll;
1007end;
1008
1009function DGroupIEN(AName: string): Integer;
1010begin
1011 Result := StrToIntDef(sCallV('ORWORDG IEN', [AName]), 0);
1012end;
1013
1014procedure ListDGroupAll(Dest: TStrings);
1015begin
1016 CallV('ORWORDG ALLTREE', [nil]);
1017 Dest.Assign(RPCBrokerV.Results);
1018end;
1019
1020procedure ListSpecialties(Dest: TStrings);
1021begin
1022 CallV('ORWOR TSALL', [nil]);
1023 MixedCaseList(RPCBrokerV.Results);
1024 Dest.Assign(RPCBrokerV.Results);
1025end;
1026
1027procedure ListSpecialtiesED(AType: Char; Dest: TStrings);
1028var
1029 i :integer;
1030 Currloc: integer;
1031 admitEvts: TStringList;
1032 otherEvts: TStringList;
1033 commonList: TStringList;
1034begin
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;
1108end;
1109
1110procedure ListOrderFilters(Dest: TStrings);
1111begin
1112 CallV('ORWORDG REVSTS', [nil]);
1113 Dest.Assign(RPCBrokerV.Results);
1114end;
1115
1116
1117procedure ListOrderFiltersAll(Dest: TStrings);
1118begin
1119 CallV('ORWORDG REVSTS', [nil]);
1120 Dest.Assign(RPCBrokerV.Results);
1121end;
1122
1123{ Write Orders }
1124
1125procedure BuildResponses(var ResolvedDialog: TOrderDialogResolved; const KeyVars: string;
1126 AnEvent: TOrderDelayEvent; ForIMO: boolean);
1127const
1128 BoolChars: array[Boolean] of Char = ('0', '1');
1129 RESERVED_PIECE = '';
1130var
1131 DelayEvent, x, TheOrder: string;
[460]1132 Idx, tmpOrderGroup, PickupIdx, ForIMOResponses: integer;
[459]1133 IfUDGrp: Boolean;
1134 IfUDGrpForQO: Boolean;
[460]1135 temp: string;
[459]1136begin
1137 ForIMOResponses := 0;
[460]1138 tmpOrderGroup := 0;
1139 temp := '';
[459]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);
[460]1148 tmpOrderGroup := CheckOrderGroup(TheOrder);
1149 if tmpOrderGroup = 1 then IfUDGrp := True else IfUDGrp := False;
[459]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
[460]1154 if (Patient.Inpatient = true) and (tmpOrderGroup = 2) then temp := '0';
1155 if temp <> '0' then temp := BoolChars[Patient.Inpatient];
[459]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;
1208end;
1209
1210procedure ClearOrderRecall;
1211begin
1212 CallV('ORWDXM2 CLRRCL', [nil]);
1213end;
1214
1215function CommonLocationForOrders(OrderList: TStringList): Integer;
1216begin
1217 Result := StrToIntDef(sCallV('ORWD1 COMLOC', [OrderList]), 0);
1218end;
1219
1220function FormIDForDialog(IEN: Integer): Integer;
1221begin
1222 Result := StrToIntDef(sCallV('ORWDXM FORMID', [IEN]), 0);
1223end;
1224
1225function DlgIENForName(DlgName: string): Integer;
1226begin
1227 Result := StrToIntDef(sCallV('OREVNTX1 DLGIEN',[DlgName]),0);
1228end;
1229
1230procedure LoadOrderMenu(AnOrderMenu: TOrderMenu; AMenuIEN: Integer);
1231var
1232 OrderMenuItem: TOrderMenuItem;
1233 i: Integer;
1234begin
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}
1261end;
1262
1263procedure LoadOrderSet(SetItems: TStrings; AnIEN: Integer; var KeyVars, ACaption: string);
1264var
1265 x: string;
1266begin
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);
1278end;
1279
1280procedure LoadWriteOrders(Dest: TStrings);
1281begin
1282 CallV('ORWDX WRLST', [Encounter.Location]);
1283 Dest.Assign(RPCBrokerV.Results);
1284end;
1285
1286procedure LoadWriteOrdersED(Dest: TStrings; EvtID: string);
1287begin
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
1294end;
1295
1296function OrderDisabledMessage(DlgIEN: Integer): string;
1297begin
1298 Result := sCallV('ORWDX DISMSG', [DlgIEN]);
1299end;
1300
1301procedure SendOrders(OrderList: TStringList; const ESCode: string);
1302var
1303 i: Integer;
1304begin
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);
1313end;
1314
1315procedure SendReleaseOrders(OrderList: TStringList);
1316var
1317 loc: string;
1318 CurrTS: Integer;
1319 PtTS: string;
1320begin
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);
1327end;
1328
1329procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string);
1330var
1331 i: Integer;
1332begin
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]);
1339end;
1340
1341procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string);
1342begin
1343 CallV('ORWD1 RVPRINT', [Encounter.Location, DeviceInfo, OrderList]);
1344end;
1345
1346procedure PrintServiceCopies(OrderList: TStringList); {*REV*}
1347begin
1348 CallV('ORWD1 SVONLY', [Encounter.Location, OrderList]);
1349end;
1350
1351procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string);
1352begin
1353 CallV('ORWD1 PRINTGUI', [Encounter.Location, DeviceInfo, SelectedList]);
1354end;
1355
1356{ Order Actions }
1357
1358function DialogForOrder(const ID: string): Integer;
1359begin
1360 Result := StrToIntDef(sCallV('ORWDX DLGID', [ID]), 0);
1361end;
1362
1363function FormIDForOrder(const ID: string): Integer;
1364begin
1365 Result := StrToIntDef(sCallV('ORWDX FORMID', [ID]), 0);
1366end;
1367
1368procedure SetOrderFromResults(AnOrder: TOrder);
1369var
1370 x, y, z: string;
1371begin
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;
1396end;
1397
1398procedure LockPatient(var ErrMsg: string);
1399begin
1400 ErrMsg := sCallV('ORWDX LOCK', [Patient.DFN]);
1401 if Piece(ErrMsg, U, 1) = '1' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
1402end;
1403
1404procedure UnlockPatient;
1405begin
1406 sCallV('ORWDX UNLOCK', [Patient.DFN]);
1407end;
1408
1409procedure LockOrder(OrderID: string; var ErrMsg: string);
1410begin
1411 ErrMsg := sCallV('ORWDX LOCK ORDER', [OrderID]);
1412 if Piece(ErrMsg, U, 1) = '1' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
1413end;
1414
1415procedure UnlockOrder(OrderID: string);
1416begin
1417 sCallV('ORWDX UNLOCK ORDER', [OrderID]);
1418end;
1419
1420procedure ValidateOrderAction(const ID, Action: string; var ErrMsg: string);
1421begin
1422 ErrMsg := sCallV('ORWDXA VALID', [ID, Action, Encounter.Provider]);
1423end;
1424
1425procedure ValidateOrderActionNature(const ID, Action, Nature: string; var ErrMsg: string);
1426begin
1427 ErrMsg := sCallV('ORWDXA VALID', [ID, Action, Encounter.Provider, Nature]);
1428end;
1429
1430procedure IsLatestAction(const ID: string; var ErrList: TStringList);
1431begin
1432 CallV('ORWOR ACTION TEXT',[ID]);
1433 if RPCBrokerV.Results.Count > 0 then
1434 Errlist.Assign(RPCBrokerV.Results);
1435end;
1436
1437procedure ChangeOrder(AnOrder: TOrder; ResponseList: TList);
1438begin
1439end;
1440
1441procedure 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 }
1443var
1444 tmplst: TStringList;
1445 i: integer;
1446 y: string;
1447begin
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
[460]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);
[459]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;
1501end;
1502
1503procedure HoldOrder(AnOrder: TOrder);
1504begin
1505 CallV('ORWDXA HOLD', [AnOrder.ID, Encounter.Provider]);
1506 SetOrderFromResults(AnOrder);
1507end;
1508
1509procedure ReleaseOrderHold(AnOrder: TOrder);
1510begin
1511 CallV('ORWDXA UNHOLD', [AnOrder.ID, Encounter.Provider]);
1512 SetOrderFromResults(AnOrder);
1513end;
1514
1515procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
1516begin
1517 CallV('ORWDXA DCREASON', [nil]);
1518 ExtractItems(Dest, RPCBrokerV.Results, 'DCReason');
[460]1519 //AGP Change 26.15 for PSI-04-63
1520 //DefaultIEN := StrToIntDef(Piece(ExtractDefault(RPCBrokerV.Results, 'DCReason'), U, 1), 0);
[459]1521end;
1522
1523function GetREQReason: Integer;
1524begin
1525 Result := StrToIntDef(sCallV('ORWDXA DCREQIEN', [nil]), 0);
1526end;
1527
1528procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);
1529var
1530 AParentID : string;
1531begin
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;
1538end;
1539
1540procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64);
1541begin
1542 CallV('ORWDXA ALERT', [AnOrder.ID, AlertRecip]);
1543 // don't worry about results
1544end;
1545
1546procedure FlagOrder(AnOrder: TOrder; const FlagReason: string; AlertRecip: Int64);
1547begin
1548 CallV('ORWDXA FLAG', [AnOrder.ID, FlagReason, AlertRecip]);
1549 SetOrderFromResults(AnOrder);
1550end;
1551
1552procedure LoadFlagReason(Dest: TStrings; const ID: string);
1553begin
1554 CallV('ORWDXA FLAGTXT', [ID]);
1555 Dest.Assign(RPCBrokerV.Results);
1556end;
1557
1558procedure UnflagOrder(AnOrder: TOrder; const AComment: string);
1559begin
1560 CallV('ORWDXA UNFLAG', [AnOrder.ID, AComment]);
1561 SetOrderFromResults(AnOrder);
1562end;
1563
1564procedure LoadWardComments(Dest: TStrings; const ID: string);
1565begin
1566 CallV('ORWDXA WCGET', [ID]);
1567 Dest.Assign(RPCBrokerV.Results);
1568end;
1569
1570procedure PutWardComments(Src: TStrings; const ID: string; var ErrMsg: string);
1571begin
1572 ErrMsg := sCallV('ORWDXA WCPUT', [ID, Src]);
1573end;
1574
1575procedure CompleteOrder(AnOrder: TOrder; const ESCode: string);
1576begin
1577 CallV('ORWDXA COMPLETE', [AnOrder.ID, ESCode]);
1578 SetOrderFromResults(AnOrder);
1579end;
1580
1581procedure VerifyOrder(AnOrder: TOrder; const ESCode: string);
1582begin
1583 CallV('ORWDXA VERIFY', [AnOrder.ID, ESCode]);
1584 SetOrderFromResults(AnOrder);
1585end;
1586
1587procedure VerifyOrderChartReview(AnOrder: TOrder; const ESCode: string);
1588begin
1589 CallV('ORWDXA VERIFY', [AnOrder.ID, ESCode, 'R']);
1590 SetOrderFromResults(AnOrder);
1591end;
1592
1593function GetOrderableIen(AnOrderId:string): integer;
1594begin
1595 Result := StrToIntDef(sCallV('ORWDXR GTORITM', [AnOrderId]),0);
1596end;
1597
1598procedure StoreDigitalSig(AID, AHash: string; AProvider: Int64; ASig, ACrlUrl: string; var AError: string);
1599var
1600 len, ix: integer;
1601 ASigAray: TStringList;
1602begin
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;
1624end;
1625
1626procedure UpdateOrderDGIfNeeded(AnID: string);
1627var
1628 NeedUpdate: boolean;
1629 tmpDFN: string;
1630begin
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]);
1637end;
1638
1639function CanEditSuchRenewedOrder(AnID: string; IsTxtOrder: integer): boolean;
1640begin
1641 Result := SCallV('ORWDXR01 CANCHG',[AnID,IsTxtOrder]) = '1';
1642end;
1643
1644function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean;
1645begin
1646 Result := SCallV('ORWDXR01 ISSPLY',[DlgID,QODlg])='1';
1647end;
1648
1649procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer);
1650begin
1651 SCallV('ORWDXR01 SAVCHG',[AnID,TheRefills,ThePickup,IsTxtOrder]);
1652 SetOrderFromResults(AnOrder);
1653end;
1654
1655{ Order Information }
1656
1657function OrderIsReleased(const ID: string): Boolean;
1658begin
1659 Result := sCallV('ORWDXR ISREL', [ID]) = '1';
1660end;
1661
1662procedure LoadRenewFields(RenewFields: TOrderRenewFields; const ID: string);
1663var
1664 i: Integer;
1665begin
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;
1678end;
1679
1680procedure GetChildrenOfComplexOrder(AnParentID,CurrAct: string; var ChildList: TStringList); //PSI-COMPLEX
1681var
1682 i: integer;
1683begin
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;
1694end;
1695
1696procedure LESValidationForChangedLabOrder(var RejectedReason: TStringList; AnOrderInfo: string);
1697begin
1698 CallV('ORWDPS5 LESAPI',[AnOrderInfo]);
1699 if RPCBrokerV.Results.Count > 0 then
1700 RejectedReason.Assign(RPCBrokerV.Results);
1701end;
1702
1703procedure ChangeEvent(AnOrderList: TStringList; APtEvtId: string);
1704begin
1705 SCallV('OREVNTX1 CHGEVT', [APtEvtId,AnOrderList]);
1706end;
1707
1708procedure DeletePtEvent(APtEvtID: string);
1709begin
1710 SCallV('OREVNTX1 DELPTEVT',[APtEvtID]);
1711end;
1712
1713function IsRenewableComplexOrder(AnParentID: string): boolean; //PSI-COMPLEX
1714var
1715 rst: integer;
1716begin
1717 Result := False;
1718 rst := StrToIntDef(SCallV('ORWDXR CANRN',[AnParentID]),0);
1719 if rst>0 then
1720 Result := True;
1721end;
1722
1723function IsComplexOrder(AnOrderID: string): boolean; //PSI-COMPLEX
1724var
1725 rst: integer;
1726begin
1727 Result := False;
1728 rst := StrToIntDef(SCallV('ORWDXR ISCPLX',[AnOrderID]),0);
1729 if rst > 0 then
1730 Result := True;
1731end;
1732
1733procedure ValidateComplexOrderAct(AnOrderID: string; var ErrMsg: string); //PSI-COMPLEX
1734begin
1735 ErrMsg := SCallV('ORWDXA OFCPLX',[AnOrderID]);
1736end;
1737
1738function GetDlgData(ADlgID: string): string;
1739begin
1740 Result := SCallV('OREVNTX1 GETDLG',[ADlgID]);
1741end;
1742
1743function PtEvtEmpty(APtEvtID: string): Boolean;
1744begin
1745 Result := False;
1746 if StrToIntDef(SCallV('OREVNTX1 EMPTY',[APtEvtID]),0)>0 then
1747 Result := True;
1748end;
1749
1750
1751function TextForOrder(const ID: string): string;
1752begin
1753 CallV('ORWORR GETTXT', [ID]);
1754 Result := RPCBrokerV.Results.Text;
1755end;
1756
1757function GetConsultOrderNumber(ConsultIEN: string): string;
1758begin
1759 Result := sCallv('ORQQCN GET ORDER NUMBER',[ConsultIEN]);
1760end;
1761
1762function GetOrderByIFN(const ID: string): TOrder;
1763var
1764 x, y, z: string;
1765 AnOrder: TOrder;
1766begin
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;
1794end;
1795
1796function GetPackageByOrderID(const OrderID: string): string;
1797begin
1798 Result := SCallV('ORWDXR GETPKG',[OrderID]);
1799end;
1800
1801function AnyOrdersRequireSignature(OrderList: TStringList): Boolean;
1802begin
1803 Result := sCallV('ORWD1 SIG4ANY', [OrderList]) = '1';
1804end;
1805
1806function OrderRequiresSignature(const ID: string): Boolean;
1807begin
1808 Result := sCallV('ORWD1 SIG4ONE', [ID]) = '1';
1809end;
1810
1811function OrderRequiresDigitalSignature(const ID: string): Boolean;
1812begin
1813 Result := sCallV('ORWOR1 CHKDIG', [ID]) = '1';
1814end;
1815
1816function GetDrugSchedule(const ID: string): string;
1817begin
1818 Result := sCallV('ORWOR1 GETDSCH', [ID]);
1819end;
1820
1821function GetExternalText(const ID: string): string;
1822var
1823 x,y: string;
1824begin
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;
1834end;
1835
1836function SetExternalText(const ID: string; ADrugSch: string; AUser: Int64): string;
1837var
1838 x,y: string;
1839begin
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;
1849end;
1850
1851function GetDigitalSignature(const ID: string): string;
1852begin
1853 CallV('ORWORR GETDSIG', [ID]);
1854 Result := RPCBrokerV.Results.Text;
1855end;
1856
1857function GetDEA(const ID: string): string;
1858begin
1859 CallV('ORWORR GETDEA', [ID]);
1860 Result := RPCBrokerV.Results.Text;
1861end;
1862
1863function GetPKISite: Boolean;
1864begin
1865 Result := sCallV('ORWOR PKISITE', [nil]) = '1';
1866end;
1867
1868function GetPKIUse: Boolean;
1869begin
1870 Result := sCallV('ORWOR PKIUSE', [nil]) = '1';
1871end;
1872
1873function DoesOIPIInSigForQO(AnQOID: integer): integer;
1874begin
1875 Result := StrToIntDef(SCallV('ORWDPS1 HASOIPI',[AnQOID]),0);
1876end;
1877
1878function GetDispGroupForLES: string;
1879begin
1880 Result := SCallV('ORWDPS5 LESGRP',[nil]);
1881end;
1882
1883function GetOrderPtEvtID(AnOrderID: string): string;
1884begin
1885 Result := SCallV('OREVNTX1 ODPTEVID',[AnOrderID]);
1886end;
1887
1888function VerbTelPolicyOrder(AnOrderID: string): boolean;
1889begin
1890 Result := SCallV('ORWDPS5 ISVTP',[AnOrderID]) = '1';
1891end;
1892
1893function ForIVandUD(AnOrderID: string): boolean;
1894begin
1895 Result := SCallV('ORWDPS4 ISUDIV',[AnOrderID]) = '1';
1896end;
1897
1898function GetEventIFN(const AEvntID: string): string;
1899begin
1900 Result := sCallV('OREVNTX1 EVT',[AEvntID]);
1901end;
1902
1903function GetEventName(const AEvntID: string): string;
1904begin
1905 Result := sCallV('OREVNTX1 NAME',[AEvntID]);
1906end;
1907
1908function GetEventLoc(const APtEvntID: string): string;
1909begin
1910 Result := SCallV('OREVNTX1 LOC', [APtEvntID]);
1911end;
1912
1913function GetEventLoc1(const AnEvntID: string): string;
1914begin
1915 Result := SCallV('OREVNTX1 LOC1', [AnEvntID]);
1916end;
1917
1918function GetEventDiv(const APtEvntID: string): string;
1919begin
1920 Result := SCallV('OREVNTX1 DIV',[APtEvntID]);
1921end;
1922
1923function GetEventDiv1(const AnEvntID: string): string;
1924begin
1925 Result := SCallV('OREVNTX1 DIV1',[AnEvntID]);
1926end;
1927
1928function GetCurrentSpec(const APtIFN: string): string;
1929begin
1930 Result := SCallV('OREVNTX1 CURSPE', [APtIFN]);
1931end;
1932
1933function GetDefaultEvt(const AProviderIFN: string): string;
1934begin
1935 Result := SCallV('OREVNTX1 DFLTEVT',[AProviderIFN]);
1936end;
1937
1938procedure DeleteDefaultEvt;
1939begin
1940 SCallV('OREVNTX1 DELDFLT',[User.DUZ]);
1941end;
1942
1943function isExistedEvent(const APtDFN: string; const AEvtID: string; var APtEvtID: string): Boolean;
1944begin
1945 Result := False;
1946 APtEvtID := SCallV('OREVNTX1 EXISTS', [APtDFN,AEvtID]);
1947 if StrToIntDef(APtEvtID,0) > 0 then
1948 Result := True;
1949end;
1950
1951function TypeOfExistedEvent(APtDFN: string; AEvtID: Integer): Integer;
1952begin
1953 Result := StrToIntDef(SCallV('OREVNTX1 TYPEXT', [APtDFN,AEvtID]),0);
1954end;
1955
1956function isMatchedEvent(const APtDFN: string; const AEvtID: string; var ATs:string): Boolean;
1957var
1958 rst: string;
1959begin
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;
1967end;
1968
1969function isDCedOrder(const AnOrderID: string): Boolean;
1970var
1971 rst: string;
1972begin
1973 Result := False;
1974 rst := SCAllV('OREVNTX1 ISDCOD',[AnOrderID]);
1975 if STrToIntDef(rst,0)>0 then
1976 Result := True;
1977end;
1978
1979function isOnholdMedOrder(AnOrderID: string): Boolean;
1980var
1981 rst: string;
1982begin
1983 Result := False;
1984 rst := SCAllV('OREVNTX1 ISHDORD',[AnOrderID]);
1985 if StrToIntDef(rst,0)>0 then
1986 Result := True;
1987end;
1988
1989function SetDefaultEvent(var AErrMsg: string; EvtID: string): Boolean;
1990begin
1991 AErrMsg := SCallV('OREVNTX1 SETDFLT',[EvtID]);
1992 Result := True;
1993end;
1994
1995function GetEventPromptID: integer;
1996var
1997 evtPrompt: string;
1998begin
1999 evtPrompt := SCallV('OREVNTX1 PRMPTID',[nil]);
2000 Result := StrToIntDef(evtPrompt,0);
2001end;
2002
2003function GetDefaultTSForEvt(AnEvtID: integer): string;
2004begin
2005 Result := SCallV('OREVNTX1 DEFLTS',[AnEvtID]);
2006end;
2007
2008function GetPromptIDs: string;
2009begin
2010 Result := SCallV('OREVNTX1 PROMPT IDS',[nil]);
2011end;
2012
2013function GetEventDefaultDlg(AEvtID: integer): string;
2014begin
2015 Result := SCallV('OREVNTX1 DFLTDLG',[AEvtID]);
2016end;
2017
2018function CanManualRelease: boolean;
2019var
2020 rst: integer;
2021begin
2022 Result := False;
2023 rst := StrToIntDef(SCallV('OREVNTX1 AUTHMREL',[nil]),0);
2024 if rst > 0 then
2025 Result := True;
2026end;
2027
2028function TheParentPtEvt(APtEvt: string): string;
2029begin
2030 Result := SCallV('OREVNTX1 HAVEPRT',[APtEvt]);
2031end;
2032
2033function IsCompletedPtEvt(APtEvtID: integer): boolean;
2034var
2035 rst : integer;
2036begin
2037 Result := False;
2038 rst := StrToIntDef(SCallV('OREVNTX1 COMP',[APtEvtID]),0);
2039 if rst > 0 then
2040 Result := True;
2041end;
2042
2043function IsPassEvt(APtEvtID: integer; APtEvtType: char): boolean;
2044var
2045 rst: integer;
2046begin
2047 Result := False;
2048 rst := StrToIntDef(SCallV('OREVNTX1 ISPASS',[APtEvtID, APtEvtType]),0);
2049 if rst = 1 then
2050 Result := True;
2051end;
2052
2053function IsPassEvt1(AnEvtID: integer; AnEvtType: char): boolean;
2054var
2055 rst: integer;
2056begin
2057 Result := False;
2058 rst := StrToIntDef(SCallV('OREVNTX1 ISPASS1',[AnEvtID, AnEvtType]),0);
2059 if rst = 1 then
2060 Result := True;
2061end;
2062
2063procedure TerminatePtEvt(APtEvtID: integer);
2064begin
2065 SCallV('OREVNTX1 DONE',[APtEvtID]);
2066end;
2067
2068procedure SetPtEvtList(Dest: TStrings; APtDFN: string; var ATotal: Integer);
2069begin
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;
2081end;
2082
2083procedure GetTSListForEvt(Dest: TStrings; AnEvtID:integer);
2084begin
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;
2091end;
2092
2093procedure GetChildEvent(var AChildList: TStringList; APtEvtID: string);
2094begin
2095//
2096end;
2097
2098function DeleteEmptyEvt(APtEvntID: string; var APtEvntName: string; Ask: boolean): boolean;
2099const
2100 TX_EVTDEL1 = 'There are no orders tied to ';
2101 TX_EVTDEL2 = ', Would you like to cancel it?';
2102begin
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;
2128end;
2129
2130function CompleteEvt(APtEvntID: string; APtEvntName: string; Ask: boolean): boolean;
2131const
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?';
2134var
2135 ThePtEvtName: string;
2136begin
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;
2162end;
2163
2164{ Order Checking }
2165
2166function FillerIDForDialog(IEN: Integer): string;
2167begin
2168 Result := sCallV('ORWDXC FILLID', [IEN]);
2169end;
2170
2171function OrderChecksEnabled: Boolean;
2172begin
2173 if uOrderChecksOn = #0 then uOrderChecksOn := CharAt(sCallV('ORWDXC ON', [nil]), 1);
2174 Result := uOrderChecksOn = 'E';
2175end;
2176
2177function OrderChecksOnDisplay(const FillerID: string): string;
2178begin
2179 CallV('ORWDXC DISPLAY', [Patient.DFN, FillerID]);
2180 with RPCBrokerV.Results do SetString(Result, GetText, Length(Text));
2181end;
2182
2183procedure OrderChecksOnAccept(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
2184 OIList: TStringList; DupORIFN: string);
2185begin
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);
2191end;
2192
2193procedure OrderChecksOnDelay(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
2194 OIList: TStringList);
2195begin
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);
2201end;
2202
2203procedure OrderChecksForSession(ListOfChecks, OrderList: TStringList);
2204begin
2205 CallV('ORWDXC SESSION', [Patient.DFN, OrderList]);
2206 ListOfChecks.Assign(RPCBrokerV.Results);
2207end;
2208
2209procedure SaveOrderChecksForSession(const AReason: string; ListOfChecks: TStringList);
2210begin
2211 CallV('ORWDXC SAVECHK', [Patient.DFN, AReason, ListOfChecks]);
2212 { no result used currently }
2213end;
2214
2215function DeleteCheckedOrder(const OrderID: string): Boolean;
2216begin
2217 Result := sCallV('ORWDXC DELORD', [OrderID]) = '1';
2218end;
2219
2220function DataForOrderCheck(const OrderID: string): string;
2221begin
2222 Result := sCallV('ORWDXR01 OXDATA',[OrderID]);
2223end;
2224
2225(*
2226 TEMPORARILY COMMENTED OUT WHILE TESTING
2227function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams;
2228var
2229 TempParams: TPrintParams;
2230 x: string;
2231begin
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;
2261end;
2262*)
2263
2264procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char);
2265var
2266 x: string;
2267begin
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;
2299end;
2300
2301procedure SaveEvtForOrder(APtDFN: string; AEvt: integer; AnOrderID: string);
2302var
2303 TheEventID: string;
2304begin
2305 TheEventID := SCallV('OREVNTX1 PUTEVNT',[APtDFN,IntToStr(AEvt),AnOrderID]);
2306end;
2307
2308function EventExist(APtDFN:string; AEvt: integer): integer;
2309var
2310 AOutCome: string;
2311begin
2312 AOutCome := SCallV('OREVNTX1 EXISTS', [APtDFN,IntToStr(AEvt)]);
2313 if AOutCome = '' then
2314 Result := 0
2315 else
2316 Result := StrToInt(AOutCome);
2317end;
2318
2319function UseNewMedDialogs: Boolean;
2320begin
2321 Result := sCallV('ORWDPS1 CHK94', [nil]) = '1';
2322end;
2323
2324{ Copay }
2325procedure GetCoPay4Orders;
2326begin
2327 RPCBrokerV.RemoteProcedure := 'ORWDPS4 CPLST';
2328 RPCBrokerV.Param[0].PType := literal;
2329 RPCBrokerV.Param[0].Value := Patient.DFN;
2330 CallBroker;
2331end;
2332
2333procedure SaveCoPayStatus(AList: TStrings);
2334var
2335 i: integer;
2336
2337begin
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;
2347end;
2348
2349
2350
2351function IsValidIMOLoc(LocID: integer; PatientID: string): boolean; //IMO
2352var
2353 rst: string;
2354begin
2355 rst := SCallV('ORIMO IMOLOC',[LocID, PatientID]);
2356 Result := StrToIntDef(rst,-1) > -1;
2357end;
2358
2359function IsIMOOrder(OrderID: string): boolean; //IMO
2360begin
2361 Result := SCallV('ORIMO IMOOD',[OrderId])='1';
2362end;
2363
2364function IsInptQO(DlgID: integer): boolean;
2365begin
2366 Result := SCallV('ORWDXM3 ISUDQO', [DlgID]) = '1';
2367end;
2368
2369function IsIVQO(DlgID: integer): boolean;
2370begin
2371 Result := SCallV('ORIMO ISIVQO', [DlgID]) = '1';
2372end;
2373
2374function IsClinicLoc(ALoc: integer): boolean;
2375begin
2376 Result := SCallV('ORIMO ISCLOC', [ALoc]) = '1';
2377end;
2378
2379function IsValidSchedule(AnOrderID: string): boolean; //nss
2380begin
2381 result := SCallV('ORWNSS VALSCH', [AnOrderID]) = '1';
2382end;
2383
2384function IsValidQOSch(QOID: string): string; //nss
2385begin
2386 Result := SCallV('ORWNSS QOSCH',[QOID]);
2387end;
2388
2389function IsValidSchStr(ASchStr: string): boolean;
2390begin
2391 Result := SCallV('ORWNSS CHKSCH',[ASchStr]) = '1';
2392end;
2393
2394{ TParentEvent }
2395
2396procedure TParentEvent.Assign(AnEvtID: string);
2397var
2398 evtInfo: string;
2399begin
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);
2409end;
2410
2411constructor TParentEvent.Create;
2412begin
2413 ParentIFN := 0;
2414 ParentName := '';
2415 ParentType := #0;
2416 ParentDlg := '0';
2417end;
2418
2419initialization
2420 uDGroupAll := 0;
2421 uOrderChecksOn := #0;
2422
2423finalization
2424 if uDGroupMap <> nil then uDGroupMap.Free;
2425
2426end.
2427
Note: See TracBrowser for help on using the repository browser.