BGP1D8.m

BGP1D8 ; IHS/CMI/LAB - measure C 03 Jul 2010 7:05 AM ;

 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33

 ;

IE2 ;EP

 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12,BGPD13,BGPD14,BGPD15,BGPD16,BGPD17,BGPD18)=0

 S BGPNO2=0

 S BGPNO2=$$HIVDX(DFN,BGPEDATE) ;has HIV dx ever (gpra)

 S BGPHIVG=""

 S BGPHIV=""

 S BGPDXB=$$HIVDX(DFN,$$FMADD^XLFDT(BGPBDATE,-1))  ;has dx before report period

 S BGPHIVD=$$HIVDX(DFN,BGPEDATE,BGPBDATE)  ;date of dx during report period

 I BGPACTCL,BGPSEX="F",$$PREG^BGP1D7(DFN,$$FMADD^XLFDT(BGPEDATE,-600),BGPEDATE,0,1),BGPNO2="" S BGPD1=1  ;active clinical, no hiv, pregnant

 S BGPN1=0

 S BGPN2=0

 I BGPD1 D

 .S BGPHIVG=$$HIVTEST(DFN,$$FMADD^XLFDT(BGPEDATE,-600),BGPEDATE)  ;get tests in past 20 months for gpra numerator

 .I $P(BGPHIVG,U)=1 S BGPN1=1  ;had a test

 .I $P(BGPHIVG,U)=2 S BGPN2=1  ;had a refusal

 ;---------------- done with GPRA num/den, now for developmental

 ;S BGPN3=$P(BGPHIV,U,3)

 ;I BGPD3,'BGPN3 S BGPSTOP=1 Q  ;screen count only but no screens

 I BGPACTUP,BGPAGEB>12,BGPAGEB<65,BGPDXB="" S BGPD2=1  ;up 13-64 with no dx before report period

 I BGPACTUP,BGPDXB="" S BGPD3=1  ;this is for screen count only, all ages and no dx before report period

 I BGPAGEB<13 S BGPD4=1

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

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

 I BGPAGEB>19,BGPAGEB<25 S BGPD7=1

 I BGPAGEB>24,BGPAGEB<30 S BGPD8=1

 I BGPAGEB>29,BGPAGEB<35 S BGPD9=1

 I BGPAGEB>34,BGPAGEB<40 S BGPD10=1

 I BGPAGEB>39,BGPAGEB<45 S BGPD11=1

 I BGPAGEB>44,BGPAGEB<50 S BGPD12=1

 I BGPAGEB>49,BGPAGEB<55 S BGPD13=1

 I BGPAGEB>54,BGPAGEB<60 S BGPD14=1

 I BGPAGEB>59,BGPAGEB<65 S BGPD15=1

 I BGPAGEB>64 S BGPD16=1

 ;get HIV test during the report period

 S BGPHIV=$$HIVTEST(DFN,BGPBDATE,BGPEDATE)  ;get tests in past 20 months for gpra numerator

 I BGPD2,$P(BGPHIV,U)=1 S BGPN4=1

 I BGPD2,$P(BGPHIV,U)=2 S BGPN8=1

 ;SET N3 TO TOTAL # OF SCREENS

 S BGPX=$$HIVTEST(DFN,BGPBDATE,$S(BGPHIVD:BGPHIVD,1:BGPEDATE))

 I BGPD3 S BGPN3=$P(BGPX,U,3)

 S BGPN5=0

 S BGPN6=0

 S BGPN7=0

 ;determine result pos or neg

 S X=$P(BGPHIV,U,5)

 S X=$$UP^XLFSTR(X)

 S D=$P(BGPHIV,U,6)

 S BGPDAFT=""

 I X="",D S G=$$HIVDX1(DFN,BGPED,D) I G S BGPN5=1,BGPDAFT="Positive HIV DX "_$P(G,U,2)_" on "_$$DATE^BGP1UTL($P(G,U)) G V

 I X="",BGPN4 S BGPN7=1,BGPDAFT="No Result"

 I X="P"!(X="POSITIVE")!(X="POS")!(X="R")!(X="REACTIVE")!(X="REPEATEDLY REACTIVE")!(X="+")!(X[">") S BGPN5=1,BGPDAFT="Positive"  ;positive result

 I X="N"!(X="NEGATIVE")!(X="NEG")!(X="NR")!(X="NON REACTIVE")!(X="NON-REACTIVE")!(X="-") S BGPN6=1,BGPDAFT="Negative"

V ;set denominator value for selected

 S BGPVALUE=""

 S BGPVAL=""

 I BGPD3 S BGPVALUE="UP"

 I BGPD2 S BGPVALUE="UP,UP13-64"

 I BGPD1 S BGPVALUE=BGPVALUE_",AC PREG (NO DX)"

 I BGPD1!(BGPD2) D

 .I BGPN1,'BGPN4 S BGPVAL=$P(BGPHIVG,U,2) Q

 .I BGPN1!(BGPN4) S BGPVAL=$P(BGPHIV,U,2)

 .I BGPN2!(BGPN8) S BGPVAL=$S(BGPHIVG]"":$P(BGPHIVG,U,4),1:$P(BGPHIV,U,4))

 I BGPD3,BGPN3 S BGPVAL=BGPVAL_$S(BGPVAL]"":"",1:$P(BGPX,U,2))_" ;Screen Count: "_BGPN3

 S BGPVALUE=BGPVALUE_"|||"_BGPVAL

 S BGPVALUD="" I BGPD2 S BGPVALUD="UP,UP13-64|||"_$S(BGPD2&(BGPHIV):"SCREEN (NO HIV DX): "_$P(BGPHIV,U,4)_" ; ",1:"")_$P(BGPHIV,U,2)_" ; "_BGPDAFT_$S(BGPN3:" ;SCREEN COUNT (NO PRIOR DX): "_$P(BGPHIV,U,3)_" screens",1:"")

 I BGPD3,'BGPD2,BGPN3 S BGPVALUD="UP|||SCREEN COUNT MEASURE: "_BGPN3_" screens"

 I BGPVALUD=" ; " S BGPVALUD=""

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

 Q:$G(BGPIISO)

 K BGPEDUC,BGPHIV

 Q

