BGP4D32 ; IHS/CMI/LAB - measure C ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
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,BGP40N,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 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^BGP4D34(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^BGP4D33(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^BGP4D33(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^BGP4D35(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^BGP4D38(DFN,BGPEDATE)
I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN90=1 ;any hit
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^BGP4D38(DFN,BGPEDATE)
.I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN90=1 ;any hit
.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^BGP4D35(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^BGP4D35(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^BGP4D35(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^BGP4D35(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^BGP4D37(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^BGP4D37(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^BGP4D37(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^BGP4D38(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),'BGPN40 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;"
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
BGP4D32 ; IHS/CMI/LAB - measure C ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+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,BGP40N,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 BGPDAYS=$$FMDIFF^XLFDT(BGPBDATE,$$DOB^AUPNPAT(DFN))
+15 SET BGPMON=BGPDAYS/30.4167
+16 ;no one less than 7 months
IF BGPMON<7
SET BGPSTOP=1
QUIT
+17 ;no one less than 23 months on 1st day of time frame
IF BGPMON>23
SET BGPSTOP=1
QUIT
+18 IF BGPACTUP
SET BGPD2=1
+19 IF BGPACTCL
SET BGPD1=1
+20 IF BGPACTUP
IF $$ACTIM(DFN,BGPBDATE,BGPEDATE)
IF BGPTIME=1
SET BGPD3=1
+21 IF 'BGPD1
IF 'BGPD2
IF 'BGPD3
SET BGPSTOP=1
QUIT
+22 ;BGPN1 - patients with 4 DTaP or various combinations
+23 KILL ^TMP($JOB,"CPT")
+24 ;1 IS had immunizations, 3 is had Refusal, 4 is disease or NMI or Contraindication
SET BGPVAL=$$DTAP^BGP4D34(DFN,BGPEDATE)
+25 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN1=1
+26 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR1=1
+27 ;had all imms
IF $PIECE(BGPVAL,U,1)=1
SET BGPI1=1
+28 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN2=1
+29 ;evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN3=1
+30 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=$PIECE(BGPVAL,U,2)
+31 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=$PIECE(BGPVAL,U,2)
+32 KILL ^TMP($JOB,"CPT")
+33 SET BGPVAL=$$OPV^BGP4D33(DFN,BGPEDATE)
+34 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN4=1
+35 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR2=1
+36 ;had all imms
IF $PIECE(BGPVAL,U,1)=1
SET BGPI2=1
+37 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN5=1
+38 ;evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN6=1
+39 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+40 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+41 SET BGPVAL=$$MMR^BGP4D33(DFN,BGPEDATE)
+42 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN7=1
+43 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR3=1
+44 IF $PIECE(BGPVAL,U,1)=1
SET BGPI3=1
+45 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN8=1
+46 ;evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN9=1
+47 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+48 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+49 ;S BGPVAL=$$HIB^BGP4D35(DFN,BGPEDATE)
+50 ;I $P(BGPVAL,U,1) S BGPN10=1 ;any hit
+51 ;I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR4=1
+52 ;I $P(BGPVAL,U,1)=1 S BGPI4=1
+53 ;I $P(BGPVAL,U,1)=3 S BGPN11=1 ;Refusal
+54 ;I $P(BGPVAL,U,1)=4 S BGPN12=1 ;Evid disease, nmi, Contraindication
+55 ;I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPVAL,U,2)
+56 ;I $P(BGPVAL,U,1)!($P(BGPVAL,U,1)=4) S BGPVALUD=BGPVALUD_$S(BGPVALUD]"":"; ",1:"")_$P(BGPVAL,U,2)
+57 SET BGPVAL=$$HIB3^BGP4D38(DFN,BGPEDATE)
+58 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN90=1
+59 IF $PIECE(BGPVAL,U,1)=4
SET BGPN92=1
+60 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+61 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+62 IF 'BGPN90
Begin DoDot:1
+63 SET BGPVAL=$$HIB4^BGP4D38(DFN,BGPEDATE)
+64 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN90=1
+65 IF $PIECE(BGPVAL,U,1)=4
SET BGPN92=1
+66 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+67 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
End DoDot:1
+68 SET BGPVAL=$$HEP^BGP4D35(DFN,BGPEDATE)
+69 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN13=1
+70 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR5=1
+71 IF $PIECE(BGPVAL,U,1)=1
SET BGPI5=1
+72 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN14=1
+73 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN15=1
+74 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+75 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+76 SET BGPVAL=$$VAR^BGP4D35(DFN,BGPEDATE)
+77 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN16=1
+78 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR6=1
+79 IF $PIECE(BGPVAL,U,1)=1
SET BGPI6=1
+80 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN17=1
+81 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN18=1
+82 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+83 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+84 SET BGPVAL=$$PNEUMO^BGP4D35(DFN,BGPEDATE,3)
+85 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN50=1
+86 IF $PIECE(BGPVAL,U,1)=1
SET BGPI50=1
+87 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN51=1
+88 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN52=1
+89 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR8=1
+90 SET BGP3PN=BGPVAL
+91 ;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)
+92 SET BGPVAL=$$PNEUMO^BGP4D35(DFN,BGPEDATE,4)
+93 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN26=1
+94 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR7=1
+95 IF $PIECE(BGPVAL,U,1)=1
SET BGPI7=1
+96 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN27=1
+97 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN28=1
+98 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+99 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+100 IF '$PIECE(BGPVAL,U,1)
IF $PIECE(BGP3PN,U,1)
Begin DoDot:1
+101 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGP3PN,U,2)
+102 SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGP3PN,U,2)
End DoDot:1
+103 SET BGPVAL=$$HEPA^BGP4D37(DFN,BGPEDATE)
+104 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN60=1
+105 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN61=1
+106 ;CONTRA
IF $PIECE(BGPVAL,U,1)=4
SET BGPN62=1
+107 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+108 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+109 SET BGPVAL=$$ROTA2^BGP4D37(DFN,BGPEDATE)
+110 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN70=1
+111 ;REFUSAL
SET BGPRROT=0
IF $PIECE(BGPVAL,U,1)=3
SET BGPN71=1
SET BGPRROT=1
+112 IF $PIECE(BGPVAL,U,1)=4
SET BGPN72=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 IF 'BGPN70
Begin DoDot:1
+116 SET BGPVAL=$$ROTA3^BGP4D37(DFN,BGPEDATE)
+117 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN70=1
+118 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN71=1
+119 IF $PIECE(BGPVAL,U,1)=4
SET BGPN72=1
+120 ;already put a Refusal in the list
IF $PIECE(BGPVAL,U,1)=3
IF BGPRROT
QUIT
+121 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+122 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
End DoDot:1
+123 SET BGPVAL=$$INFLU^BGP4D38(DFN,BGPEDATE)
+124 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN80=1
+125 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN81=1
+126 IF $PIECE(BGPVAL,U,1)=4
SET BGPN82=1
+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)
+129 ;
+130 ;4313314
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
IF BGPN16
IF BGPN26
SET BGPN19=1
+131 ;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
+132 ;4313314 REF
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17)!(BGPN27)
SET BGPN32=1
+133 ;4313314 CONTRA
IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18)!(BGPN28)
SET BGPN33=1
+134 ;HEDIS ONLY 1.1.8 431331
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
IF BGPN16
SET BGPN29=1
+135 ;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
+136 ;431331 REFUSALS
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17)
SET BGPN30=1
+137 ;431331 CONTRA/DX
IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18)
SET BGPN31=1
+138 ;REFUSAL OF 43133
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)
SET BGPN22=1
+139 IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)
SET BGPN23=1
+140 IF BGPN1
IF BGPN4
IF BGPN7
SET BGPN20=1
+141 ;4:3:1:3:3
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
SET BGPN21=1
+142 ;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
+143 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
IF BGPI6
IF BGPI7
SET BGPN24=1
+144 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
IF BGPI6
SET BGPN34=1
+145 ;I BGPI1,BGPI2,BGPI3 S BGPN25=1
+146 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
SET BGPN25=1
+147 ;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
+148 ;4313*313
IF BGPR1
IF BGPR2
IF BGPR3
IF BGPN90
IF BGPR5
IF BGPR6
IF BGPR8
SET BGPN43=1
+149 IF BGPRTYPE=3
IF 'BGPN41
SET BGPVALUE="DID NOT HAVE: "
Begin DoDot:1
+150 IF 'BGPR1
SET BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
+151 IF 'BGPR2
SET BGPVALUE=BGPVALUE_"3 Polio;"
+152 IF 'BGPR3
SET BGPVALUE=BGPVALUE_"MMR;"
+153 IF 'BGPR4
SET BGPVALUE=BGPVALUE_"3 Hib;"
+154 IF 'BGPR5
SET BGPVALUE=BGPVALUE_"3 HEP;"
+155 IF 'BGPR6
SET BGPVALUE=BGPVALUE_"VAR;"
+156 IF 'BGPR7
SET BGPVALUE=BGPVALUE_"4 Pneumo"
End DoDot:1
+157 IF $GET(BGPISSO)
IF 'BGPN40
SET BGPVALUE="Immunizations Overdue for: |"
Begin DoDot:1
+158 IF 'BGPR1
SET BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
+159 IF 'BGPR2
SET BGPVALUE=BGPVALUE_"3 Polio;"
+160 IF 'BGPR3
SET BGPVALUE=BGPVALUE_"1 MMR;"
+161 IF 'BGPR4
SET BGPVALUE=BGPVALUE_"3 Hib;"
+162 IF 'BGPR5
SET BGPVALUE=BGPVALUE_"3 HEP;"
End DoDot:1
+163 SET D=""
+164 IF BGPD1
SET D="UP,AC"
+165 IF '$TEST
SET D="UP"
+166 IF BGPD3
SET D=D_",IMM"
+167 IF BGPRTYPE=3
SET D="AC"
+168 SET BGPVALUE=D_"|||"_BGPVALUE
+169 SET BGPVALUD=D_"|||"_BGPVALUD
+170 ;I BGPN19 S BGPVALUE=$P(BGPVALUE,"|||",1)_"|||4:3:1:3:3:1"
+171 ;I BGPN21,'BGPN19 S $P(BGPVALUE,"|||",2)="4:3:1:3:3"
+172 KILL BGPTET,BGPDTAP,BGPDT,BGPTD,BGPPER,BGPDIP,BGPMU,BGPME,BGPMMR,BGPMR,BGPRM,BGPOPV,BGPRUB,BGPHIB,BGPHEB,BGPVAR,BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPVAL
+173 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
