BGP2D85 ; IHS/CMI/LAB - measure C 09 Jun 2012 5:18 PM ;
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;
I28 ;EP
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20)=0
S (BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27,BGPN28,BGPN29,BGPN30,BGPN31,BGPN32,BGPN33,BGPN34,BGPN35,BGPN40,BGPN41)=0
S (BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6)=0
S (BGPX1,BGPX2,BGPX3,BGPX4,BGPX5,BGPX6)=0
S BGPVALUE=""
K BGPDTAP,BGPOPV,BGPMMR,BGPD,BGPT,BGPPER,BGPTET,BGPM,BGPMU,BGPME,BGPHIB,BGPHEP,BGPVAR
I 'BGPACTUP S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q ;must be active clinical
I $$AGE^AUPNPAT(DFN,BGPBDATE)<13 S BGPSTOP=1 Q ;not 13 at beginning of time period
I $$AGE^AUPNPAT(DFN,BGPBDATE)>17 S BGPSTOP=1 Q
I $$AGE^AUPNPAT(DFN,BGPBDATE)=13 S BGPD1=1 I BGPSEX="F" S BGPD3=1
S BGPD2=1
I BGPSEX="F" S BGPD4=1
K ^TMP($J,"CPT")
S BGPVAL=$$TDAP^BGP2D86(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4)!($P(BGPVAL,U,1)=2) S BGPN10=1 ;any hit
I $P(BGPVAL,U,1) S BGPX1=1
I $P(BGPVAL,U,1)=3 S BGPN11=1
I $P(BGPVAL,U,1)=4 S BGPN12=1 ;Evid disease, nmi, Contraindication
I $P(BGPVAL,U,2)["Tdap",'BGPN11 S BGPN6=1 ;tdap
I $P(BGPVAL,U,1) S BGPVALUE=$P(BGPVAL,U,2)
S BGPVAL=$$MMR^BGP2D811(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4)!($P(BGPVAL,U,1)=2) S BGPN7=1 ;any hit
I $P(BGPVAL,U,1) S BGPX2=1
I $P(BGPVAL,U,1)=3 S BGPN8=1
I $P(BGPVAL,U,1)=4 S BGPN9=1 ;Evid disease, nmi, Contraindication
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPADOL=1
S BGPVAL=$$HEP^BGP2D35(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4)!($P(BGPVAL,U,1)=2) S BGPN13=1 ;any hit
I $P(BGPVAL,U,1) S BGPX3=1
I $P(BGPVAL,U,1)=3 S BGPN14=1
I $P(BGPVAL,U,1)=4 S BGPN15=1 ;Evid disease, nmi, Contraindication
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
K BGPADOL
S BGPVAL=$$VAR^BGP2D35(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4)!($P(BGPVAL,U,1)=2) S BGPN16=1 ;any hit
I $P(BGPVAL,U,1) S BGPX4=1
I $P(BGPVAL,U,1)=3 S BGPN17=1
I $P(BGPVAL,U,1)=4 S BGPN18=1 ;Evid disease, nmi, Contraindication
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPVAL=$$MEN^BGP2D36(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4)!($P(BGPVAL,U,1)=2) S BGPN1=1 ;any hit
I $P(BGPVAL,U,1) S BGPX5=1
I $P(BGPVAL,U,1)=3 S BGPN2=1
I $P(BGPVAL,U,1)=4 S BGPN3=1 ;Evid disease, nmi, Contraindication
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPVAL=$$HPV^BGP2D36(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4)!($P(BGPVAL,U,1)=2) S BGPN4=1 ;any hit
I $P(BGPVAL,U,1) S BGPX6=1
I $P(BGPVAL,U,1)=3 S BGPN5=1
I $P(BGPVAL,U,1)=4 S BGPN27=1 ;Evid disease, nmi, Contraindication
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
I BGPX1,BGPX2,BGPX3,BGPX4 S BGPN40=1
I BGPX2,BGPX3,BGPX4 S BGPN41=1
I BGPN7,BGPN13,BGPN16 S BGPN19=1 ;15.1.1
I BGPN8!(BGPN17)!(BGPN14) S BGPN22=1 ;15.1.2
I BGPN9!(BGPN18)!(BGPN15) S BGPN23=1 ;15.1.3
I BGPN7,BGPN13,BGPN16,BGPN10 S BGPN24=1 ;15.1.4
I BGPN8!(BGPN17)!(BGPN14)!(BGPN11) S BGPN25=1 ;15.1.5
I BGPN9!(BGPN18)!(BGPN15)!(BGPN12) S BGPN26=1 ;15.1.6
I BGPN1,BGPN10 S BGPN32=1 ;12.1 new 1:1:3 combo, tdap, men, 3 hpv
I BGPN3!(BGPN12) S BGPN33=1 ;12.1 new 1:1:3 combo evid, contra
I BGPN11!(BGPN2) S BGPN34=1 ;12.1 new 1:1:3 refusal
I BGPX1,BGPX5 S BGPN35=1
I BGPN1,BGPN4,BGPN10 S BGPN28=1 ;12.1 new 1:1:3 combo, tdap, men, 3 hpv
I BGPN3!(BGPN27)!(BGPN12) S BGPN29=1 ;12.1 new 1:1:3 combo evid, contra
I BGPN11!(BGPN2)!(BGPN5) S BGPN30=1 ;12.1 new 1:1:3 refusal
I BGPX1,BGPX5,BGPX6 S BGPN31=1
I BGPRTYPE=3,'BGPN19 S BGPVALUE="DID NOT HAVE: " D
.I 'BGPN7 S BGPVALUE=BGPVALUE_"2 MMR;"
.I 'BGPN13 S BGPVALUE=BGPVALUE_"3 HEP;"
.I 'BGPN16 S BGPVALUE=BGPVALUE_"VAR"
S D=""
S D="AC"
S BGPVALUE=D_"|||"_BGPVALUE
K BGPTET,BGPDTAP,BGPDT,BGPTD,BGPPER,BGPDIP,BGPMU,BGPME,BGPMMR,BGPMR,BGPRM,BGPOPV,BGPRUB,BGPHIB,BGPHEB,BGPVAR,BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPVAL
Q
IMMREF(P,IMM,BD,ED) ;EP
NEW X,Y,G,D,R
I 'IMM Q ""
S (X,G)=0,Y=$O(^AUTTIMM("C",IMM,0))
I 'Y Q ""
F S X=$O(^BIPC("AC",P,Y,X)) Q:X'=+X D
.S R=$P(^BIPC(X,0),U,3)
.Q:R=""
.Q:'$D(^BICONT(R,0))
.Q:$P(^BICONT(R,0),U,1)'["Refusal"
.S D=$P(^BIPC(X,0),U,4)
.Q:D=""
.Q:$P(^BIPC(X,0),U,4)<BD
.Q:$P(^BIPC(X,0),U,4)>ED
.S G=G+1
Q G
BGP2D85 ; IHS/CMI/LAB - measure C 09 Jun 2012 5:18 PM ;
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;
I28 ;EP
+1 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20)=0
+2 SET (BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27,BGPN28,BGPN29,BGPN30,BGPN31,BGPN32,BGPN33,BGPN34,BGPN35,BGPN40,BGPN41)=0
+3 SET (BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6)=0
+4 SET (BGPX1,BGPX2,BGPX3,BGPX4,BGPX5,BGPX6)=0
+5 SET BGPVALUE=""
+6 KILL BGPDTAP,BGPOPV,BGPMMR,BGPD,BGPT,BGPPER,BGPTET,BGPM,BGPMU,BGPME,BGPHIB,BGPHEP,BGPVAR
+7 IF 'BGPACTUP
SET BGPSTOP=1
QUIT
+8 ;must be active clinical
IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+9 ;not 13 at beginning of time period
IF $$AGE^AUPNPAT(DFN,BGPBDATE)<13
SET BGPSTOP=1
QUIT
+10 IF $$AGE^AUPNPAT(DFN,BGPBDATE)>17
SET BGPSTOP=1
QUIT
+11 IF $$AGE^AUPNPAT(DFN,BGPBDATE)=13
SET BGPD1=1
IF BGPSEX="F"
SET BGPD3=1
+12 SET BGPD2=1
+13 IF BGPSEX="F"
SET BGPD4=1
+14 KILL ^TMP($JOB,"CPT")
+15 SET BGPVAL=$$TDAP^BGP2D86(DFN,BGPEDATE)
+16 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)!($PIECE(BGPVAL,U,1)=2)
SET BGPN10=1
+17 IF $PIECE(BGPVAL,U,1)
SET BGPX1=1
+18 IF $PIECE(BGPVAL,U,1)=3
SET BGPN11=1
+19 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN12=1
+20 ;tdap
IF $PIECE(BGPVAL,U,2)["Tdap"
IF 'BGPN11
SET BGPN6=1
+21 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=$PIECE(BGPVAL,U,2)
+22 SET BGPVAL=$$MMR^BGP2D811(DFN,BGPEDATE)
+23 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)!($PIECE(BGPVAL,U,1)=2)
SET BGPN7=1
+24 IF $PIECE(BGPVAL,U,1)
SET BGPX2=1
+25 IF $PIECE(BGPVAL,U,1)=3
SET BGPN8=1
+26 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN9=1
+27 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+28 SET BGPADOL=1
+29 SET BGPVAL=$$HEP^BGP2D35(DFN,BGPEDATE)
+30 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)!($PIECE(BGPVAL,U,1)=2)
SET BGPN13=1
+31 IF $PIECE(BGPVAL,U,1)
SET BGPX3=1
+32 IF $PIECE(BGPVAL,U,1)=3
SET BGPN14=1
+33 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN15=1
+34 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+35 KILL BGPADOL
+36 SET BGPVAL=$$VAR^BGP2D35(DFN,BGPEDATE)
+37 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)!($PIECE(BGPVAL,U,1)=2)
SET BGPN16=1
+38 IF $PIECE(BGPVAL,U,1)
SET BGPX4=1
+39 IF $PIECE(BGPVAL,U,1)=3
SET BGPN17=1
+40 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN18=1
+41 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+42 SET BGPVAL=$$MEN^BGP2D36(DFN,BGPEDATE)
+43 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)!($PIECE(BGPVAL,U,1)=2)
SET BGPN1=1
+44 IF $PIECE(BGPVAL,U,1)
SET BGPX5=1
+45 IF $PIECE(BGPVAL,U,1)=3
SET BGPN2=1
+46 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN3=1
+47 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+48 SET BGPVAL=$$HPV^BGP2D36(DFN,BGPEDATE)
+49 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)!($PIECE(BGPVAL,U,1)=2)
SET BGPN4=1
+50 IF $PIECE(BGPVAL,U,1)
SET BGPX6=1
+51 IF $PIECE(BGPVAL,U,1)=3
SET BGPN5=1
+52 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN27=1
+53 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+54 IF BGPX1
IF BGPX2
IF BGPX3
IF BGPX4
SET BGPN40=1
+55 IF BGPX2
IF BGPX3
IF BGPX4
SET BGPN41=1
+56 ;15.1.1
IF BGPN7
IF BGPN13
IF BGPN16
SET BGPN19=1
+57 ;15.1.2
IF BGPN8!(BGPN17)!(BGPN14)
SET BGPN22=1
+58 ;15.1.3
IF BGPN9!(BGPN18)!(BGPN15)
SET BGPN23=1
+59 ;15.1.4
IF BGPN7
IF BGPN13
IF BGPN16
IF BGPN10
SET BGPN24=1
+60 ;15.1.5
IF BGPN8!(BGPN17)!(BGPN14)!(BGPN11)
SET BGPN25=1
+61 ;15.1.6
IF BGPN9!(BGPN18)!(BGPN15)!(BGPN12)
SET BGPN26=1
+62 ;12.1 new 1:1:3 combo, tdap, men, 3 hpv
IF BGPN1
IF BGPN10
SET BGPN32=1
+63 ;12.1 new 1:1:3 combo evid, contra
IF BGPN3!(BGPN12)
SET BGPN33=1
+64 ;12.1 new 1:1:3 refusal
IF BGPN11!(BGPN2)
SET BGPN34=1
+65 IF BGPX1
IF BGPX5
SET BGPN35=1
+66 ;12.1 new 1:1:3 combo, tdap, men, 3 hpv
IF BGPN1
IF BGPN4
IF BGPN10
SET BGPN28=1
+67 ;12.1 new 1:1:3 combo evid, contra
IF BGPN3!(BGPN27)!(BGPN12)
SET BGPN29=1
+68 ;12.1 new 1:1:3 refusal
IF BGPN11!(BGPN2)!(BGPN5)
SET BGPN30=1
+69 IF BGPX1
IF BGPX5
IF BGPX6
SET BGPN31=1
+70 IF BGPRTYPE=3
IF 'BGPN19
SET BGPVALUE="DID NOT HAVE: "
Begin DoDot:1
+71 IF 'BGPN7
SET BGPVALUE=BGPVALUE_"2 MMR;"
+72 IF 'BGPN13
SET BGPVALUE=BGPVALUE_"3 HEP;"
+73 IF 'BGPN16
SET BGPVALUE=BGPVALUE_"VAR"
End DoDot:1
+74 SET D=""
+75 SET D="AC"
+76 SET BGPVALUE=D_"|||"_BGPVALUE
+77 KILL BGPTET,BGPDTAP,BGPDT,BGPTD,BGPPER,BGPDIP,BGPMU,BGPME,BGPMMR,BGPMR,BGPRM,BGPOPV,BGPRUB,BGPHIB,BGPHEB,BGPVAR,BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPVAL
+78 QUIT
IMMREF(P,IMM,BD,ED) ;EP
+1 NEW X,Y,G,D,R
+2 IF 'IMM
QUIT ""
+3 SET (X,G)=0
SET Y=$ORDER(^AUTTIMM("C",IMM,0))
+4 IF 'Y
QUIT ""
+5 FOR
SET X=$ORDER(^BIPC("AC",P,Y,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET R=$PIECE(^BIPC(X,0),U,3)
+7 IF R=""
QUIT
+8 IF '$DATA(^BICONT(R,0))
QUIT
+9 IF $PIECE(^BICONT(R,0),U,1)'["Refusal"
QUIT
+10 SET D=$PIECE(^BIPC(X,0),U,4)
+11 IF D=""
QUIT
+12 IF $PIECE(^BIPC(X,0),U,4)<BD
QUIT
+13 IF $PIECE(^BIPC(X,0),U,4)>ED
QUIT
+14 SET G=G+1
End DoDot:1
+15 QUIT G
