unit rOrders; {$OPTIMIZATION OFF} interface uses SysUtils, Classes, ORFn, ORNet, uCore, Dialogs, Controls; type TOrder = class public ICD9Code: string; ID: string; DGroup: Integer; OrderTime: TFMDateTime; StartTime: string; StopTime: string; Status: Integer; Signature: Integer; VerNurse: string; VerClerk: string; ChartRev: string; Provider: Int64; ProviderName: string; ProviderDEA: string; ProviderVa: string; DigSigReq: string; XMLText: string; Text: string; DGroupSeq: Integer; DGroupName: string; Flagged: Boolean; Retrieved: Boolean; EditOf: string; ActionOn: string; EventPtr: string; //ptr to #100.2 EventName: string; //Event name in #100.5 OrderLocIEN: string; //imo OrderLocName: string; //imo ParentID : string; LinkObject: TObject; EnteredInError: Integer; //AGP Changes 26.12 PSI-04-053 DCOriginalOrder: boolean; procedure Assign(Source: TOrder); procedure Clear; end; TParentEvent = class public ParentIFN: integer; ParentName: string; ParentType: Char; ParentDlg: string; constructor Create; procedure Assign(AnEvtID: string); end; TOrderDelayEvent = record EventType: Char; // A=admit, T=transfer, D=discharge, C=current TheParent: TParentEvent; // Parent Event EventIFN : Integer; // Pointer to OE/RR EVENTS file (#100.5) EventName: String; // Event name from OR/RR EVENTS file (#100.5) PtEventIFN: Integer; // Patient event IFN ptr to #100.2 Specialty: Integer; // pointer to facility treating specialty file Effective: TFMDateTime; // effective date/time (estimated start time) IsNewEvent: Boolean; // is new event for an patient end; TOrderDialogResolved = record InputID: string; // can be dialog IEN or '#ORIFN' QuickLevel: Integer; // 0=dialog,1=auto,2=verify,8=reject,9=cancel ResponseID: string; // DialogID + ';' + $H DialogIEN: Integer; // pointer to 101.41 for dialog (may be quick order IEN) DialogType: Char; // type of dialog (Q or D) FormID: Integer; // windows form to display DisplayGroup: Integer; // pointer to 100.98, display group for dialog ShowText: string; // text to show for verify or rejection QOKeyVars: string; // from entry action of quick order end; TNextMoveRec = record NextStep: Integer; LastIndex: Integer; end; TOrderMenu = class IEN: Integer; NumCols: Integer; Title: string; KeyVars: string; MenuItems: TList; {of TOrderMenuItem} end; TOrderMenuItem = class IEN: Integer; Row: Integer; Col: Integer; DlgType: Char; FormID: Integer; AutoAck: Boolean; ItemText: string; Mnemonic: string; Display: Integer; Selected: Boolean; end; TSelectedOrder = class public Position: Integer; Order: TOrder; end; TOrderRenewFields = class public BaseType: Integer; StartTime: string; StopTime: string; Refills: Integer; Pickup: string; Comments: string; NewText: string; end; TPrintParams = record PromptForChartCopy : char; ChartCopyDevice : string; PromptForLabels : char; LabelDevice : string; PromptForRequisitions : char; RequisitionDevice : string; PromptForWorkCopy : char; WorkCopyDevice : string; AnyPrompts : boolean; // OrdersToPrint : TStringList; {*KCM*} end; TOrderView = class Changed: Boolean; // true when view has been modified DGroup: Integer; // display group (pointer value) Filter: Integer; // FLGS parameter passed to ORQ InvChrono: Boolean; // true for inverse chronological order ByService: Boolean; // true for grouping orders by service TimeFrom: TFMDateTime; // beginning time for orders in list TimeThru: TFMDateTime; // ending time for orders in list CtxtTime: TFMDateTime; // set by server, context hours begin time TextView: Integer; // set by server, 0 if mult views of same order ViewName: string; // display name for the view EventDelay: TOrderDelayEvent; // fields for event delay view public procedure Assign(Src: TOrderView); end; { Order List functions } function DetailOrder(const ID: string): TStrings; function ResultOrder(const ID: string): TStrings; function ResultOrderHistory(const ID: string): TStrings; function NameOfStatus(IEN: Integer): string; function GetOrderStatus(AnOrderId: string): integer; function ExpiredOrdersStartDT: TFMDateTime; procedure ClearOrders(AList: TList); procedure LoadOrders(Dest: TList; Filter, Groups: Integer); procedure LoadOrdersAbbr(Dest: TList; AView: TOrderView; APtEvtID: string); overload; procedure LoadOrdersAbbr(DestDC,DestRL: TList; AView: TOrderView; APtEvtID: string); overload; procedure LoadOrderSheets(Dest: TStrings); procedure LoadOrderSheetsED(Dest: TStrings); procedure LoadOrderViewDefault(AView: TOrderView); procedure LoadUnsignedOrders(IDList, HaveList: TStrings); procedure SaveOrderViewDefault(AView: TOrderView); procedure RetrieveOrderFields(OrderList: TList; ATextView: Integer; ACtxtTime: TFMDateTime); procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string); procedure SetOrderFromResults(AnOrder: TOrder); procedure SortOrders(AList: TList; ByGroup, InvChron: Boolean); { Display Group & List functions } function DGroupAll: Integer; function DGroupIEN(AName: string): Integer; procedure ListDGroupAll(Dest: TStrings); procedure ListSpecialties(Dest: TStrings); procedure ListSpecialtiesED(AType: Char; Dest: TStrings); procedure ListOrderFilters(Dest: TStrings); procedure ListOrderFiltersAll(Dest: TStrings); function NameOfDGroup(IEN: Integer): string; function ShortNameOfDGroup(IEN: Integer): string; function SeqOfDGroup(IEN: Integer): Integer; function CheckOrderGroup(AOrderID: string): integer; function CheckQOGroup(AQOId:string): Boolean; { Write Orders } procedure BuildResponses(var ResolvedDialog: TOrderDialogResolved; const KeyVars: string; AnEvent: TOrderDelayEvent; ForIMO: boolean = False); procedure ClearOrderRecall; function CommonLocationForOrders(OrderList: TStringList): Integer; function FormIDForDialog(IEN: Integer): Integer; function DlgIENForName(DlgName: string): Integer; procedure LoadOrderMenu(AnOrderMenu: TOrderMenu; AMenuIEN: Integer); procedure LoadOrderSet(SetItems: TStrings; AnIEN: Integer; var KeyVars, ACaption: string); procedure LoadWriteOrders(Dest: TStrings); procedure LoadWriteOrdersED(Dest: TStrings; EvtID: string); function OrderDisabledMessage(DlgIEN: Integer): string; procedure SendOrders(OrderList: TStringList; const ESCode: string); procedure SendReleaseOrders(OrderList: TStringList); procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string); procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string); procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0); {*KCM*} procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0); {*REV*} procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0); {*KCM*} function UseNewMedDialogs: Boolean; { Order Actions } function DialogForOrder(const ID: string): Integer; procedure LockPatient(var ErrMsg: string); procedure UnlockPatient; procedure LockOrder(OrderID: string; var ErrMsg: string); procedure UnlockOrder(OrderID: string); function FormIDForOrder(const ID: string): Integer; procedure ValidateOrderAction(const ID, Action: string; var ErrMsg: string); procedure ValidateOrderActionNature(const ID, Action, Nature: string; var ErrMsg: string); procedure IsLatestAction(const ID: string; var ErrList: TStringList); procedure ChangeOrder(AnOrder: TOrder; ResponseList: TList); procedure RenewOrder(AnOrder: TOrder; RenewFields: TOrderRenewFields; IsComplex: integer; AnIMOOrderAppt: double; OCList: TStringList); procedure HoldOrder(AnOrder: TOrder); procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer); function GetREQReason: Integer; procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer); procedure ReleaseOrderHold(AnOrder: TOrder); procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64); procedure FlagOrder(AnOrder: TOrder; const FlagReason: string; AlertRecip: Int64); procedure UnflagOrder(AnOrder: TOrder; const AComment: string); procedure LoadFlagReason(Dest: TStrings; const ID: string); procedure LoadWardComments(Dest: TStrings; const ID: string); procedure PutWardComments(Src: TStrings; const ID: string; var ErrMsg: string); procedure CompleteOrder(AnOrder: TOrder; const ESCode: string); procedure VerifyOrder(AnOrder: TOrder; const ESCode: string); procedure VerifyOrderChartReview(AnOrder: TOrder; const ESCode: string); function GetOrderableIen(AnOrderId:string): integer; procedure StoreDigitalSig(AID, AHash: string; AProvider: Int64; ASig, ACrlUrl: string; var AError: string); procedure UpdateOrderDGIfNeeded(AnID: string); function CanEditSuchRenewedOrder(AnID: string; IsTxtOrder: integer): boolean; function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean; procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer); function DoesOrderStatusMatch(OrderArray: TStringList): boolean; //function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams; { Order Information } procedure LoadRenewFields(RenewFields: TOrderRenewFields; const ID: string); procedure GetChildrenOfComplexOrder(AnParentID,CurrAct: string; var ChildList: TStringList); //PSI-COMPLEX procedure LESValidationForChangedLabOrder(var RejectedReason: TStringList; AnOrderInfo: string); procedure ValidateComplexOrderAct(AnOrderID: string; var ErrMsg: string); //PSI-COMPLEX function IsRenewableComplexOrder(AnParentID: string): boolean; //PSI-COMPLEX function IsComplexOrder(AnOrderID: string): boolean; //PSI-COMPLEX function GetDlgData(ADlgID: string): string; function OrderIsReleased(const ID: string): Boolean; function TextForOrder(const ID: string): string; function GetConsultOrderNumber(ConsultIEN: string): string; function GetOrderByIFN(const ID: string): TOrder; function GetPackageByOrderID(const OrderID: string): string; function AnyOrdersRequireSignature(OrderList: TStringList): Boolean; function OrderRequiresSignature(const ID: string): Boolean; function OrderRequiresDigitalSignature(const ID: string): Boolean; function GetDrugSchedule(const ID: string): string; function GetExternalText(const ID: string): string; function SetExternalText(const ID: string; ADrugSch: string; AUser: Int64): string; function GetDEA(const ID: string): string; function GetDigitalSignature(const ID: string): string; function GetPKIUse: Boolean; function GetPKISite: Boolean; function DoesOIPIInSigForQO(AnQOID: integer): integer; function GetDispGroupForLES: string; function GetOrderPtEvtID(AnOrderID: string): string; function VerbTelPolicyOrder(AnOrderID: string): boolean; function ForIVandUD(AnOrderID: string): boolean; {Event Delay Enhancement} function DeleteEmptyEvt(APtEvntID: string; var APtEvntName: string; Ask: boolean = True): boolean; function DispOrdersForEvent(AEvtId: string): boolean; function EventInfo(APtEvtID: string): string; // ptr to #100.2 function EventInfo1(AnEvtID: string): string; // ptr to #100.5 function EventExist(APtDFN:string; AEvt: integer): integer; function CompleteEvt(APtEvntID: string; APtEvntName: string; Ask: boolean = True): boolean; function PtEvtEmpty(APtEvtID: string): Boolean; function GetEventIFN(const AEvntID: string): string; function GetEventName(const AEvntID: string): string; function GetEventLoc(const APtEvntID: string): string; function GetEventLoc1(const AnEvntID: string): string; function GetEventDiv(const APtEvntID: string): string; function GetEventDiv1(const AnEvntID: string): string; function GetCurrentSpec(const APtIFN: string): string; function GetDefaultEvt(const AProviderIFN: string): string; function isExistedEvent(const APtDFN: string; const AEvtID: string; var APtEvtID: string): Boolean; function TypeOfExistedEvent(APtDFN: string; AEvtID: Integer): Integer; function isMatchedEvent(const APtDFN: string; const AEvtID: string; var ATs: string): Boolean; function isDCedOrder(const AnOrderID: string): Boolean; function isOnholdMedOrder(AnOrderID: string): Boolean; function SetDefaultEvent(var AErrMsg: string; EvtID: string): Boolean; function GetEventPromptID: integer; function GetDefaultTSForEvt(AnEvtID: integer): string; function GetPromptIDs: string; function GetEventDefaultDlg(AEvtID: integer): string; function CanManualRelease: boolean; function TheParentPtEvt(APtEvt: string): string; function IsCompletedPtEvt(APtEvtID: integer): boolean; function IsPassEvt(APtEvtID: integer; APtEvtType: char): boolean; function IsPassEvt1(AnEvtID: integer; AnEvtType: char): boolean; procedure DeleteDefaultEvt; procedure TerminatePtEvt(APtEvtID: integer); procedure ChangeEvent(AnOrderList: TStringList; APtEvtId: string); procedure DeletePtEvent(APtEvtID: string); procedure SaveEvtForOrder(APtDFN: string; AEvt: integer; AnOrderID: string); procedure SetPtEvtList(Dest: TStrings; APtDFN: string; var ATotal: integer); procedure GetTSListForEvt(Dest: TStrings; AnEvtID:integer); procedure GetChildEvent(var AChildList: TStringList; APtEvtID: string); { Order Checking } function FillerIDForDialog(IEN: Integer): string; function OrderChecksEnabled: Boolean; function OrderChecksOnDisplay(const FillerID: string): string; procedure OrderChecksOnAccept(ListOfChecks: TStringList; const FillerID, StartDtTm: string; OIList: TStringList; DupORIFN: string); procedure OrderChecksOnDelay(ListOfChecks: TStringList; const FillerID, StartDtTm: string; OIList: TStringList); procedure OrderChecksForSession(ListOfChecks, OrderList: TStringList); procedure SaveOrderChecksForSession(const AReason: string; ListOfChecks: TStringList); function DeleteCheckedOrder(const OrderID: string): Boolean; function DataForOrderCheck(const OrderID: string): string; { Copay } procedure GetCoPay4Orders; procedure SaveCoPayStatus(AList: TStrings); {IMO: inpatient medication for outpatient} function IsValidIMOLoc(LocID: integer; PatientID: string): boolean; //IMO function IsIMOOrder(OrderID: string): boolean; function IsInptQO(DlgID: integer): boolean; function IsIVQO(DlgID: integer): boolean; function IsClinicLoc(ALoc: integer): boolean; {None-standard Schedule} //nss function IsValidSchedule(AnOrderID: string): boolean; //NSS function IsValidQOSch(QOID: string): string; //NSS function IsValidSchStr(ASchStr: string): boolean; implementation uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore, VAUtils; var uDGroupMap: TStringList; // each string is DGroupIEN=Sequence^TopName^Name uDGroupAll: Integer; uOrderChecksOn: Char; { TOrderView methods } procedure TOrderView.Assign(Src: TOrderView); begin Self.Changed := Src.Changed; Self.DGroup := Src.DGroup; Self.Filter := Src.Filter; Self.InvChrono := Src.InvChrono; Self.ByService := Src.ByService; Self.TimeFrom := Src.TimeFrom; Self.TimeThru := Src.TimeThru; Self.CtxtTime := Src.CtxtTime; Self.TextView := Src.TextView; Self.ViewName := Src.ViewName; Self.EventDelay.EventIFN := Src.EventDelay.EventIFN; Self.EventDelay.EventName := Src.EventDelay.EventName; Self.EventDelay.EventType := Src.EventDelay.EventType; Self.EventDelay.Specialty := Src.EventDelay.Specialty; Self.EventDelay.Effective := Src.EventDelay.Effective; end; { TOrder methods } procedure TOrder.Assign(Source: TOrder); begin ID := Source.ID; DGroup := Source.DGroup; OrderTime := Source.OrderTime; StartTime := Source.StartTime; StopTime := Source.StopTime; Status := Source.Status; Signature := Source.Signature; VerNurse := Source.VerNurse; VerClerk := Source.VerClerk; ChartRev := Source.ChartRev; Provider := Source.Provider; ProviderName := Source.ProviderName; ProviderDEA := Source.ProviderDEA; ProviderVA := Source.ProviderVA; DigSigReq := Source.DigSigReq; XMLText := Source.XMLText; Text := Source.Text; DGroupSeq := Source.DGroupSeq; DGroupName := Source.DGroupName; Flagged := Source.Flagged; Retrieved := Source.Retrieved; EditOf := Source.EditOf; ActionOn := Source.ActionOn; EventPtr := Source.EventPtr; EventName := Source.EventName; OrderLocIEN := Source.OrderLocIEN; OrderLocName := Source.OrderLocName; ParentID := Source.ParentID; LinkObject := Source.LinkObject; end; procedure TOrder.Clear; begin ID := ''; DGroup := 0; OrderTime := 0; StartTime := ''; StopTime := ''; Status := 0; Signature := 0; VerNurse := ''; VerClerk := ''; ChartRev := ''; Provider := 0; ProviderName := ''; ProviderDEA := ''; ProviderVA :=''; DigSigReq :=''; XMLText := ''; Text := ''; DGroupSeq := 0; DGroupName := ''; Flagged := False; Retrieved := False; EditOf := ''; ActionOn := ''; OrderLocIEN := ''; //imo OrderLocName := ''; //imo ParentID := ''; LinkObject := nil; end; { Order List functions } function DetailOrder(const ID: string): TStrings; begin CallV('ORQOR DETAIL', [ID, Patient.DFN]); Result := RPCBrokerV.Results; end; function ResultOrder(const ID: string): TStrings; begin CallV('ORWOR RESULT', [Patient.DFN,ID,ID]); Result := RPCBrokerV.Results; end; function ResultOrderHistory(const ID: string): TStrings; begin CallV('ORWOR RESULT HISTORY', [Patient.DFN,ID,ID]); Result := RPCBrokerV.Results; end; procedure LoadDGroupMap; begin if uDGroupMap = nil then begin uDGroupMap := TStringList.Create; tCallV(uDGroupMap, 'ORWORDG MAPSEQ', [nil]); end; end; function NameOfStatus(IEN: Integer): string; begin case IEN of 0: Result := 'error'; 1: Result := 'discontinued'; 2: Result := 'complete'; 3: Result := 'hold'; 4: Result := 'flagged'; 5: Result := 'pending'; 6: Result := 'active'; 7: Result := 'expired'; 8: Result := 'scheduled'; 9: Result := 'partial results'; 10: Result := 'delayed'; 11: Result := 'unreleased'; 12: Result := 'dc/edit'; 13: Result := 'cancelled'; 14: Result := 'lapsed'; 15: Result := 'renewed'; 97: Result := ''; { null status, used for 'No Orders Found.' } 98: Result := 'new'; 99: Result := 'no status'; end; end; function GetOrderStatus(AnOrderId: string): integer; begin Result := StrToIntDef(SCallV('OREVNTX1 GETSTS',[AnOrderId]),0); end; function ExpiredOrdersStartDT: TFMDateTime; //Return FM date/time to begin search for expired orders begin Result := MakeFMDateTime(sCallV('ORWOR EXPIRED', [nil])); end; function DispOrdersForEvent(AEvtId: string): boolean; var theResult: integer; begin Result := False; theResult := StrToIntDef(SCallV('OREVNTX1 CPACT',[AEvtId]),0); if theResult > 0 then Result := True; end; function EventInfo(APtEvtID: string): string; begin Result := SCallV('OREVNTX1 GTEVT', [APtEvtID]); end; function EventInfo1(AnEvtID: string): string; begin Result := SCallV('OREVNTX1 GTEVT1', [AnEvtID]); end; function NameOfDGroup(IEN: Integer): string; begin if uDGroupMap = nil then LoadDGroupMap; Result := uDGroupMap.Values[IntToStr(IEN)]; Result := Piece(Result, U, 3); end; function ShortNameOfDGroup(IEN: Integer): string; begin if uDGroupMap = nil then LoadDGroupMap; Result := uDGroupMap.Values[IntToStr(IEN)]; Result := Piece(Result, U, 4); end; function SeqOfDGroup(IEN: Integer): Integer; var x: string; begin if uDGroupMap = nil then LoadDGroupMap; x := uDGroupMap.Values[IntToStr(IEN)]; Result := StrToIntDef(Piece(x, U, 1), 0); end; function CheckOrderGroup(AOrderID: string): integer; begin // Result = 1 Inpatient Medication Display Group; // Result = 2 OutPatient Medication Display Group; // Result = 0 None of In or Out patient display group; Result := StrToInt(SCallV('ORWDPS2 CHKGRP',[AOrderID])); end; function CheckQOGroup(AQOId:string): Boolean; var rst: integer; begin rst := StrToInt(SCallV('ORWDPS2 QOGRP',[AQOId])); Result := False; if rst > 0 then Result := True; end; function TopNameOfDGroup(IEN: Integer): string; begin if uDGroupMap = nil then LoadDGroupMap; Result := uDGroupMap.Values[IntToStr(IEN)]; Result := Piece(Result, U, 2); end; procedure ClearOrders(AList: TList); var i: Integer; begin with AList do for i := 0 to Count - 1 do with TOrder(Items[i]) do Free; AList.Clear; end; procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string); { 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 { Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig^IMO^DCOrigOrder} begin with AnOrder do begin Clear; ID := Copy(Piece(x, U, 1), 2, Length(Piece(x, U, 1))); DGroup := StrToIntDef(Piece(x, U, 2), 0); OrderTime := MakeFMDateTime(Piece(x, U, 3)); StartTime := Piece(x, U, 4); StopTime := Piece(x, U, 5); Status := StrToIntDef(Piece(x, U, 6), 0); Signature := StrToIntDef(Piece(x, U, 7), 0); VerNurse := Piece(x, U, 8); VerClerk := Piece(x, U, 9); ChartRev := Piece(x, U, 15); Provider := StrToInt64Def(Piece(x, U, 10), 0); ProviderName := Piece(x, U, 11); ProviderDEA := Piece(x, U, 16); ProviderVA := Piece(x, U, 17); DigSigReq := Piece(x, U, 18); Flagged := Piece(x, U, 13) = '1'; Retrieved := True; OrderLocIEN := Piece(Piece(x,U,19),':',2); //imo if Piece(Piece(x,U,19),':',1) = '0;SC(' then OrderLocName := 'Unknown' else OrderLocName := Piece(Piece(x,U,19),':',1); //imo Text := y; XMLText := z; DGroupSeq := SeqOfDGroup(DGroup); DGroupName := TopNameOfDGroup(DGroup); //AGP Changes 26.15 PSI-04-063 if (pos('Entered in error',Text)>0) then AnOrder.EnteredInError := 1 else AnOrder.EnteredInError := 0; //if DGroupName = 'Non-VA Meds' then Text := 'Non-VA ' + Text; if Piece(x,U,20) = '1' then DCOriginalOrder := True else DCOriginalOrder := False; end; end; procedure LoadOrders(Dest: TList; Filter, Groups: Integer); var x, y, z: string; AnOrder: TOrder; begin ClearOrders(Dest); if uDGroupMap = nil then LoadDGroupMap; // to make sure broker not called while looping thru Results CallV('ORWORR GET', [Patient.DFN, Filter, Groups]); with RPCBrokerV do while Results.Count > 0 do begin x := Results[0]; Results.Delete(0); if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch y := ''; while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do begin y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF; Results.Delete(0); end; if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF z := ''; if (Results.Count > 0) and (Results[0] = '|') then begin Results.Delete(0); while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do begin z := z + Copy(Results[0], 2, Length(Results[0])); Results.Delete(0); end; end; AnOrder := TOrder.Create; SetOrderFields(AnOrder, x, y, z); Dest.Add(AnOrder); end; end; procedure LoadOrdersAbbr(Dest: TList; AView: TOrderView; APtEvtID: string); //Filter, Specialty, Groups: Integer; var TextView: Integer; // var CtxtTime: TFMDateTime); var i: Integer; AnOrder: TOrder; FilterTS: string; AlertedUserOnly: boolean; begin ClearOrders(Dest); if uDGroupMap = nil then LoadDGroupMap; // to make sure broker not called while looping thru Results FilterTS := IntToStr(AView.Filter) + U + IntToStr(AView.EventDelay.Specialty); AlertedUserOnly := (Notifications.Active and (AView.Filter = 12)); CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID, AlertedUserOnly]); 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) begin CallV('ORWORR AGET', [Patient.DFN, '27^0', AView.DGroup, ExpiredOrdersStartDT, FMNow, APtEvtID]); AView.ViewName := 'Recently Expired Orders (No Expiring Orders Found) -' + Piece(AView.ViewName, '-', 2); end; {if (Piece(RPCBrokerV.Results[0], U, 1) = '0') or (Piece(RPCBrokerV.Results[0], U, 1) = '') then // if no orders found (0 element is count) begin AnOrder := TOrder.Create; with AnOrder do begin ID := '0'; DGroup := 0; OrderTime := FMNow; Status := 97; Text := 'No orders found.'; Retrieved := True; end; Dest.Add(AnOrder); Exit; end;} AView.TextView := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0); AView.CtxtTime := MakeFMDateTime(Piece(RPCBrokerV.Results[0], U, 3)); with RPCBrokerV do for i := 1 to Results.Count - 1 do // if orders found (skip 0 element) begin if (Piece(RPCBrokerV.Results[i], U, 1) = '0') or (Piece(RPCBrokerV.Results[i], U, 1) = '') then Continue; if (DelimCount(Results[i],U) = 2) then Continue; AnOrder := TOrder.Create; with AnOrder do begin ID := Piece(Results[i], U, 1); DGroup := StrToIntDef(Piece(Results[i], U, 2), 0); OrderTime := MakeFMDateTime(Piece(Results[i], U, 3)); EventPtr := Piece(Results[i],U,4); EventName := Piece(Results[i],U,5); DGroupSeq := SeqOfDGroup(DGroup); end; Dest.Add(AnOrder); end; end; procedure LoadOrdersAbbr(DestDC,DestRL: TList; AView: TOrderView; APtEvtID: string); var i: Integer; AnOrder: TOrder; FilterTS: string; DCStart: boolean; begin DCStart := False; if uDGroupMap = nil then LoadDGroupMap; FilterTS := IntToStr(AView.Filter) + U + IntToStr(AView.EventDelay.Specialty); CallV('ORWORR RGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID]); if RPCBrokerV.Results[0] = '0' then // if no orders found (0 element is count) begin AnOrder := TOrder.Create; with AnOrder do begin ID := '0'; DGroup := 0; OrderTime := FMNow; Status := 97; Text := 'No orders found.'; Retrieved := True; end; DestDC.Add(AnOrder); Exit; end; AView.TextView := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0); AView.CtxtTime := MakeFMDateTime(Piece(RPCBrokerV.Results[0], U, 3)); with RPCBrokerV do for i := 1 to Results.Count - 1 do // if orders found (skip 0 element) begin if AnsiCompareText('DC START', Results[i]) = 0 then begin DCStart := True; Continue; end; AnOrder := TOrder.Create; with AnOrder do begin ID := Piece(Results[i], U, 1); DGroup := StrToIntDef(Piece(Results[i], U, 2), 0); OrderTime := MakeFMDateTime(Piece(Results[i], U, 3)); EventPtr := Piece(Results[i],U,4); EventName := Piece(Results[i],U,5); DGroupSeq := SeqOfDGroup(DGroup); end; if DCStart then DestDC.Add(AnOrder) else DestRL.Add(AnOrder); end; end; procedure LoadOrderSheets(Dest: TStrings); begin CallV('ORWOR SHEETS', [Patient.DFN]); MixedCaseByPiece(RPCBrokerV.Results, U, 2); FastAssign(RPCBrokerV.Results, Dest); end; procedure LoadOrderSheetsED(Dest: TStrings); var i: integer; begin CallV('OREVNTX PAT', [Patient.DFN]); MixedCaseByPiece(RPCBrokerV.Results, U, 2); Dest.Add('C;O^Current View'); if RPCBrokerV.Results.Count > 1 then begin RPCBrokerV.Results.Delete(0); for i := 0 to RPCbrokerV.Results.Count - 1 do RPCBrokerV.Results[i] := RPCBrokerV.Results[i] + ' Orders'; FastAddStrings(RPCBrokerV.Results, Dest); end; end; procedure LoadOrderViewDefault(AView: TOrderView); var x: string; begin x := sCallV('ORWOR VWGET', [nil]); with AView do begin Changed := False; DGroup := StrToIntDef(Piece(x, ';', 4), 0); Filter := StrToIntDef(Piece(x, ';', 3), 0); InvChrono := Piece(x, ';', 6) = 'R'; ByService := Piece(x, ';', 7) = '1'; TimeFrom := StrToFloat(Piece(x, ';', 1)); TimeThru := StrToFloat(Piece(x, ';', 2)); CtxtTime := 0; TextView := 0; ViewName := Piece(x, ';', 8); EventDelay.EventType := 'C'; EventDelay.Specialty := 0; EventDelay.Effective := 0; end; end; procedure LoadUnsignedOrders(IDList, HaveList: TStrings); var i: Integer; begin with RPCBrokerV do begin ClearParameters := True; RemoteProcedure := 'ORWOR UNSIGN'; Param[0].PType := literal; Param[0].Value := Patient.DFN; Param[1].PType := list; Param[1].Mult['0'] := ''; // (to prevent broker from hanging if empty list) for i := 0 to Pred(HaveList.Count) do Param[1].Mult['"' + HaveList[i] + '"'] := ''; CallBroker; FastAssign(RPCBrokerV.Results,IDList); end; end; procedure RetrieveOrderFields(OrderList: TList; ATextView: Integer; ACtxtTime: TFMDateTime); var i, OrderIndex: Integer; x, y, z: string; AnOrder: TOrder; IDList: TStringList; begin IDList := TStringList.Create; try with OrderList do for i := 0 to Count - 1 do IDList.Add(TOrder(Items[i]).ID); CallV('ORWORR GET4LST', [ATextView, ACtxtTime, IDList]); finally IDList.Free; end; OrderIndex := -1; with RPCBrokerV do while Results.Count > 0 do begin Inc(OrderIndex); if (OrderIndex >= OrderList.Count) then begin Results.Delete(0); Continue; end; AnOrder := TOrder(OrderList.Items[OrderIndex]); x := Results[0]; Results.Delete(0); if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch if Piece(x, U, 1) <> '~' + AnOrder.ID then Continue; // only happens if out of synch y := ''; while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do begin y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF; Results.Delete(0); end; if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF z := ''; if (Results.Count > 0) and (Results[0] = '|') then begin Results.Delete(0); while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do begin z := z + Copy(Results[0], 2, Length(Results[0])); Results.Delete(0); end; end; SetOrderFields(AnOrder, x, y, z); end; end; procedure SaveOrderViewDefault(AView: TOrderView); var x: string; begin with AView do begin x := MakeRelativeDateTime(TimeFrom) + ';' + // 1 MakeRelativeDateTime(TimeThru) + ';' + // 2 IntToStr(Filter) + ';' + // 3 IntToStr(DGroup) + ';;'; // 4, skip 5 if InvChrono then x := x + 'R;' else x := x + 'F;'; // 6 if ByService then x := x + '1' else x := x + '0'; // 7 CallV('ORWOR VWSET', [x]); end; end; { MOVE THESE FUNCTIONS INTO UORDERS??? } { < 0 if Item1 is less and Item2, 0 if they are equal and > 0 if Item1 is greater than Item2 } function InverseByGroup(Item1, Item2: Pointer): Integer; var Order1, Order2: TOrder; DSeq1, DSeq2, IFN1, IFN2: Integer; begin Order1 := TOrder(Item1); Order2 := TOrder(Item2); if ( (Piece(Order1.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order1.ID)) ) and ( StrToIntDef(Order1.EventPtr,0) = 0 ) then DSeq1 := 0 else DSeq1 := Order1.DGroupSeq; if ((Piece(Order2.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order2.ID))) and ( StrToIntDef(Order1.EventPtr,0) = 0 ) then DSeq2 := 0 else DSeq2 := Order2.DGroupSeq; if DSeq1 = DSeq2 then begin if Order1.OrderTime > Order2.OrderTime then Result := -1 else if Order1.OrderTime < Order2.OrderTime then Result := 1 else Result := 0; if Result = 0 then begin IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0); IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0); if IFN1 < IFN2 then Result := -1; if IFN1 > IFN2 then Result := 1; end; end else if DSeq1 < DSeq2 then Result := -1 else Result := 1; end; function ForwardByGroup(Item1, Item2: Pointer): Integer; var Order1, Order2: TOrder; DSeq1, DSeq2, IFN1, IFN2: Integer; begin Order1 := TOrder(Item1); Order2 := TOrder(Item2); if (Piece(Order1.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order1.ID)) then DSeq1 := 0 else DSeq1 := Order1.DGroupSeq; if (Piece(Order2.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order2.ID)) then DSeq2 := 0 else DSeq2 := Order2.DGroupSeq; if DSeq1 = DSeq2 then begin if Order1.OrderTime < Order2.OrderTime then Result := -1 else if Order1.OrderTime > Order2.OrderTime then Result := 1 else Result := 0; if Result = 0 then begin IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0); IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0); if IFN1 < IFN2 then Result := -1; if IFN1 > IFN2 then Result := 1; end; end else if DSeq1 < DSeq2 then Result := -1 else Result := 1; end; function InverseChrono(Item1, Item2: Pointer): Integer; var Order1, Order2: TOrder; IFN1, IFN2: Integer; begin Order1 := TOrder(Item1); Order2 := TOrder(Item2); if Order1.OrderTime > Order2.OrderTime then Result := -1 else if Order1.OrderTime < Order2.OrderTime then Result := 1 else Result := 0; if Result = 0 then begin IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0); IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0); if IFN1 < IFN2 then Result := -1; if IFN1 > IFN2 then Result := 1; end; end; function ForwardChrono(Item1, Item2: Pointer): Integer; var Order1, Order2: TOrder; IFN1, IFN2: Integer; begin Order1 := TOrder(Item1); Order2 := TOrder(Item2); if Order1.OrderTime < Order2.OrderTime then Result := -1 else if Order1.OrderTime > Order2.OrderTime then Result := 1 else Result := 0; if Result = 0 then begin IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0); IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0); if IFN1 < IFN2 then Result := -1; if IFN1 > IFN2 then Result := 1; end; end; procedure SortOrders(AList: TList; ByGroup, InvChron: Boolean); begin if ByGroup then begin if InvChron then AList.Sort(InverseByGroup) else AList.Sort(ForwardByGroup); end else begin if InvChron then AList.Sort(InverseChrono) else AList.Sort(ForwardChrono); end; end; function DGroupAll: Integer; var x: string; begin if uDGroupAll = 0 then begin x := sCallV('ORWORDG IEN', ['ALL']); uDGroupAll := StrToIntDef(x, 1); end; Result := uDGroupAll; end; function DGroupIEN(AName: string): Integer; begin Result := StrToIntDef(sCallV('ORWORDG IEN', [AName]), 0); end; procedure ListDGroupAll(Dest: TStrings); begin CallV('ORWORDG ALLTREE', [nil]); FastAssign(RPCBrokerV.Results, Dest); end; procedure ListSpecialties(Dest: TStrings); begin CallV('ORWOR TSALL', [nil]); MixedCaseList(RPCBrokerV.Results); FastAssign(RPCBrokerV.Results, Dest); end; procedure ListSpecialtiesED(AType: Char; Dest: TStrings); var i :integer; Currloc: integer; admitEvts: TStringList; otherEvts: TStringList; commonList: TStringList; IsObservation: boolean; begin if Encounter <> nil then Currloc := Encounter.Location else Currloc := 0; IsObservation := (Piece(GetCurrentSpec(Patient.DFN), U, 3) = '1'); commonList := TStringList.Create; CallV('OREVNTX1 CMEVTS',[Currloc]); //MixedCaseList(RPCBrokerV.Results); if RPCBrokerV.Results.Count > 0 then with RPCBrokerV do for i := 0 to Results.Count - 1 do begin if AType = 'D' then begin if AType = Piece(Results[i],'^',3) then commonList.Add(Results[i]); end else if AType = 'A' then begin if (Piece(Results[i],'^',3) = 'T') or (Piece(Results[i],'^',3) = 'D') then Continue; commonList.Add(Results[i]); end else if IsObservation then begin if (Piece(Results[i],'^',3) = 'T') then Continue; commonList.Add(Results[i]); end else begin if Length(Results[i])> 0 then commonList.Add(Results[i]); end; end; if commonList.Count > 0 then begin FastAddStrings(TStrings(commonList), Dest); Dest.Add('^^^^^^^^___________________________________________________________________________________________'); Dest.Add(LLS_SPACE); end; if AType = #0 then begin admitEvts := TStringList.Create; otherEvts := TSTringList.Create; CallV('OREVNTX ACTIVE',['A']); //MixedCaseList(RPCBrokerV.Results); if RPCBrokerV.Results.Count > 0 then begin RPCBrokerV.Results.Delete(0); FastAddStrings(RPCBrokerV.Results, admitEvts); end; if IsObservation then CallV('OREVNTX ACTIVE',['O^M^D']) else CallV('OREVNTX ACTIVE',['T^O^M^D']); //MixedCaseList(RPCBrokerV.Results); if RPCBrokerV.Results.Count > 0 then begin RPCBrokerV.Results.Delete(0); FastAddStrings(RPCBrokerV.Results, otherEvts); end; FastAddStrings(TStrings(otherEvts), Dest); Dest.Add('^^^^^^^^_____________________________________________________________________________________________'); Dest.Add(LLS_SPACE); FastAddStrings(TStrings(admitEvts), Dest); admitEvts.Free; otherEvts.Free; end else if AType = 'A' then begin CallV('OREVNTX ACTIVE',['A^O^M']); //MixedCaseList(RPCBrokerV.Results); if RPCBrokerV.Results.Count > 0 then RPCBrokerV.Results.Delete(0); FastAddStrings(RPCBrokerV.Results, Dest); end else begin CallV('OREVNTX ACTIVE',[AType]); //MixedCaseList(RPCBrokerV.Results); if RPCBrokerV.Results.Count > 0 then RPCBrokerV.Results.Delete(0); FastAddStrings(RPCBrokerV.Results, Dest); end; end; procedure ListOrderFilters(Dest: TStrings); begin CallV('ORWORDG REVSTS', [nil]); FastAssign(RPCBrokerV.Results, Dest); end; procedure ListOrderFiltersAll(Dest: TStrings); begin CallV('ORWORDG REVSTS', [nil]); FastAssign(RPCBrokerV.Results, Dest); end; { Write Orders } procedure BuildResponses(var ResolvedDialog: TOrderDialogResolved; const KeyVars: string; AnEvent: TOrderDelayEvent; ForIMO: boolean); const BoolChars: array[Boolean] of Char = ('0', '1'); RESERVED_PIECE = ''; var DelayEvent, x, TheOrder: string; Idx, tmpOrderGroup, PickupIdx, ForIMOResponses: integer; IfUDGrp: Boolean; IfUDGrpForQO: Boolean; temp: string; begin ForIMOResponses := 0; tmpOrderGroup := 0; temp := ''; if ForIMO then ForIMOResponses := 1; PickupIdx := 0; IfUDGrp := False; TheOrder := ResolvedDialog.InputID; IfUDGrpForQO := CheckQOGroup(TheOrder); if (CharAt(TheOrder,1) in ['C','T']) then begin Delete(TheOrder,1,1); tmpOrderGroup := CheckOrderGroup(TheOrder); if tmpOrderGroup = 1 then IfUDGrp := True else IfUDGrp := False; end; if (not IfUDGrp) and (AnEvent.EventType in ['A','T']) then IfUDGrp := True; //FLDS=DFN^LOC^ORNP^INPT^SEX^AGE^EVENT^SC%^^^Key Variables if (Patient.Inpatient = true) and (tmpOrderGroup = 2) then temp := '0'; if temp <> '0' then temp := BoolChars[Patient.Inpatient]; with AnEvent do begin if isNewEvent then DelayEvent := '0;'+ EventType + ';' + IntToStr(Specialty) + ';' + FloatToStr(Effective) else DelayEvent := IntToStr(AnEvent.PtEventIFN) + ';' + EventType + ';' + IntToStr(Specialty) + ';' + FloatToStr(Effective); end; x := Patient.DFN + U + // 1 IntToStr(Encounter.Location) + U + // 2 IntToStr(Encounter.Provider) + U + // 3 BoolChars[Patient.Inpatient] + U + // 4 Patient.Sex + U + // 5 IntToStr(Patient.Age) + U + // 6 DelayEvent + U + // 7 (for OREVENT) IntToStr(Patient.SCPercent) + U + // 8 RESERVED_PIECE + U + // 9 RESERVED_PIECE + U + // 10 KeyVars; CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses, Encounter.Location]); // LST(0)=QuickLevel^ResponseID(ORIT;$H)^Dialog^Type^FormID^DGrp with RPCBrokerV do begin x := Results[0]; with ResolvedDialog do begin QuickLevel := StrToIntDef(Piece(x, U, 1), 0); ResponseID := Piece(x, U, 2); DialogIEN := StrToIntDef(Piece(x, U, 3), 0); DialogType := CharAt(Piece(x, U, 4), 1); FormID := StrToIntDef(Piece(x, U, 5), 0); DisplayGroup := StrToIntDef(Piece(x, U, 6), 0); QOKeyVars := Pieces(x, U, 7, 7 + MAX_KEYVARS); Results.Delete(0); if Results.Count > 0 then begin if (IfUDGrp) or (IfUDGrpForQO) then begin for Idx := 0 to Results.Count - 1 do begin if(Pos('PICK UP',UpperCase(Results[idx])) > 0) or (Pos('PICK-UP',UpperCase(Results[idx])) > 0) then begin PickupIdx := Idx; Break; end; end; end; if PickupIdx > 0 then Results.Delete(PickupIdx); SetString(ShowText, Results.GetText, StrLen(Results.GetText)); end; end; end; end; procedure ClearOrderRecall; begin CallV('ORWDXM2 CLRRCL', [nil]); end; function CommonLocationForOrders(OrderList: TStringList): Integer; begin Result := StrToIntDef(sCallV('ORWD1 COMLOC', [OrderList]), 0); end; function FormIDForDialog(IEN: Integer): Integer; begin Result := StrToIntDef(sCallV('ORWDXM FORMID', [IEN]), 0); end; function DlgIENForName(DlgName: string): Integer; begin Result := StrToIntDef(sCallV('OREVNTX1 DLGIEN',[DlgName]),0); end; procedure LoadOrderMenu(AnOrderMenu: TOrderMenu; AMenuIEN: Integer); var OrderMenuItem: TOrderMenuItem; i: Integer; begin CallV('ORWDXM MENU', [AMenuIEN]); with RPCBrokerV do if Results.Count > 0 then begin // Results[0] = Name^Cols^PathSwitch^^^LRFZX^LRFSAMP^LRFSPEC^LRFDATE^LRFURG^LRFSCH^PSJNPOC^ // GMRCNOPD^GMRCNOAT^GMRCREAF^^^^^ AnOrderMenu.Title := Piece(Results[0], U, 1); AnOrderMenu.NumCols := StrToIntDef(Piece(Results[0], U, 2), 1); AnOrderMenu.KeyVars := Pieces(Results[0], U, 6, 6 + MAX_KEYVARS); for i := 1 to Results.Count - 1 do begin OrderMenuItem := TOrderMenuItem.Create; with OrderMenuItem do begin Col := StrToIntDef(Piece(Results[i], U, 1), 0) - 1; Row := StrToIntDef(Piece(Results[i], U, 2), 0) - 1; DlgType := CharAt(Piece(Results[i], U, 3), 1); IEN := StrToIntDef(Piece(Results[i], U, 4), 0); FormID := StrToIntDef(Piece(Results[i], U, 5), 0); AutoAck := Piece(Results[i], U, 6) = '1'; ItemText := Piece(Results[i], U, 7); Mnemonic := Piece(Results[i], U, 8); Display := StrToIntDef(Piece(Results[i], U, 9), 0); end; {with OrderItem} AnOrderMenu.MenuItems.Add(OrderMenuItem); end; {for i} end; {with RPCBrokerV} end; procedure LoadOrderSet(SetItems: TStrings; AnIEN: Integer; var KeyVars, ACaption: string); var x: string; begin CallV('ORWDXM LOADSET', [AnIEN]); KeyVars := ''; ACaption := ''; if RPCBrokerV.Results.Count > 0 then begin x := RPCBrokerV.Results[0]; ACaption := Piece(x, U, 1); KeyVars := Copy(x, Pos(U, x) + 1, Length(x)); RPCBrokerV.Results.Delete(0); end; FastAssign(RPCBrokerV.Results, SetItems); end; procedure LoadWriteOrders(Dest: TStrings); begin CallV('ORWDX WRLST', [Encounter.Location]); FastAssign(RPCBrokerV.Results, Dest); end; procedure LoadWriteOrdersED(Dest: TStrings; EvtID: string); begin CallV('OREVNTX1 WRLSTED', [Encounter.Location,EvtID]); if RPCBrokerV.Results.count > 0 then begin Dest.Clear; FastAssign(RPCBrokerV.Results, Dest); end end; function OrderDisabledMessage(DlgIEN: Integer): string; begin Result := sCallV('ORWDX DISMSG', [DlgIEN]); end; procedure SendOrders(OrderList: TStringList; const ESCode: string); var i: Integer; begin { prepending the space to ESCode is temporary way to keep broker from crashing } CallV('ORWDX SEND', [Patient.DFN, Encounter.Provider, Encounter.Location, ' ' + ESCode, OrderList]); { this is a stop gap way to prevent an undesired error message when user chooses not to sign } with RPCBrokerV do for i := 0 to Results.Count - 1 do if Piece(Results[i], U, 4) = 'This order requires a signature.' then Results[i] := Piece(Results[i], U, 1); OrderList.Clear; FastAssign(RPCBrokerV.Results, OrderList); end; procedure SendReleaseOrders(OrderList: TStringList); var loc: string; CurrTS: Integer; PtTS: string; begin PtTS := Piece(GetCurrentSpec(Patient.DFN),'^',2); CurrTS := StrToIntDef(PtTS,0); Loc := IntToStr(Encounter.Location); CallV('ORWDX SENDED',[OrderList,CurrTS,Loc]); OrderList.Clear; FastAssign(RPCBrokerV.Results, OrderList); end; procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string); var i: Integer; begin { prepending the space to ESCode is temporary way to keep broker from crashing } CallV('ORWDX SENDP', [Patient.DFN, Encounter.Provider, Encounter.Location, ' ' + ESCode, DeviceInfo, OrderList]); { this is a stop gap way to prevent an undesired error message when user chooses not to sign } with RPCBrokerV do for i := 0 to Results.Count - 1 do if Piece(Results[i], U, 3) <> 'This order requires a signature.' then ErrList.Add(Results[i]); end; procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0); var Loc: Integer; begin if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc else Loc := Encounter.Location; CallV('ORWD1 RVPRINT', [Loc, DeviceInfo, OrderList]); end; procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0); {*REV*} var Loc: Integer; begin if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc else Loc := Encounter.Location; CallV('ORWD1 SVONLY', [Loc, OrderList]); end; procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string); begin CallV('ORWD1 PRINTGUI', [Encounter.Location, DeviceInfo, SelectedList]); end; { Order Actions } function DialogForOrder(const ID: string): Integer; begin Result := StrToIntDef(sCallV('ORWDX DLGID', [ID]), 0); end; function FormIDForOrder(const ID: string): Integer; begin Result := StrToIntDef(sCallV('ORWDX FORMID', [ID]), 0); end; procedure SetOrderFromResults(AnOrder: TOrder); var x, y, z: string; begin with RPCBrokerV do while Results.Count > 0 do begin x := Results[0]; Results.Delete(0); if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch y := ''; while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do begin y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF; Results.Delete(0); end; if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF z := ''; if (Results.Count > 0) and (Results[0] = '|') then begin Results.Delete(0); while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do begin z := z + Copy(Results[0], 2, Length(Results[0])); //PKI Change Results.Delete(0); end; end; SetOrderFields(AnOrder, x, y, z); end; end; procedure LockPatient(var ErrMsg: string); begin ErrMsg := sCallV('ORWDX LOCK', [Patient.DFN]); if Piece(ErrMsg, U, 1) = '1' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2); end; procedure UnlockPatient; begin sCallV('ORWDX UNLOCK', [Patient.DFN]); end; procedure LockOrder(OrderID: string; var ErrMsg: string); begin ErrMsg := sCallV('ORWDX LOCK ORDER', [OrderID]); if Piece(ErrMsg, U, 1) = '1' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2); end; procedure UnlockOrder(OrderID: string); begin sCallV('ORWDX UNLOCK ORDER', [OrderID]); end; procedure ValidateOrderAction(const ID, Action: string; var ErrMsg: string); begin ErrMsg := sCallV('ORWDXA VALID', [ID, Action, Encounter.Provider]); end; procedure ValidateOrderActionNature(const ID, Action, Nature: string; var ErrMsg: string); begin ErrMsg := sCallV('ORWDXA VALID', [ID, Action, Encounter.Provider, Nature]); end; procedure IsLatestAction(const ID: string; var ErrList: TStringList); begin CallV('ORWOR ACTION TEXT',[ID]); if RPCBrokerV.Results.Count > 0 then FastAssign(RPCBrokerV.Results, Errlist); end; procedure ChangeOrder(AnOrder: TOrder; ResponseList: TList); begin end; procedure RenewOrder(AnOrder: TOrder; RenewFields: TOrderRenewFields; IsComplex: integer; AnIMOOrderAppt: double; OCList: TStringList); { put RenewFields into tmplst[0]=BaseType^Start^Stop^Refills^Pickup, tmplst[n]=comments } var tmplst: TStringList; i: integer; y: string; begin tmplst := TStringList.Create; {Begin Billing Aware} UBAGlobals.SourceOrderID := AnOrder.ID; {End Billing Aware} try with RenewFields do begin tmplst.SetText(PChar(Comments)); tmplst.Insert(0, IntToStr(BaseType) + U + StartTime + U + StopTime + U + IntToStr(Refills) + U + Pickup); end; with RPCBrokerV do begin ClearParameters := True; RemoteProcedure := 'ORWDXR RENEW'; Param[0].PType := literal; Param[0].Value := AnOrder.ID; Param[1].PType := literal; Param[1].Value := Patient.DFN; Param[2].PType := literal; Param[2].Value := IntToStr(Encounter.Provider); Param[3].PType := literal; Param[3].Value := IntToStr(Encounter.Location); Param[4].PType := list; for i := 0 to tmplst.Count - 1 do Param[4].Mult[IntToStr(i+1)] := tmplst[i]; Param[4].Mult['"ORCHECK"'] := IntToStr(OCList.Count); for i := 0 to OCList.Count - 1 do begin // put quotes around everything to prevent broker from choking y := '"ORCHECK","' + Piece(OCList[i], U, 1) + '","' + Piece(OCList[i], U, 3) + '","' + IntToStr(i+1) + '"'; Param[4].Mult[y] := Pieces(OCList[i], U, 2, 4); end; Param[5].PType := literal; Param[5].Value := IntToStr(IsComplex); Param[6].PType := literal; Param[6].Value := FloatToStr(AnIMOOrderAppt); CallBroker; SetOrderFromResults(AnOrder); {Begin Billing Aware} UBAGlobals.TargetOrderID := AnOrder.ID; //the ID of the renewed order UBAGlobals.CopyTreatmentFactorsDxsToRenewedOrder; {End Billing Aware} end; finally tmplst.Free; end; end; procedure HoldOrder(AnOrder: TOrder); begin CallV('ORWDXA HOLD', [AnOrder.ID, Encounter.Provider]); SetOrderFromResults(AnOrder); end; procedure ReleaseOrderHold(AnOrder: TOrder); begin CallV('ORWDXA UNHOLD', [AnOrder.ID, Encounter.Provider]); SetOrderFromResults(AnOrder); end; procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer); begin CallV('ORWDX2 DCREASON', [nil]); ExtractItems(Dest, RPCBrokerV.Results, 'DCReason'); //AGP Change 26.15 for PSI-04-63 //DefaultIEN := StrToIntDef(Piece(ExtractDefault(RPCBrokerV.Results, 'DCReason'), U, 1), 0); end; function GetREQReason: Integer; begin Result := StrToIntDef(sCallV('ORWDXA DCREQIEN', [nil]), 0); end; procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer); var AParentID, DCOrigOrder: string; begin AParentID := AnOrder.ParentID; if AnOrder.DCOriginalOrder = true then DCOrigOrder := '1' else DCOrigOrder := '0'; CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason, DCOrigOrder, NewOrder]); UBACore.DeleteDCOrdersFromCopiedList(AnOrder.ID); DCType := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 14), 0); SetOrderFromResults(AnOrder); AnOrder.ParentID := AParentID; end; procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64); begin CallV('ORWDXA ALERT', [AnOrder.ID, AlertRecip]); // don't worry about results end; procedure FlagOrder(AnOrder: TOrder; const FlagReason: string; AlertRecip: Int64); begin CallV('ORWDXA FLAG', [AnOrder.ID, FlagReason, AlertRecip]); SetOrderFromResults(AnOrder); end; procedure LoadFlagReason(Dest: TStrings; const ID: string); begin CallV('ORWDXA FLAGTXT', [ID]); FastAssign(RPCBrokerV.Results, Dest); end; procedure UnflagOrder(AnOrder: TOrder; const AComment: string); begin CallV('ORWDXA UNFLAG', [AnOrder.ID, AComment]); SetOrderFromResults(AnOrder); end; procedure LoadWardComments(Dest: TStrings; const ID: string); begin CallV('ORWDXA WCGET', [ID]); FastAssign(RPCBrokerV.Results, Dest); end; procedure PutWardComments(Src: TStrings; const ID: string; var ErrMsg: string); begin ErrMsg := sCallV('ORWDXA WCPUT', [ID, Src]); end; procedure CompleteOrder(AnOrder: TOrder; const ESCode: string); begin CallV('ORWDXA COMPLETE', [AnOrder.ID, ESCode]); SetOrderFromResults(AnOrder); end; procedure VerifyOrder(AnOrder: TOrder; const ESCode: string); begin CallV('ORWDXA VERIFY', [AnOrder.ID, ESCode]); SetOrderFromResults(AnOrder); end; procedure VerifyOrderChartReview(AnOrder: TOrder; const ESCode: string); begin CallV('ORWDXA VERIFY', [AnOrder.ID, ESCode, 'R']); SetOrderFromResults(AnOrder); end; function GetOrderableIen(AnOrderId:string): integer; begin Result := StrToIntDef(sCallV('ORWDXR GTORITM', [AnOrderId]),0); end; procedure StoreDigitalSig(AID, AHash: string; AProvider: Int64; ASig, ACrlUrl: string; var AError: string); var len, ix: integer; ASigAray: TStringList; begin ASigAray := TStringList.Create; ix := 1; len := length(ASig); while len >= ix do begin ASigAray.Add(copy(ASig, ix, 240)); inc(ix, 240); end; //while try CallV('ORWOR1 SIG', [AID, AHash, len, '100', AProvider, ASigAray, ACrlUrl]); with RPCBrokerV do if piece(Results[0],'^',1) = '-1' then begin ShowMsg('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF + 'This error will prevent this order from being sent to the service for processing. Please cancel the order and try again.' + CRLF + CRLF + '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.'); AError := '1'; end; finally ASigAray.Free; end; end; procedure UpdateOrderDGIfNeeded(AnID: string); var NeedUpdate: boolean; tmpDFN: string; begin tmpDFN := Patient.DFN; Patient.Clear; Patient.DFN := tmpDFN; NeedUpdate := SCallV('ORWDPS4 IPOD4OP', [AnID]) = '1'; if Patient.Inpatient and needUpdate then SCallV('ORWDPS4 UPDTDG',[AnID]); end; function CanEditSuchRenewedOrder(AnID: string; IsTxtOrder: integer): boolean; begin Result := SCallV('ORWDXR01 CANCHG',[AnID,IsTxtOrder]) = '1'; end; function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean; begin Result := SCallV('ORWDXR01 ISSPLY',[DlgID,QODlg])='1'; end; procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer); begin SCallV('ORWDXR01 SAVCHG',[AnID,TheRefills,ThePickup,IsTxtOrder]); SetOrderFromResults(AnOrder); end; function DoesOrderStatusMatch(OrderArray: TStringList): boolean; begin Result := StrtoIntDef(SCallV('ORWDX1 ORDMATCH',[Patient.DFN, OrderArray]),0)=1; end; { Order Information } function OrderIsReleased(const ID: string): Boolean; begin Result := sCallV('ORWDXR ISREL', [ID]) = '1'; end; procedure LoadRenewFields(RenewFields: TOrderRenewFields; const ID: string); var i: Integer; begin CallV('ORWDXR RNWFLDS', [ID]); with RPCBrokerV, RenewFields do begin BaseType := StrToIntDef(Piece(Results[0], U, 1), 0); StartTime := Piece(Results[0], U, 2); StopTime := Piece(Results[0], U, 3); Refills := StrToIntDef(Piece(Results[0], U, 4), 0); Pickup := Piece(Results[0], U, 5); Comments := ''; for i := 1 to Results.Count - 1 do Comments := Comments + CRLF + Results[i]; if Copy(Comments, 1, 2) = CRLF then Delete(Comments, 1, 2); end; end; procedure GetChildrenOfComplexOrder(AnParentID,CurrAct: string; var ChildList: TStringList); //PSI-COMPLEX var i: integer; begin CallV('ORWDXR ORCPLX',[AnParentID,CurrAct]); if RPCBrokerV.Results.Count = 0 then Exit; With RPCBrokerV do begin for i := 0 to Results.Count - 1 do begin if (Piece(Results[i],'^',1) <> 'E') and (Length(Results[i])>0) then ChildList.Add(Results[i]); end; end; end; procedure LESValidationForChangedLabOrder(var RejectedReason: TStringList; AnOrderInfo: string); begin CallV('ORWDPS5 LESAPI',[AnOrderInfo]); if RPCBrokerV.Results.Count > 0 then FastAssign(RPCBrokerV.Results, RejectedReason); end; procedure ChangeEvent(AnOrderList: TStringList; APtEvtId: string); begin SCallV('OREVNTX1 CHGEVT', [APtEvtId,AnOrderList]); end; procedure DeletePtEvent(APtEvtID: string); begin SCallV('OREVNTX1 DELPTEVT',[APtEvtID]); end; function IsRenewableComplexOrder(AnParentID: string): boolean; //PSI-COMPLEX var rst: integer; begin Result := False; rst := StrToIntDef(SCallV('ORWDXR CANRN',[AnParentID]),0); if rst>0 then Result := True; end; function IsComplexOrder(AnOrderID: string): boolean; //PSI-COMPLEX var rst: integer; begin Result := False; rst := StrToIntDef(SCallV('ORWDXR ISCPLX',[AnOrderID]),0); if rst > 0 then Result := True; end; procedure ValidateComplexOrderAct(AnOrderID: string; var ErrMsg: string); //PSI-COMPLEX begin ErrMsg := SCallV('ORWDXA OFCPLX',[AnOrderID]); end; function GetDlgData(ADlgID: string): string; begin Result := SCallV('OREVNTX1 GETDLG',[ADlgID]); end; function PtEvtEmpty(APtEvtID: string): Boolean; begin Result := False; if StrToIntDef(SCallV('OREVNTX1 EMPTY',[APtEvtID]),0)>0 then Result := True; end; function TextForOrder(const ID: string): string; begin CallV('ORWORR GETTXT', [ID]); Result := RPCBrokerV.Results.Text; end; function GetConsultOrderNumber(ConsultIEN: string): string; begin Result := sCallv('ORQQCN GET ORDER NUMBER',[ConsultIEN]); end; function GetOrderByIFN(const ID: string): TOrder; var x, y, z: string; AnOrder: TOrder; begin AnOrder := TOrder.Create; CallV('ORWORR GETBYIFN', [ID]); with RPCBrokerV do while Results.Count > 0 do begin x := Results[0]; Results.Delete(0); if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch y := ''; while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do begin y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF; Results.Delete(0); end; if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF z := ''; if (Results.Count > 0) and (Results[0] = '|') then begin Results.Delete(0); while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do begin z := z + Copy(Results[0], 2, Length(Results[0])); //PKI Change Results.Delete(0); end; end; SetOrderFields(AnOrder, x, y, z); end; Result := AnOrder; end; function GetPackageByOrderID(const OrderID: string): string; begin Result := SCallV('ORWDXR GETPKG',[OrderID]); end; function AnyOrdersRequireSignature(OrderList: TStringList): Boolean; begin Result := sCallV('ORWD1 SIG4ANY', [OrderList]) = '1'; end; function OrderRequiresSignature(const ID: string): Boolean; begin Result := sCallV('ORWD1 SIG4ONE', [ID]) = '1'; end; function OrderRequiresDigitalSignature(const ID: string): Boolean; begin Result := sCallV('ORWOR1 CHKDIG', [ID]) = '1'; end; function GetDrugSchedule(const ID: string): string; begin Result := sCallV('ORWOR1 GETDSCH', [ID]); end; function GetExternalText(const ID: string): string; var x,y: string; begin CallV('ORWOR1 GETDTEXT', [ID]); y := ''; with RPCBrokerV do while Results.Count > 0 do begin x := Results[0]; Results.Delete(0); y := y + x; end; Result := y; end; function SetExternalText(const ID: string; ADrugSch: string; AUser: Int64): string; var x,y: string; begin CallV('ORWOR1 SETDTEXT', [ID, ADrugSch, AUser]); y := ''; with RPCBrokerV do while Results.Count > 0 do begin x := Results[0]; Results.Delete(0); y := y + x; end; Result := y; end; function GetDigitalSignature(const ID: string): string; begin CallV('ORWORR GETDSIG', [ID]); Result := RPCBrokerV.Results.Text; end; function GetDEA(const ID: string): string; begin CallV('ORWORR GETDEA', [ID]); Result := RPCBrokerV.Results.Text; end; function GetPKISite: Boolean; begin Result := sCallV('ORWOR PKISITE', [nil]) = '1'; end; function GetPKIUse: Boolean; begin Result := sCallV('ORWOR PKIUSE', [nil]) = '1'; end; function DoesOIPIInSigForQO(AnQOID: integer): integer; begin Result := StrToIntDef(SCallV('ORWDPS1 HASOIPI',[AnQOID]),0); end; function GetDispGroupForLES: string; begin Result := SCallV('ORWDPS5 LESGRP',[nil]); end; function GetOrderPtEvtID(AnOrderID: string): string; begin Result := SCallV('OREVNTX1 ODPTEVID',[AnOrderID]); end; function VerbTelPolicyOrder(AnOrderID: string): boolean; begin Result := SCallV('ORWDPS5 ISVTP',[AnOrderID]) = '1'; end; function ForIVandUD(AnOrderID: string): boolean; begin Result := SCallV('ORWDPS4 ISUDIV',[AnOrderID]) = '1'; end; function GetEventIFN(const AEvntID: string): string; begin Result := sCallV('OREVNTX1 EVT',[AEvntID]); end; function GetEventName(const AEvntID: string): string; begin Result := sCallV('OREVNTX1 NAME',[AEvntID]); end; function GetEventLoc(const APtEvntID: string): string; begin Result := SCallV('OREVNTX1 LOC', [APtEvntID]); end; function GetEventLoc1(const AnEvntID: string): string; begin Result := SCallV('OREVNTX1 LOC1', [AnEvntID]); end; function GetEventDiv(const APtEvntID: string): string; begin Result := SCallV('OREVNTX1 DIV',[APtEvntID]); end; function GetEventDiv1(const AnEvntID: string): string; begin Result := SCallV('OREVNTX1 DIV1',[AnEvntID]); end; function GetCurrentSpec(const APtIFN: string): string; begin Result := SCallV('OREVNTX1 CURSPE', [APtIFN]); end; function GetDefaultEvt(const AProviderIFN: string): string; begin Result := SCallV('OREVNTX1 DFLTEVT',[AProviderIFN]); end; procedure DeleteDefaultEvt; begin SCallV('OREVNTX1 DELDFLT',[User.DUZ]); end; function isExistedEvent(const APtDFN: string; const AEvtID: string; var APtEvtID: string): Boolean; begin Result := False; APtEvtID := SCallV('OREVNTX1 EXISTS', [APtDFN,AEvtID]); if StrToIntDef(APtEvtID,0) > 0 then Result := True; end; function TypeOfExistedEvent(APtDFN: string; AEvtID: Integer): Integer; begin Result := StrToIntDef(SCallV('OREVNTX1 TYPEXT', [APtDFN,AEvtID]),0); end; function isMatchedEvent(const APtDFN: string; const AEvtID: string; var ATs:string): Boolean; var rst: string; begin Result := False; rst := SCallV('OREVNTX1 MATCH',[APtDFN,AEvtID]); if StrToIntDef(Piece(rst,'^',1),0)>0 then begin ATs := Piece(rst,'^',2); Result := True; end; end; function isDCedOrder(const AnOrderID: string): Boolean; var rst: string; begin Result := False; rst := SCAllV('OREVNTX1 ISDCOD',[AnOrderID]); if STrToIntDef(rst,0)>0 then Result := True; end; function isOnholdMedOrder(AnOrderID: string): Boolean; var rst: string; begin Result := False; rst := SCAllV('OREVNTX1 ISHDORD',[AnOrderID]); if StrToIntDef(rst,0)>0 then Result := True; end; function SetDefaultEvent(var AErrMsg: string; EvtID: string): Boolean; begin AErrMsg := SCallV('OREVNTX1 SETDFLT',[EvtID]); Result := True; end; function GetEventPromptID: integer; var evtPrompt: string; begin evtPrompt := SCallV('OREVNTX1 PRMPTID',[nil]); Result := StrToIntDef(evtPrompt,0); end; function GetDefaultTSForEvt(AnEvtID: integer): string; begin Result := SCallV('OREVNTX1 DEFLTS',[AnEvtID]); end; function GetPromptIDs: string; begin Result := SCallV('OREVNTX1 PROMPT IDS',[nil]); end; function GetEventDefaultDlg(AEvtID: integer): string; begin Result := SCallV('OREVNTX1 DFLTDLG',[AEvtID]); end; function CanManualRelease: boolean; var rst: integer; begin Result := False; rst := StrToIntDef(SCallV('OREVNTX1 AUTHMREL',[nil]),0); if rst > 0 then Result := True; end; function TheParentPtEvt(APtEvt: string): string; begin Result := SCallV('OREVNTX1 HAVEPRT',[APtEvt]); end; function IsCompletedPtEvt(APtEvtID: integer): boolean; var rst : integer; begin Result := False; rst := StrToIntDef(SCallV('OREVNTX1 COMP',[APtEvtID]),0); if rst > 0 then Result := True; end; function IsPassEvt(APtEvtID: integer; APtEvtType: char): boolean; var rst: integer; begin Result := False; rst := StrToIntDef(SCallV('OREVNTX1 ISPASS',[APtEvtID, APtEvtType]),0); if rst = 1 then Result := True; end; function IsPassEvt1(AnEvtID: integer; AnEvtType: char): boolean; var rst: integer; begin Result := False; rst := StrToIntDef(SCallV('OREVNTX1 ISPASS1',[AnEvtID, AnEvtType]),0); if rst = 1 then Result := True; end; procedure TerminatePtEvt(APtEvtID: integer); begin SCallV('OREVNTX1 DONE',[APtEvtID]); end; procedure SetPtEvtList(Dest: TStrings; APtDFN: string; var ATotal: Integer); begin CallV('OREVNTX LIST',[APtDFN]); if RPCBrokerV.Results.Count > 0 then begin ATotal := StrToIntDef(RPCBrokerV.Results[0],0); if ATotal > 0 then begin MixedCaseList( RPCBrokerV.Results ); RPCBrokerV.Results.Delete(0); FastAssign(RPCBrokerV.Results, Dest); end; end; end; procedure GetTSListForEvt(Dest: TStrings; AnEvtID:integer); begin CallV('OREVNTX1 MULTS',[AnEvtID]); if RPCBrokerV.Results.Count > 0 then begin SortByPiece(TStringList(RPCBrokerV.Results),'^',2); FastAssign(RPCBrokerV.Results, Dest); end; end; procedure GetChildEvent(var AChildList: TStringList; APtEvtID: string); begin // end; function DeleteEmptyEvt(APtEvntID: string; var APtEvntName: string; Ask: boolean): boolean; const TX_EVTDEL1 = 'There are no orders tied to '; TX_EVTDEL2 = ', Would you like to cancel it?'; begin Result := false; if APtEvntID = '0' then begin Result := True; Exit; end; if PtEvtEmpty(APtEvntID) then begin if Length(APtEvntName)=0 then APtEvntName := GetEventName(APtEvntID); if Ask then begin if InfoBox(TX_EVTDEL1 + APtEvntName + TX_EVTDEL2, 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then begin DeletePtEvent(APtEvntID); Result := True; end; end; if not Ask then begin DeletePtEvent(APtEvntID); Result := True; end; end; end; function CompleteEvt(APtEvntID: string; APtEvntName: string; Ask: boolean): boolean; const TX_EVTFIN1 = 'All of the orders tied to '; TX_EVTFIN2 = ' have been released to a service, ' + #13 + 'Would you like to terminate this event?'; var ThePtEvtName: string; begin Result := false; if APtEvntID = '0' then begin Result := True; Exit; end; if PtEvtEmpty(APtEvntID) then begin if Length(APtEvntName)=0 then ThePtEvtName := GetEventName(APtEvntID) else ThePtEvtName := APtEvntName; if Ask then begin if InfoBox(TX_EVTFIN1 + ThePtEvtName + TX_EVTFIN2, 'Confirmation', MB_OKCANCEL or MB_ICONQUESTION) = IDOK then begin SCallV('OREVNTX1 DONE',[APtEvntID]); Result := True; end; end else begin SCallV('OREVNTX1 DONE',[APtEvntID]); Result := True; end; end; end; { Order Checking } function FillerIDForDialog(IEN: Integer): string; begin Result := sCallV('ORWDXC FILLID', [IEN]); end; function OrderChecksEnabled: Boolean; begin if uOrderChecksOn = #0 then uOrderChecksOn := CharAt(sCallV('ORWDXC ON', [nil]), 1); Result := uOrderChecksOn = 'E'; end; function OrderChecksOnDisplay(const FillerID: string): string; begin CallV('ORWDXC DISPLAY', [Patient.DFN, FillerID]); with RPCBrokerV.Results do SetString(Result, GetText, Length(Text)); end; procedure OrderChecksOnAccept(ListOfChecks: TStringList; const FillerID, StartDtTm: string; OIList: TStringList; DupORIFN: string); begin // don't pass OIList if no items, since broker pauses 5 seconds per order if OIList.Count > 0 then CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList, DupORIFN]) else CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]); FastAssign(RPCBrokerV.Results, ListOfChecks); end; procedure OrderChecksOnDelay(ListOfChecks: TStringList; const FillerID, StartDtTm: string; OIList: TStringList); begin // don't pass OIList if no items, since broker pauses 5 seconds per order if OIList.Count > 0 then CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList]) else CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]); FastAssign(RPCBrokerV.Results, ListOfChecks); end; procedure OrderChecksForSession(ListOfChecks, OrderList: TStringList); begin CallV('ORWDXC SESSION', [Patient.DFN, OrderList]); FastAssign(RPCBrokerV.Results, ListOfChecks); end; procedure SaveOrderChecksForSession(const AReason: string; ListOfChecks: TStringList); begin CallV('ORWDXC SAVECHK', [Patient.DFN, AReason, ListOfChecks]); { no result used currently } end; function DeleteCheckedOrder(const OrderID: string): Boolean; begin Result := sCallV('ORWDXC DELORD', [OrderID]) = '1'; end; function DataForOrderCheck(const OrderID: string): string; begin Result := sCallV('ORWDXR01 OXDATA',[OrderID]); end; (* TEMPORARILY COMMENTED OUT WHILE TESTING function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams; var TempParams: TPrintParams; x: string; begin tempParams.OrdersToPrint := TStringList.Create; try CallV('ORWD1 PARAM', [Location, Nature, OrderList]); x := RPCBrokerV.Results[0]; with TempParams do begin PromptForChartCopy := CharAt(Piece(x, U, 1),1); if Piece(x, U, 5) <> '' then ChartCopyDevice := Piece(Piece(x, U, 5),';',1) + '^' + Piece(Piece(x, U, 5),';',2); PromptForLabels := CharAt(Piece(x, U, 2),1); if Piece(x, U, 6) <> '' then LabelDevice := Piece(Piece(x, U, 6),';',1) + '^' + Piece(Piece(x, U, 6),';',2); PromptForRequisitions := CharAt(Piece(x, U, 3),1); if Piece(x, U, 7) <> '' then RequisitionDevice := Piece(Piece(x, U, 7),';',1) + '^' + Piece(Piece(x, U, 7),';',2); PromptForWorkCopy := CharAt(Piece(x, U, 4),1); if Piece(x, U, 8) <> '' then WorkCopyDevice := Piece(Piece(x, U, 8),';',1) + '^' + Piece(Piece(x, U, 8),';',2); AnyPrompts := ((PromptForChartCopy in ['1','2']) or (PromptForLabels in ['1','2']) or (PromptForRequisitions in ['1','2']) or (PromptForWorkCopy in ['1','2'])); RPCBrokerV.Results.Delete(0); FastAssign(RPCBrokerV.Results, OrdersToPrint); end; Result := TempParams; finally tempParams.OrdersToPrint.Free; end; end; *) procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0); var x: string; begin if Nature <> #0 then begin if PrintLoc > 0 then CallV('ORWD2 DEVINFO', [PrintLoc, Nature, OrderList]) else CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList]); end else begin if PrintLoc > 0 then CallV('ORWD2 MANUAL', [PrintLoc, OrderList]) else CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]); end; x := RPCBrokerV.Results[0]; FillChar(PrintParams, SizeOf(PrintParams), #0); with PrintParams do begin PromptForChartCopy := CharAt(Piece(x, U, 1),1); if Piece(x, U, 5) <> '' then ChartCopyDevice := Piece(Piece(x, U, 5),';',1) + '^' + Piece(Piece(x, U, 5),';',2); PromptForLabels := CharAt(Piece(x, U, 2),1); if Piece(x, U, 6) <> '' then LabelDevice := Piece(Piece(x, U, 6),';',1) + '^' + Piece(Piece(x, U, 6),';',2); PromptForRequisitions := CharAt(Piece(x, U, 3),1); if Piece(x, U, 7) <> '' then RequisitionDevice := Piece(Piece(x, U, 7),';',1) + '^' + Piece(Piece(x, U, 7),';',2); PromptForWorkCopy := CharAt(Piece(x, U, 4),1); if Piece(x, U, 8) <> '' then WorkCopyDevice := Piece(Piece(x, U, 8),';',1) + '^' + Piece(Piece(x, U, 8),';',2); AnyPrompts := ((PromptForChartCopy in ['1','2']) or (PromptForLabels in ['1','2']) or (PromptForRequisitions in ['1','2']) or (PromptForWorkCopy in ['1','2'])); end; if Nature <> #0 then begin RPCBrokerV.Results.Delete(0); OrderList.Clear; FastAssign(RPCBrokerV.Results, OrderList); end; end; procedure SaveEvtForOrder(APtDFN: string; AEvt: integer; AnOrderID: string); var TheEventID: string; begin TheEventID := SCallV('OREVNTX1 PUTEVNT',[APtDFN,IntToStr(AEvt),AnOrderID]); end; function EventExist(APtDFN:string; AEvt: integer): integer; var AOutCome: string; begin AOutCome := SCallV('OREVNTX1 EXISTS', [APtDFN,IntToStr(AEvt)]); if AOutCome = '' then Result := 0 else Result := StrToInt(AOutCome); end; function UseNewMedDialogs: Boolean; begin Result := sCallV('ORWDPS1 CHK94', [nil]) = '1'; end; { Copay } procedure GetCoPay4Orders; begin RPCBrokerV.RemoteProcedure := 'ORWDPS4 CPLST'; RPCBrokerV.Param[0].PType := literal; RPCBrokerV.Param[0].Value := Patient.DFN; CallBroker; end; procedure SaveCoPayStatus(AList: TStrings); var i: integer; begin if AList.Count > 0 then begin RPCBrokerV.ClearParameters := True; RPCBrokerV.RemoteProcedure := 'ORWDPS4 CPINFO'; RPCBrokerV.Param[0].PType := list; for i := 0 to AList.Count-1 do RPCBrokerV.Param[0].Mult[IntToStr(i+1)] := AList[i]; CallBroker; end; end; function IsValidIMOLoc(LocID: integer; PatientID: string): boolean; //IMO var rst: string; begin rst := SCallV('ORIMO IMOLOC',[LocID, PatientID]); Result := StrToIntDef(rst,-1) > -1; end; function IsIMOOrder(OrderID: string): boolean; //IMO begin Result := SCallV('ORIMO IMOOD',[OrderId])='1'; end; function IsInptQO(DlgID: integer): boolean; begin Result := SCallV('ORWDXM3 ISUDQO', [DlgID]) = '1'; end; function IsIVQO(DlgID: integer): boolean; begin Result := SCallV('ORIMO ISIVQO', [DlgID]) = '1'; end; function IsClinicLoc(ALoc: integer): boolean; begin Result := SCallV('ORIMO ISCLOC', [ALoc]) = '1'; end; function IsValidSchedule(AnOrderID: string): boolean; //nss begin result := SCallV('ORWNSS VALSCH', [AnOrderID]) = '1'; end; function IsValidQOSch(QOID: string): string; //nss begin Result := SCallV('ORWNSS QOSCH',[QOID]); end; function IsValidSchStr(ASchStr: string): boolean; begin Result := SCallV('ORWNSS CHKSCH',[ASchStr]) = '1'; end; { TParentEvent } procedure TParentEvent.Assign(AnEvtID: string); var evtInfo: string; begin // ORY = EVTTYPE_U_EVT_U_EVTNAME_U_EVTDISP_U_EVTDLG evtInfo := EventInfo1(AnEvtID); ParentIFN := StrToInt(AnEvtID); if Length(Piece(evtInfo,'^',4)) < 1 then ParentName := Piece(evtInfo,'^',3) else ParentName := Piece(evtInfo,'^',4); ParentType := CharAt(Piece(evtInfo,'^',1),1); ParentDlg := Piece(evtInfo,'^',5); end; constructor TParentEvent.Create; begin ParentIFN := 0; ParentName := ''; ParentType := #0; ParentDlg := '0'; end; initialization uDGroupAll := 0; uOrderChecksOn := #0; finalization if uDGroupMap <> nil then uDGroupMap.Free; end.