BGP6D51 ; IHS/CMI/LAB - measure I2 26 Mar 2015 10:09 AM ;
;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
;
ICRSAMM ;EP
K ^TMP($J,"A"),^TMP($J,"MEDS")
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
I BGPAGEB<18 S BGPSTOP=1 Q ;18 and older
S BGPC1B=($E(BGPBDATE,1,3)-1)_$E(BGPBDATE,4,7)
S BGPC1=$$CRIT1DEN(DFN,$$FMADD^XLFDT(BGPC1B,120),$$FMADD^XLFDT(BGPBDATE,120)) ;set equal to index start date
K ^TMP($J,"A")
I BGPC1="" S BGPSTOP=1 Q ;no dx of depression
S BGPC2=$$CRIT2DEN(DFN,$$FMADD^XLFDT($P(BGPC1,U,2),-30),$$FMADD^XLFDT($P(BGPC1,U,2),14)) ;set equal prescription start date
K ^TMP($J,"MEDS")
I BGPC2="" S BGPSTOP=1 Q ;no prescription filled, therefore does not meet criteria 2 for denominator
S BGPE=$$EXCL(DFN,$P(BGPC1,U),$P(BGPC2,U),$P(BGPC1,U,2))
I BGPE S BGPSTOP=1 Q ;met an exclusion criteria so don't count in denominator
;S BGPN1=$$OPC(DFN,$$FMADD^XLFDT($P(BGPC1,U,2),1),$$FMADD^XLFDT($P(BGPC1,U,2),84))
S BGPN2=$$EAPT^BGP6D52(DFN,$P(BGPC2,U),$$FMADD^XLFDT($P(BGPC2,U),114),84,30,114)
S BGPN3=$$EAPT^BGP6D52(DFN,$P(BGPC2,U),$$FMADD^XLFDT($P(BGPC2,U),231),180,51,231)
I BGPACTCB S BGPD1=1
I BGPACTUP S BGPD2=1
S BGPVALUE=$S($G(BGPRTYPE)=3:"AC+BH",BGPD1:"UP,AC+BH",1:"UP")
S BGPV="IPSD: "_$$DATE^BGP6UTL($P(BGPC1,U,2))
;S BGPV=BGPV_$S(BGPN1:"; OPC",1:"; NOT OPC")
I BGPN2 S BGPV=BGPV_$S(BGPV]"":"; ",1:"")_"APT"
I 'BGPN2 S BGPV=BGPV_$S(BGPV]"":"; ",1:"")_"NOT APT: "_$P(BGPN2,U,3)
I BGPN3 S BGPV=BGPV_$S(BGPV]"":"; ",1:"")_"CONPT"
I 'BGPN3 S BGPV=BGPV_$S(BGPV]"":"; ",1:"")_"NOT CONPT: "_$P(BGPN3,U,3)
;S BGPVALUE=BGPVALUE_" IPSD: "_$$DATE^BGP6UTL($P(BGPC1,U,2))_"|||"_BGPV
S BGPVALUE=BGPVALUE_"|||"_BGPV
K %,A,B,C,D,E,F,G,H,J,K,M,N,O,P,Q,R,S,T,T1,T2,V,W,X,Y,Z
Q
NDC(A,B) ;
;a is drug ien
;b is taxonomy ien
S BGPNDC=$P($G(^PSDRUG(A,2)),U,4)
I BGPNDC]"",B,$D(^ATXAX(B,21,"B",BGPNDC)) Q 1
Q 0
CRIT1DEN(P,BDATE,EDATE) ;
K Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z
K ^TMP($J,"A")
K S,Q
S G="",S=0
S T=$O(^ATXAX("B","BGP MAJOR DEPRESSION (ADM)",0))
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q ""
S X="",G="" F S X=$O(^TMP($J,"A",X),-1) Q:X="" S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:"EC"[$P(^AUPNVSIT(V,0),U,7)
.Q:'$D(^AUPNVPOV("AD",V)) ;NO POVS
.S Y=$$PRIMPOV^APCLV(V,"I") ;get primary pov
.I $$ICD^BGP6UTL2(Y,T,9) S S($P($P(^AUPNVSIT(V,0),U),"."))=$S($P(^AUPNVSIT(V,0),U,7)'="H":$P($P(^AUPNVSIT(V,0),U),"."),1:$$DSCHDATE^APCLV(V,"I"))_U_V,G=1 Q ;had one primary dx of major depression
.K Q S (C,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y D
..Q:'$D(^AUPNVPOV(Y,0))
..S C=C+1
..S Q(C)=Y_U_$P(^AUPNVPOV(Y,0),U,12)_U_$P(^AUPNVPOV(Y,0),U)
..Q
.S (Y,F)=0 F S Y=$O(Q(Y)) Q:Y'=+Y I $P(Q(Y),U,2)="P" K Q(Y) S F=1 ;has one marked as primary so kill it
.I '$O(Q(0)) Q ;no more povs left
.I 'F S Y=$O(Q(0)) I Y K Q(Y) ;kill off first one if none marked as primary
.;now go through and see if any are depression
.S F=0 F S Y=$O(Q(Y)) Q:Y'=+Y I $$ICD^BGP6UTL2($P(Q(Y),U,3),T,9) S F=1
.I F=1,$P(^AUPNVSIT(V,0),U,7)="H" S S($P($P(^AUPNVSIT(V,0),U),"."))=$$DSCHDATE^APCLV(V,"I")_U_V,G=1 Q
.I F=1 S D=$P($P(^AUPNVSIT(V,0),U,1),".") I '$D(S(D)) S S(D)=D_U_V,S=S+1
.Q
K ^TMP($J,"A")
;I G]"" Q G
I G S Y=$O(S(0)) Q Y_U_S(Y)
I S>1 S Y=$O(S(0)) Q Y_U_S(Y)
Q ""
CRIT2DEN(P,BDATE,EDATE) ;
K Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z
;see if there ACTIVE PRESCRIPTION of beta blockers in time window
K ^TMP($J,"MEDS")
S BGPG=""
S Y="^TMP($J,""MEDS"",",X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S T=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT MEDS",0))
S T2=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT NDC",0))
S X=0 F S X=$O(^TMP($J,"MEDS",X)) Q:X'=+X!(BGPG]"") S Y=+$P(^TMP($J,"MEDS",X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S V=$P(^AUPNVMED(Y,0),U,3)
.S G=0
.S D=$P(^AUPNVMED(Y,0),U)
.I $P(^AUPNVMED(Y,0),U,8)=$P($P(^AUPNVSIT(V,0),U),".") Q ;date discont=visit
.I T,$D(^ATXAX(T,21,"B",D))!($$NDC(D,T2)) S BGPG=$P($P(^AUPNVSIT(V,0),U),".")_U_V_U_Y Q
.;S C=$P($G(^PSDRUG(D,0)),U,2)
.;I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S BGPG=$P($P(^AUPNVSIT(V,0),U),".")_U_V_U_Y Q
K ^TMP($J,"MEDS")
Q BGPG
EXCL(P,ISD,PSD,ISD1) ;
K Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z
;S %=P_"^ALL DX [BGP MAJOR DEPRESSION PRIOR;DURING "_$$FMADD^XLFDT(ISD,-120)_"-"_$$FMADD^XLFDT(ISD,-1),E=$$START1^APCLDF(%,"BGPG(")
;I $D(BGPG(1)) Q 1 ;HAD A VISIT PRIOR WITH DX
;now check for prescriptions
K ^TMP($J,"MEDS")
S BGPG=""
S Y="^TMP($J,""MEDS"",",X=P_"^ALL MED;DURING "_$$FMADD^XLFDT(PSD,-90)_"-"_$$FMADD^XLFDT(PSD,-1) S E=$$START1^APCLDF(X,Y)
S T=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT MEDS",0))
S T2=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT VA CLASS",0))
S X=0 F S X=$O(^TMP($J,"MEDS",X)) Q:X'=+X!(BGPG]"") S Y=+$P(^TMP($J,"MEDS",X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S V=$P(^AUPNVMED(Y,0),U,3)
.S G=0
.S D=$P(^AUPNVMED(Y,0),U)
.I $P(^AUPNVMED(Y,0),U,8)=$P($P(^AUPNVSIT(V,0),U),".") Q ;date discont=visit
.I T,$D(^ATXAX(T,21,"B",D))!($$NDC(D,T2)) S BGPG=$P($P(^AUPNVSIT(V,0),U),".")_U_V_U_Y Q
.;S C=$P($G(^PSDRUG(D,0)),U,2)
.;I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S BGPG=$P($P(^AUPNVSIT(V,0),U),".")_U_V_U_Y Q
K ^TMP($J,"MEDS")
I BGPG]"" Q 1
Q ""
OPC(P,BDATE,EDATE) ;
;3 visits or 2 visits and a telephone call
;A=# of outpt mental hlth visits
;B=# of outpt non mh visits
;C=# prescribing provider visits
;D=# of telephone calls for mh visits
K Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z,C
K ^TMP($J,"A")
S Z="^TMP($J,""A"",",%=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,Z)
I '$D(^TMP($J,"A",1)) Q ""
S (A,B,C,D)=0
S X=0,G="" F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G]"") S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:$$CLINIC^APCLV(V,"C")=30
.I $$MHO(V) S A=A+1,A(V)="" I $$PPCHK(V) S C=C+1,C(V)="" Q
.I $$MHT(V) S D=D+1,D(V)="" I $$PPCHK(V) S C=C+1,C(V)="" Q
.I $$NMHO(V) S A=A+1,A(V)="" I $$PPCHK(V) S C=C+1,C(V)="" Q
;NOW CHECK BH AND ADD IN VISITS
S E=9999999-BDATE,J=9999999-EDATE-1_".99" F S J=$O(^AMHREC("AE",P,J)) Q:J'=+J!($P(J,".")>E) S V=0 F S V=$O(^AMHREC("AE",P,J,V)) Q:V'=+V D
.Q:'$D(^AMHREC(V,0))
.S Y=$P(^AMHREC(V,0),U,16)
.I Y,$D(A(Y)) Q ;already checked this visit
.I Y,$D(B(Y)) Q
.I Y,$D(C(Y)) Q
.I Y,$D(D(Y)) Q
.S X=$P(^AMHREC(V,0),U,25) I X,$P($G(^DIC(40.7,X,0)),U,2)=30 Q
.S X=$P(^AMHREC(V,0),U,7) I X,$P($G(^AMHTSET(X,0)),U,2)=9 Q
.I $$BHMHO(V) S A=A+1 I $$PPCHK(V) S C=C+1 Q
.I $$BHMHT(V) S D=D+1 I $$PPCHK(V) S C=C+1 Q
.I $$BHNMHO(V) S A=A+1 I $$PPCHK(V) S C=C+1 Q
K ^TMP($J,"A")
I A>2,C Q 1
I A=2,D>0,C Q 1
Q ""
CPTV(V,T) ;does this visit have a cpt code in taxonomy T
NEW X,G,Z
I $G(T)="" Q ""
I '$G(V) Q ""
S T=$O(^ATXAX("B",T,0))
I '$G(T) W BGPBOMB Q ""
I '$D(^AUPNVSIT(V,0)) Q ""
S G=0
S X=$P(^AUPNVSIT(V,0),U,17) I X,$$ICD^BGP6UTL2(X,T,1) Q 1
S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G) D
.Q:'$D(^AUPNVCPT(X,0))
.S Z=$P(^AUPNVCPT(X,0),U)
.I $$ICD^BGP6UTL2(Z,T,1) S G=1
.Q
Q G
POVV(V,T) ;does this visit have a pov of a code in taxonomy T
NEW X,G,Z
I $G(T)="" Q ""
I '$G(V) Q ""
S T=$O(^ATXAX("B",T,0))
I '$G(T) W BGPBOMB Q ""
I '$D(^AUPNVSIT(V,0)) Q ""
S G=0
S X=0 F S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X!(G) D
.Q:'$D(^AUPNVPOV(X,0))
.S Z=$P(^AUPNVPOV(X,0),U)
.I $$ICD^BGP6UTL2(Z,T,9) S G=1
.Q
Q G
PRVV(V,T) ;does this visit have a primary provider with a class in taxonomy T
NEW X
I $G(T)="" Q ""
I '$G(V) Q ""
S T=$O(^ATXAX("B",T,0))
I '$G(T) W BGPBOMB Q ""
I '$D(^AUPNVSIT(V,0)) Q ""
S X=$$PRIMPROV^APCLV(V,"F")
I X="" Q ""
I $D(^ATXAX(T,21,"B",X)) Q 1
Q 0
MHO(V) ;EP
I '$$PRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
I "AOS"[$P(^AUPNVSIT(V,0),U,7),$$CPTV(V,"BGP OPT MH VISIT CPTS MH")!($$POVV(V,"BGP OPT MH VISIT POVS")) Q 1
I "AOS"[$P(^AUPNVSIT(V,0),U,7),($P(^AUPNVSIT(V,0),U,6)=$P($G(^BGPSITE(DUZ(2),0)),U,2)!($$CLINIC^APCLV(V,"C")=11)) Q 1
Q 0
MHT(V) ;EP
I '$$PRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
I $P(^AUPNVSIT(V,0),U,7)="T" Q 1
Q 0
PPCHK(V) ;EP
I $$PRVV(V,"BGP PRESCRIBING PROVIDER CLASS") Q 1
Q 0
NMHO(V) ;EP
I $$PRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
I "AOS"[$P(^AUPNVSIT(V,0),U,7),$$CPTV(V,"BGP MH OPT VISIT CPT NMH 1") Q 1
I "AOST"[$P(^AUPNVSIT(V,0),U,7)!($P(^AUPNVSIT(V,0),U,6)=$P($G(^BGPSITE(DUZ(2),0)),U,2))!($$CLINIC^APCLV(V,"C")=11),$$POVV(V,"BGP OPT MH VISIT POVS") Q 1
I "AOS"[$P(^AUPNVSIT(V,0),U,7),$$CPTV(V,"BGP MH OPT VISIT CPT NMH 3"),$$POVV(V,"BGP OPT MH VISIT POVS") Q 1
Q 0
BHCPTV(V,T) ;does this visit have a cpt code in taxonomy T
NEW X,G,Z
I $G(T)="" Q ""
I '$G(V) Q ""
S T=$O(^ATXAX("B",T,0))
I '$G(T) W BGPBOMB Q ""
I '$D(^AMHREC(V,0)) Q ""
S G=0
S X=0 F S X=$O(^AMHRPROC("AD",V,X)) Q:X'=+X!(G) D
.Q:'$D(^AMHRPROC(X,0))
.S Z=$P(^AMHRPROC(X,0),U)
.I $$ICD^BGP6UTL2(Z,T,1) S G=1
.Q
Q G
BHPOVV(V,T) ;does this visit have a pov of a code in taxonomy T
NEW X,G,Z
I $G(T)="" Q ""
I '$G(V) Q ""
S T=$O(^ATXAX("B",T,0))
I '$G(T) W BGPBOMB Q ""
I '$D(^AUPNVSIT(V,0)) Q ""
S G=0
S X=0 F S X=$O(^AMHRPRO("AD",V,X)) Q:X'=+X!(G) D
.Q:'$D(^AMHRPRO(X,0))
.S Z=$P(^AMHRPRO(X,0),U)
.I Z="" Q
.S Z=$P($G(^AMHPROB(Z,0)),U,5)
.I Z="" Q
.;S Z=$O(^ICD9("AB",Z,0))
.S Z=+$$CODEN^BGP6UTL2(Z,80)
.I Z'>0 Q
.I $$ICD^BGP6UTL2(Z,T,9) S G=1
.Q
Q G
BHPRVV(V,T) ;does this visit have a primary provider with a class in taxonomy T
NEW X,G,Y
I $G(T)="" Q ""
I '$G(V) Q ""
S T=$O(^ATXAX("B",T,0))
I '$G(T) W BGPBOMB Q ""
S G=0
S X=0 F S X=$O(^AMHRPROV("AD",V,X)) Q:X'=+X!(G) D
.Q:'$D(^AMHRPROV(X,0))
.I $P(^AMHRPROV(X,0),U,4)="P" S Y=$P(^AMHRPROV(X,0),U) I Y S G=$P($G(^VA(200,Y,53.5)),U)
I 'G Q ""
I $D(^ATXAX(T,21,"B",G)) Q 1
Q 0
BHMHO(V) ;EP
I '$$BHPRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
I $$BHOTOC(V),$$BHCPTV(V,"BGP OPT MH VISIT CPTS MH")!($$BHPOVV(V,"BGP OPT MH VISIT POVS")) Q 1
I $$BHOTOC(V),($P(^AMHREC(V,0),U,4)=$P($G(^BGPSITE(DUZ(2),0)),U,2)!($$BHCLINIC(V,"C")=11)) Q 1
Q ""
BHMHT(V) ;EP
I '$$BHPRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
I $$BHTTOC(V) Q 1
Q 0
BHPPCHK(V) ;EP
I $$BHPRVV(V,"BGP PRESCRIBING PROVIDER CLASS") Q 1
Q 0
BHNMHO(V) ;EP
I $$BHPRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
I $$BHOTOC(V),$$BHCPTV(V,"BGP MH OPT VISIT CPT NMH 1") Q 1
I $$BHOTOC(V)!($$BHOTOC(V))!($P(^AMHREC(V,0),U,4)=$P($G(^BGPSITE(DUZ(2),0)),U,2))!($$CLINIC^APCLV(V,"C")=11),$$POVV(V,"BGP OPT MH VISIT POVS") Q 1
I $$BHOTOC(V),$$BHCPTV(V,"BGP MH OPT VISIT CPT NMH 3"),$$BHPOVV(V,"BGP OPT MH VISIT POVS") Q 1
Q 0
BHOTOC(V) ;EP is type of contact 2, 16
NEW X
S X=$P(^AMHREC(V,0),U,7)
I X="" Q ""
S X=$P($G(^AMHTSET(X,0)),U,2)
I X=2 Q 1
I X=16 Q 1
Q ""
BHCLINIC(V) ;EP
NEW X
I '$D(^AMHREC(V,0)) Q ""
S X=$P(^AMHREC(V,0),U,25)
I X="" Q ""
Q $P($G(^DIC(40.7,X,0)),U,2)
BHTTOC(V) ;EP is type of contact 8,15
NEW X
S X=$P(^AMHREC(V,0),U,7)
I X="" Q ""
S X=$P($G(^AMHTSET(X,0)),U,2)
I X=8 Q 1
I X=15 Q 1
Q ""
BGP6D51 ; IHS/CMI/LAB - measure I2 26 Mar 2015 10:09 AM ;
+1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
+2 ;
ICRSAMM ;EP
+1 KILL ^TMP($JOB,"A"),^TMP($JOB,"MEDS")
+2 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
+3 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
+4 ;18 and older
IF BGPAGEB<18
SET BGPSTOP=1
QUIT
+5 SET BGPC1B=($EXTRACT(BGPBDATE,1,3)-1)_$EXTRACT(BGPBDATE,4,7)
+6 ;set equal to index start date
SET BGPC1=$$CRIT1DEN(DFN,$$FMADD^XLFDT(BGPC1B,120),$$FMADD^XLFDT(BGPBDATE,120))
+7 KILL ^TMP($JOB,"A")
+8 ;no dx of depression
IF BGPC1=""
SET BGPSTOP=1
QUIT
+9 ;set equal prescription start date
SET BGPC2=$$CRIT2DEN(DFN,$$FMADD^XLFDT($PIECE(BGPC1,U,2),-30),$$FMADD^XLFDT($PIECE(BGPC1,U,2),14))
+10 KILL ^TMP($JOB,"MEDS")
+11 ;no prescription filled, therefore does not meet criteria 2 for denominator
IF BGPC2=""
SET BGPSTOP=1
QUIT
+12 SET BGPE=$$EXCL(DFN,$PIECE(BGPC1,U),$PIECE(BGPC2,U),$PIECE(BGPC1,U,2))
+13 ;met an exclusion criteria so don't count in denominator
IF BGPE
SET BGPSTOP=1
QUIT
+14 ;S BGPN1=$$OPC(DFN,$$FMADD^XLFDT($P(BGPC1,U,2),1),$$FMADD^XLFDT($P(BGPC1,U,2),84))
+15 SET BGPN2=$$EAPT^BGP6D52(DFN,$PIECE(BGPC2,U),$$FMADD^XLFDT($PIECE(BGPC2,U),114),84,30,114)
+16 SET BGPN3=$$EAPT^BGP6D52(DFN,$PIECE(BGPC2,U),$$FMADD^XLFDT($PIECE(BGPC2,U),231),180,51,231)
+17 IF BGPACTCB
SET BGPD1=1
+18 IF BGPACTUP
SET BGPD2=1
+19 SET BGPVALUE=$SELECT($GET(BGPRTYPE)=3:"AC+BH",BGPD1:"UP,AC+BH",1:"UP")
+20 SET BGPV="IPSD: "_$$DATE^BGP6UTL($PIECE(BGPC1,U,2))
+21 ;S BGPV=BGPV_$S(BGPN1:"; OPC",1:"; NOT OPC")
+22 IF BGPN2
SET BGPV=BGPV_$SELECT(BGPV]"":"; ",1:"")_"APT"
+23 IF 'BGPN2
SET BGPV=BGPV_$SELECT(BGPV]"":"; ",1:"")_"NOT APT: "_$PIECE(BGPN2,U,3)
+24 IF BGPN3
SET BGPV=BGPV_$SELECT(BGPV]"":"; ",1:"")_"CONPT"
+25 IF 'BGPN3
SET BGPV=BGPV_$SELECT(BGPV]"":"; ",1:"")_"NOT CONPT: "_$PIECE(BGPN3,U,3)
+26 ;S BGPVALUE=BGPVALUE_" IPSD: "_$$DATE^BGP6UTL($P(BGPC1,U,2))_"|||"_BGPV
+27 SET BGPVALUE=BGPVALUE_"|||"_BGPV
+28 KILL %,A,B,C,D,E,F,G,H,J,K,M,N,O,P,Q,R,S,T,T1,T2,V,W,X,Y,Z
+29 QUIT
NDC(A,B) ;
+1 ;a is drug ien
+2 ;b is taxonomy ien
+3 SET BGPNDC=$PIECE($GET(^PSDRUG(A,2)),U,4)
+4 IF BGPNDC]""
IF B
IF $DATA(^ATXAX(B,21,"B",BGPNDC))
QUIT 1
+5 QUIT 0
CRIT1DEN(P,BDATE,EDATE) ;
+1 KILL Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z
+2 KILL ^TMP($JOB,"A")
+3 KILL S,Q
+4 SET G=""
SET S=0
+5 SET T=$ORDER(^ATXAX("B","BGP MAJOR DEPRESSION (ADM)",0))
+6 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+7 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+8 SET X=""
SET G=""
FOR
SET X=$ORDER(^TMP($JOB,"A",X),-1)
IF X=""
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+9 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+10 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+11 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+12 IF "EC"[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+13 ;NO POVS
IF '$DATA(^AUPNVPOV("AD",V))
QUIT
+14 ;get primary pov
SET Y=$$PRIMPOV^APCLV(V,"I")
+15 ;had one primary dx of major depression
IF $$ICD^BGP6UTL2(Y,T,9)
SET S($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))=$SELECT($PIECE(^AUPNVSIT(V,0),U,7)'="H":$PIECE($PIECE(^AUPNVSIT(V,0),U),"."),1:$$DSCHDATE^APCLV(V,"I"))_U_V
SET G=1
QUIT
+16 KILL Q
SET (C,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+17 IF '$DATA(^AUPNVPOV(Y,0))
QUIT
+18 SET C=C+1
+19 SET Q(C)=Y_U_$PIECE(^AUPNVPOV(Y,0),U,12)_U_$PIECE(^AUPNVPOV(Y,0),U)
+20 QUIT
End DoDot:2
+21 ;has one marked as primary so kill it
SET (Y,F)=0
FOR
SET Y=$ORDER(Q(Y))
IF Y'=+Y
QUIT
IF $PIECE(Q(Y),U,2)="P"
KILL Q(Y)
SET F=1
+22 ;no more povs left
IF '$ORDER(Q(0))
QUIT
+23 ;kill off first one if none marked as primary
IF 'F
SET Y=$ORDER(Q(0))
IF Y
KILL Q(Y)
+24 ;now go through and see if any are depression
+25 SET F=0
FOR
SET Y=$ORDER(Q(Y))
IF Y'=+Y
QUIT
IF $$ICD^BGP6UTL2($PIECE(Q(Y),U,3),T,9)
SET F=1
+26 IF F=1
IF $PIECE(^AUPNVSIT(V,0),U,7)="H"
SET S($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))=$$DSCHDATE^APCLV(V,"I")_U_V
SET G=1
QUIT
+27 IF F=1
SET D=$PIECE($PIECE(^AUPNVSIT(V,0),U,1),".")
IF '$DATA(S(D))
SET S(D)=D_U_V
SET S=S+1
+28 QUIT
End DoDot:1
+29 KILL ^TMP($JOB,"A")
+30 ;I G]"" Q G
+31 IF G
SET Y=$ORDER(S(0))
QUIT Y_U_S(Y)
+32 IF S>1
SET Y=$ORDER(S(0))
QUIT Y_U_S(Y)
+33 QUIT ""
CRIT2DEN(P,BDATE,EDATE) ;
+1 KILL Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z
+2 ;see if there ACTIVE PRESCRIPTION of beta blockers in time window
+3 KILL ^TMP($JOB,"MEDS")
+4 SET BGPG=""
+5 SET Y="^TMP($J,""MEDS"","
SET X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+6 SET T=$ORDER(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT MEDS",0))
+7 SET T2=$ORDER(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT NDC",0))
+8 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"MEDS",X))
IF X'=+X!(BGPG]"")
QUIT
SET Y=+$PIECE(^TMP($JOB,"MEDS",X),U,4)
Begin DoDot:1
+9 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+10 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+11 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
+12 SET G=0
+13 SET D=$PIECE(^AUPNVMED(Y,0),U)
+14 ;date discont=visit
IF $PIECE(^AUPNVMED(Y,0),U,8)=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
QUIT
+15 IF T
IF $DATA(^ATXAX(T,21,"B",D))!($$NDC(D,T2))
SET BGPG=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")_U_V_U_Y
QUIT
+16 ;S C=$P($G(^PSDRUG(D,0)),U,2)
+17 ;I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S BGPG=$P($P(^AUPNVSIT(V,0),U),".")_U_V_U_Y Q
End DoDot:1
+18 KILL ^TMP($JOB,"MEDS")
+19 QUIT BGPG
EXCL(P,ISD,PSD,ISD1) ;
+1 KILL Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z
+2 ;S %=P_"^ALL DX [BGP MAJOR DEPRESSION PRIOR;DURING "_$$FMADD^XLFDT(ISD,-120)_"-"_$$FMADD^XLFDT(ISD,-1),E=$$START1^APCLDF(%,"BGPG(")
+3 ;I $D(BGPG(1)) Q 1 ;HAD A VISIT PRIOR WITH DX
+4 ;now check for prescriptions
+5 KILL ^TMP($JOB,"MEDS")
+6 SET BGPG=""
+7 SET Y="^TMP($J,""MEDS"","
SET X=P_"^ALL MED;DURING "_$$FMADD^XLFDT(PSD,-90)_"-"_$$FMADD^XLFDT(PSD,-1)
SET E=$$START1^APCLDF(X,Y)
+8 SET T=$ORDER(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT MEDS",0))
+9 SET T2=$ORDER(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT VA CLASS",0))
+10 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"MEDS",X))
IF X'=+X!(BGPG]"")
QUIT
SET Y=+$PIECE(^TMP($JOB,"MEDS",X),U,4)
Begin DoDot:1
+11 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+12 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+13 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
+14 SET G=0
+15 SET D=$PIECE(^AUPNVMED(Y,0),U)
+16 ;date discont=visit
IF $PIECE(^AUPNVMED(Y,0),U,8)=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
QUIT
+17 IF T
IF $DATA(^ATXAX(T,21,"B",D))!($$NDC(D,T2))
SET BGPG=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")_U_V_U_Y
QUIT
+18 ;S C=$P($G(^PSDRUG(D,0)),U,2)
+19 ;I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S BGPG=$P($P(^AUPNVSIT(V,0),U),".")_U_V_U_Y Q
End DoDot:1
+20 KILL ^TMP($JOB,"MEDS")
+21 IF BGPG]""
QUIT 1
+22 QUIT ""
OPC(P,BDATE,EDATE) ;
+1 ;3 visits or 2 visits and a telephone call
+2 ;A=# of outpt mental hlth visits
+3 ;B=# of outpt non mh visits
+4 ;C=# prescribing provider visits
+5 ;D=# of telephone calls for mh visits
+6 KILL Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z,C
+7 KILL ^TMP($JOB,"A")
+8 SET Z="^TMP($J,""A"","
SET %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,Z)
+9 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+10 SET (A,B,C,D)=0
+11 SET X=0
SET G=""
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G]"")
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+12 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+13 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+14 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+15 IF $$CLINIC^APCLV(V,"C")=30
QUIT
+16 IF $$MHO(V)
SET A=A+1
SET A(V)=""
IF $$PPCHK(V)
SET C=C+1
SET C(V)=""
QUIT
+17 IF $$MHT(V)
SET D=D+1
SET D(V)=""
IF $$PPCHK(V)
SET C=C+1
SET C(V)=""
QUIT
+18 IF $$NMHO(V)
SET A=A+1
SET A(V)=""
IF $$PPCHK(V)
SET C=C+1
SET C(V)=""
QUIT
End DoDot:1
+19 ;NOW CHECK BH AND ADD IN VISITS
+20 SET E=9999999-BDATE
SET J=9999999-EDATE-1_".99"
FOR
SET J=$ORDER(^AMHREC("AE",P,J))
IF J'=+J!($PIECE(J,".")>E)
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",P,J,V))
IF V'=+V
QUIT
Begin DoDot:1
+21 IF '$DATA(^AMHREC(V,0))
QUIT
+22 SET Y=$PIECE(^AMHREC(V,0),U,16)
+23 ;already checked this visit
IF Y
IF $DATA(A(Y))
QUIT
+24 IF Y
IF $DATA(B(Y))
QUIT
+25 IF Y
IF $DATA(C(Y))
QUIT
+26 IF Y
IF $DATA(D(Y))
QUIT
+27 SET X=$PIECE(^AMHREC(V,0),U,25)
IF X
IF $PIECE($GET(^DIC(40.7,X,0)),U,2)=30
QUIT
+28 SET X=$PIECE(^AMHREC(V,0),U,7)
IF X
IF $PIECE($GET(^AMHTSET(X,0)),U,2)=9
QUIT
+29 IF $$BHMHO(V)
SET A=A+1
IF $$PPCHK(V)
SET C=C+1
QUIT
+30 IF $$BHMHT(V)
SET D=D+1
IF $$PPCHK(V)
SET C=C+1
QUIT
+31 IF $$BHNMHO(V)
SET A=A+1
IF $$PPCHK(V)
SET C=C+1
QUIT
End DoDot:1
+32 KILL ^TMP($JOB,"A")
+33 IF A>2
IF C
QUIT 1
+34 IF A=2
IF D>0
IF C
QUIT 1
+35 QUIT ""
CPTV(V,T) ;does this visit have a cpt code in taxonomy T
+1 NEW X,G,Z
+2 IF $GET(T)=""
QUIT ""
+3 IF '$GET(V)
QUIT ""
+4 SET T=$ORDER(^ATXAX("B",T,0))
+5 IF '$GET(T)
WRITE BGPBOMB
QUIT ""
+6 IF '$DATA(^AUPNVSIT(V,0))
QUIT ""
+7 SET G=0
+8 SET X=$PIECE(^AUPNVSIT(V,0),U,17)
IF X
IF $$ICD^BGP6UTL2(X,T,1)
QUIT 1
+9 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+10 IF '$DATA(^AUPNVCPT(X,0))
QUIT
+11 SET Z=$PIECE(^AUPNVCPT(X,0),U)
+12 IF $$ICD^BGP6UTL2(Z,T,1)
SET G=1
+13 QUIT
End DoDot:1
+14 QUIT G
POVV(V,T) ;does this visit have a pov of a code in taxonomy T
+1 NEW X,G,Z
+2 IF $GET(T)=""
QUIT ""
+3 IF '$GET(V)
QUIT ""
+4 SET T=$ORDER(^ATXAX("B",T,0))
+5 IF '$GET(T)
WRITE BGPBOMB
QUIT ""
+6 IF '$DATA(^AUPNVSIT(V,0))
QUIT ""
+7 SET G=0
+8 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+9 IF '$DATA(^AUPNVPOV(X,0))
QUIT
+10 SET Z=$PIECE(^AUPNVPOV(X,0),U)
+11 IF $$ICD^BGP6UTL2(Z,T,9)
SET G=1
+12 QUIT
End DoDot:1
+13 QUIT G
PRVV(V,T) ;does this visit have a primary provider with a class in taxonomy T
+1 NEW X
+2 IF $GET(T)=""
QUIT ""
+3 IF '$GET(V)
QUIT ""
+4 SET T=$ORDER(^ATXAX("B",T,0))
+5 IF '$GET(T)
WRITE BGPBOMB
QUIT ""
+6 IF '$DATA(^AUPNVSIT(V,0))
QUIT ""
+7 SET X=$$PRIMPROV^APCLV(V,"F")
+8 IF X=""
QUIT ""
+9 IF $DATA(^ATXAX(T,21,"B",X))
QUIT 1
+10 QUIT 0
MHO(V) ;EP
+1 IF '$$PRVV(V,"BGP MENTAL HEALTH PROV CLASS")
QUIT ""
+2 IF "AOS"[$PIECE(^AUPNVSIT(V,0),U,7)
IF $$CPTV(V,"BGP OPT MH VISIT CPTS MH")!($$POVV(V,"BGP OPT MH VISIT POVS"))
QUIT 1
+3 IF "AOS"[$PIECE(^AUPNVSIT(V,0),U,7)
IF ($PIECE(^AUPNVSIT(V,0),U,6)=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2)!($$CLINIC^APCLV(V,"C")=11))
QUIT 1
+4 QUIT 0
MHT(V) ;EP
+1 IF '$$PRVV(V,"BGP MENTAL HEALTH PROV CLASS")
QUIT ""
+2 IF $PIECE(^AUPNVSIT(V,0),U,7)="T"
QUIT 1
+3 QUIT 0
PPCHK(V) ;EP
+1 IF $$PRVV(V,"BGP PRESCRIBING PROVIDER CLASS")
QUIT 1
+2 QUIT 0
NMHO(V) ;EP
+1 IF $$PRVV(V,"BGP MENTAL HEALTH PROV CLASS")
QUIT ""
+2 IF "AOS"[$PIECE(^AUPNVSIT(V,0),U,7)
IF $$CPTV(V,"BGP MH OPT VISIT CPT NMH 1")
QUIT 1
+3 IF "AOST"[$PIECE(^AUPNVSIT(V,0),U,7)!($PIECE(^AUPNVSIT(V,0),U,6)=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2))!($$CLINIC^APCLV(V,"C")=11)
IF $$POVV(V,"BGP OPT MH VISIT POVS")
QUIT 1
+4 IF "AOS"[$PIECE(^AUPNVSIT(V,0),U,7)
IF $$CPTV(V,"BGP MH OPT VISIT CPT NMH 3")
IF $$POVV(V,"BGP OPT MH VISIT POVS")
QUIT 1
+5 QUIT 0
BHCPTV(V,T) ;does this visit have a cpt code in taxonomy T
+1 NEW X,G,Z
+2 IF $GET(T)=""
QUIT ""
+3 IF '$GET(V)
QUIT ""
+4 SET T=$ORDER(^ATXAX("B",T,0))
+5 IF '$GET(T)
WRITE BGPBOMB
QUIT ""
+6 IF '$DATA(^AMHREC(V,0))
QUIT ""
+7 SET G=0
+8 SET X=0
FOR
SET X=$ORDER(^AMHRPROC("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+9 IF '$DATA(^AMHRPROC(X,0))
QUIT
+10 SET Z=$PIECE(^AMHRPROC(X,0),U)
+11 IF $$ICD^BGP6UTL2(Z,T,1)
SET G=1
+12 QUIT
End DoDot:1
+13 QUIT G
BHPOVV(V,T) ;does this visit have a pov of a code in taxonomy T
+1 NEW X,G,Z
+2 IF $GET(T)=""
QUIT ""
+3 IF '$GET(V)
QUIT ""
+4 SET T=$ORDER(^ATXAX("B",T,0))
+5 IF '$GET(T)
WRITE BGPBOMB
QUIT ""
+6 IF '$DATA(^AUPNVSIT(V,0))
QUIT ""
+7 SET G=0
+8 SET X=0
FOR
SET X=$ORDER(^AMHRPRO("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+9 IF '$DATA(^AMHRPRO(X,0))
QUIT
+10 SET Z=$PIECE(^AMHRPRO(X,0),U)
+11 IF Z=""
QUIT
+12 SET Z=$PIECE($GET(^AMHPROB(Z,0)),U,5)
+13 IF Z=""
QUIT
+14 ;S Z=$O(^ICD9("AB",Z,0))
+15 SET Z=+$$CODEN^BGP6UTL2(Z,80)
+16 IF Z'>0
QUIT
+17 IF $$ICD^BGP6UTL2(Z,T,9)
SET G=1
+18 QUIT
End DoDot:1
+19 QUIT G
BHPRVV(V,T) ;does this visit have a primary provider with a class in taxonomy T
+1 NEW X,G,Y
+2 IF $GET(T)=""
QUIT ""
+3 IF '$GET(V)
QUIT ""
+4 SET T=$ORDER(^ATXAX("B",T,0))
+5 IF '$GET(T)
WRITE BGPBOMB
QUIT ""
+6 SET G=0
+7 SET X=0
FOR
SET X=$ORDER(^AMHRPROV("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+8 IF '$DATA(^AMHRPROV(X,0))
QUIT
+9 IF $PIECE(^AMHRPROV(X,0),U,4)="P"
SET Y=$PIECE(^AMHRPROV(X,0),U)
IF Y
SET G=$PIECE($GET(^VA(200,Y,53.5)),U)
End DoDot:1
+10 IF 'G
QUIT ""
+11 IF $DATA(^ATXAX(T,21,"B",G))
QUIT 1
+12 QUIT 0
BHMHO(V) ;EP
+1 IF '$$BHPRVV(V,"BGP MENTAL HEALTH PROV CLASS")
QUIT ""
+2 IF $$BHOTOC(V)
IF $$BHCPTV(V,"BGP OPT MH VISIT CPTS MH")!($$BHPOVV(V,"BGP OPT MH VISIT POVS"))
QUIT 1
+3 IF $$BHOTOC(V)
IF ($PIECE(^AMHREC(V,0),U,4)=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2)!($$BHCLINIC(V,"C")=11))
QUIT 1
+4 QUIT ""
BHMHT(V) ;EP
+1 IF '$$BHPRVV(V,"BGP MENTAL HEALTH PROV CLASS")
QUIT ""
+2 IF $$BHTTOC(V)
QUIT 1
+3 QUIT 0
BHPPCHK(V) ;EP
+1 IF $$BHPRVV(V,"BGP PRESCRIBING PROVIDER CLASS")
QUIT 1
+2 QUIT 0
BHNMHO(V) ;EP
+1 IF $$BHPRVV(V,"BGP MENTAL HEALTH PROV CLASS")
QUIT ""
+2 IF $$BHOTOC(V)
IF $$BHCPTV(V,"BGP MH OPT VISIT CPT NMH 1")
QUIT 1
+3 IF $$BHOTOC(V)!($$BHOTOC(V))!($PIECE(^AMHREC(V,0),U,4)=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2))!($$CLINIC^APCLV(V,"C")=11)
IF $$POVV(V,"BGP OPT MH VISIT POVS")
QUIT 1
+4 IF $$BHOTOC(V)
IF $$BHCPTV(V,"BGP MH OPT VISIT CPT NMH 3")
IF $$BHPOVV(V,"BGP OPT MH VISIT POVS")
QUIT 1
+5 QUIT 0
BHOTOC(V) ;EP is type of contact 2, 16
+1 NEW X
+2 SET X=$PIECE(^AMHREC(V,0),U,7)
+3 IF X=""
QUIT ""
+4 SET X=$PIECE($GET(^AMHTSET(X,0)),U,2)
+5 IF X=2
QUIT 1
+6 IF X=16
QUIT 1
+7 QUIT ""
BHCLINIC(V) ;EP
+1 NEW X
+2 IF '$DATA(^AMHREC(V,0))
QUIT ""
+3 SET X=$PIECE(^AMHREC(V,0),U,25)
+4 IF X=""
QUIT ""
+5 QUIT $PIECE($GET(^DIC(40.7,X,0)),U,2)
BHTTOC(V) ;EP is type of contact 8,15
+1 NEW X
+2 SET X=$PIECE(^AMHREC(V,0),U,7)
+3 IF X=""
QUIT ""
+4 SET X=$PIECE($GET(^AMHTSET(X,0)),U,2)
+5 IF X=8
QUIT 1
+6 IF X=15
QUIT 1
+7 QUIT ""