IE1 ;EP

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

 I BGPAGEB<13 S BGPSTOP=1 Q

 I 'BGPACTCL S BGPSTOP=1 Q  ;not active clinical pt

 I '$$V2HIV(DFN,BGP365,BGPEDATE) S BGPSTOP=1 Q

 I BGPACTCL S BGPD1=1

 I 'BGPD1 S BGPSTOP=1 Q

 S BGPCD4=$$CD4(DFN,BGP365,BGPEDATE)

 S BGPPCR=$$PCR(DFN,BGP365,BGPEDATE)

 I BGPCD4,'BGPPCR S BGPN1=1

 I BGPPCR,'BGPCD4 S BGPN2=1

 I BGPPCR,BGPCD4 S BGPN3=1

 I (BGPN1+BGPN2+BGPN3) S BGPN4=1

 S BGPVALUE="UP|||"_$S(BGPCD4:"CD4: "_$$DATE^BGP1UTL($P(BGPCD4,U,2))_" "_$P(BGPCD4,U,3),1:"")

 I $P(BGPVALUE,"|||",2)]"" S BGPVALUE=BGPVALUE_"; "

 S BGPVALUE=BGPVALUE_$S(BGPPCR:"Viral Load: "_$$DATE^BGP1UTL($P(BGPPCR,U,2))_" "_$P(BGPPCR,U,3),1:"")

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

 K ^TMP($J,"A")

 Q

