BGP4D21.m

BGP4D21 ; IHS/CMI/LAB - measure 6 ;

 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 ;

I6 ;EP

 K BGPN1,BGPN2,BGPN3,BGPN4,BGPVALUE,BGPUP,BGPGFR

 S (BGPN1,BGPN2,BGPN3,BGPN4)=0

 I 'BGPDM1 S BGPSTOP=1 Q

DMNA ;EP - called from elder care

 S BGPBD1=BGP365

 S BGPBD2=BGPBDATE

I61 ;EP

 S BGPGFR=$$GFR^BGP4D211(DFN,BGPBD1,BGPEDATE)

 S BGPESRD=$$ESRD^BGP4D211(DFN,$P(^DPT(DFN,0),U,3),BGPEDATE)

 S BGPQUP=$$QUANTUP^BGP4D211(DFN,BGPBD2,BGPEDATE)

 S BGPHOLD=BGPGFR_"|"_BGPESRD_"|"_BGPQUP

 I $P(BGPESRD,U) S BGPN1=1

 I BGPGFR&(BGPQUP) S BGPN1=1

 S BGPVALUE=$S(BGPDMD1:"UP",1:"")_$S(BGPDMD2:",AD",1:"")_$S(BGPDMD3:",AAD",1:"")_"|||"

 I BGPN1 D

 .I BGPESRD S BGPVALUE=BGPVALUE_$S(BGPESRD]"":"ESRD: "_$$DATE^BGP4UTL($P(BGPESRD,U,3))_" "_$P(BGPESRD,U,2),1:"") Q

 .S BGPVALUE=BGPVALUE_$S(BGPESRD:"; ",1:""),BGPVALUE=BGPVALUE_"GFR: "_$$DATE^BGP4UTL($P(BGPGFR,U,2))

 .S BGPVALUE=BGPVALUE_" & UACR: "_$$DATE^BGP4UTL($P(BGPQUP,U,3))_" "_$P(BGPQUP,U,2)

 K BGPUP,BGPGFR,BGPX,BGPY,BGPC,BGPG,BGPBD1,BGPBD2,BGPQUP,BGPESRD

 Q

 ;

I7 ;EP

 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPVALUE,BGPD1)=""

 NEW BGPEYE,BGPJVN

 I 'BGPDM1 S BGPSTOP=1 Q

 S X=$$LASTDX^BGP4UTL1(DFN,"BGP BILATERAL BLINDNESS DXS",$$DOB^AUPNPAT(DFN),BGPEDATE)

 I 'X S X=$$BLINDPL^BGP4D21A(DFN,BGPEDATE)

 I X S BGPSTOP=1 Q  ;V13.0 EXCLUDE ALL THOSE WHO ARE BLIND S BGPBLIND=1

 I BGPDMD2 S BGPD1=1

DMEYE ;EP - called from elder care

 S BGPEYE=$$EYE(DFN,BGPBDATE,BGPEDATE)

 S BGPN1=0 I $P(BGPEYE,U)=1!($P(BGPEYE,U)=3) S BGPN1=1

 S BGPN2=0 I $P(BGPEYE,U)=1 S BGPN2=1  ;QUALIFIED

 S BGPN3=0 I $P(BGPEYE,U)=3 S BGPN3=1  ;OTHER EYE EXAM

 S BGPJVN=$$JVN(DFN,BGPBDATE,BGPEDATE)

 I $P(BGPJVN,U,1)]"" S BGPN4=1  ;JVN

 I $P(BGPJVN,U,2)]"" S BGPN5=1  ;OPTH

 I $P(BGPJVN,U,3)]"" S BGPN6=1  ;OPTOMETRY

 S BGPVALUE=$S(BGPDMD1:"UP",1:"")_$S(BGPDMD2:",AD",1:"")_$S(BGPDMD3:",AAD",1:"")_"|||"

 S X=$S(BGPEYE:"Eval: "_$$DATE^BGP4UTL($P(BGPEYE,U,2))_" "_$P(BGPEYE,U,3),1:"")

 I $P(BGPJVN,U,1)]"" S X=X_$S(X]"":"; ",1:""),X=X_$P(BGPJVN,U,1)

 I $P(BGPJVN,U,2)]"" S X=X_$S(X]"":"; ",1:""),X=X_$P(BGPJVN,U,2)

 I $P(BGPJVN,U,3)]"" S X=X_$S(X]"":"; ",1:""),X=X_$P(BGPJVN,U,3)

 S BGPVALUE=BGPVALUE_X

 K BGPG,BGPEYE,BGPJVN

 K ^TMP($J,"A")

 Q

 ;

