BGP8D21.m

BGP8D21 ; IHS/CMI/LAB - measure 6 ;

 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 ;

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^BGP8D211(DFN,BGPBD1,BGPEDATE)

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

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

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

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

 I BGPGFR&(BGPQUP) S BGPN1=1

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

 I BGPN1 D

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

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

 .S BGPVALUE=BGPVALUE_" & UACR: "_$$DATE^BGP8UTL($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^BGP8UTL1(DFN,"BGP BILATERAL BLINDNESS DXS",$$DOB^AUPNPAT(DFN),BGPEDATE)

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

 I X S BGPSTOP=1 Q

 ;EXCL EYE ENUCLEATION

 S X=$$EYEENUC^BGP8D21A(DFN,BGPEDATE)

 I X S BGPSTOP=1 Q

 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(BGPDMD6:"UPDM",1:"")_$S(BGPDMD2:",AD",1:"")

 I BGPDMD3,BGPVALUE]"" S BGPVALUE=BGPVALUE_",AAD"

 I BGPDMD3,BGPVALUE="" S BGPVALUE="AAD"

 S BGPVALUE=BGPVALUE_"|||"

 S X=$S(BGPEYE:"Eval: "_$$DATE^BGP8UTL($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

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

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

 Q

I9 ;EP

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

 NEW BGPTC,BGPPN,BGPV1

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

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

 S BGPD1=1  ;USER POP

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

 I A<6 S BGPD2=1

 I A>15,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>74 S BGPD8=1

 I A<3 S BGPD9=1

 I A>2,A<6 S BGPD11=1

 I A>5,A<10 S BGPD12=1

 I A>9,A<13 S BGPD13=1

 I A>12,A<16 S BGPD14=1

 S BGPVALUE=$$DENTSRV(DFN,BGPBDATE,BGPEDATE)  ;DOCUMENTED DENTAL VISIT

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

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

 S BGPN9=0

 S BGPDEVV=$$DENTSRVD^BGP8D211(DFN,BGPBDATE,BGPEDATE)  ;ddocumented dental visit  BGPN9 GPRA DEV

 I BGPDEVV S BGPN9=1

 S BGPV1=$$DENTDEV(DFN,BGPBDATE,BGPEDATE)  ;DENTAL EXAM

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

 S BGPTC=$$TC(DFN,BGPBDATE,BGPEDATE)  ;ALL TX COMPLETED

 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^BGP8D3A(DFN,BGPBDATE,BGPEDATE)

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

 S BGPVALUD="UP" I BGPN9 S BGPVALUD="UP,UP w/dental visit "_$$DATE^BGP8UTL($P(BGPDEVV,U,2))

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

 S BGPVALUD=BGPVALUD_"|||"

 I BGPN9 S BGPVALUD=BGPVALUD_"Visit: "_$$DATE^BGP8UTL($P(BGPDEVV,U,2))_" "_$P(BGPDEVV,U,3)

 I BGPN3 S BGPVALUD=BGPVALUD_";Exam: "_$$DATE^BGP8UTL($P(BGPV1,U,2))_" CDT "_$P(BGPV1,U,3)

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

 I BGPN6 S BGPVALUD=BGPVALUD_$S(BGPTC:"; ",1:""),BGPVALUD=BGPVALUD_"PN: "_$$DATE^BGP8UTL($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^BGP8UTL($P(BGPVALUE,U,2))_" "_$P(BGPVALUE,U,3)

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

 K BGPDEVV

 Q

PREG(P,BDATE,EDATE) ;EP

 NEW X,Y,Z

 S (X,Y)=0

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

 S X=$$PREG^BGP8D7(P,$$FMADD^XLFDT(EDATE,-608),EDATE,1,1,,BDATE,EDATE)  ;V17.1 CMI/LAB ADDED DATES FOR CURRENTLY PREGNANT

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

 Q (X+Y)

BF(P,BDATE,EDATE) ;EP

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

 ;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^BGP8UTL1(P,"BGP BREASTFEEDING DXS",BDATE,EDATE)

 I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))

 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 SN=$O(^BGPSNOMR("B","BREASTFEEDING PATIENT ED",0))

 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 $P(T,"-")]"",$D(^BGPSNOMR(SN,11,"B",$P(T,"-"))) S %=T_U_$P(BGPG(X),U) Q

 I %]"" Q 1_U_$$DATE^BGP8UTL($P(%,U,2))

 Q 0

 ;

