BGP9DHE1.m

BGP9DHE1 ; IHS/CMI/LAB - measure HEDIS ;

 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 ;

I2 ;EP

 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0

 S (BGPFOB,BGPSIG,BGPCOLO,BGPBE)=""

 I BGPAGEB<51 S BGPSTOP=1 Q

 I BGPAGEB>80 S BGPSTOP=1 Q

 I BGPACTCL S BGPD1=1

 I 'BGPD1 S BGPSTOP=1 Q

 I $$CRC^BGP9D61(DFN,BGPEDATE) S BGPSTOP=1 Q  ;has colorectal cancer

 S BGPFOB=$$FOB^BGP9D61(DFN,BGPBDATE,BGPEDATE)

 S BGPSIG=$$SIG^BGP9D61(DFN,BGPEDATE)

 S BGPCOLO=$$COLO^BGP9D61(DFN,BGPEDATE)

 S BGPBE=$$BE^BGP9D61(DFN,BGPEDATE)

 ;S BGPRECT=$$RECT^BGP9D61(DFN,BGPEDATE)

 I BGPFOB]""!(BGPSIG]"")!(BGPCOLO]"")!(BGPBE]"") S BGPN1=1

 S BGPREF="" I 'BGPN1 S BGPREF=$$REF^BGP9D61(DFN,$$FMADD^XLFDT(BGPEDATE,-365),BGPEDATE) I BGPREF S BGPN1=1,BGPN4=1

 S BGPVALUE=""

 I BGPFOB]"" S BGPVALUE="FOBT: "_$P(BGPFOB,U)_" "_$$DATE^BGP9UTL($P(BGPFOB,U,2))_" "

 I BGPSIG]"" S BGPVALUE=BGPVALUE_"SIG: "_$P(BGPSIG,U)_":"_$P(BGPSIG,U,2)_" "

 I BGPCOLO]"" S BGPVALUE=BGPVALUE_"COLO: "_$P(BGPCOLO,U)_":"_$P(BGPCOLO,U,2)_" "

 I BGPBE]"" S BGPVALUE=BGPVALUE_"BE: "_$P(BGPBE,U)_":"_$P(BGPBE,U,2)_" "

 I BGPREF]"" S BGPVALUE=BGPVALUE_$P(BGPREF,U,3)_":"_$$DATE^BGP9UTL($P(BGPREF,U,2))

 S BGPVALUE="AC|||"_BGPVALUE

 K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P

 Q

I5 ;EP

 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0

 I 'BGPACTUP S BGPSTOP=1 Q

 I BGPSEX'="F" S BGPSTOP=1 Q

 I BGPAGEB<16 S BGPSTOP=1 Q

 I BGPAGEB>25 S BGPSTOP=1 Q

 I BGPACTUP S BGPD2=1

 I BGPACTCL S BGPD1=1

 I 'BGPD1 S BGPSTOP=1 Q

 I BGPD1,BGPAGEB>15,BGPAGEB<21 S BGPD3=1

 I BGPD1,BGPAGEB>20,BGPAGEB<26 S BGPD4=1

 S BGPN1=$$CHL^BGP9D53(DFN,BGP365,BGPEDATE)

 S BGPVALUE="AC"

 K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T

 Q

I7 ;EP

 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPHOSP,BGPIHD)=0

 I $$V2IHD^BGP9D9(DFN,BGP365,BGPEDATE),$$FIRSTIHD^BGP9D9(DFN,BGPEDATE) S BGPIHD=1,BGPD1=1

 I 'BGPD1 S BGPSTOP=1 Q  ;not ihd patient

 S (BGPVALUE,BGPLP,BGPLDL,BGPHDL,BGPTRI)=""

 S BGPLDL=$$LDL^BGP9D2(DFN,BGP365,BGPEDATE) ;date^value

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

 I $P(BGPLDL,U,3)]"" D

 .S V=$P(BGPLDL,U,3)

 .I V]"",+V'>100 S BGPN2=1

 .I +V>100.99999,+V<131 S BGPN3=1

 S BGPVALUE="IHD|||"_$S(BGPN1:"LDL; ",1:"")

 S %=$S($P(BGPLDL,U,2):$$DATE^BGP9UTL($P(BGPLDL,U,2))_" "_$S($P(BGPLDL,U,3)]"":$P(BGPLDL,U,3),1:"no result"),1:"")

 S BGPVALUE=BGPVALUE_%

 K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T

 Q