I8 ;EP

 K BGPN1,BGPVALUE,BGPN2,BGPN3,BGPN4,BGPN5

 S BGPN1=0

 I '$G(BGPDMD2) S BGPSTOP=1 Q

 S BGPVALUE=$$DENTSRV(DFN,BGPBDATE,BGPEDATE)

 S BGPN1=0 I $P(BGPVALUE,U)=1 S BGPN1=1

 ;S BGPN2=0 I $P(BGPVALUE,U)=2 S BGPN2=1

 ;S BGPN3=0 I BGPN1,'BGPN2 S BGPN3=1

 I BGPRTYPE=1 S BGPVALUE="AD|||" I BGPN1 S BGPVALUE=BGPVALUE_$$DATE^BGP4UTL($P(BGPVALUE,U,2))_" "_$P(BGPVALUE,U,3)

 I BGPRTYPE'=1 S BGPVALUE="AD|||"_$$DATE^BGP4UTL($P(BGPVALUE,U,2))_" "_$P(BGPVALUE,U,3)

 Q

I9 ;EP

 K BGPN1,BGPVALUE,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8

 NEW BGPTC,BGPPN,BGPV1

 S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10)=0

 I '$G(BGPACTUP) S BGPSTOP=1 Q

 S BGPD1=1

 S A=$$AGE^AUPNPAT(DFN,BGPBDATE)

 I A<6 S BGPD2=1

 I A>5,A<22 S BGPD3=1

 I A>21,A<35 S BGPD4=1

 I A>34,A<45 S BGPD5=1

 I A>44,A<55 S BGPD6=1

 I A>54,A<75 S BGPD7=1

 ;I A>54,A<75 S BGPD8=1

 I A>74 S BGPD8=1

 S BGPVALUE=$$DENTSRV(DFN,BGPBDATE,BGPEDATE)

 S BGPN1=0 I $P(BGPVALUE,U)=1 S BGPN1=1

 ;S BGPN2=0 I $P(BGPVALUE,U)=2 S BGPN2=1

 S BGPV1=$$DENTDEV(DFN,BGPBDATE,BGPEDATE)

 S BGPN3=0 I $P(BGPV1,U)=1 S BGPN3=1

 S BGPTC=$$TC(DFN,BGPBDATE,BGPEDATE)

 S BGPN4=0 I $P(BGPTC,U,1) S BGPN4=1

 S BGPD10=$$PREG(DFN,BGPBDATE,BGPEDATE)

 S BGPPN="" I BGPD10 S BGPPN=$$PN(DFN,BGPBDATE,BGPEDATE)

 S BGPN6=0 I $P(BGPPN,U,1) S BGPN6=1

 S BGPN7=0,BGPN8=0

 S BGPGAX=""

 I BGPD2 D

 .S BGPGAX=$$GA^BGP4D3A(DFN,BGPBDATE,BGPEDATE)

 .S BGPN7=$P(BGPGAX,U,1),BGPN8=$P(BGPGAX,U,2)

 S BGPVALUD="" I BGPN3 S BGPVALUD="UP w/exam "_$$DATE^BGP4UTL($P(BGPV1,U,2))_" "_$P(BGPV1,U,3)

 S BGPVALUD=BGPVALUD_$S(BGPD10:",PREG",1:"")

 S BGPVALUD=BGPVALUD_"|||"

 I BGPTC S BGPVALUD=BGPVALUD_"TC: "_$$DATE^BGP4UTL($P(BGPTC,U,2))_" "_$P(BGPTC,U,3)

 I BGPN6 S BGPVALUD=BGPVALUD_$S(BGPTC:"; ",1:""),BGPVALUD=BGPVALUD_"PN: "_$$DATE^BGP4UTL($P(BGPPN,U,2))_" "_$P(BGPPN,U,3)

 I BGPN7 S BGPVALUD=BGPVALUD_" GEN/SSC: "_$P(BGPGAX,U,3)

 ;S BGPN3=0 I BGPN1,'BGPN2 S BGPN3=1

 I BGPRTYPE'=1 S BGPVALUE="UP|||"_$$DATE^BGP4UTL($P(BGPVALUE,U,2))_" "_$P(BGPVALUE,U,3)

 I BGPRTYPE=1 S X=BGPVALUE S BGPVALUE="UP|||" I BGPN1 S BGPVALUE=BGPVALUE_$$DATE^BGP4UTL($P(X,U,2))_" "_$P(X,U,3)

 Q