DENTDEV(P,BDATE,EDATE) ;

 ;ADA 1050, 1045

 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)_"^"_"RPMS DENTAL "_$P(BGPG(1),U,2)

 S BGPC=$$CPT^BGP8DU(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,%,V,X

 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)_"^"_"RPMS DENTAL "_$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)_"^"_"RPMS DENTAL "_$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)_"^"_"RPMS DENTAL "_$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)_"^"_"RPMS DENTAL "_$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)_"^"_"RPMS DENTAL "_$P(BGPG(1),U,2)

 K BGPG

 S BGPG(1)=$$CPT^BGP8DU(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)_"^"_"CDT "_$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^BGP8UTL1(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 RPMS DENTAL "_$P(BGPG(X),U,2) Q

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

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

 Q BGPC

 ;

EYE(P,BDATE,EDATE) ;EP - REPORT PERIOD

 NEW BGPLEYE,T,E,%,X,R,Y,D,J,V

 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]"" Q 1_U_$P(X,U,1)_U_"CPT: "_$P(X,U,2)

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

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

 K ^TMP($J,"A")

 S R=$NA(^TMP($J,"A"))

 ;CHANGE 16.1 TO CLINIC A2 OR CLINIC 17 OR 18 WITH PROVIDER 24, 79,08 AND NOT C OR T

 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^BGP8DU(P,BDATE,EDATE,T,5) I X]"" Q

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

 S X=$$LASTPRC^BGP2UTL1(P,"BGP EYE EXAM PROCS",BDATE,EDATE) I X]"" Q 3_U_$P(X,U,3)_U_"Proc "_$P(X,U,2)

 D ALLV^APCLAPIU(P,BDATE,EDATE,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="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)  D

 .S V=$P(^TMP($J,"A",X),U,5)

 .I 'V Q

 .I $P($G(^AUPNVSIT(V,0)),U,7)="T" Q

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

 .S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C")

 .I R'=17,R'=18 Q  ;MUST BE 17 OR 18

 .Q:$$DNKA($P(^TMP($J,"A",X),U,5))  ;CAN'T BE A DNKA

 .S J=$$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D")

 .I J'=24,J'=79,J'="08" Q  ;MUST BE PROVIDER 24,79,08

 .S Y=1,D=$P(^TMP($J,"A",X),U)

 I Y Q 3_"^"_D_"^Cl/Prv "_R_"/"_J

 ;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^BGP8DU(P,BDATE,EDATE,T,5) I X]"" Q

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

 Q ""

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^BGP8UTL((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^BGP8UTL1(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^BGP8DU(P,$$DOB^AUPNPAT(P),EDATE,T,5) I X]"" Q

 .S X=$$TRAN^BGP8DU(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 2017

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

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

 ;

 ;does patient have HTN?

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

 I '$$FIRSTHTN^BGP8D9(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^BGP8D723(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE,BGPBDATE)

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

 S BGPACEA=$$ACEALG^BGP8D723(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^BGP8UTL2(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^BGP8D82(Y,V,EDATE)

 .S K=S+K

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

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

 I K>BGPNDAYS Q 1_U_R

 Q 0

JVN(P,BDATE,EDATE) ;EP

 G JVN^BGP8D211

BGP8D21   ; IHS/CMI/LAB - measure 6 ;

 +1       ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 +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^BGP8D211(DFN,BGPBD1,BGPEDATE)

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

 +3        SET BGPQUP=$$QUANTUP^BGP8D211(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(BGPDMD6:"UPDM",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^BGP8UTL($PIECE(BGPESRD,U,3))_" "_$PIECE(BGPESRD,U,2),1:"")

                       QUIT 

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

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

 +11               SET BGPVALUE=BGPVALUE_" & UACR: "_$$DATE^BGP8UTL($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^BGP8UTL1(DFN,"BGP BILATERAL BLINDNESS DXS",$$DOB^AUPNPAT(DFN),BGPEDATE)

 +5        IF 'X

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

 +6        IF X

               SET BGPSTOP=1

               QUIT 

 +7       ;EXCL EYE ENUCLEATION

 +8        SET X=$$EYEENUC^BGP8D21A(DFN,BGPEDATE)

 +9        IF X

               SET BGPSTOP=1

               QUIT 

 +10       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)

               SET BGPN1=1

 +3       ;QUALIFIED

           SET BGPN2=0

           IF $PIECE(BGPEYE,U)=1

               SET BGPN2=1

 +4       ;OTHER EYE EXAM

           SET BGPN3=0

           IF $PIECE(BGPEYE,U)=3

               SET BGPN3=1

 +5        SET BGPJVN=$$JVN(DFN,BGPBDATE,BGPEDATE)

 +6       ;JVN

           IF $PIECE(BGPJVN,U,1)]""

               SET BGPN4=1

 +7       ;OPTH

           IF $PIECE(BGPJVN,U,2)]""

               SET BGPN5=1

 +8       ;OPTOMETRY

           IF $PIECE(BGPJVN,U,3)]""

               SET BGPN6=1

 +9        SET BGPVALUE=$SELECT(BGPDMD6:"UPDM",1:"")_$SELECT(BGPDMD2:",AD",1:"")

 +10       IF BGPDMD3

               IF BGPVALUE]""

                   SET BGPVALUE=BGPVALUE_",AAD"