PHYACT ;EP

 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10)=""

 I BGPAGEB<5 S BGPSTOP=1 Q

 S BGPVALUE=""

 I BGPACTUP S BGPD1=1

 I BGPACTCL S BGPD2=1

 I '(BGPACTUP+BGPACTCL) S BGPSTOP=1 Q  ;not in measure

 I BGPACTCL,BGPAGEB>4,BGPAGEB<12 S BGPD3=1  ;5-11

 I BGPACTCL,BGPAGEB>11,BGPAGEB<20 S BGPD4=1  ;12-19

 I BGPACTCL,BGPAGEB>19,BGPAGEB<25 S BGPD5=1  ;20-24

 I BGPACTCL,BGPAGEB>24,BGPAGEB<35 S BGPD6=1 ;25-34

 I BGPACTCL,BGPAGEB>34,BGPAGEB<45 S BGPD7=1

 I BGPACTCL,BGPAGEB>44,BGPAGEB<55 S BGPD8=1

 I BGPACTCL,BGPAGEB>54,BGPAGEB<75 S BGPD9=1

 I BGPACTCL,BGPAGEB>74 S BGPD10=1

 S BGPPHYA=$$FIRSTHF(DFN,BGPBDATE,BGPEDATE,"ACTIVITY LEVEL")  ;get the first health factor in this category recorded in this time period

 ;return 1^date internal^date external^factor found

 I BGPPHYA S BGPN1=1,BGPVALUE="PHYS ACT: "_$P(BGPPHYA,U,3)_" "_$P(BGPPHYA,U,4)  ;had assessment

 S BGPEXER="" I BGPPHYA S BGPEXER=$$EXER(DFN,$P(BGPPHYA,U,2),BGPEDATE)

 I BGPEXER S BGPN2=1,BGPVALUE=BGPVALUE_"; EXER ED: "_$$DATE^BGP1UTL($P(BGPEXER,U,1))_" "_$P(BGPEXER,U,2)

 I BGPD1,'BGPD2 S BGPVALUE="UP|||"_BGPVALUE

 I BGPD2 S BGPVALUE="UP,AC|||"_BGPVALUE

 K BGPEXER,BGPPHYA

 Q

EXER(P,BDATE,EDATE) ;

 NEW BGPG,X,E,BGPALLED

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

 I $D(BGPG(1)) Q $P(BGPG(1),U)_U_"V65.41"_U_$$DATE^BGP1UTL($P(BGPG(1),U,1))

 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)) 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)="EX"!($P(T,"-")="V65.41") S %=$P(BGPALLED(X),U)_U_T Q

 Q %

FIRSTHF(P,BDATE,EDATE,CAT) ;EP

 NEW C,H,D,O

 S C=$O(^AUTTHF("B",CAT,0))

 I '$G(C) Q ""

 S (H,D)=0 K O

 F  S H=$O(^AUTTHF("AC",C,H))  Q:'+H  D

 .Q:'$D(^AUPNVHF("AA",P,H))

 .S D="" F  S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D  D

 ..Q:(9999999-D)>EDATE

 ..Q:(9999999-D)<BDATE

 ..S O(9999999-D)=$O(^AUPNVHF("AA",P,H,D,""))

 .Q

 S D=$O(O(0))

 I D="" Q D

 Q 1_U_D_U_$$DATE^BGP1UTL(D)_U_$$VAL^XBDIQ1(9000010.23,O(D),.01)

 ;

HIVDX1(P,EDATE,BDATE) ;EP - any HIV dx

 NEW BGPG,G,Y,X,T,E

 K BGPG

 S Y="BGPG("

 S BDATE=$G(BDATE)

 I BDATE="" S BDATE=$P(^DPT(P,0),U,3)  ;dob

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

 I $D(BGPG(1)) Q $P(BGPG(1),U)_U_$P(BGPG(1),U,2)

 S T=$O(^ATXAX("B","BGP HIV/AIDS DXS",0))

 S X=0,G="" F  S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G]"")  D

 .Q:$P(^AUPNPROB(X,0),U,8)>EDATE

 .S Y=$P(^AUPNPROB(X,0),U)

 .Q:'$$ICD^ATXCHK(Y,T,9)

 .S G=$P(^AUPNPROB(X,0),U,8)_U_$$VAL^XBDIQ1(9000011,X,.01)

 .Q

 Q G

