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

Last change on this file since 1429 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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