- BGP4D85 ; IHS/CMI/LAB - measure C 09 Jun 2014 5:18 PM ;
- ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
- ;
- 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^BGP4D86(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^BGP4D811(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^BGP4D35(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^BGP4D35(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^BGP4D36(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^BGP4D36(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
- BGP4D85 ; IHS/CMI/LAB - measure C 09 Jun 2014 5:18 PM ;
- +1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
- +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^BGP4D86(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^BGP4D811(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^BGP4D35(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^BGP4D35(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^BGP4D36(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^BGP4D36(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