PREG(P,BDATE,EDATE) ;

 NEW X,Y,Z

 S (X,Y)=0

 I $P(^DPT(P,0),U,2)'="F" Q 0

 S X=$$PREG^BGP4D7(P,$$FMADD^XLFDT(EDATE,-608),EDATE,1,1)

 I BGPAGEB>9 S Y=$$BF(P,BDATE,EDATE)

 Q (X+Y)

BF(P,BDATE,EDATE) ;

 NEW BGPG,Y,X,E,D,T,%

 ;S Y="BGPG(",X=P_"^LAST [BGP BREASTFEEDING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)

 S X=$$LASTDX^BGP4UTL1(P,"BGP BREASTFEEDING DXS",BDATE,EDATE)

 I X Q 1

 K BGPG

 S Y="BGPG("

 S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)

 I '$D(BGPG) Q ""

 S (X,D)=0,%="",T="" F  S X=$O(BGPG(X)) Q:X'=+X!(%]"")  D

 .S T=$P(^AUPNVPED(+$P(BGPG(X),U,4),0),U)

 .Q:'T

 .Q:'$D(^AUTTEDT(T,0))

 .S T=$P(^AUTTEDT(T,0),U,2)

 .I T="BF-BC" S %=T_U_$P(BGPG(X),U) Q

 .I T="BF-BP" S %=T_U_$P(BGPG(X),U) Q

 .I T="BF-CS" S %=T_U_$P(BGPG(X),U) Q

 .I T="BF-EQ" S %=T_U_$P(BGPG(X),U) Q

 .I T="BF-FU" S %=T_U_$P(BGPG(X),U) Q

 .I T="BF-HC" S %=T_U_$P(BGPG(X),U) Q

 .I T="BF-ON" S %=T_U_$P(BGPG(X),U) Q

 .I T="BF-M" S %=T_U_$P(BGPG(X),U) Q

 .I T="BF-MK" S %=T_U_$P(BGPG(X),U) Q

 .I T="BF-N" S %=T_U_$P(BGPG(X),U) Q

 I %]"" Q 1

 Q 0

 ;

DENTDEV(P,BDATE,EDATE) ;

 ;ADA 0120, 1050, 1045, 9990

 NEW BGPG,BGPC,%

 S BGPC="",%=P_"^LAST ADA [BGP DENTAL EXAM ADA CODES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) Q 1_U_$P(BGPG(1),U)_"^"_"ADA "_$P(BGPG(1),U,2)

 S BGPC=$$CPT^BGP4DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP DENTAL EXAM CPTS",0)),5)

 I BGPC Q 1_U_BGPC

 Q ""

TC(P,BDATE,EDATE) ;

 NEW BGPG,BGPC,%

 S BGPC="",%=P_"^LAST ADA 9990;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) Q 1_U_$P(BGPG(1),U)_"^"_"ADA "_$P(BGPG(1),U,2)

 Q ""