HIVDX(P,EDATE,BDATE) ;EP - any HIV dx ever or problem list HIV dx

 NEW BGPG,G,Y,X,T,E

 K BGPG

 S Y="BGPG("

 S BDATE=$G(BDATE)

 I BDATE="" S BDATE=$P(^DPT(P,0),U,3)  ;dob

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

 I $D(BGPG(1)) Q $P(BGPG(1),U)

 S T=$O(^ATXAX("B","BGP HIV/AIDS DXS",0))

 S X=0,G="" F  S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G]"")  D

 .Q:$P(^AUPNPROB(X,0),U,8)>EDATE

 .S Y=$P(^AUPNPROB(X,0),U)

 .Q:'$$ICD^ATXCHK(Y,T,9)

 .S G=$P(^AUPNPROB(X,0),U,8)

 .Q

 Q G

HIVTEST(P,BDATE,EDATE) ;

 NEW BGPC,BGPT,T,X,BGPLT,E,D,B,L,J,G,BGPT1,BGPA

 NEW BD,ED,Y,D,V

 K BGPA

 S BGPC=0

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

 S BGPLT=$O(^ATXLAB("B","BGP HIV TEST 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))

 ...S V=$P(^AUPNVLAB(X,0),U,3)

 ...I BGPLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT,21,"B",$P(^AUPNVLAB(X,0),U))) S BGPC=BGPC+1,BGPC(BGPC)=1_U_$$DATE^BGP1UTL((9999999-D))_" LAB"_U_$P(^AUPNVLAB(X,0),U,4)_U_D,BGPA((9999999-D))="" Q

 ...Q:'T

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

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

 ...S BGPC=BGPC+1,BGPC(BGPC)=1_U_$$DATE^BGP1UTL((9999999-D))_"  LAB "_$P($G(^LAB(95.3,J,0)),U)_"-"_$P($G(^LAB(95.3,J,0)),U,15)_U_$P(^AUPNVLAB(X,0),U,4)_U_D,BGPA((9999999-D))=""

 ...Q

 S T=$O(^ATXAX("B","BGP CPT HIV TESTS",0))

 I T D

 .;go through visits in a date range for this patient, check cpts

 .S ED=(9999999-EDATE),BD=9999999-BDATE,G=0

 .F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)  D

 ..S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V  D

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

 ...Q:'$D(^AUPNVCPT("AD",V))

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

 ....I $$ICD^ATXCHK($P(^AUPNVCPT(X,0),U),T,1) I '$D(BGPA((9999999-$P(ED,".")))) S BGPC=BGPC+1,BGPC(BGPC)=1_U_$$DATE^BGP1UTL((9999999-$P(ED,".")))_" CPT "_$$VAL^XBDIQ1(9000010.18,X,.01)_U_U_$P(ED,"."),BGPA((9999999-$P(ED,".")))=""

 ....Q

 ...Q

 ..Q

 I BGPC>0 D  S $P(X,U,2)=X,$P(X,U,1)=1,$P(X,U,3)=BGPC,$P(X,U,4)=Y,$P(X,U,6)=(9999999-T) Q X

 .S X=""

 .S T=0 F  S T=$O(BGPC(T)) Q:T'=+T  S:X]"" X=X_" " S X=X_$S(X]"":"; ",1:"")_$P(BGPC(T),U,2)_" result: "_$P(BGPC(T),U,3)

 .;GET LAST ONE WITH A RESULT AND SET INTO Y

 .K BGPA

 .S T=0 F  S T=$O(BGPC(T)) Q:T'=+T  I $P(BGPC(T),U,3)]"" S BGPA($P(BGPC(T),U,4))=BGPC(T)

 .S T=$O(BGPA(0))

 .I T S Y=$P(BGPA(T),U,2)_" result: "_$P(BGPA(T),U,3)_U_$P(BGPA(T),U,3) Q

 .S T=0 F  S T=$O(BGPC(T)) Q:T'=+T  S BGPA($P(BGPC(T),U,4))=BGPC(T)

 .S T=$O(BGPA(0))

 .S Y=$P(BGPA(T),U,2)_" No Result"

 ;now check for refusal of an HIV test

 S BGPT=$O(^ATXLAB("B","BGP HIV TEST TAX",0))

 I 'BGPT Q ""

 S (G,BGPT1)=0,G="" F  S BGPT1=$O(^ATXLAB(BGPT,21,"B",BGPT1)) Q:BGPT1=""!(G)  D

 .S T=$$REFUSAL^BGP1UTL1(P,60,BGPT1,BDATE,EDATE) I $P(T,U)=1 S G=2_U_$$DATE^BGP1UTL($P(T,U,2))_" lab refusal"_U_U_$$DATE^BGP1UTL($P(T,U,2))_" lab refusal"

 Q G

