ORWDPS1 ; SLC/KCM/JLI - Pharmacy Calls for Windows Dialog; 03/10/2008
;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,132,141,163,215,255,243**;Dec 17, 1997;Build 242
;
ODSLCT(LST,PSTYPE,DFN,LOC) ; return default lists for dialog
; PSTYPE: pharmacy type (U=unit dose, F=IV fluids, O=outpatient)
N ILST S ILST=0
S ILST=ILST+1,LST(ILST)="~Priority" D PRIOR
S ILST=ILST+1,LST(ILST)="~DispMsg"
S ILST=ILST+1,LST(ILST)="d"_$$DISPMSG
;
; I PSTYPE="F" D Q ; IV Fluids
; . S ILST=ILST+1,LST(ILST)="~ShortList" D SHORT
;
I PSTYPE="O" D ; Outpatient
. S ILST=ILST+1,LST(ILST)="~Refills"
. S ILST=ILST+1,LST(ILST)="d0^0"
. S ILST=ILST+1,LST(ILST)="~Pickup"
. S ILST=ILST+1,LST(ILST)="d"_$$DEFPICK($G(LOC))
. ; S ILST=ILST+1,LST(ILST)="~Supply"
. ; S ILST=ILST+1,LST(ILST)="d^"_$$DEFSPLY(DFN)
Q
PKI(ORY,OI,PSTYPE,ORVP,PKIACTIV) ; return DEA Schedule for drug
N ILST,ORDOSE,ORWPSOI,ORWDOSES,X1,X2,X
K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSSDIN",$J)
S ILST=0
S ORWPSOI=0
S:+OI ORWPSOI=+$P($G(^ORD(101.43,+OI,0)),U,2)
D START^PSSJORDF(ORWPSOI,$S(PSTYPE="U":"I",1:"O")) ; dflt route, schedule, etc.
I '$L($T(DOSE^PSSOPKI1)) D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,PSTYPE,ORVP) ; dflt doses
I $L($T(DOSE^PSSOPKI1)) D DOSE^PSSOPKI1(.ORDOSE,ORWPSOI,PSTYPE,ORVP) ; dflt doses NEW PKI CODE from pharmacy
D EN^PSSDIN(ORWPSOI) ; nfi text
S ORY="" ;PKI
I $D(ORDOSE("DEA")) S X="",X1=$P(ORDOSE("DEA"),";"),X2=$P(ORDOSE("DEA"),";",2) D
. I '$L(X2) Q
. I $G(PKIACTIV) S X=X2
S ORY=X
K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSSDIN",$J)
Q
PRIOR ; from DLGSLCT, get list of allowed priorities
N X,XREF
S XREF=$S(PSTYPE="O":"S.PSO",1:"S.PSJ")
S X="" F S X=$O(^ORD(101.42,XREF,X)) Q:'$L(X) D
. I XREF["PSJ",X'="ASAP",X'="ROUTINE",X'="STAT" Q
. S ILST=ILST+1,LST(ILST)="i"_$O(^ORD(101.42,XREF,X,0))_U_X
S ILST=ILST+1,LST(ILST)="d"_$O(^ORD(101.42,"B","ROUTINE",0))_U_"ROUTINE"
Q
DEFPICK(LOC) ; return default routing
N X,DLG,PRMT
S DLG=$O(^ORD(101.41,"AB","PSO OERR",0)),X=""
S PRMT=$O(^ORD(101.41,"AB","OR GTX ROUTING",0))
I $D(^TMP("ORECALL",$J,+DLG,+PRMT,1)) S X=^(1)
I X'="" S EDITONLY=1 Q X ; EDITONLY used by default action
;
;S X=$$GET^XPAR("ALL^"_"LOC.`"_LOC,"ORWDPS ROUTING DEFAULT",1,"I")
S X=$$GET^XPAR("LOC.`"_LOC_"^SYS","ORWDPS ROUTING DEFAULT",1,"I")
I X="C" S X="C^in Clinic" G XPICK
I X="M" S X="M^by Mail" G XPICK
I X="W" S X="W^at Window" G XPICK
I X="N" S X="" G XPICK
I X="" S X=$S($D(^PSX(550,"C")):"M^by Mail",1:"W^at Window")
XPICK Q X
;
DEFSPLY(DFN) ; return default days supply for this patient
N ORWX
S ORWX("PATIENT")=DFN
D DSUP^PSOSIGDS(.ORWX)
Q $G(ORWX("DAYS SUPPLY"))
;
DFLTSPLY(VAL,UPD,SCH,PAT,DRG) ; return days supply given quantity
; VAL: default days supply
N ORWX,I
S ORWX("PATIENT")=PAT
I DRG S ORWX("DRUG")=DRG
F I=1:1:$L(UPD,U)-1 D
. S ORWX("DOSE ORDERED",I)=$P(UPD,U,I)
. S ORWX("SCHEDULE",I)=$P(SCH,U,I)
D DSUP^PSOSIGDS(.ORWX)
S VAL=$G(ORWX("DAYS SUPPLY"))
Q
DISPMSG() ; return 1 to suppress dispense message
Q +$$GET^XPAR("ALL","ORWDPS SUPPRESS DISPENSE MSG",1,"I")
;
DOWSCH(LST,DFN,LOCIEN) ; return all schedules
N CNT,FREQ,ILST,ORARRAY,WIEN
S WIEN=$$WARDIEN^ORWDPS32(+$G(LOCIEN))
D SCHED^PSS51P1(WIEN,.ORARRAY)
S ILST=0
S CNT=0 F S CNT=$O(ORARRAY(CNT)) Q:CNT'>0 D
.S NODE=$G(ORARRAY(CNT))
.I $P(NODE,U,4)="C" D
..K ^TMP($J,"ORWDPS1 DOWSCH")
..D ZERO^PSS51P1($P(NODE,U),,,,"ORWDPS1 DOWSCH")
..S FREQ=$G(^TMP($J,"ORWDPS1 DOWSCH",$P(NODE,U),2))
..K ^TMP($J,"ORWDPS1 DOWSCH")
..I +FREQ=0 Q
..I +FREQ>1440 Q
..S ILST=ILST+1,LST(ILST)=$P(ORARRAY(CNT),U,2,5)
Q
;
SCHALL(LST,DFN,LOCIEN) ; return all schedules
N CNT,ILST,ORARRAY,WIEN
S WIEN=$$WARDIEN^ORWDPS32(+$G(LOCIEN))
D SCHED^PSS51P1(WIEN,.ORARRAY)
S ILST=0
S CNT=0 F S CNT=$O(ORARRAY(CNT)) Q:CNT'>0 D
.S ILST=ILST+1,LST(ILST)=$P(ORARRAY(CNT),U,2,5)
Q
;
FORMALT(ORLST,ORIEN,PSTYPE) ; return a list of formulary alternatives
N PSID,I
S ORIEN=+$P(^ORD(101.43,ORIEN,0),U,2)
D EN1^PSSUTIL1(.ORIEN,PSTYPE)
S PSID=0,I=0
F S PSID=$O(ORIEN(PSID)) Q:'PSID D
. S OI=+$O(^ORD(101.43,"ID",PSID_";99PSP",0))
. I OI S I=I+1,ORLST(I)=OI,$P(ORLST(I),U,2)=$P(^ORD(101.43,OI,0),U)
Q
DOSEALT(LST,DDRUG,CUROI,PSTYPE) ; return a list of formulary alternatives for dose
N I,OI,ORWLST,ILST S ILST=0
D ENRFA^PSJORUTL(DDRUG,PSTYPE,.ORWLST)
S I=0 F S I=$O(ORWLST(I)) Q:'I D
. S OI=+$O(^ORD(101.43,"ID",+$P(ORWLST(I),U,4)_";99PSP",0))
. I OI,OI'=CUROI S ILST=ILST+1,LST(ILST)=OI_U_$P(^ORD(101.43,OI,0),U)
Q
QOMEDALT(ORY,ODIEN) ;
N ARRAY,IDIEN,ORDERID,PKG,PSTYPE,VALUE
S ORY=0,PKG=+$P(^ORD(101.41,ODIEN,0),U,7)
S PSTYPE=$S($$GET1^DIQ(9.4,PKG_",",1)="PSO":"O",1:"I")
S ORDERID=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM","")) Q:ORDERID'>0
S IDIEN=$O(^ORD(101.41,ODIEN,6,"D",ORDERID,"")) Q:IDIEN'>0
S VALUE=$G(^ORD(101.41,ODIEN,6,IDIEN,1)) Q:VALUE'>0
I $P($G(^ORD(101.43,VALUE,"PS")),U,6)=1 S ORY=VALUE
;D FORMALT(.ARRAY,VALUE,PSTYPE) I $D(ARRAY)>0 S ORY=VALUE
;I ORY=0,$P($G(^ORD(101.43,VALUE,"PS")),U,6)=1 S ORY=VALUE
Q
FAILDEA(FAIL,OI,ORNP,PSTYPE) ; return 1 if DEA check fails for this provider
N DEAFLG,PSOI,TPKG
S FAIL=0,TPKG=$P($G(^ORD(101.43,+$G(OI),0)),U,2)
Q:TPKG'["PS"
S PSOI=+TPKG Q:PSOI'>0
I '$L($T(OIDEA^PSSUTLA1)) Q
S DEAFLG=$$OIDEA^PSSUTLA1(PSOI,PSTYPE) Q:DEAFLG'>0
I '$L($$DEA^XUSER(,+$G(ORNP))) S FAIL=1
Q
FDEA1(FAIL,OI,OITYPE,ORNP) ; only be called for an outpaitent and IV dialog
;OI: IV Orderable Item
;OITYPE: A:ADDITIVE S:SOLUTION
N DEAFLG,PSOI,TKPG
S FAIL=0,TPKG=$P($G(^ORD(101.43,+$G(OI),0)),U,2)
Q:TPKG'["PS"
S PSOI=+TPKG Q:PSOI'>0
I '$L($T(IVDEA^PSSUTIL1)) Q
S DEAFLG=$$IVDEA^PSSUTIL1(PSOI,OITYPE) Q:DEAFLG'>0
I '$L($P($G(^VA(200,+$G(ORNP),"PS")),U,2)),'$L($P($G(^("PS")),U,3)) S FAIL=1
Q
;
CHK94(VAL) ; return 1 if patch 94 has been installed
S VAL=0
I $O(^ORD(101.41,"B","PS MEDS",0)) S VAL=1
Q
LOCPICK(Y,LOC) ; return default Location level routing
S Y=""
S Y=$$GET^XPAR("LOC.`"_LOC_"^SYS","ORWDPS ROUTING DEFAULT",1,"I")
I Y="C" S Y="C^in Clinic"
I Y="M" S Y="M^by Mail"
I Y="W" S Y="W^at Window"
I Y="N" S Y=""
Q
HASOIPI(Y,QOID) ; Check if QO put orderable item's PI into Sig
N PIIEN,OIX
S Y=0
Q:'$D(^ORD(101.41,QOID,0))
S PIIEN=$O(^ORD(101.41,"B","OR GTX PATIENT INSTRUCTIONS",0))
Q:'PIIEN
S OIX=0
Q:'$D(^ORD(101.41,QOID,6,"D"))
F S OIX=$O(^ORD(101.41,+QOID,6,"D",OIX)) Q:'OIX D
. I OIX=PIIEN S Y=1 Q
Q
HASROUTE(Y,QOID) ;Check if QO has a ROUTE defined
N ROUTID
S Y=0,ROUTID=0
S ROUTID=$O(^ORD(101.41,"B","OR GTX ROUTING",0))
Q:'ROUTID
Q:'$D(^ORD(101.41,+QOID))
I $D(^ORD(101.41,+QOID,6,"D",ROUTID)) S Y=1
Q
QOCHECK(ORY,DIEN) ;
N ARY,DG,FORMIEN,NAME,OI,OIIEN,ORDIALOG,ORPKG,TYPE
S ORPKG=$$NMSP^ORCD($P($G(^ORD(101.41,DIEN,0)),U,7)) Q:ORPKG'["PS"
S DG=$P(^ORD(101.41,DIEN,0),U,5)
S NAME=$P(^ORD(100.98,DIEN,0),U)
S TYPE=$S(NAME="INPATIENT MEDICATIONS":"I",NAME="OUTPATIENT MEDICATIONS":"O",1:"")
I TYPE="" Q
S ORDIALOG=$$DEFDLG^ORCD(DIEN) Q:ORDIALOG
D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD("^ORD(101.41,"_DIEN_",6)")
I $D(ORDIALOG)'>0 Q
S OI=$P($G(ORDIALOG("B","ORDERABLE")),U,2) Q:OI'>0
S OIIEN=$G(ORDIALOG(OI,1)) Q:OIIEN'>0
D FORMALT(.ARY,OIIEN,TYPE) I $D(ARY)'>0 Q
S ORY=OIIEN
Q
ORWDPS1 ; SLC/KCM/JLI - Pharmacy Calls for Windows Dialog; 03/10/2008
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,132,141,163,215,255,243**;Dec 17, 1997;Build 242
+2 ;
ODSLCT(LST,PSTYPE,DFN,LOC) ; return default lists for dialog
+1 ; PSTYPE: pharmacy type (U=unit dose, F=IV fluids, O=outpatient)
+2 NEW ILST
SET ILST=0
+3 SET ILST=ILST+1
SET LST(ILST)="~Priority"
DO PRIOR
+4 SET ILST=ILST+1
SET LST(ILST)="~DispMsg"
+5 SET ILST=ILST+1
SET LST(ILST)="d"_$$DISPMSG
+6 ;
+7 ; I PSTYPE="F" D Q ; IV Fluids
+8 ; . S ILST=ILST+1,LST(ILST)="~ShortList" D SHORT
+9 ;
+10 ; Outpatient
IF PSTYPE="O"
Begin DoDot:1
+11 SET ILST=ILST+1
SET LST(ILST)="~Refills"
+12 SET ILST=ILST+1
SET LST(ILST)="d0^0"
+13 SET ILST=ILST+1
SET LST(ILST)="~Pickup"
+14 SET ILST=ILST+1
SET LST(ILST)="d"_$$DEFPICK($GET(LOC))
+15 ; S ILST=ILST+1,LST(ILST)="~Supply"
+16 ; S ILST=ILST+1,LST(ILST)="d^"_$$DEFSPLY(DFN)
End DoDot:1
+17 QUIT
PKI(ORY,OI,PSTYPE,ORVP,PKIACTIV) ; return DEA Schedule for drug
+1 NEW ILST,ORDOSE,ORWPSOI,ORWDOSES,X1,X2,X
+2 KILL ^TMP("PSJINS",$JOB),^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB),^TMP("PSJSCH",$JOB),^TMP("PSSDIN",$JOB)
+3 SET ILST=0
+4 SET ORWPSOI=0
+5 IF +OI
SET ORWPSOI=+$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
+6 ; dflt route, schedule, etc.
DO START^PSSJORDF(ORWPSOI,$SELECT(PSTYPE="U":"I",1:"O"))
+7 ; dflt doses
IF '$LENGTH($TEXT(DOSE^PSSOPKI1))
DO DOSE^PSSORUTL(.ORDOSE,ORWPSOI,PSTYPE,ORVP)
+8 ; dflt doses NEW PKI CODE from pharmacy
IF $LENGTH($TEXT(DOSE^PSSOPKI1))
DO DOSE^PSSOPKI1(.ORDOSE,ORWPSOI,PSTYPE,ORVP)
+9 ; nfi text
DO EN^PSSDIN(ORWPSOI)
+10 ;PKI
SET ORY=""
+11 IF $DATA(ORDOSE("DEA"))
SET X=""
SET X1=$PIECE(ORDOSE("DEA"),";")
SET X2=$PIECE(ORDOSE("DEA"),";",2)
Begin DoDot:1
+12 IF '$LENGTH(X2)
QUIT
+13 IF $GET(PKIACTIV)
SET X=X2
End DoDot:1
+14 SET ORY=X
+15 KILL ^TMP("PSJINS",$JOB),^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB),^TMP("PSJSCH",$JOB),^TMP("PSSDIN",$JOB)
+16 QUIT
PRIOR ; from DLGSLCT, get list of allowed priorities
+1 NEW X,XREF
+2 SET XREF=$SELECT(PSTYPE="O":"S.PSO",1:"S.PSJ")
+3 SET X=""
FOR
SET X=$ORDER(^ORD(101.42,XREF,X))
IF '$LENGTH(X)
QUIT
Begin DoDot:1
+4 IF XREF["PSJ"
IF X'="ASAP"
IF X'="ROUTINE"
IF X'="STAT"
QUIT
+5 SET ILST=ILST+1
SET LST(ILST)="i"_$ORDER(^ORD(101.42,XREF,X,0))_U_X
End DoDot:1
+6 SET ILST=ILST+1
SET LST(ILST)="d"_$ORDER(^ORD(101.42,"B","ROUTINE",0))_U_"ROUTINE"
+7 QUIT
DEFPICK(LOC) ; return default routing
+1 NEW X,DLG,PRMT
+2 SET DLG=$ORDER(^ORD(101.41,"AB","PSO OERR",0))
SET X=""
+3 SET PRMT=$ORDER(^ORD(101.41,"AB","OR GTX ROUTING",0))
+4 IF $DATA(^TMP("ORECALL",$JOB,+DLG,+PRMT,1))
SET X=^(1)
+5 ; EDITONLY used by default action
IF X'=""
SET EDITONLY=1
QUIT X
+6 ;
+7 ;S X=$$GET^XPAR("ALL^"_"LOC.`"_LOC,"ORWDPS ROUTING DEFAULT",1,"I")
+8 SET X=$$GET^XPAR("LOC.`"_LOC_"^SYS","ORWDPS ROUTING DEFAULT",1,"I")
+9 IF X="C"
SET X="C^in Clinic"
GOTO XPICK
+10 IF X="M"
SET X="M^by Mail"
GOTO XPICK
+11 IF X="W"
SET X="W^at Window"
GOTO XPICK
+12 IF X="N"
SET X=""
GOTO XPICK
+13 IF X=""
SET X=$SELECT($DATA(^PSX(550,"C")):"M^by Mail",1:"W^at Window")
XPICK QUIT X
+1 ;
DEFSPLY(DFN) ; return default days supply for this patient
+1 NEW ORWX
+2 SET ORWX("PATIENT")=DFN
+3 DO DSUP^PSOSIGDS(.ORWX)
+4 QUIT $GET(ORWX("DAYS SUPPLY"))
+5 ;
DFLTSPLY(VAL,UPD,SCH,PAT,DRG) ; return days supply given quantity
+1 ; VAL: default days supply
+2 NEW ORWX,I
+3 SET ORWX("PATIENT")=PAT
+4 IF DRG
SET ORWX("DRUG")=DRG
+5 FOR I=1:1:$LENGTH(UPD,U)-1
Begin DoDot:1
+6 SET ORWX("DOSE ORDERED",I)=$PIECE(UPD,U,I)
+7 SET ORWX("SCHEDULE",I)=$PIECE(SCH,U,I)
End DoDot:1
+8 DO DSUP^PSOSIGDS(.ORWX)
+9 SET VAL=$GET(ORWX("DAYS SUPPLY"))
+10 QUIT
DISPMSG() ; return 1 to suppress dispense message
+1 QUIT +$$GET^XPAR("ALL","ORWDPS SUPPRESS DISPENSE MSG",1,"I")
+2 ;
DOWSCH(LST,DFN,LOCIEN) ; return all schedules
+1 NEW CNT,FREQ,ILST,ORARRAY,WIEN
+2 SET WIEN=$$WARDIEN^ORWDPS32(+$GET(LOCIEN))
+3 DO SCHED^PSS51P1(WIEN,.ORARRAY)
+4 SET ILST=0
+5 SET CNT=0
FOR
SET CNT=$ORDER(ORARRAY(CNT))
IF CNT'>0
QUIT
Begin DoDot:1
+6 SET NODE=$GET(ORARRAY(CNT))
+7 IF $PIECE(NODE,U,4)="C"
Begin DoDot:2
+8 KILL ^TMP($JOB,"ORWDPS1 DOWSCH")
+9 DO ZERO^PSS51P1($PIECE(NODE,U),,,,"ORWDPS1 DOWSCH")
+10 SET FREQ=$GET(^TMP($JOB,"ORWDPS1 DOWSCH",$PIECE(NODE,U),2))
+11 KILL ^TMP($JOB,"ORWDPS1 DOWSCH")
+12 IF +FREQ=0
QUIT
+13 IF +FREQ>1440
QUIT
+14 SET ILST=ILST+1
SET LST(ILST)=$PIECE(ORARRAY(CNT),U,2,5)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
SCHALL(LST,DFN,LOCIEN) ; return all schedules
+1 NEW CNT,ILST,ORARRAY,WIEN
+2 SET WIEN=$$WARDIEN^ORWDPS32(+$GET(LOCIEN))
+3 DO SCHED^PSS51P1(WIEN,.ORARRAY)
+4 SET ILST=0
+5 SET CNT=0
FOR
SET CNT=$ORDER(ORARRAY(CNT))
IF CNT'>0
QUIT
Begin DoDot:1
+6 SET ILST=ILST+1
SET LST(ILST)=$PIECE(ORARRAY(CNT),U,2,5)
End DoDot:1
+7 QUIT
+8 ;
FORMALT(ORLST,ORIEN,PSTYPE) ; return a list of formulary alternatives
+1 NEW PSID,I
+2 SET ORIEN=+$PIECE(^ORD(101.43,ORIEN,0),U,2)
+3 DO EN1^PSSUTIL1(.ORIEN,PSTYPE)
+4 SET PSID=0
SET I=0
+5 FOR
SET PSID=$ORDER(ORIEN(PSID))
IF 'PSID
QUIT
Begin DoDot:1
+6 SET OI=+$ORDER(^ORD(101.43,"ID",PSID_";99PSP",0))
+7 IF OI
SET I=I+1
SET ORLST(I)=OI
SET $PIECE(ORLST(I),U,2)=$PIECE(^ORD(101.43,OI,0),U)
End DoDot:1
+8 QUIT
DOSEALT(LST,DDRUG,CUROI,PSTYPE) ; return a list of formulary alternatives for dose
+1 NEW I,OI,ORWLST,ILST
SET ILST=0
+2 DO ENRFA^PSJORUTL(DDRUG,PSTYPE,.ORWLST)
+3 SET I=0
FOR
SET I=$ORDER(ORWLST(I))
IF 'I
QUIT
Begin DoDot:1
+4 SET OI=+$ORDER(^ORD(101.43,"ID",+$PIECE(ORWLST(I),U,4)_";99PSP",0))
+5 IF OI
IF OI'=CUROI
SET ILST=ILST+1
SET LST(ILST)=OI_U_$PIECE(^ORD(101.43,OI,0),U)
End DoDot:1
+6 QUIT
QOMEDALT(ORY,ODIEN) ;
+1 NEW ARRAY,IDIEN,ORDERID,PKG,PSTYPE,VALUE
+2 SET ORY=0
SET PKG=+$PIECE(^ORD(101.41,ODIEN,0),U,7)
+3 SET PSTYPE=$SELECT($$GET1^DIQ(9.4,PKG_",",1)="PSO":"O",1:"I")
+4 SET ORDERID=$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",""))
IF ORDERID'>0
QUIT
+5 SET IDIEN=$ORDER(^ORD(101.41,ODIEN,6,"D",ORDERID,""))
IF IDIEN'>0
QUIT
+6 SET VALUE=$GET(^ORD(101.41,ODIEN,6,IDIEN,1))
IF VALUE'>0
QUIT
+7 IF $PIECE($GET(^ORD(101.43,VALUE,"PS")),U,6)=1
SET ORY=VALUE
+8 ;D FORMALT(.ARRAY,VALUE,PSTYPE) I $D(ARRAY)>0 S ORY=VALUE
+9 ;I ORY=0,$P($G(^ORD(101.43,VALUE,"PS")),U,6)=1 S ORY=VALUE
+10 QUIT
FAILDEA(FAIL,OI,ORNP,PSTYPE) ; return 1 if DEA check fails for this provider
+1 NEW DEAFLG,PSOI,TPKG
+2 SET FAIL=0
SET TPKG=$PIECE($GET(^ORD(101.43,+$GET(OI),0)),U,2)
+3 IF TPKG'["PS"
QUIT
+4 SET PSOI=+TPKG
IF PSOI'>0
QUIT
+5 IF '$LENGTH($TEXT(OIDEA^PSSUTLA1))
QUIT
+6 SET DEAFLG=$$OIDEA^PSSUTLA1(PSOI,PSTYPE)
IF DEAFLG'>0
QUIT
+7 IF '$LENGTH($$DEA^XUSER(,+$GET(ORNP)))
SET FAIL=1
+8 QUIT
FDEA1(FAIL,OI,OITYPE,ORNP) ; only be called for an outpaitent and IV dialog
+1 ;OI: IV Orderable Item
+2 ;OITYPE: A:ADDITIVE S:SOLUTION
+3 NEW DEAFLG,PSOI,TKPG
+4 SET FAIL=0
SET TPKG=$PIECE($GET(^ORD(101.43,+$GET(OI),0)),U,2)
+5 IF TPKG'["PS"
QUIT
+6 SET PSOI=+TPKG
IF PSOI'>0
QUIT
+7 IF '$LENGTH($TEXT(IVDEA^PSSUTIL1))
QUIT
+8 SET DEAFLG=$$IVDEA^PSSUTIL1(PSOI,OITYPE)
IF DEAFLG'>0
QUIT
+9 IF '$LENGTH($PIECE($GET(^VA(200,+$GET(ORNP),"PS")),U,2))
IF '$LENGTH($PIECE($GET(^("PS")),U,3))
SET FAIL=1
+10 QUIT
+11 ;
CHK94(VAL) ; return 1 if patch 94 has been installed
+1 SET VAL=0
+2 IF $ORDER(^ORD(101.41,"B","PS MEDS",0))
SET VAL=1
+3 QUIT
LOCPICK(Y,LOC) ; return default Location level routing
+1 SET Y=""
+2 SET Y=$$GET^XPAR("LOC.`"_LOC_"^SYS","ORWDPS ROUTING DEFAULT",1,"I")
+3 IF Y="C"
SET Y="C^in Clinic"
+4 IF Y="M"
SET Y="M^by Mail"
+5 IF Y="W"
SET Y="W^at Window"
+6 IF Y="N"
SET Y=""
+7 QUIT
HASOIPI(Y,QOID) ; Check if QO put orderable item's PI into Sig
+1 NEW PIIEN,OIX
+2 SET Y=0
+3 IF '$DATA(^ORD(101.41,QOID,0))
QUIT
+4 SET PIIEN=$ORDER(^ORD(101.41,"B","OR GTX PATIENT INSTRUCTIONS",0))
+5 IF 'PIIEN
QUIT
+6 SET OIX=0
+7 IF '$DATA(^ORD(101.41,QOID,6,"D"))
QUIT
+8 FOR
SET OIX=$ORDER(^ORD(101.41,+QOID,6,"D",OIX))
IF 'OIX
QUIT
Begin DoDot:1
+9 IF OIX=PIIEN
SET Y=1
QUIT
End DoDot:1
+10 QUIT
HASROUTE(Y,QOID) ;Check if QO has a ROUTE defined
+1 NEW ROUTID
+2 SET Y=0
SET ROUTID=0
+3 SET ROUTID=$ORDER(^ORD(101.41,"B","OR GTX ROUTING",0))
+4 IF 'ROUTID
QUIT
+5 IF '$DATA(^ORD(101.41,+QOID))
QUIT
+6 IF $DATA(^ORD(101.41,+QOID,6,"D",ROUTID))
SET Y=1
+7 QUIT
QOCHECK(ORY,DIEN) ;
+1 NEW ARY,DG,FORMIEN,NAME,OI,OIIEN,ORDIALOG,ORPKG,TYPE
+2 SET ORPKG=$$NMSP^ORCD($PIECE($GET(^ORD(101.41,DIEN,0)),U,7))
IF ORPKG'["PS"
QUIT
+3 SET DG=$PIECE(^ORD(101.41,DIEN,0),U,5)
+4 SET NAME=$PIECE(^ORD(100.98,DIEN,0),U)
+5 SET TYPE=$SELECT(NAME="INPATIENT MEDICATIONS":"I",NAME="OUTPATIENT MEDICATIONS":"O",1:"")
+6 IF TYPE=""
QUIT
+7 SET ORDIALOG=$$DEFDLG^ORCD(DIEN)
IF ORDIALOG
QUIT
+8 DO GETDLG^ORCD(ORDIALOG)
DO GETORDER^ORCD("^ORD(101.41,"_DIEN_",6)")
+9 IF $DATA(ORDIALOG)'>0
QUIT
+10 SET OI=$PIECE($GET(ORDIALOG("B","ORDERABLE")),U,2)
IF OI'>0
QUIT
+11 SET OIIEN=$GET(ORDIALOG(OI,1))
IF OIIEN'>0
QUIT
+12 DO FORMALT(.ARY,OIIEN,TYPE)
IF $DATA(ARY)'>0
QUIT
+13 SET ORY=OIIEN
+14 QUIT