PN(P,BDATE,EDATE) ;

 NEW BGPG,BGPC,%

 S BGPC="",%=P_"^LAST ADA [BGP PRENATAL DENTAL ADA CODES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) Q 1_U_$P(BGPG(1),U)_"^"_"ADA "_$P(BGPG(1),U,2)

 Q ""

DENTSRV(P,BDATE,EDATE,FORECAST) ;EP

 NEW BGPG,BGPC

 K BGPG

 S FORECAST=$G(FORECAST)

 S BGPC="",%=P_"^LAST ADA 0000;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) S BGPC=$P(BGPG(1),U)_"^"_"ADA "_$P(BGPG(1),U,2)

 K BGPG

 S %=P_"^LAST ADA 0190;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)),$P(BGPG(1),U)>$P(BGPC,U) S BGPC=$P(BGPG(1),U)_"^"_"ADA "_$P(BGPG(1),U,2)

 K BGPG

 S %=P_"^LAST ADA 0191;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)),$P(BGPG(1),U)>$P(BGPC,U) S BGPC=$P(BGPG(1),U)_"^"_"ADA "_$P(BGPG(1),U,2)

 K BGPG

 S BGPG(1)=$$CPT^BGP4DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP DENTAL EXAM CPT 0190",0)),5)

 I $D(BGPG(1)),$P(BGPG(1),U)>$P(BGPC,U) S BGPC=$P(BGPG(1),U)_"^"_"ADA "_$P(BGPG(1),U,2)

 K BGPG

 S %=P_"^LAST EXAM DENTAL;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)),$P(BGPG(1),U)>$P(BGPC,U) S BGPC=$P(BGPG(1),U)_"^"_$P(BGPG(1),U,3)

 I BGPC]"",'FORECAST Q "1^"_BGPC

 S BGPG=$$LASTDX^BGP4UTL1(P,"BGP DENTAL EXAM DXS",BDATE,EDATE)

 I BGPG,'$G(FORECAST) Q "1^"_$P(BGPG,U,3)_"^"_$P(BGPG,U,2)

 I BGPG,$G(FORECAST),$P(BGPG,U,3)>$P(BGPC,U) S BGPC=$P(BGPG,U,3)_"^POV "_$P(BGPG,U,2)

 K BGPG S G="" S %=P_"^ALL ADA;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG) D  I G]"",'$G(FORECAST) Q G

 .S X=0 F  S X=$O(BGPG(X)) Q:X'=+X  S V=$P(BGPG(X),U,5) D

 ..I $P($G(^AUPNVSIT(V,0)),U,3)="C" D

 ...I '$G(FORECAST) S G=1_"^"_$P(BGPG(X),U)_"^CHS VISIT ADA "_$P(BGPG(X),U,2) Q

 ...I $G(FORECAST),$P(BGPG(X),U)>$P(BGPC,U) S BGPC=$P(BGPG(X),U)_"^CHS ADA VISIT"

 I BGPC]"" S BGPC=1_"^"_BGPC Q BGPC

 Q BGPC

 ;

EYE(P,BDATE,EDATE) ;EP

 S BGPLEYE=""

 K BGPG S %=P_"^LAST EXAM DIABETIC EYE EXAM;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) Q "1^"_$P(BGPG(1),U)_"^Diab Eye Ex"

 ;now check cpt taxonomies

 S T=$O(^ATXAX("B","BGP DM RETINAL EXAM CPTS",0))

 I T D  I X]"",$P(BGPLEYE,U,2)<$P(X,U,1) Q 1_U_$P(X,U,1)_U_"CPT: "_$P(X,U,2)

 .S X=$$CPT^BGP4DU(P,BDATE,EDATE,T,5) I X]"" Q

 .S X=$$TRAN^BGP4DU(P,BDATE,EDATE,T,5)

 K ^TMP($J,"A")

 S A="^TMP($J,""A"","

 S %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,A)

 S X=0,Y=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C") I R="A2",'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)

 I Y Q 3_"^"_D_"^Cl "_R

 ;REMOVED CLINIC 64 12.1

 S X=0,Y=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C") I (R=17!(R=18)),'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)

 I Y Q $S(R="A2":3,1:3)_"^"_D_"^Cl "_R

 S (X,Y)=0,D="" F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D") I (R=24!(R=79)!(R="08")),'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)

 I Y Q "3^"_D_"^Prv "_R

 ;

 ;

 S T=$O(^ATXAX("B","BGP DM EYE EXAM CPTS",0))

 I T D  I X]"" Q 3_U_$P(X,U,1)_U_"CPT: "_$P(X,U,2)

 .S X=$$CPT^BGP4DU(P,BDATE,EDATE,T,5) I X]"" Q

 .S X=$$TRAN^BGP4DU(P,BDATE,EDATE,T,5)

 Q BGPLEYE