HIVEDUC(P,BDATE,EDATE) ;

 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(1)) Q ""

 S X=0,G="",%="",T="" F  S X=$O(BGPG(X)) Q:X'=+X!($P(G,U))  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 $P(T,"-",1)="HIV"!($P(T,"-",1)["042")!($P(T,"-",1)["043")!($P(T,"-",1)["044")!($P(T,"-",1)="V08.")!($P(T,"-",1)["795.71")!($P(T,"-",2)="HIV") S G=1_U_$$DATE^BGP1UTL($P(BGPG(X),U))_U_T

 I $P(G,U)=1 Q G

 ;

 K BGPG

 S Y="BGPG("

 S X=P_"^LAST DX V65.44;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)

 I $D(BGPG(1)) Q 1_U_$$DATE^BGP1UTL($P(BGPG(1),U))_"V65.44"  ;has a dx

 Q ""

 ;

CD4(P,BDATE,EDATE) ;

 K BGPG

 S %=P_"^LAST LAB [BGP CD4 TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) Q 1_U_$P(BGPG(1),U,1)_U_$P(BGPG(1),U,2)

 S E=+$$CODEN^ICPTCOD(86361),%=$$CPTI^BGP1DU(P,BDATE,EDATE,E) I %]"" Q 1_U_$P(%,U,2)_"^86361"

 S E=+$$CODEN^ICPTCOD(86360),%=$$CPTI^BGP1DU(P,BDATE,EDATE,E) I %]"" Q 1_U_$P(%,U,2)_"^86360"

 S E=+$$CODEN^ICPTCOD(86359),%=$$CPTI^BGP1DU(P,BDATE,EDATE,E) I %]"" Q 1_U_$P(%,U,2)_"^86359"

 ;tran codes

 S E=+$$CODEN^ICPTCOD(86361),%=$$TRANI^BGP1DU(P,BDATE,EDATE,E) I %]"" Q 1_U_$P(%,U,2)_"^86361 TRAN"

 S E=+$$CODEN^ICPTCOD(86360),%=$$TRANI^BGP1DU(P,BDATE,EDATE,E) I %]"" Q 1_U_$P(%,U,2)_"^86360 TRAN"

 S E=+$$CODEN^ICPTCOD(86359),%=$$TRANI^BGP1DU(P,BDATE,EDATE,E) I %]"" Q 1_U_$P(%,U,2)_"^86359 TRAN"

 ;now go through all labs and check loinc codes

 K ^TMP($J,"A")

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

 I '$D(^TMP($J,"A",1)) Q ""

 ;now go through all lab tests and see if any are the loinc codes in the taxonomy

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

 I 'T Q ""

 S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G)  S I=+$P(^TMP($J,"A",X),U,4) I $P($G(^AUPNVLAB(I,11)),U,13)]"" D

 .S J=$P(^AUPNVLAB(I,11),U,13)

 .I $$LOINC^BGP1D21(J,T) S G=1_U_$$VD^APCLV($P(^AUPNVLAB(I,0),U,3))_U_$$VAL^XBDIQ1(9000010.09,I,.01)

 Q G