I11 ;EP

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

 S BGPD1=0

 I 'BGPDMD2 S BGPSTOP=1 Q  ;not active diabetic

 I BGPDMD2 S BGPD1=1

 I 'BGPDM1 S BGPSTOP=1 Q

 S BGPLHGB=$$HGBA1C(DFN,BGP365,BGPEDATE)

 S BGPN1=$P(BGPLHGB,U)

 S BGPN2=$P(BGPLHGB,U,2)

 S BGPN11=$P(BGPLHGB,U,3)

 S BGPVALUE=""

 S BGPVALUE=BGPVALUE_"A1c:"_$P(BGPLHGB,U,4)

 ;I 'BGPN1 S BGPVALUE=BGPVALUE_"No A1c done"

 K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,J,K,G,I,L,T,BGPG

73 S BGPEYE=$$EYE(DFN,BGP365,BGPEDATE)

 S A=0 I $P(BGPEYE,U)=1 S A=1

 S B=0 I $P(BGPEYE,U)=2 S B=1

 S BGPN3=0 I A!(B) S BGPN3=1

 I BGPN3 S BGPVALUE=BGPVALUE_";eye: "_$$DATE^BGP9UTL($P(BGPEYE,U,2))_" "_$P(BGPEYE,U,3)

 K BGPG

 K ^TMP($J,"A")

74 ;

 S BGPLDL=$$LDL^BGP9D2(DFN,BGP365,BGPEDATE)

 S BGPN4=$P(BGPLDL,U),BGPN5=0,BGPN6=0

 I $P(BGPLDL,U,3)]"",$P(BGPLDL,U,3)["3048F" S BGPN6=1,$P(BGPLDL,U,3)="CPT 3048F LDL<100"

 I $P(BGPLDL,U,3)]"",$P(BGPLDL,U,3)["CPT" G 741

 I $P(BGPLDL,U,3)]"",+$P(BGPLDL,U,3)>0,$P(BGPLDL,U,3)<100 S BGPN6=1

 ;I $P(BGPLDL,U,3)]"",+$P(BGPLDL,U,3),$P(BGPLDL,U,3)<130 S BGPN5=1

741 ;

 I BGPN4 S BGPVALUE=BGPVALUE_";LDL: "_$$DATE^BGP9UTL($P(BGPLDL,U,2))_" "_$P(BGPLDL,U,3)

 K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,BGPLDL,BGPHDL,BGPTRI,BGPLP

77 ;

 S BGPUP=$$MEDNEPH^BGP9DHE2(DFN,BGP365,BGPEDATE)

 S BGPN7=0 I $P(BGPUP,U)=1 S BGPN7=1

 I BGPN7 S BGPVALUE=BGPVALUE_";NEP SCR/EVID: "_$$DATE^BGP9UTL($P(BGPUP,U,4))_" "_$P(BGPUP,U,2)_" "_$P(BGPUP,U,3)

BP ;

 S (BGPN8,BGPN9)=0,BGPV=""

 S BGPBP=$$MEANBP^BGP9D2(DFN,BGPBDATE,BGPEDATE)

 I BGPBP="" S BGPBP=$$BPCPT(DFN,BGPBDATE,BGPEDATE) I BGPBP]"" D  G BPS

 .I $P(BGPBP,U,1) S BGPV="BP <130/80,140/90: BP :"_$P(BGPBP,U,3),BGPN8=1,BGPN9=1 Q

 .I $P(BGPBP,U,2) S BGPV="BP <140/90: BP :"_$P(BGPBP,U,3),BGPN9=1 Q

 I BGPBP="" G BPS

 S S=$P(BGPBP," ",1)

 S DS=$P(S,"/",2),S=$P(S,"/",1)

 I S<130&(DS<80) S BGPN8=1,BGPN9=1,BGPV="BP: <130/80,140/90: BP: "_S_"/"_DS G BPS

 I S<140&(DS<90) S BGPN9=1,BGPV="BP: <140/90: BP: "_S_"/"_DS

BPS ;

 K ^TMP($J,"A")

 I BGPV]"" S BGPVALUE=BGPVALUE_";"_BGPV

 S BGPVALUE="AD|||"_BGPVALUE

 Q