DNKA(V) ;EP

 NEW D,N

 S D=$$PRIMPOV^APCLV(V,"C")

 I D=".0860" Q 1

 S N=$$PRIMPOV^APCLV(V,"N")

 I $E(D)="V",N["DNKA" Q 1

 I $E(D)="V",N["DID NOT KEEP APPOINTMENT" Q 1

 I $E(D)="V",N["DID NOT KEEP APPT" Q 1

 Q 0

GFR(P,BDATE,EDATE) ;EP

 S BGPC=""

 S T=$O(^LAB(60,"B","ESTIMATED GFR",0))

 S T1=$O(^ATXLAB("B","BGP GPRA ESTIMATED GFR TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(BGPC]"")  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(BGPC]"")  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(BGPC]"")  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...Q:$P(^AUPNVLAB(X,0),U,4)=""

 ...I T,$P(^AUPNVLAB(X,0),U)=T S BGPC=1_U_$$DATE^BGP4UTL((9999999-D)) Q

 ...I T1,$D(^ATXLAB(T1,21,"B",$P(^AUPNVLAB(X,0),U))) S BGPC=1_U_(9999999-D) Q

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...S %=$P($G(^LAB(95.3,J,9999999)),U,2)

 ...I %="33914-3" S BGPC=1_U_(9999999-D) Q

 ...S J=$P($G(^LAB(95.3,J,0)),U)_"-"_$P($G(^LAB(95.3,J,0)),U,15)

 ...I J="33914-3" S BGPC=1_U_(9999999-D) Q

 ...Q

 Q BGPC

LOINC(A,B) ;EP

 NEW %

 S %=$P($G(^LAB(95.3,A,9999999)),U,2)

 I %]"",$D(^ATXAX(B,21,"B",%)) Q 1

 S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)

 I $D(^ATXAX(B,21,"B",%)) Q 1

 Q ""

ESRD(P,BDATE,EDATE) ;EP

 K BGPG S %=P_"^LAST DX [BGP ESRD PMS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) Q "1^ESRD "_$P(BGPG(1),U,2)_"^^"_$P(BGPG(1),U)

 S X=$$LASTPRC^BGP4UTL1(P,"BGP ESRD PROCS",BDATE,EDATE)

 I X Q 1_"^ESRD PROC "_$P(X,U,2)_"^^"_$P(X,U,3)

 S T=$O(^ATXAX("B","BGP ESRD CPTS",0))

 I T D  I X]"" Q 1_U_"ESRD "_$P(X,U,2)_U_U_$P(X,U,1)

 .S X=$$CPT^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,T,5) I X]"" Q

 .S X=$$TRAN^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,T,5)

 Q 0