PCR(P,BDATE,EDATE) ;

 K BGPG

 S %=P_"^LAST LAB [BGP HIV VIRAL LOAD TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) Q 1_U_$P(BGPG(1),U,1)_U_$P(BGPG(1),U,2)

 S E=+$$CODEN^ICPTCOD(87536),%=$$CPTI^BGP1DU(P,BDATE,EDATE,E) I %]"" Q 1_U_$P(%,U,2)_"^87536"

 S E=+$$CODEN^ICPTCOD(87539),%=$$CPTI^BGP1DU(P,BDATE,EDATE,E) I %]"" Q 1_U_$P(%,U,2)_"^87539"

 S E=+$$CODEN^ICPTCOD(87536),%=$$TRANI^BGP1DU(P,BDATE,EDATE,E) I %]"" Q 1_U_$P(%,U,2)_"^87536 TRAN"

 S E=+$$CODEN^ICPTCOD(87539),%=$$TRANI^BGP1DU(P,BDATE,EDATE,E) I %]"" Q 1_U_$P(%,U,2)_"^87539 TRAN"

 ;now go through all labs and check loinc codes

 K ^TMP($J,"A")

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

 I '$D(^TMP($J,"A",1)) Q ""

 ;now go through all lab tests and see if any are the loinc codes in the taxonomy

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

 I 'T Q ""

 S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G)  S I=+$P(^TMP($J,"A",X),U,4) I $P($G(^AUPNVLAB(I,11)),U,13)]"" D

 .S J=$P(^AUPNVLAB(I,11),U,13)

 .I $$LOINC^BGP1D21(J,T) S G=1_U_$$VD^APCLV($P(^AUPNVLAB(I,0),U,3))_U_$$VAL^XBDIQ1(9000010.09,I,.01)

 Q G

V2HIV(P,BDATE,EDATE) ;

 I '$G(P) Q ""

 I '$D(^AUPNVSIT("AC",P)) Q ""

 NEW BGP1M

 S BGP1M=$$FMADD^XLFDT(EDATE,-(6*30))

 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 T=$O(^ATXAX("B","BGP HIV/AIDS DXS",0))

 I 'T Q ""

 S (X,G,H)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+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:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)

 .Q:"CV"[$P(^AUPNVSIT(V,0),U,3)

 .S (D,Y)=0 F  S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D)  I $D(^AUPNVPOV(Y,0)) S %=$P(^AUPNVPOV(Y,0),U) I $$ICD^ATXCHK(%,T,9) S D=1

 .Q:'D

 .I $P($P(^AUPNVSIT(V,0),U),".")'<BGP1M S H=1

 .S G=G+1

 .Q

 I G>1,H=1 Q 1

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

BGP1D8    ; IHS/CMI/LAB - measure C 03 Jul 2010 7:05 AM ;

 +1       ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33

 +2       ;