I013 ;EP

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

 S (BGPN1,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7)=0

 ;I 'BGPACTUP S BGPSTOP=1 Q  ;not in denominator so don't bother

 I BGPAGEB>2,BGPAGEB<22 S BGPD1=1

 I BGPDMD2 S BGPD2=1

 I BGPAGEB>2,BGPAGEB<7 S BGPD3=1

 I BGPAGEB>6,BGPAGEB<11 S BGPD4=1

 I BGPAGEB>10,BGPAGEB<15 S BGPD5=1

 I BGPAGEB>14,BGPAGEB<19 S BGPD6=1

 I BGPAGEB>18,BGPAGEB<22 S BGPD7=1

 I '(BGPD1+BGPD2+BGPD3+BGPD4+BGPD5+BGPD6+BGPD7) S BGPST0P=1 Q

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

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

 S BGPVALUE=$S(BGPD1:"UP",1:"")_$S(BGPD2:";AD",1:"")_"|||"_$$DATE^BGP9UTL($P(BGPVALUE,U,2))_" "_$P(BGPVALUE,U,3)

 Q

BPCPT(P,BDATE,EDATE) ;EP

 NEW S,D,C,E,BGPG,X,Y,G,T

 K BGPG S Y="BGPG(",X=P_"^ALL VISIT;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,Y)

 ;go through and get all cpt codes in the 2 taxonomies and table by date using the lowest value on that day, skip ER visits

 S X=0,G="" F  S X=$O(BGPG(X)) Q:X'=+X  D

 .S V=$P(BGPG(X),U,5)  ;visit ien

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

 .Q:$$CLINIC^APCLV(V,"C")=30  ;clinic ER

 .Q:'$D(^AUPNVCPT("AD",V))  ;no cpt codes

 .S E=0 F  S E=$O(^AUPNVCPT("AD",V,E)) Q:E'=+E  D

 ..S C=$P($G(^AUPNVCPT(E,0)),U)

 ..I 'C Q

 ..S D=$P($P(^AUPNVSIT(V,0),U),"."),D=(9999999-D)_"."_$P(D,".",2)

 ..I $$ICD^ATXCHK(C,$O(^ATXAX("B","BGP SYSTOLIC BP CPTS",0)),1) D

 ...S Y=$P($$CPT^ICPTCOD(C),U,2)

 ...S:'$D(S(D)) S(D)=Y

 ...I +S(D)>+Y S S(D)=Y

 ..I $$ICD^ATXCHK(C,$O(^ATXAX("B","BGP DIASTOLIC BP CPTS",0)),1) D

 ...S Y=$P($$CPT^ICPTCOD(C),U,2)

 ...S:'$D(T(D)) T(D)=Y

 ...I +T(D)>+Y S T(D)=Y

 I '$D(S),'$D(T) Q ""

 S S=$O(S(0)) I S S S=S(S)

 S D=$O(T(0)) I D S D=T(D)

 I S=""!(D="") Q 0_U_0_U_S_"/"_$P(D,".")

 I S="3074F",D="3078F" Q 1_U_1_U_S_"/"_$P(D,".")

 I S="3074F",D="3079F" Q 0_U_1_U_S_"/"_$P(D,".")

 I S="3075F",D="3078F" Q 0_U_1_U_S_"/"_$P(D,".")

 I S="3075F",D="3079F" Q 0_U_1_U_S_"/"_$P(D,".")

 I S="3076F",D="3078F" Q 0_U_1_U_S_"/"_$P(D,".")

 I S="3076F",D="3079F" Q 0_U_1_U_S_"/"_$P(D,".")

 I S="3077F",D="3080F" Q 0_U_0_U_S_"/"_$P(D,".")

 Q 0_U_0_U_S_"/"_$P(D,".")

 Q ""

LOINC(A,B) ;

 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 ""

