BGP6D32 ; IHS/CMI/LAB - measure C ; 28 Sep 2015 11:39 AM
;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
;
I14 ;EP
;3 denominators, 32 numerators
;F X=1:1:42,50:1:52,60:1:62,70:1:72,80:1:82 NEW @("BGPN"_X)
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,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27)=0
S (BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPI7,BGPN28,BGPN29,BGP60N,BGPN30,BGPN31,BGPN32,BGPN33,BGPN34,BGPN40,BGPN41,BGPN42,BGPN43)=0
S (BGPN50,BGPN51,BGPN52,BGPI50)=""
S (BGPN60,BGPN61,BGPN62)=""
S (BGPN70,BGPN71,BGPN72)=""
S (BGPN80,BGPN81,BGPN82)=""
S (BGPN90,BGPN91,BGPN92)=""
S (BGPR1,BGPR2,BGPR3,BGPR4,BGPR5,BGPR6,BGPR7,BGPR8,BGPR9)=""
S BGPVALUE="",BGPVALUD=""
K BGPDTAP,BGPOPV,BGPMMR,BGPD,BGPT,BGPPER,BGPTET,BGPM,BGPMU,BGPME,BGPHIB,BGPHEP,BGPVAR
I 'BGPACTUP S BGPSTOP=1 Q
S (B,E,C)=""
D AGEDATE^BGP6UTL3("19-35",BGPEDATE,.B,.E,.C)
I $$DOB^AUPNPAT(DFN)<B S BGPSTOP=1 Q
I $$DOB^AUPNPAT(DFN)>E S BGPSTOP=1 Q
;S BGPDAYS=$$FMDIFF^XLFDT(BGPBDATE,$$DOB^AUPNPAT(DFN))
;S BGPMON=BGPDAYS/30.4167
;I BGPMON<7 S BGPSTOP=1 Q ;no one less than 7 months
;I BGPMON>23 S BGPSTOP=1 Q ;no one less than 23 months on 1st day of time frame
I BGPACTUP S BGPD2=1
I BGPACTCL S BGPD1=1
I BGPACTUP,$$ACTIM(DFN,BGPBDATE,BGPEDATE),BGPTIME=1 S BGPD3=1
I 'BGPD1,'BGPD2,'BGPD3 S BGPSTOP=1 Q
;BGPN1 - patients with 4 DTaP or various combinations
K ^TMP($J,"CPT")
S BGPVAL=$$DTAP^BGP6D34(DFN,BGPEDATE) ;1 IS had immunizations, 3 is had Refusal, 4 is disease or NMI or Contraindication
I $P(BGPVAL,U,1) S BGPN1=1 ;any hit
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR1=1
I $P(BGPVAL,U,1)=1 S BGPI1=1 ;had all imms
I $P(BGPVAL,U,1)=3 S BGPN2=1 ;Refusal
I $P(BGPVAL,U,1)=4 S BGPN3=1 ;evid disease, nmi, Contraindication
I $P(BGPVAL,U,1) S BGPVALUE=$P(BGPVAL,U,2)
I $P(BGPVAL,U,1) S BGPVALUD=$P(BGPVAL,U,2)
K ^TMP($J,"CPT")
S BGPVAL=$$OPV^BGP6D33(DFN,BGPEDATE)
I $P(BGPVAL,U,1) S BGPN4=1 ;any hit
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR2=1
I $P(BGPVAL,U,1)=1 S BGPI2=1 ;had all imms
I $P(BGPVAL,U,1)=3 S BGPN5=1 ;Refusal
I $P(BGPVAL,U,1)=4 S BGPN6=1 ;evid disease, nmi, Contraindication
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPVAL=$$MMR^BGP6D33(DFN,BGPEDATE)
I $P(BGPVAL,U,1) S BGPN7=1 ;any hit
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR3=1
I $P(BGPVAL,U,1)=1 S BGPI3=1
I $P(BGPVAL,U,1)=3 S BGPN8=1 ;Refusal
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)
I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
;S BGPVAL=$$HIB^BGP6D35(DFN,BGPEDATE)
;I $P(BGPVAL,U,1) S BGPN10=1 ;any hit
;I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR4=1
;I $P(BGPVAL,U,1)=1 S BGPI4=1
;I $P(BGPVAL,U,1)=3 S BGPN11=1 ;Refusal
;I $P(BGPVAL,U,1)=4 S BGPN12=1 ;Evid disease, nmi, Contraindication
;I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
;I $P(BGPVAL,U,1)!($P(BGPVAL,U,1)=4) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPVAL=$$HIB3^BGP6D38(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN90=1 ;any hit
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR4=1
I $P(BGPVAL,U,1)=4 S BGPN92=1
I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
I 'BGPN90 D
.S BGPVAL=$$HIB4^BGP6D38(DFN,BGPEDATE)
.I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN90=1 ;any hit
.I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR4=1
.I $P(BGPVAL,U,1)=4 S BGPN92=1
.I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
.I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPVAL=$$HEP^BGP6D35(DFN,BGPEDATE)
I $P(BGPVAL,U,1) S BGPN13=1 ;any hit
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR5=1
I $P(BGPVAL,U,1)=1 S BGPI5=1
I $P(BGPVAL,U,1)=3 S BGPN14=1 ;Refusal
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)
I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPVAL=$$VAR^BGP6D35(DFN,BGPEDATE)
I $P(BGPVAL,U,1) S BGPN16=1 ;any hit
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR6=1
I $P(BGPVAL,U,1)=1 S BGPI6=1
I $P(BGPVAL,U,1)=3 S BGPN17=1 ;Refusal
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)
I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPVAL=$$PNEUMO^BGP6D35(DFN,BGPEDATE,3)
I $P(BGPVAL,U,1) S BGPN50=1 ;any hit
I $P(BGPVAL,U,1)=1 S BGPI50=1
I $P(BGPVAL,U,1)=3 S BGPN51=1 ;Refusal
I $P(BGPVAL,U,1)=4 S BGPN52=1 ;Evid disease, nmi, Contraindication
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR8=1
S BGP3PN=BGPVAL
;I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPVAL=$$PNEUMO^BGP6D35(DFN,BGPEDATE,4)
I $P(BGPVAL,U,1) S BGPN26=1 ;any hit
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR7=1
I $P(BGPVAL,U,1)=1 S BGPI7=1
I $P(BGPVAL,U,1)=3 S BGPN27=1 ;Refusal
I $P(BGPVAL,U,1)=4 S BGPN28=1 ;Evid disease, nmi, Contraindication
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
I '$P(BGPVAL,U,1),$P(BGP3PN,U,1) D
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGP3PN,U,2)
.S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGP3PN,U,2)
S BGPVAL=$$HEPA^BGP6D37(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN60=1 ;any hit
I $P(BGPVAL,U,1)=3 S BGPN61=1 ;REFUSAL
I $P(BGPVAL,U,1)=4 S BGPN62=1 ;CONTRA
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPVAL=$$ROTA2^BGP6D37(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN70=1 ;any hit
S BGPRROT=0 I $P(BGPVAL,U,1)=3 S BGPN71=1,BGPRROT=1 ;REFUSAL
I $P(BGPVAL,U,1)=4 S BGPN72=1
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
I 'BGPN70 D
.S BGPVAL=$$ROTA3^BGP6D37(DFN,BGPEDATE)
.I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN70=1 ;any hit
.I $P(BGPVAL,U,1)=3 S BGPN71=1 ;REFUSAL
.I $P(BGPVAL,U,1)=4 S BGPN72=1
.I $P(BGPVAL,U,1)=3,BGPRROT Q ;already put a Refusal in the list
.I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
.I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
S BGPVAL=$$INFLU^BGP6D38(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN80=1 ;any hit
I $P(BGPVAL,U,1)=3 S BGPN81=1 ;REFUSAL
I $P(BGPVAL,U,1)=4 S BGPN82=1
I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
;
I BGPN1,BGPN4,BGPN7,BGPN10,BGPN13,BGPN16,BGPN26 S BGPN19=1 ;4313314
I BGPN1,'BGPN2,BGPN4,'BGPN5,BGPN7,'BGPN8,BGPN10,'BGPN11,BGPN13,'BGPN14,BGPN16,'BGPN17,BGPN26,'BGPN27 S BGPN42=1 ;4313314
I BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17)!(BGPN27) S BGPN32=1 ;4313314 REF
I BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18)!(BGPN28) S BGPN33=1 ;4313314 CONTRA
I BGPN1,BGPN4,BGPN7,BGPN10,BGPN13,BGPN16 S BGPN29=1 ;HEDIS ONLY 1.1.8 431331
I BGPN1,'BGPN2,BGPN4,'BGPN5,BGPN7,'BGPN8,BGPN10,'BGPN11,BGPN13,'BGPN14,BGPN16,'BGPN17 S BGPN41=1 ;HEDIS ONLY 1.1.8 431331 - no Refusals 027.a.23
I BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17) S BGPN30=1 ;431331 REFUSALS
I BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18) S BGPN31=1 ;431331 CONTRA/DX
I BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14) S BGPN22=1 ;REFUSAL OF 43133
I BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15) S BGPN23=1
I BGPN1,BGPN4,BGPN7 S BGPN20=1
I BGPN1,BGPN4,BGPN7,BGPN10,BGPN13 S BGPN21=1 ;4:3:1:3:3
I BGPN1,'BGPN2,BGPN4,'BGPN5,BGPN7,'BGPN8,BGPN10,'BGPN11,BGPN13,'BGPN14 S BGPN40=1 ;4:3:1:3:3 - no
I BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPI7 S BGPN24=1
I BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6 S BGPN34=1
;I BGPI1,BGPI2,BGPI3 S BGPN25=1
I BGPI1,BGPI2,BGPI3,BGPI4,BGPI5 S BGPN25=1
I BGPN1,'BGPN2,BGPN4,'BGPN5,BGPN7,'BGPN8,BGPN90,BGPN13,'BGPN14,BGPN16,'BGPN17,BGPN26,'BGPN27 S BGPN91=1 ;4313*314 GPRA DEV
I BGPR1,BGPR2,BGPR3,BGPN90,BGPR5,BGPR6,BGPR8 S BGPN43=1 ;4313*313
I BGPRTYPE=3,'BGPN41 S BGPVALUE="DID NOT HAVE: " D
.I 'BGPR1 S BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
.I 'BGPR2 S BGPVALUE=BGPVALUE_"3 Polio;"
.I 'BGPR3 S BGPVALUE=BGPVALUE_"MMR;"
.I 'BGPR4 S BGPVALUE=BGPVALUE_"3 Hib;"
.I 'BGPR5 S BGPVALUE=BGPVALUE_"3 HEP;"
.I 'BGPR6 S BGPVALUE=BGPVALUE_"VAR;"
.I 'BGPR7 S BGPVALUE=BGPVALUE_"4 Pneumo"
I $G(BGPISSO),'BGPN91 S BGPVALUE="Immunizations Overdue for: |" D
.I 'BGPR1 S BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
.I 'BGPR2 S BGPVALUE=BGPVALUE_"3 Polio;"
.I 'BGPR3 S BGPVALUE=BGPVALUE_"1 MMR;"
.I 'BGPR4 S BGPVALUE=BGPVALUE_"3 Hib;"
.I 'BGPR5 S BGPVALUE=BGPVALUE_"3 HEP;"
.I 'BGPR6 S BGPVALUE=BGPVALUE_"1 Varicella;"
.I 'BGPR7 S BGPVALUE=BGPVALUE_"4 Pneumo"
S D=""
I BGPD1 S D="UP,AC"
E S D="UP"
I BGPD3 S D=D_",IMM"
I BGPRTYPE=3 S D="AC"
S BGPVALUE=D_"|||"_BGPVALUE
S BGPVALUD=D_"|||"_BGPVALUD
;I BGPN19 S BGPVALUE=$P(BGPVALUE,"|||",1)_"|||4:3:1:3:3:1"
;I BGPN21,'BGPN19 S $P(BGPVALUE,"|||",2)="4:3:1:3:3"
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
ACTIM(P,BDATE,EDATE) ;EP is patient active on imm register as of EDATE?
I '$G(P) Q ""
I '$D(^BIP(P,0)) Q ""
I $P(^BIP(P,0),U,8)="" Q 1
I $P(^BIP(P,0),U,8)<EDATE Q ""
I $P(^BIP(P,0),U,8)=EDATE Q ""
Q 1
GETIMMS(P,EDATE,C,BGPX) ;EP
K BGPX
NEW X,Y,I,Z,V
S X=0 F S X=$O(^AUPNVIMM("AC",P,X)) Q:X'=+X D
.Q:'$D(^AUPNVIMM(X,0)) ;happens
.S Y=$P(^AUPNVIMM(X,0),U)
.Q:'Y ;happens too
.S I=$P($G(^AUTTIMM(Y,0)),U,3) ;get HL7/CVX code
.F Z=1:1:$L(C,U) I I=$P(C,U,Z) S V=$P(^AUPNVIMM(X,0),U,3) I V S D=$P($P($G(^AUPNVSIT(V,0)),U),".") I D]"",D'>EDATE S BGPX(D)=Y
.Q
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
BGP6D32 ; IHS/CMI/LAB - measure C ; 28 Sep 2015 11:39 AM
+1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
+2 ;
I14 ;EP
+1 ;3 denominators, 32 numerators
+2 ;F X=1:1:42,50:1:52,60:1:62,70:1:72,80:1:82 NEW @("BGPN"_X)
+3 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,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27)=0
+4 SET (BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPI7,BGPN28,BGPN29,BGP60N,BGPN30,BGPN31,BGPN32,BGPN33,BGPN34,BGPN40,BGPN41,BGPN42,BGPN43)=0
+5 SET (BGPN50,BGPN51,BGPN52,BGPI50)=""
+6 SET (BGPN60,BGPN61,BGPN62)=""
+7 SET (BGPN70,BGPN71,BGPN72)=""
+8 SET (BGPN80,BGPN81,BGPN82)=""
+9 SET (BGPN90,BGPN91,BGPN92)=""
+10 SET (BGPR1,BGPR2,BGPR3,BGPR4,BGPR5,BGPR6,BGPR7,BGPR8,BGPR9)=""
+11 SET BGPVALUE=""
SET BGPVALUD=""
+12 KILL BGPDTAP,BGPOPV,BGPMMR,BGPD,BGPT,BGPPER,BGPTET,BGPM,BGPMU,BGPME,BGPHIB,BGPHEP,BGPVAR
+13 IF 'BGPACTUP
SET BGPSTOP=1
QUIT
+14 SET (B,E,C)=""
+15 DO AGEDATE^BGP6UTL3("19-35",BGPEDATE,.B,.E,.C)
+16 IF $$DOB^AUPNPAT(DFN)<B
SET BGPSTOP=1
QUIT
+17 IF $$DOB^AUPNPAT(DFN)>E
SET BGPSTOP=1
QUIT
+18 ;S BGPDAYS=$$FMDIFF^XLFDT(BGPBDATE,$$DOB^AUPNPAT(DFN))
+19 ;S BGPMON=BGPDAYS/30.4167
+20 ;I BGPMON<7 S BGPSTOP=1 Q ;no one less than 7 months
+21 ;I BGPMON>23 S BGPSTOP=1 Q ;no one less than 23 months on 1st day of time frame
+22 IF BGPACTUP
SET BGPD2=1
+23 IF BGPACTCL
SET BGPD1=1
+24 IF BGPACTUP
IF $$ACTIM(DFN,BGPBDATE,BGPEDATE)
IF BGPTIME=1
SET BGPD3=1
+25 IF 'BGPD1
IF 'BGPD2
IF 'BGPD3
SET BGPSTOP=1
QUIT
+26 ;BGPN1 - patients with 4 DTaP or various combinations
+27 KILL ^TMP($JOB,"CPT")
+28 ;1 IS had immunizations, 3 is had Refusal, 4 is disease or NMI or Contraindication
SET BGPVAL=$$DTAP^BGP6D34(DFN,BGPEDATE)
+29 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN1=1
+30 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR1=1
+31 ;had all imms
IF $PIECE(BGPVAL,U,1)=1
SET BGPI1=1
+32 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN2=1
+33 ;evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN3=1
+34 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=$PIECE(BGPVAL,U,2)
+35 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=$PIECE(BGPVAL,U,2)
+36 KILL ^TMP($JOB,"CPT")
+37 SET BGPVAL=$$OPV^BGP6D33(DFN,BGPEDATE)
+38 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN4=1
+39 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR2=1
+40 ;had all imms
IF $PIECE(BGPVAL,U,1)=1
SET BGPI2=1
+41 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN5=1
+42 ;evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN6=1
+43 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+44 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+45 SET BGPVAL=$$MMR^BGP6D33(DFN,BGPEDATE)
+46 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN7=1
+47 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR3=1
+48 IF $PIECE(BGPVAL,U,1)=1
SET BGPI3=1
+49 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN8=1
+50 ;evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN9=1
+51 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+52 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+53 ;S BGPVAL=$$HIB^BGP6D35(DFN,BGPEDATE)
+54 ;I $P(BGPVAL,U,1) S BGPN10=1 ;any hit
+55 ;I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR4=1
+56 ;I $P(BGPVAL,U,1)=1 S BGPI4=1
+57 ;I $P(BGPVAL,U,1)=3 S BGPN11=1 ;Refusal
+58 ;I $P(BGPVAL,U,1)=4 S BGPN12=1 ;Evid disease, nmi, Contraindication
+59 ;I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
+60 ;I $P(BGPVAL,U,1)!($P(BGPVAL,U,1)=4) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
+61 SET BGPVAL=$$HIB3^BGP6D38(DFN,BGPEDATE)
+62 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN90=1
+63 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR4=1
+64 IF $PIECE(BGPVAL,U,1)=4
SET BGPN92=1
+65 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+66 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+67 IF 'BGPN90
Begin DoDot:1
+68 SET BGPVAL=$$HIB4^BGP6D38(DFN,BGPEDATE)
+69 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN90=1
+70 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR4=1
+71 IF $PIECE(BGPVAL,U,1)=4
SET BGPN92=1
+72 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+73 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
End DoDot:1
+74 SET BGPVAL=$$HEP^BGP6D35(DFN,BGPEDATE)
+75 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN13=1
+76 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR5=1
+77 IF $PIECE(BGPVAL,U,1)=1
SET BGPI5=1
+78 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN14=1
+79 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN15=1
+80 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+81 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+82 SET BGPVAL=$$VAR^BGP6D35(DFN,BGPEDATE)
+83 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN16=1
+84 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR6=1
+85 IF $PIECE(BGPVAL,U,1)=1
SET BGPI6=1
+86 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN17=1
+87 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN18=1
+88 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+89 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+90 SET BGPVAL=$$PNEUMO^BGP6D35(DFN,BGPEDATE,3)
+91 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN50=1
+92 IF $PIECE(BGPVAL,U,1)=1
SET BGPI50=1
+93 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN51=1
+94 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN52=1
+95 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR8=1
+96 SET BGP3PN=BGPVAL
+97 ;I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
+98 SET BGPVAL=$$PNEUMO^BGP6D35(DFN,BGPEDATE,4)
+99 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN26=1
+100 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR7=1
+101 IF $PIECE(BGPVAL,U,1)=1
SET BGPI7=1
+102 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN27=1
+103 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN28=1
+104 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+105 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+106 IF '$PIECE(BGPVAL,U,1)
IF $PIECE(BGP3PN,U,1)
Begin DoDot:1
+107 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGP3PN,U,2)
+108 SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGP3PN,U,2)
End DoDot:1
+109 SET BGPVAL=$$HEPA^BGP6D37(DFN,BGPEDATE)
+110 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN60=1
+111 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN61=1
+112 ;CONTRA
IF $PIECE(BGPVAL,U,1)=4
SET BGPN62=1
+113 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+114 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+115 SET BGPVAL=$$ROTA2^BGP6D37(DFN,BGPEDATE)
+116 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN70=1
+117 ;REFUSAL
SET BGPRROT=0
IF $PIECE(BGPVAL,U,1)=3
SET BGPN71=1
SET BGPRROT=1
+118 IF $PIECE(BGPVAL,U,1)=4
SET BGPN72=1
+119 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+120 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+121 IF 'BGPN70
Begin DoDot:1
+122 SET BGPVAL=$$ROTA3^BGP6D37(DFN,BGPEDATE)
+123 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN70=1
+124 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN71=1
+125 IF $PIECE(BGPVAL,U,1)=4
SET BGPN72=1
+126 ;already put a Refusal in the list
IF $PIECE(BGPVAL,U,1)=3
IF BGPRROT
QUIT
+127 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+128 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
End DoDot:1
+129 SET BGPVAL=$$INFLU^BGP6D38(DFN,BGPEDATE)
+130 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN80=1
+131 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN81=1
+132 IF $PIECE(BGPVAL,U,1)=4
SET BGPN82=1
+133 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+134 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+135 ;
+136 ;4313314
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
IF BGPN16
IF BGPN26
SET BGPN19=1
+137 ;4313314
IF BGPN1
IF 'BGPN2
IF BGPN4
IF 'BGPN5
IF BGPN7
IF 'BGPN8
IF BGPN10
IF 'BGPN11
IF BGPN13
IF 'BGPN14
IF BGPN16
IF 'BGPN17
IF BGPN26
IF 'BGPN27
SET BGPN42=1
+138 ;4313314 REF
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17)!(BGPN27)
SET BGPN32=1
+139 ;4313314 CONTRA
IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18)!(BGPN28)
SET BGPN33=1
+140 ;HEDIS ONLY 1.1.8 431331
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
IF BGPN16
SET BGPN29=1
+141 ;HEDIS ONLY 1.1.8 431331 - no Refusals 027.a.23
IF BGPN1
IF 'BGPN2
IF BGPN4
IF 'BGPN5
IF BGPN7
IF 'BGPN8
IF BGPN10
IF 'BGPN11
IF BGPN13
IF 'BGPN14
IF BGPN16
IF 'BGPN17
SET BGPN41=1
+142 ;431331 REFUSALS
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17)
SET BGPN30=1
+143 ;431331 CONTRA/DX
IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18)
SET BGPN31=1
+144 ;REFUSAL OF 43133
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)
SET BGPN22=1
+145 IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)
SET BGPN23=1
+146 IF BGPN1
IF BGPN4
IF BGPN7
SET BGPN20=1
+147 ;4:3:1:3:3
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
SET BGPN21=1
+148 ;4:3:1:3:3 - no
IF BGPN1
IF 'BGPN2
IF BGPN4
IF 'BGPN5
IF BGPN7
IF 'BGPN8
IF BGPN10
IF 'BGPN11
IF BGPN13
IF 'BGPN14
SET BGPN40=1
+149 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
IF BGPI6
IF BGPI7
SET BGPN24=1
+150 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
IF BGPI6
SET BGPN34=1
+151 ;I BGPI1,BGPI2,BGPI3 S BGPN25=1
+152 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
SET BGPN25=1
+153 ;4313*314 GPRA DEV
IF BGPN1
IF 'BGPN2
IF BGPN4
IF 'BGPN5
IF BGPN7
IF 'BGPN8
IF BGPN90
IF BGPN13
IF 'BGPN14
IF BGPN16
IF 'BGPN17
IF BGPN26
IF 'BGPN27
SET BGPN91=1
+154 ;4313*313
IF BGPR1
IF BGPR2
IF BGPR3
IF BGPN90
IF BGPR5
IF BGPR6
IF BGPR8
SET BGPN43=1
+155 IF BGPRTYPE=3
IF 'BGPN41
SET BGPVALUE="DID NOT HAVE: "
Begin DoDot:1
+156 IF 'BGPR1
SET BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
+157 IF 'BGPR2
SET BGPVALUE=BGPVALUE_"3 Polio;"
+158 IF 'BGPR3
SET BGPVALUE=BGPVALUE_"MMR;"
+159 IF 'BGPR4
SET BGPVALUE=BGPVALUE_"3 Hib;"
+160 IF 'BGPR5
SET BGPVALUE=BGPVALUE_"3 HEP;"
+161 IF 'BGPR6
SET BGPVALUE=BGPVALUE_"VAR;"
+162 IF 'BGPR7
SET BGPVALUE=BGPVALUE_"4 Pneumo"
End DoDot:1
+163 IF $GET(BGPISSO)
IF 'BGPN91
SET BGPVALUE="Immunizations Overdue for: |"
Begin DoDot:1
+164 IF 'BGPR1
SET BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
+165 IF 'BGPR2
SET BGPVALUE=BGPVALUE_"3 Polio;"
+166 IF 'BGPR3
SET BGPVALUE=BGPVALUE_"1 MMR;"
+167 IF 'BGPR4
SET BGPVALUE=BGPVALUE_"3 Hib;"
+168 IF 'BGPR5
SET BGPVALUE=BGPVALUE_"3 HEP;"
+169 IF 'BGPR6
SET BGPVALUE=BGPVALUE_"1 Varicella;"
+170 IF 'BGPR7
SET BGPVALUE=BGPVALUE_"4 Pneumo"
End DoDot:1
+171 SET D=""
+172 IF BGPD1
SET D="UP,AC"
+173 IF '$TEST
SET D="UP"
+174 IF BGPD3
SET D=D_",IMM"
+175 IF BGPRTYPE=3
SET D="AC"
+176 SET BGPVALUE=D_"|||"_BGPVALUE
+177 SET BGPVALUD=D_"|||"_BGPVALUD
+178 ;I BGPN19 S BGPVALUE=$P(BGPVALUE,"|||",1)_"|||4:3:1:3:3:1"
+179 ;I BGPN21,'BGPN19 S $P(BGPVALUE,"|||",2)="4:3:1:3:3"
+180 KILL BGPTET,BGPDTAP,BGPDT,BGPTD,BGPPER,BGPDIP,BGPMU,BGPME,BGPMMR,BGPMR,BGPRM,BGPOPV,BGPRUB,BGPHIB,BGPHEB,BGPVAR,BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPVAL
+181 QUIT
ACTIM(P,BDATE,EDATE) ;EP is patient active on imm register as of EDATE?
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^BIP(P,0))
QUIT ""
+3 IF $PIECE(^BIP(P,0),U,8)=""
QUIT 1
+4 IF $PIECE(^BIP(P,0),U,8)<EDATE
QUIT ""
+5 IF $PIECE(^BIP(P,0),U,8)=EDATE
QUIT ""
+6 QUIT 1
GETIMMS(P,EDATE,C,BGPX) ;EP
+1 KILL BGPX
+2 NEW X,Y,I,Z,V
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVIMM("AC",P,X))
IF X'=+X
QUIT
Begin DoDot:1
+4 ;happens
IF '$DATA(^AUPNVIMM(X,0))
QUIT
+5 SET Y=$PIECE(^AUPNVIMM(X,0),U)
+6 ;happens too
IF 'Y
QUIT
+7 ;get HL7/CVX code
SET I=$PIECE($GET(^AUTTIMM(Y,0)),U,3)
+8 FOR Z=1:1:$LENGTH(C,U)
IF I=$PIECE(C,U,Z)
SET V=$PIECE(^AUPNVIMM(X,0),U,3)
IF V
SET D=$PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
IF D]""
IF D'>EDATE
SET BGPX(D)=Y
+9 QUIT
End DoDot:1
+10 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