IE2       ;EP

 +1        SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12,BGPD13,BGPD14,BGPD15,BGPD16,BGPD17,BGPD18)=0

 +2        SET BGPNO2=0

 +3       ;has HIV dx ever (gpra)

           SET BGPNO2=$$HIVDX(DFN,BGPEDATE)

 +4        SET BGPHIVG=""

 +5        SET BGPHIV=""

 +6       ;has dx before report period

           SET BGPDXB=$$HIVDX(DFN,$$FMADD^XLFDT(BGPBDATE,-1))

 +7       ;date of dx during report period

           SET BGPHIVD=$$HIVDX(DFN,BGPEDATE,BGPBDATE)

 +8       ;active clinical, no hiv, pregnant

           IF BGPACTCL

               IF BGPSEX="F"

                   IF $$PREG^BGP1D7(DFN,$$FMADD^XLFDT(BGPEDATE,-600),BGPEDATE,0,1)

                       IF BGPNO2=""

                           SET BGPD1=1

 +9        SET BGPN1=0

 +10       SET BGPN2=0

 +11       IF BGPD1

               Begin DoDot:1

 +12      ;get tests in past 20 months for gpra numerator

                   SET BGPHIVG=$$HIVTEST(DFN,$$FMADD^XLFDT(BGPEDATE,-600),BGPEDATE)

 +13      ;had a test

                   IF $PIECE(BGPHIVG,U)=1

                       SET BGPN1=1

 +14      ;had a refusal

                   IF $PIECE(BGPHIVG,U)=2

                       SET BGPN2=1

               End DoDot:1

 +15      ;---------------- done with GPRA num/den, now for developmental

 +16      ;S BGPN3=$P(BGPHIV,U,3)

 +17      ;I BGPD3,'BGPN3 S BGPSTOP=1 Q  ;screen count only but no screens

 +18      ;up 13-64 with no dx before report period

           IF BGPACTUP

               IF BGPAGEB>12

                   IF BGPAGEB<65

                       IF BGPDXB=""

                           SET BGPD2=1

 +19      ;this is for screen count only, all ages and no dx before report period

           IF BGPACTUP

               IF BGPDXB=""

                   SET BGPD3=1

 +20       IF BGPAGEB<13

               SET BGPD4=1

 +21       IF BGPAGEB>12

               IF BGPAGEB<15

                   SET BGPD5=1

 +22       IF BGPAGEB>14

               IF BGPAGEB<20

                   SET BGPD6=1

 +23       IF BGPAGEB>19

               IF BGPAGEB<25

                   SET BGPD7=1

 +24       IF BGPAGEB>24

               IF BGPAGEB<30

                   SET BGPD8=1

 +25       IF BGPAGEB>29

               IF BGPAGEB<35

                   SET BGPD9=1

 +26       IF BGPAGEB>34

               IF BGPAGEB<40

                   SET BGPD10=1

 +27       IF BGPAGEB>39

               IF BGPAGEB<45

                   SET BGPD11=1

 +28       IF BGPAGEB>44

               IF BGPAGEB<50

                   SET BGPD12=1

 +29       IF BGPAGEB>49

               IF BGPAGEB<55

                   SET BGPD13=1

 +30       IF BGPAGEB>54

               IF BGPAGEB<60

                   SET BGPD14=1

 +31       IF BGPAGEB>59

               IF BGPAGEB<65

                   SET BGPD15=1

 +32       IF BGPAGEB>64

               SET BGPD16=1

 +33      ;get HIV test during the report period

 +34      ;get tests in past 20 months for gpra numerator

           SET BGPHIV=$$HIVTEST(DFN,BGPBDATE,BGPEDATE)

 +35       IF BGPD2

               IF $PIECE(BGPHIV,U)=1

                   SET BGPN4=1

 +36       IF BGPD2

               IF $PIECE(BGPHIV,U)=2

                   SET BGPN8=1

 +37      ;SET N3 TO TOTAL # OF SCREENS

 +38       SET BGPX=$$HIVTEST(DFN,BGPBDATE,$SELECT(BGPHIVD:BGPHIVD,1:BGPEDATE))

 +39       IF BGPD3

               SET BGPN3=$PIECE(BGPX,U,3)

 +40       SET BGPN5=0

 +41       SET BGPN6=0

 +42       SET BGPN7=0

 +43      ;determine result pos or neg

 +44       SET X=$PIECE(BGPHIV,U,5)

 +45       SET X=$$UP^XLFSTR(X)

 +46       SET D=$PIECE(BGPHIV,U,6)

 +47       SET BGPDAFT=""

 +48       IF X=""

               IF D

                   SET G=$$HIVDX1(DFN,BGPED,D)

                   IF G

                       SET BGPN5=1

                       SET BGPDAFT="Positive HIV DX "_$PIECE(G,U,2)_" on "_$$DATE^BGP1UTL($PIECE(G,U))