EYE(P,BDATE,EDATE) ;EP  HEDIS ONLY

 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"

 S BD=BDATE

 S ED=EDATE

 S T=$O(^ATXAX("B","BGP HEDIS RETINAL SCREENING",0))

 K BGPG S BGPG=$$CPT^BGP9DU(P,BDATE,EDATE,T,6)

 I $P(BGPG,U)=1 Q "1^"_$P(BGPG,U,2)_"^Ret Scr CPT : "_$P(BGPG,U,3)

 K BGPG S BGPG=$$TRAN^BGP9DU(P,BDATE,EDATE,T,6)

 I $P(BGPG,U)=1 Q "1^"_$P(BGPG,U,2)_"^Ret Scr TRAN : "_$P(BGPG,U,3)

 K BGPG S BGPG=$$LASTPRC^BGP9UTL1(P,"BGP HEDIS RETINAL SCRN PROCS",BDATE,EDATE)

 I $P(BGPG,U)=1 Q "1^"_$P(BGPG,U,3)_"^Ret scr Proc: "_$P(BGPG,U,2)

 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=17!(R=18)!(R=64)!(R="A2")),'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)

 I Y Q $S(R="A2":2,1:2)_"^"_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 "2^"_D_"^Prv: "_R

 K BGPG S %=P_"^LAST DX V72.0;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) Q "2^"_$P(BGPG(1),U)_"V72.0 DX"

 ;now check for refusal of diabetic eye exam

 S G=$$REFUSAL^BGP9UTL1(P,9999999.15,$O(^AUTTEXAM("B","DIABETIC EYE EXAM",0)),BDATE,EDATE)

 I $P(G,U)=1 Q "1^"_$P(G,U,2)_"^Refused"

 Q ""

DNKA(V) ;EP - is this a DNKA visit?

 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

PED(P,BDATE,EDATE) ;EP

 K BGPALLED

 S Y="BGPALLED("

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

 I $D(BGPALLED(1)) S %="" D  I %]"" Q %

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

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

 ..Q:'T

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

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

 ..I $P(T,"-",2)="TO" S %=$P(BGPALLED(X),U)_U_T Q

 ..I $P(T,"-",2)="SHS" S %=$P(BGPALLED(X),U)_U_T Q

 ..I $P(T,"-")="TO",T'="TO-M" S %=$P(BGPALLED(1),U)_U_T Q

 K ^TMP($J,"A")

 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=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)

 .S B=$$CLINIC^APCLV(V,"C")

 .I B=94 S G=$P($P(^AUPNVSIT(V,0),U),".")_U_"CL 94" Q

 .S Z=0 F  S Z=$O(^AUPNVDEN("AD",V,Z)) Q:Z'=+Z!(G)  S B=$P($G(^AUPNVDEN(Z,0)),U) I B S B=$P($G(^AUTTADA(B,0)),U) I B=1320 S G=$P($P(^AUPNVSIT(V,0),U),".")_U_"ADA 1320" Q

 .Q

 I G]"" Q G

 S G="",X=0 F  S X=$O(^AUPNPREF("AA",P,9999999.09,X)) Q:X=""!(G]"")  D

 .S D=0 F  S D=$O(^AUPNPREF("AA",P,9999999.09,X,D)) Q:D=""!(G]"")  D

 ..S I=0 F  S I=$O(^AUPNPREF("AA",P,9999999.09,X,D,I)) Q:I'=+I!(G]"")  D

 ...S Z=$P($G(^AUPNPREF(I,0)),U,3)

 ...Q:Z=""

 ...I Z<BDATE Q

 ...I Z>EDATE Q

 ...S Y=$P($G(^AUTTEDT(X,0)),U,2)

 ...I $P(Y,"-")="TO"&(Y'="TO-M")!($P(Y,"-",2)="TO")!($P(Y,"-",2)="SHS") S G=Z_U_"ref "_Y

 Q G

TOMED(P,BDATE,EDATE) ;EP

 K BGPALLED

 S Y="BGPALLED("

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

 I $D(BGPALLED(1)) S %="" D  I %]"" Q %

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

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

 ..Q:'T

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

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

 ..I T="TO-M" S %=$P(BGPALLED(X),U)_U_T Q

 S G="",X=0 F  S X=$O(^AUPNPREF("AA",P,9999999.09,X)) Q:X=""!(G]"")  D

 .S D=0 F  S D=$O(^AUPNPREF("AA",P,9999999.09,X,D)) Q:D=""!(G]"")  D

 ..S I=0 F  S I=$O(^AUPNPREF("AA",P,9999999.09,X,D,I)) Q:I'=+I!(G]"")  D

 ...S Z=$P($G(^AUPNPREF(I,0)),U,3)

 ...Q:Z=""

 ...I Z<BDATE Q

 ...I Z>EDATE Q

 ...S Y=$P($G(^AUPNPREF(I,0)),U)

 ...Q:Y=""

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

 ...I Y="TO-M" S G=Z_U_"ref "_Y

 Q G