DMACE ;EP

 NEW BGPACERX,BGPACEC,BGPACEA

 S (BGPD1,BGPN1,BGPN2)=0

 ;BGPN4 AND BGPN5, BGPN6 ARE GPRA DEV 2014

 I 'BGPDMD2 S BGPSTOP=1 Q  ;don't process this measure, pt not diabetic per active diabetic definition

 I $$ESRD^BGP4D211(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) S BGPSTOP=1 Q  ;no one with ESRD 14.1

 ;

 ;does patient have HTN?

 I '$$V1HTN^BGP4D9(DFN,BGP365,BGPEDATE) S BGPSTOP=1 Q  ;no 1 visit of htn during report period

 I '$$FIRSTHTN^BGP4D9(DFN,BGPEDATE) S BGPSTOP=1 Q  ;no htn prior to report period

 S BGPD1=1,BGPN1=0

 S BGPACERX=$$ACERX(DFN,BGPBDATE,BGPEDATE,0)  ;did PT HAVE ACE/ARB IN REPORT PERIOD?

 I BGPACERX S BGPN1=1,BGPVALUE="AD|||"_$P(BGPACERX,U,2) G DMACEX

 S BGPACEC=$$ACECONT^BGP4D723(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE,BGPBDATE)

 I BGPACEC S BGPN2=1,BGPVALUE="AD|||"_$P(BGPACEC,U,2) G DMACEX

 S BGPACEA=$$ACEALG^BGP4D723(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)

 I BGPACEA S BGPN2=1,BGPVALUE="AD|||"_$P(BGPACEA,U,2) G DMACEX

 S BGPVALUE="AD|||"

DMACEX ;

 K BGPACERX

 Q

ACERX(P,BDATE,EDATE,BGPNDAYS) ;EP

 K BGPMEDS1

 NEW K,R,T,T1,T2,T3,X,Y,G,D,N,J,V,S

 S K=0,R="",G=""

 D GETMEDS^BGP4UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)

 I '$D(BGPMEDS1) Q ""

 S T=$O(^ATXAX("B","BGP HEDIS ACEI MEDS",0))

 S T1=$O(^ATXAX("B","BGP HEDIS ACEI NDC",0))

 S T2=$O(^ATXAX("B","BGP HEDIS ARB MEDS",0))

 S T3=$O(^ATXAX("B","BGP HEDIS ARB NDC",0))

 S X=0 F  S X=$O(BGPMEDS1(X)) Q:X'=+X!(G)  S Y=+$P(BGPMEDS1(X),U,4) D

 .Q:'$D(^AUPNVMED(Y,0))

 .Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"

 .S G=0

 .S D=$P(^AUPNVMED(Y,0),U)

 .I T,$D(^ATXAX(T,21,"B",D)) S G=1 G ACE1

 .I T2,$D(^ATXAX(T2,21,"B",D)) S G=1 G ACE1

 .S N=$P($G(^PSDRUG(D,2)),U,4)

 .I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1

 .I N]"",T3,$D(^ATXAX(T3,21,"B",N)) S G=1

 .Q:'G

ACE1 .;

 .S J=$P(^AUPNVMED(Y,0),U,8)

 .S V=$P(^AUPNVMED(Y,0),U,3)

 .Q:'V

 .Q:'$D(^AUPNVSIT(V,0))

 .S S=$$DAYS^BGP4D82(Y,V,EDATE)

 .S K=S+K

 .I R]"" S R=R_";"

 .S R=R_$$DATE^BGP4UTL($P($P(^AUPNVSIT(V,0),U),"."))

 I K>BGPNDAYS Q 1_U_R

 Q 0

JVN(P,BDATE,EDATE) ;EP

 NEW BGPVAL,A,E,%,Y,X,R,D

 S BGPVAL=""

 K ^TMP($J,"A")

 S A="^TMP($J,""A"","

 S %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,A)

 S X=0,Y=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C") I R="A2",'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)

 I Y S $P(BGPVAL,U,1)="JVN: "_$$DATE^BGP4UTL(D)_" Cl "_R

 S X=0,Y=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C") I R=17,'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)

 I Y S $P(BGPVAL,U,2)="Ophth: "_$$DATE^BGP4UTL(D)_" Cl "_R

 I 'Y D

 .S (X,Y)=0,D="" F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D") I R=79,'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)

 .I Y S $P(BGPVAL,U,2)="Ophth: "_$$DATE^BGP4UTL(D)_" Prv "_R

 S X=0,Y=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C") I R=18,'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)

 I Y S $P(BGPVAL,U,3)="Optom: "_$$DATE^BGP4UTL(D)_" Cl "_R

 I 'Y D

 .S (X,Y)=0,D="" F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D") I R="08"!(R=24),'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)

 .I Y S $P(BGPVAL,U,3)="Optom: "_$$DATE^BGP4UTL(D)_" Prv "_R

 Q BGPVAL

