- BGP0D51 ; IHS/CMI/LAB - measure I2 ;
- ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- ;
- 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^BGP0D52(DFN,$P(BGPC2,U),$$FMADD^XLFDT($P(BGPC2,U),114),84,30,114)
- S BGPN3=$$EAPT^BGP0D52(DFN,$P(BGPC2,U),$$FMADD^XLFDT($P(BGPC2,U),231),180,51,231)
- I BGPACTCL S BGPD1=1
- I BGPACTUP S BGPD2=1
- S BGPVALUE=$S($G(BGPRTYPE)=3:"AC",BGPD1:"UP,AC",1:"UP")
- S 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,2)
- I BGPN3 S BGPV=BGPV_$S(BGPV]"":";",1:"")_"CONPT"
- I 'BGPN3 S BGPV=BGPV_$S(BGPV]"":";",1:"")_"NOT CONPT: "_$P(BGPN3,U,2)
- S BGPVALUE=BGPVALUE_" IESD: "_$$DATE^BGP0UTL($P(BGPC1,U,2))_"|||"_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^ATXCHK(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^ATXCHK($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))
- .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))
- .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
- ;now check for hospital stay
- K ^TMP($J,"A")
- S G="",S=0
- S T=$O(^ATXAX("B","BGP ACUTE MENTAL HEALTH",0))
- S T1=$O(^ATXAX("B","BGP SUBSTANCE ABUSE",0))
- S T2=$O(^ATXAX("B","BGP POISONINGS SUBSTANCE ABUSE",0))
- S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMADD^XLFDT(ISD1,1)_"-"_$$FMADD^XLFDT(ISD1,245),E=$$START1^APCLDF(B,A)
- 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:$P(^AUPNVSIT(V,0),U,7)'="H"
- .Q:'$D(^AUPNVPOV("AD",V)) ;NO POVS
- .S Y=$$PRIMPOV^APCLV(V,"I") ;get primary pov
- .I $$ICD^ATXCHK(Y,T,9) S G=$P($P(^AUPNVSIT(V,0),U),".")_U_V Q ;had one primary dx of major depression
- .I $$ICD^ATXCHK(Y,T1,9) S G=$P($P(^AUPNVSIT(V,0),U),".")_U_V Q
- .I $$ICD^ATXCHK(Y,T2,9) D Q
- ..;CHECK SECONDARY POVS FOR SUBSTANCE ABUSE
- ..S Q=$$PRIMPOV^APCLV(V,"I")
- ..S (F,W,Z)=0 F S W=$O(^AUPNVPOV("AD",V,W)) Q:W'=+W D
- ...Q:'$D(^AUPNVPOV(W,0))
- ...S Z=$P(^AUPNVPOV(W,0),U)
- ...Q:W=Q
- ...I $$ICD^ATXCHK(Z,T1,9) S G=$P($P(^AUPNVSIT(V,0),U),".")_U_V Q
- K ^TMP($J,"A")
- I G]"" 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^ATXCHK(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^ATXCHK(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^ATXCHK(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^ATXCHK(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^ICDCODE(Z,80)
- .I Z'>0 Q
- .I $$ICD^ATXCHK(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 ""
- BGP0D51 ; IHS/CMI/LAB - measure I2 ;
- +1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- +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 SET BGPN1=$$OPC(DFN,$$FMADD^XLFDT($PIECE(BGPC1,U,2),1),$$FMADD^XLFDT($PIECE(BGPC1,U,2),84))
- +15 SET BGPN2=$$EAPT^BGP0D52(DFN,$PIECE(BGPC2,U),$$FMADD^XLFDT($PIECE(BGPC2,U),114),84,30,114)
- +16 SET BGPN3=$$EAPT^BGP0D52(DFN,$PIECE(BGPC2,U),$$FMADD^XLFDT($PIECE(BGPC2,U),231),180,51,231)
- +17 IF BGPACTCL
- SET BGPD1=1
- +18 IF BGPACTUP
- SET BGPD2=1
- +19 SET BGPVALUE=$SELECT($GET(BGPRTYPE)=3:"AC",BGPD1:"UP,AC",1:"UP")
- +20 SET BGPV=$SELECT(BGPN1:"OPC",1:"NOT OPC")
- +21 IF BGPN2
- SET BGPV=BGPV_$SELECT(BGPV]"":";",1:"")_" APT"
- +22 IF 'BGPN2
- SET BGPV=BGPV_$SELECT(BGPV]"":";",1:"")_"NOT APT: "_$PIECE(BGPN2,U,2)
- +23 IF BGPN3
- SET BGPV=BGPV_$SELECT(BGPV]"":";",1:"")_"CONPT"
- +24 IF 'BGPN3
- SET BGPV=BGPV_$SELECT(BGPV]"":";",1:"")_"NOT CONPT: "_$PIECE(BGPN3,U,2)
- +25 SET BGPVALUE=BGPVALUE_" IESD: "_$$DATE^BGP0UTL($PIECE(BGPC1,U,2))_"|||"_BGPV
- +26 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
- +27 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^ATXCHK(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^ATXCHK($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 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
- +11 SET G=0
- +12 SET D=$PIECE(^AUPNVMED(Y,0),U)
- +13 ;date discont=visit
- IF $PIECE(^AUPNVMED(Y,0),U,8)=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
- QUIT
- +14 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
- +15 ;S C=$P($G(^PSDRUG(D,0)),U,2)
- +16 ;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
- +17 KILL ^TMP($JOB,"MEDS")
- +18 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 SET %=P_"^ALL DX [BGP MAJOR DEPRESSION PRIOR;DURING "_$$FMADD^XLFDT(ISD,-120)_"-"_$$FMADD^XLFDT(ISD,-1)
- SET E=$$START1^APCLDF(%,"BGPG(")
- +3 ;HAD A VISIT PRIOR WITH DX
- IF $DATA(BGPG(1))
- QUIT 1
- +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 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
- +13 SET G=0
- +14 SET D=$PIECE(^AUPNVMED(Y,0),U)
- +15 ;date discont=visit
- IF $PIECE(^AUPNVMED(Y,0),U,8)=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
- QUIT
- +16 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
- +17 ;S C=$P($G(^PSDRUG(D,0)),U,2)
- +18 ;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
- +19 KILL ^TMP($JOB,"MEDS")
- +20 IF BGPG]""
- QUIT 1
- +21 ;now check for hospital stay
- +22 KILL ^TMP($JOB,"A")
- +23 SET G=""
- SET S=0
- +24 SET T=$ORDER(^ATXAX("B","BGP ACUTE MENTAL HEALTH",0))
- +25 SET T1=$ORDER(^ATXAX("B","BGP SUBSTANCE ABUSE",0))
- +26 SET T2=$ORDER(^ATXAX("B","BGP POISONINGS SUBSTANCE ABUSE",0))
- +27 SET A="^TMP($J,""A"","
- SET B=P_"^ALL VISITS;DURING "_$$FMADD^XLFDT(ISD1,1)_"-"_$$FMADD^XLFDT(ISD1,245)
- SET E=$$START1^APCLDF(B,A)
- +28 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
- +29 IF '$DATA(^AUPNVSIT(V,0))
- QUIT
- +30 IF '$PIECE(^AUPNVSIT(V,0),U,9)
- QUIT
- +31 IF $PIECE(^AUPNVSIT(V,0),U,11)
- QUIT
- +32 IF $PIECE(^AUPNVSIT(V,0),U,7)'="H"
- QUIT
- +33 ;NO POVS
- IF '$DATA(^AUPNVPOV("AD",V))
- QUIT
- +34 ;get primary pov
- SET Y=$$PRIMPOV^APCLV(V,"I")
- +35 ;had one primary dx of major depression
- IF $$ICD^ATXCHK(Y,T,9)
- SET G=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")_U_V
- QUIT
- +36 IF $$ICD^ATXCHK(Y,T1,9)
- SET G=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")_U_V
- QUIT
- +37 IF $$ICD^ATXCHK(Y,T2,9)
- Begin DoDot:2
- +38 ;CHECK SECONDARY POVS FOR SUBSTANCE ABUSE
- +39 SET Q=$$PRIMPOV^APCLV(V,"I")
- +40 SET (F,W,Z)=0
- FOR
- SET W=$ORDER(^AUPNVPOV("AD",V,W))
- IF W'=+W
- QUIT
- Begin DoDot:3
- +41 IF '$DATA(^AUPNVPOV(W,0))
- QUIT
- +42 SET Z=$PIECE(^AUPNVPOV(W,0),U)
- +43 IF W=Q
- QUIT
- +44 IF $$ICD^ATXCHK(Z,T1,9)
- SET G=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")_U_V
- QUIT
- End DoDot:3
- End DoDot:2
- QUIT
- End DoDot:1
- +45 KILL ^TMP($JOB,"A")
- +46 IF G]""
- QUIT 1
- +47 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^ATXCHK(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^ATXCHK(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^ATXCHK(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^ATXCHK(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^ICDCODE(Z,80)
- +16 IF Z'>0
- QUIT
- +17 IF $$ICD^ATXCHK(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 ""