HGBA1C(P,BDATE,EDATE) ;EP

 NEW BGPG,BGPT,BGPC,E,%,L,T,BGPLT,D,X,J,C,G

 S BGPC=0

 S G=$$CPT^BGP9DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP HGBA1C CPTS",0)),5)

 I G]"" S BGPC=BGPC+1,BGPT((9999999-$P(G,U,1)),BGPC)=U_"CPT "_$P(G,U,2)

 ;now get all loinc/taxonomy tests

 S T=$O(^ATXAX("B","BGP HGBA1C LOINC CODES",0))

 S BGPLT=$O(^ATXLAB("B","DM AUDIT HGB A1C 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)  D

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

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

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

 ...I BGPLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT,21,"B",$P(^AUPNVLAB(X,0),U))) S BGPC=BGPC+1,BGPT(D,BGPC)=$P(^AUPNVLAB(X,0),U,4)_U_"LAB: "_$$VAL^XBDIQ1(9000010.09,X,.01) Q

 ...Q:'T

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

 ...Q:'$$LOINC^BGP9D2(J,T)

 ...S BGPC=BGPC+1,BGPT(D,BGPC)=$P(^AUPNVLAB(X,0),U,4)_U_"LAB LOINC: "_$$VAL^XBDIQ1(9000010.09,X,.01)_" "_$P(^AUPNVLAB(X,11),U,13)

 ...Q

 ; now got though and set return value of done 1 or 0^numerator 2-7^date^value

 I '$D(BGPT) Q 0_U_1_U_0_U_"No documented HgbA1c"  ;no tests so is hit in numerator

 ; now get rid of all on same day where 1 has a result and the other doesn't

 K BGPC S D=0 F  S D=$O(BGPT(D)) Q:D'=+D  S C=0,G=0 F  S C=$O(BGPT(D,C)) Q:C'=+C  D

 .I $P(BGPT(D,C),U,1)]"" S BGPC(D,C)=""   ;=D_U_C

 .;I BGPC>0,$P(BGPT(D,C),U,1)="" K BGPT(D,C)

 I $D(BGPC) D

 .;loop through and get rid of all w/o results

 .S D=0 F  S D=$O(BGPT(D)) Q:D=""  D

 ..S C=0 F  S C=$O(BGPT(D,C)) Q:C=""  D

 ...I '$D(BGPC(D,C)) K BGPT(D,C)

 S D=0,G=""

 S D=$O(BGPT(D))

 S C=0,C=$O(BGPT(D,C))

 S X=$P(BGPT(D,C),U,1)

 I $$UP^XLFSTR(X)="COMMENT" Q 1_U_1_U_0_U_$P(BGPT(D,C),U,2)_" "_$$DATE^BGP9UTL(9999999-D)_" (no result) "_X

 I X="" D  Q G

 .S G=""

 .I $P(BGPT(D,C),U,2)="CPT 3046F"!($P(BGPT(D,C),U,2)="CPT 83036")!($P(BGPT(D,C),U,2)="CPT 83037") S G=1_U_1_U_0_U_$P(BGPT(D,C),U,2)_" "_$$DATE^BGP9UTL(9999999-D) Q

 .I $P(BGPT(D,C),U,2)="CPT 3047F"!($P(BGPT(D,C),U,2)="CPT 3045F") S G=1_U_0_U_0_$P(BGPT(D,C),U,2)_" "_$$DATE^BGP9UTL(9999999-D) Q

 .I $P(BGPT(D,C),U,2)="CPT 3044F" S G=1_U_0_U_1_$P(BGPT(D,C),U,2)_" "_$$DATE^BGP9UTL(9999999-D) Q

 .S G=1_U_1_U_0_U_$P(BGPT(D,C),U,2)_" "_$$DATE^BGP9UTL(9999999-D)_" (no result)" Q

 S X=$$STRIP^XLFSTR(X," ")  ;strip spaces

 I X[">9" Q 1_U_1_U_0_$P(BGPT(D,C),U,2)_" "_$$DATE^BGP9UTL(9999999-D)_" "_X

 S X=$$STV^BGP9EO1(X)

 I X="" Q 1_U_1_U_0_U_$P(BGPT(D,C),U,2)_" "_$$DATE^BGP9UTL(9999999-D)_" (no result) "_X

 I +X>9 Q 1_U_1_U_0_U_$P(BGPT(D,C),U,2)_" "_$$DATE^BGP9UTL(9999999-D)_" "_X

 I +X<7 Q 1_U_0_U_1_U_$P(BGPT(D,C),U,2)_" "_$$DATE^BGP9UTL(9999999-D)_" "_X

 Q 1_U_0_U_0_U_$P(BGPT(D,C),U,2)_" "_$$DATE^BGP9UTL(9999999-D)_" result: "_X

 ;

BGP9DHE1  ; IHS/CMI/LAB - measure HEDIS ;

 +1       ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 +2       ;

I2        ;EP

 +1        SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0

 +2        SET (BGPFOB,BGPSIG,BGPCOLO,BGPBE)=""

 +3        IF BGPAGEB<51

               SET BGPSTOP=1

               QUIT 

 +4        IF BGPAGEB>80

               SET BGPSTOP=1

               QUIT 

 +5        IF BGPACTCL

               SET BGPD1=1

 +6        IF 'BGPD1

               SET BGPSTOP=1

               QUIT 

 +7       ;has colorectal cancer

           IF $$CRC^BGP9D61(DFN,BGPEDATE)

               SET BGPSTOP=1

               QUIT 

 +8        SET BGPFOB=$$FOB^BGP9D61(DFN,BGPBDATE,BGPEDATE)

 +9        SET BGPSIG=$$SIG^BGP9D61(DFN,BGPEDATE)

 +10       SET BGPCOLO=$$COLO^BGP9D61(DFN,BGPEDATE)

 +11       SET BGPBE=$$BE^BGP9D61(DFN,BGPEDATE)

 +12      ;S BGPRECT=$$RECT^BGP9D61(DFN,BGPEDATE)

 +13       IF BGPFOB]""!(BGPSIG]"")!(BGPCOLO]"")!(BGPBE]"")

               SET BGPN1=1

 +14       SET BGPREF=""

           IF 'BGPN1

               SET BGPREF=$$REF^BGP9D61(DFN,$$FMADD^XLFDT(BGPEDATE,-365),BGPEDATE)

               IF BGPREF

                   SET BGPN1=1

                   SET BGPN4=1

 +15       SET BGPVALUE=""

 +16       IF BGPFOB]""

               SET BGPVALUE="FOBT: "_$PIECE(BGPFOB,U)_" "_$$DATE^BGP9UTL($PIECE(BGPFOB,U,2))_" "

 +17       IF BGPSIG]""

               SET BGPVALUE=BGPVALUE_"SIG: "_$PIECE(BGPSIG,U)_":"_$PIECE(BGPSIG,U,2)_" "

 +18       IF BGPCOLO]""

               SET BGPVALUE=BGPVALUE_"COLO: "_$PIECE(BGPCOLO,U)_":"_$PIECE(BGPCOLO,U,2)_" "

 +19       IF BGPBE]""

               SET BGPVALUE=BGPVALUE_"BE: "_$PIECE(BGPBE,U)_":"_$PIECE(BGPBE,U,2)_" "

 +20       IF BGPREF]""

               SET BGPVALUE=BGPVALUE_$PIECE(BGPREF,U,3)_":"_$$DATE^BGP9UTL($PIECE(BGPREF,U,2))

 +21       SET BGPVALUE="AC|||"_BGPVALUE

 +22       KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P

 +23       QUIT 

I5        ;EP

 +1        SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0

 +2        IF 'BGPACTUP

               SET BGPSTOP=1

               QUIT 

 +3        IF BGPSEX'="F"

               SET BGPSTOP=1

               QUIT 

 +4        IF BGPAGEB<16

               SET BGPSTOP=1

               QUIT 

 +5        IF BGPAGEB>25

               SET BGPSTOP=1

               QUIT 

 +6        IF BGPACTUP

               SET BGPD2=1

 +7        IF BGPACTCL

               SET BGPD1=1

 +8        IF 'BGPD1

               SET BGPSTOP=1

               QUIT 

 +9        IF BGPD1

               IF BGPAGEB>15

                   IF BGPAGEB<21

                       SET BGPD3=1

 +10       IF BGPD1

               IF BGPAGEB>20

                   IF BGPAGEB<26

                       SET BGPD4=1