BGP4D21   ; IHS/CMI/LAB - measure 6 ;

 +1       ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 +2       ;

I6        ;EP

 +1        KILL BGPN1,BGPN2,BGPN3,BGPN4,BGPVALUE,BGPUP,BGPGFR

 +2        SET (BGPN1,BGPN2,BGPN3,BGPN4)=0

 +3        IF 'BGPDM1

               SET BGPSTOP=1

               QUIT 

DMNA      ;EP - called from elder care

 +1        SET BGPBD1=BGP365

 +2        SET BGPBD2=BGPBDATE

I61       ;EP

 +1        SET BGPGFR=$$GFR^BGP4D211(DFN,BGPBD1,BGPEDATE)

 +2        SET BGPESRD=$$ESRD^BGP4D211(DFN,$PIECE(^DPT(DFN,0),U,3),BGPEDATE)

 +3        SET BGPQUP=$$QUANTUP^BGP4D211(DFN,BGPBD2,BGPEDATE)

 +4        SET BGPHOLD=BGPGFR_"|"_BGPESRD_"|"_BGPQUP

 +5        IF $PIECE(BGPESRD,U)

               SET BGPN1=1

 +6        IF BGPGFR&(BGPQUP)

               SET BGPN1=1

 +7        SET BGPVALUE=$SELECT(BGPDMD1:"UP",1:"")_$SELECT(BGPDMD2:",AD",1:"")_$SELECT(BGPDMD3:",AAD",1:"")_"|||"

 +8        IF BGPN1

               Begin DoDot:1

 +9                IF BGPESRD

                       SET BGPVALUE=BGPVALUE_$SELECT(BGPESRD]"":"ESRD: "_$$DATE^BGP4UTL($PIECE(BGPESRD,U,3))_" "_$PIECE(BGPESRD,U,2),1:"")

                       QUIT 

 +10               SET BGPVALUE=BGPVALUE_$SELECT(BGPESRD:"; ",1:"")

                   SET BGPVALUE=BGPVALUE_"GFR: "_$$DATE^BGP4UTL($PIECE(BGPGFR,U,2))

 +11               SET BGPVALUE=BGPVALUE_" & UACR: "_$$DATE^BGP4UTL($PIECE(BGPQUP,U,3))_" "_$PIECE(BGPQUP,U,2)

               End DoDot:1

 +12       KILL BGPUP,BGPGFR,BGPX,BGPY,BGPC,BGPG,BGPBD1,BGPBD2,BGPQUP,BGPESRD

 +13       QUIT 

 +14      ;

I7        ;EP

 +1        SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPVALUE,BGPD1)=""

 +2        NEW BGPEYE,BGPJVN

 +3        IF 'BGPDM1

               SET BGPSTOP=1

               QUIT 

 +4        SET X=$$LASTDX^BGP4UTL1(DFN,"BGP BILATERAL BLINDNESS DXS",$$DOB^AUPNPAT(DFN),BGPEDATE)

 +5        IF 'X

               SET X=$$BLINDPL^BGP4D21A(DFN,BGPEDATE)

 +6       ;V13.0 EXCLUDE ALL THOSE WHO ARE BLIND S BGPBLIND=1

           IF X

               SET BGPSTOP=1

               QUIT 

 +7        IF BGPDMD2

               SET BGPD1=1

DMEYE     ;EP - called from elder care

 +1        SET BGPEYE=$$EYE(DFN,BGPBDATE,BGPEDATE)

 +2        SET BGPN1=0

           IF $PIECE(BGPEYE,U)=1!($PIECE(BGPEYE,U)=3)