Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP0D51

BGP0D51.m

Go to the documentation of this file.
  1. BGP0D51 ; IHS/CMI/LAB - measure I2 ;
  1. ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
  1. ;
  1. ICRSAMM ;EP
  1. K ^TMP($J,"A"),^TMP($J,"MEDS")
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
  1. I BGPAGEB<18 S BGPSTOP=1 Q ;18 and older
  1. S BGPC1B=($E(BGPBDATE,1,3)-1)_$E(BGPBDATE,4,7)
  1. S BGPC1=$$CRIT1DEN(DFN,$$FMADD^XLFDT(BGPC1B,120),$$FMADD^XLFDT(BGPBDATE,120)) ;set equal to index start date
  1. K ^TMP($J,"A")
  1. I BGPC1="" S BGPSTOP=1 Q ;no dx of depression
  1. S BGPC2=$$CRIT2DEN(DFN,$$FMADD^XLFDT($P(BGPC1,U,2),-30),$$FMADD^XLFDT($P(BGPC1,U,2),14)) ;set equal prescription start date
  1. K ^TMP($J,"MEDS")
  1. I BGPC2="" S BGPSTOP=1 Q ;no prescription filled, therefore does not meet criteria 2 for denominator
  1. S BGPE=$$EXCL(DFN,$P(BGPC1,U),$P(BGPC2,U),$P(BGPC1,U,2))
  1. I BGPE S BGPSTOP=1 Q ;met an exclusion criteria so don't count in denominator
  1. S BGPN1=$$OPC(DFN,$$FMADD^XLFDT($P(BGPC1,U,2),1),$$FMADD^XLFDT($P(BGPC1,U,2),84))
  1. S BGPN2=$$EAPT^BGP0D52(DFN,$P(BGPC2,U),$$FMADD^XLFDT($P(BGPC2,U),114),84,30,114)
  1. S BGPN3=$$EAPT^BGP0D52(DFN,$P(BGPC2,U),$$FMADD^XLFDT($P(BGPC2,U),231),180,51,231)
  1. I BGPACTCL S BGPD1=1
  1. I BGPACTUP S BGPD2=1
  1. S BGPVALUE=$S($G(BGPRTYPE)=3:"AC",BGPD1:"UP,AC",1:"UP")
  1. S BGPV=$S(BGPN1:"OPC",1:"NOT OPC")
  1. I BGPN2 S BGPV=BGPV_$S(BGPV]"":";",1:"")_" APT"
  1. I 'BGPN2 S BGPV=BGPV_$S(BGPV]"":";",1:"")_"NOT APT: "_$P(BGPN2,U,2)
  1. I BGPN3 S BGPV=BGPV_$S(BGPV]"":";",1:"")_"CONPT"
  1. I 'BGPN3 S BGPV=BGPV_$S(BGPV]"":";",1:"")_"NOT CONPT: "_$P(BGPN3,U,2)
  1. S BGPVALUE=BGPVALUE_" IESD: "_$$DATE^BGP0UTL($P(BGPC1,U,2))_"|||"_BGPV
  1. 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
  1. Q
  1. NDC(A,B) ;
  1. ;a is drug ien
  1. ;b is taxonomy ien
  1. S BGPNDC=$P($G(^PSDRUG(A,2)),U,4)
  1. I BGPNDC]"",B,$D(^ATXAX(B,21,"B",BGPNDC)) Q 1
  1. Q 0
  1. CRIT1DEN(P,BDATE,EDATE) ;
  1. K Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z
  1. K ^TMP($J,"A")
  1. K S,Q
  1. S G="",S=0
  1. S T=$O(^ATXAX("B","BGP MAJOR DEPRESSION (ADM)",0))
  1. S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1. I '$D(^TMP($J,"A",1)) Q ""
  1. S X="",G="" F S X=$O(^TMP($J,"A",X),-1) Q:X="" S V=$P(^TMP($J,"A",X),U,5) D
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .Q:"EC"[$P(^AUPNVSIT(V,0),U,7)
  1. .Q:'$D(^AUPNVPOV("AD",V)) ;NO POVS
  1. .S Y=$$PRIMPOV^APCLV(V,"I") ;get primary pov
  1. .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
  1. .K Q S (C,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y D
  1. ..Q:'$D(^AUPNVPOV(Y,0))
  1. ..S C=C+1
  1. ..S Q(C)=Y_U_$P(^AUPNVPOV(Y,0),U,12)_U_$P(^AUPNVPOV(Y,0),U)
  1. ..Q
  1. .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
  1. .I '$O(Q(0)) Q ;no more povs left
  1. .I 'F S Y=$O(Q(0)) I Y K Q(Y) ;kill off first one if none marked as primary
  1. .;now go through and see if any are depression
  1. .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
  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
  1. .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
  1. .Q
  1. K ^TMP($J,"A")
  1. ;I G]"" Q G
  1. I G S Y=$O(S(0)) Q Y_U_S(Y)
  1. I S>1 S Y=$O(S(0)) Q Y_U_S(Y)
  1. Q ""
  1. CRIT2DEN(P,BDATE,EDATE) ;
  1. K Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z
  1. ;see if there ACTIVE PRESCRIPTION of beta blockers in time window
  1. K ^TMP($J,"MEDS")
  1. S BGPG=""
  1. S Y="^TMP($J,""MEDS"",",X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. S T=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT MEDS",0))
  1. S T2=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT NDC",0))
  1. 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
  1. .Q:'$D(^AUPNVMED(Y,0))
  1. .S V=$P(^AUPNVMED(Y,0),U,3)
  1. .S G=0
  1. .S D=$P(^AUPNVMED(Y,0),U)
  1. .I $P(^AUPNVMED(Y,0),U,8)=$P($P(^AUPNVSIT(V,0),U),".") Q ;date discont=visit
  1. .I T,$D(^ATXAX(T,21,"B",D))!($$NDC(D,T2)) S BGPG=$P($P(^AUPNVSIT(V,0),U),".")_U_V_U_Y Q
  1. .;S C=$P($G(^PSDRUG(D,0)),U,2)
  1. .;I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S BGPG=$P($P(^AUPNVSIT(V,0),U),".")_U_V_U_Y Q
  1. K ^TMP($J,"MEDS")
  1. Q BGPG
  1. EXCL(P,ISD,PSD,ISD1) ;
  1. K Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z
  1. S %=P_"^ALL DX [BGP MAJOR DEPRESSION PRIOR;DURING "_$$FMADD^XLFDT(ISD,-120)_"-"_$$FMADD^XLFDT(ISD,-1),E=$$START1^APCLDF(%,"BGPG(")
  1. I $D(BGPG(1)) Q 1 ;HAD A VISIT PRIOR WITH DX
  1. ;now check for prescriptions
  1. K ^TMP($J,"MEDS")
  1. S BGPG=""
  1. S Y="^TMP($J,""MEDS"",",X=P_"^ALL MED;DURING "_$$FMADD^XLFDT(PSD,-90)_"-"_$$FMADD^XLFDT(PSD,-1) S E=$$START1^APCLDF(X,Y)
  1. S T=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT MEDS",0))
  1. S T2=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT VA CLASS",0))
  1. 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
  1. .Q:'$D(^AUPNVMED(Y,0))
  1. .S V=$P(^AUPNVMED(Y,0),U,3)
  1. .S G=0
  1. .S D=$P(^AUPNVMED(Y,0),U)
  1. .I $P(^AUPNVMED(Y,0),U,8)=$P($P(^AUPNVSIT(V,0),U),".") Q ;date discont=visit
  1. .I T,$D(^ATXAX(T,21,"B",D))!($$NDC(D,T2)) S BGPG=$P($P(^AUPNVSIT(V,0),U),".")_U_V_U_Y Q
  1. .;S C=$P($G(^PSDRUG(D,0)),U,2)
  1. .;I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S BGPG=$P($P(^AUPNVSIT(V,0),U),".")_U_V_U_Y Q
  1. K ^TMP($J,"MEDS")
  1. I BGPG]"" Q 1
  1. ;now check for hospital stay
  1. K ^TMP($J,"A")
  1. S G="",S=0
  1. S T=$O(^ATXAX("B","BGP ACUTE MENTAL HEALTH",0))
  1. S T1=$O(^ATXAX("B","BGP SUBSTANCE ABUSE",0))
  1. S T2=$O(^ATXAX("B","BGP POISONINGS SUBSTANCE ABUSE",0))
  1. S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMADD^XLFDT(ISD1,1)_"-"_$$FMADD^XLFDT(ISD1,245),E=$$START1^APCLDF(B,A)
  1. 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
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .Q:$P(^AUPNVSIT(V,0),U,7)'="H"
  1. .Q:'$D(^AUPNVPOV("AD",V)) ;NO POVS
  1. .S Y=$$PRIMPOV^APCLV(V,"I") ;get primary pov
  1. .I $$ICD^ATXCHK(Y,T,9) S G=$P($P(^AUPNVSIT(V,0),U),".")_U_V Q ;had one primary dx of major depression
  1. .I $$ICD^ATXCHK(Y,T1,9) S G=$P($P(^AUPNVSIT(V,0),U),".")_U_V Q
  1. .I $$ICD^ATXCHK(Y,T2,9) D Q
  1. ..;CHECK SECONDARY POVS FOR SUBSTANCE ABUSE
  1. ..S Q=$$PRIMPOV^APCLV(V,"I")
  1. ..S (F,W,Z)=0 F S W=$O(^AUPNVPOV("AD",V,W)) Q:W'=+W D
  1. ...Q:'$D(^AUPNVPOV(W,0))
  1. ...S Z=$P(^AUPNVPOV(W,0),U)
  1. ...Q:W=Q
  1. ...I $$ICD^ATXCHK(Z,T1,9) S G=$P($P(^AUPNVSIT(V,0),U),".")_U_V Q
  1. K ^TMP($J,"A")
  1. I G]"" Q 1
  1. Q ""
  1. OPC(P,BDATE,EDATE) ;
  1. ;3 visits or 2 visits and a telephone call
  1. ;A=# of outpt mental hlth visits
  1. ;B=# of outpt non mh visits
  1. ;C=# prescribing provider visits
  1. ;D=# of telephone calls for mh visits
  1. K Y,V,T,X,T2,D,BGPG,G,S,T1,A,B,F,W,%,Q,Z,C
  1. K ^TMP($J,"A")
  1. S Z="^TMP($J,""A"",",%=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,Z)
  1. I '$D(^TMP($J,"A",1)) Q ""
  1. S (A,B,C,D)=0
  1. 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
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .Q:$$CLINIC^APCLV(V,"C")=30
  1. .I $$MHO(V) S A=A+1,A(V)="" I $$PPCHK(V) S C=C+1,C(V)="" Q
  1. .I $$MHT(V) S D=D+1,D(V)="" I $$PPCHK(V) S C=C+1,C(V)="" Q
  1. .I $$NMHO(V) S A=A+1,A(V)="" I $$PPCHK(V) S C=C+1,C(V)="" Q
  1. ;NOW CHECK BH AND ADD IN VISITS
  1. 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
  1. .Q:'$D(^AMHREC(V,0))
  1. .S Y=$P(^AMHREC(V,0),U,16)
  1. .I Y,$D(A(Y)) Q ;already checked this visit
  1. .I Y,$D(B(Y)) Q
  1. .I Y,$D(C(Y)) Q
  1. .I Y,$D(D(Y)) Q
  1. .S X=$P(^AMHREC(V,0),U,25) I X,$P($G(^DIC(40.7,X,0)),U,2)=30 Q
  1. .S X=$P(^AMHREC(V,0),U,7) I X,$P($G(^AMHTSET(X,0)),U,2)=9 Q
  1. .I $$BHMHO(V) S A=A+1 I $$PPCHK(V) S C=C+1 Q
  1. .I $$BHMHT(V) S D=D+1 I $$PPCHK(V) S C=C+1 Q
  1. .I $$BHNMHO(V) S A=A+1 I $$PPCHK(V) S C=C+1 Q
  1. K ^TMP($J,"A")
  1. I A>2,C Q 1
  1. I A=2,D>0,C Q 1
  1. Q ""
  1. CPTV(V,T) ;does this visit have a cpt code in taxonomy T
  1. NEW X,G,Z
  1. I $G(T)="" Q ""
  1. I '$G(V) Q ""
  1. S T=$O(^ATXAX("B",T,0))
  1. I '$G(T) W BGPBOMB Q ""
  1. I '$D(^AUPNVSIT(V,0)) Q ""
  1. S G=0
  1. S X=$P(^AUPNVSIT(V,0),U,17) I X,$$ICD^ATXCHK(X,T,1) Q 1
  1. S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G) D
  1. .Q:'$D(^AUPNVCPT(X,0))
  1. .S Z=$P(^AUPNVCPT(X,0),U)
  1. .I $$ICD^ATXCHK(Z,T,1) S G=1
  1. .Q
  1. Q G
  1. POVV(V,T) ;does this visit have a pov of a code in taxonomy T
  1. NEW X,G,Z
  1. I $G(T)="" Q ""
  1. I '$G(V) Q ""
  1. S T=$O(^ATXAX("B",T,0))
  1. I '$G(T) W BGPBOMB Q ""
  1. I '$D(^AUPNVSIT(V,0)) Q ""
  1. S G=0
  1. S X=0 F S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X!(G) D
  1. .Q:'$D(^AUPNVPOV(X,0))
  1. .S Z=$P(^AUPNVPOV(X,0),U)
  1. .I $$ICD^ATXCHK(Z,T,9) S G=1
  1. .Q
  1. Q G
  1. PRVV(V,T) ;does this visit have a primary provider with a class in taxonomy T
  1. NEW X
  1. I $G(T)="" Q ""
  1. I '$G(V) Q ""
  1. S T=$O(^ATXAX("B",T,0))
  1. I '$G(T) W BGPBOMB Q ""
  1. I '$D(^AUPNVSIT(V,0)) Q ""
  1. S X=$$PRIMPROV^APCLV(V,"F")
  1. I X="" Q ""
  1. I $D(^ATXAX(T,21,"B",X)) Q 1
  1. Q 0
  1. MHO(V) ;EP
  1. I '$$PRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
  1. 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
  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
  1. Q 0
  1. MHT(V) ;EP
  1. I '$$PRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
  1. I $P(^AUPNVSIT(V,0),U,7)="T" Q 1
  1. Q 0
  1. PPCHK(V) ;EP
  1. I $$PRVV(V,"BGP PRESCRIBING PROVIDER CLASS") Q 1
  1. Q 0
  1. NMHO(V) ;EP
  1. I $$PRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
  1. I "AOS"[$P(^AUPNVSIT(V,0),U,7),$$CPTV(V,"BGP MH OPT VISIT CPT NMH 1") Q 1
  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
  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
  1. Q 0
  1. BHCPTV(V,T) ;does this visit have a cpt code in taxonomy T
  1. NEW X,G,Z
  1. I $G(T)="" Q ""
  1. I '$G(V) Q ""
  1. S T=$O(^ATXAX("B",T,0))
  1. I '$G(T) W BGPBOMB Q ""
  1. I '$D(^AMHREC(V,0)) Q ""
  1. S G=0
  1. S X=0 F S X=$O(^AMHRPROC("AD",V,X)) Q:X'=+X!(G) D
  1. .Q:'$D(^AMHRPROC(X,0))
  1. .S Z=$P(^AMHRPROC(X,0),U)
  1. .I $$ICD^ATXCHK(Z,T,1) S G=1
  1. .Q
  1. Q G
  1. BHPOVV(V,T) ;does this visit have a pov of a code in taxonomy T
  1. NEW X,G,Z
  1. I $G(T)="" Q ""
  1. I '$G(V) Q ""
  1. S T=$O(^ATXAX("B",T,0))
  1. I '$G(T) W BGPBOMB Q ""
  1. I '$D(^AUPNVSIT(V,0)) Q ""
  1. S G=0
  1. S X=0 F S X=$O(^AMHRPRO("AD",V,X)) Q:X'=+X!(G) D
  1. .Q:'$D(^AMHRPRO(X,0))
  1. .S Z=$P(^AMHRPRO(X,0),U)
  1. .I Z="" Q
  1. .S Z=$P($G(^AMHPROB(Z,0)),U,5)
  1. .I Z="" Q
  1. .;S Z=$O(^ICD9("AB",Z,0))
  1. .S Z=+$$CODEN^ICDCODE(Z,80)
  1. .I Z'>0 Q
  1. .I $$ICD^ATXCHK(Z,T,9) S G=1
  1. .Q
  1. Q G
  1. BHPRVV(V,T) ;does this visit have a primary provider with a class in taxonomy T
  1. NEW X,G,Y
  1. I $G(T)="" Q ""
  1. I '$G(V) Q ""
  1. S T=$O(^ATXAX("B",T,0))
  1. I '$G(T) W BGPBOMB Q ""
  1. S G=0
  1. S X=0 F S X=$O(^AMHRPROV("AD",V,X)) Q:X'=+X!(G) D
  1. .Q:'$D(^AMHRPROV(X,0))
  1. .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)
  1. I 'G Q ""
  1. I $D(^ATXAX(T,21,"B",G)) Q 1
  1. Q 0
  1. BHMHO(V) ;EP
  1. I '$$BHPRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
  1. I $$BHOTOC(V),$$BHCPTV(V,"BGP OPT MH VISIT CPTS MH")!($$BHPOVV(V,"BGP OPT MH VISIT POVS")) Q 1
  1. I $$BHOTOC(V),($P(^AMHREC(V,0),U,4)=$P($G(^BGPSITE(DUZ(2),0)),U,2)!($$BHCLINIC(V,"C")=11)) Q 1
  1. Q ""
  1. BHMHT(V) ;EP
  1. I '$$BHPRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
  1. I $$BHTTOC(V) Q 1
  1. Q 0
  1. BHPPCHK(V) ;EP
  1. I $$BHPRVV(V,"BGP PRESCRIBING PROVIDER CLASS") Q 1
  1. Q 0
  1. BHNMHO(V) ;EP
  1. I $$BHPRVV(V,"BGP MENTAL HEALTH PROV CLASS") Q ""
  1. I $$BHOTOC(V),$$BHCPTV(V,"BGP MH OPT VISIT CPT NMH 1") Q 1
  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
  1. I $$BHOTOC(V),$$BHCPTV(V,"BGP MH OPT VISIT CPT NMH 3"),$$BHPOVV(V,"BGP OPT MH VISIT POVS") Q 1
  1. Q 0
  1. BHOTOC(V) ;EP is type of contact 2, 16
  1. NEW X
  1. S X=$P(^AMHREC(V,0),U,7)
  1. I X="" Q ""
  1. S X=$P($G(^AMHTSET(X,0)),U,2)
  1. I X=2 Q 1
  1. I X=16 Q 1
  1. Q ""
  1. BHCLINIC(V) ;EP
  1. NEW X
  1. I '$D(^AMHREC(V,0)) Q ""
  1. S X=$P(^AMHREC(V,0),U,25)
  1. I X="" Q ""
  1. Q $P($G(^DIC(40.7,X,0)),U,2)
  1. BHTTOC(V) ;EP is type of contact 8,15
  1. NEW X
  1. S X=$P(^AMHREC(V,0),U,7)
  1. I X="" Q ""
  1. S X=$P($G(^AMHTSET(X,0)),U,2)
  1. I X=8 Q 1
  1. I X=15 Q 1
  1. Q ""