BGP5D32 ; IHS/CMI/LAB - measure C ;
;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
;
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,BGP50N,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^BGP5D34(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^BGP5D33(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^BGP5D33(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^BGP5D35(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^BGP5D38(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^BGP5D38(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^BGP5D35(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^BGP5D35(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^BGP5D35(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^BGP5D35(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^BGP5D37(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^BGP5D37(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^BGP5D37(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^BGP5D38(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
BGP5D32 ; IHS/CMI/LAB - measure C ;
+1 ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
+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,BGP50N,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^BGP5D34(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^BGP5D33(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^BGP5D33(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^BGP5D35(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^BGP5D38(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)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR4=1
+60 IF $PIECE(BGPVAL,U,1)=4
SET BGPN92=1
+61 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+62 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+63 IF 'BGPN90
Begin DoDot:1
+64 SET BGPVAL=$$HIB4^BGP5D38(DFN,BGPEDATE)
+65 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN90=1
+66 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR4=1
+67 IF $PIECE(BGPVAL,U,1)=4
SET BGPN92=1
+68 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+69 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
End DoDot:1
+70 SET BGPVAL=$$HEP^BGP5D35(DFN,BGPEDATE)
+71 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN13=1
+72 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR5=1
+73 IF $PIECE(BGPVAL,U,1)=1
SET BGPI5=1
+74 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN14=1
+75 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN15=1
+76 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+77 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+78 SET BGPVAL=$$VAR^BGP5D35(DFN,BGPEDATE)
+79 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN16=1
+80 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR6=1
+81 IF $PIECE(BGPVAL,U,1)=1
SET BGPI6=1
+82 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN17=1
+83 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN18=1
+84 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+85 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+86 SET BGPVAL=$$PNEUMO^BGP5D35(DFN,BGPEDATE,3)
+87 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN50=1
+88 IF $PIECE(BGPVAL,U,1)=1
SET BGPI50=1
+89 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN51=1
+90 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN52=1
+91 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR8=1
+92 SET BGP3PN=BGPVAL
+93 ;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)
+94 SET BGPVAL=$$PNEUMO^BGP5D35(DFN,BGPEDATE,4)
+95 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN26=1
+96 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR7=1
+97 IF $PIECE(BGPVAL,U,1)=1
SET BGPI7=1
+98 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN27=1
+99 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN28=1
+100 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+101 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+102 IF '$PIECE(BGPVAL,U,1)
IF $PIECE(BGP3PN,U,1)
Begin DoDot:1
+103 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGP3PN,U,2)
+104 SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGP3PN,U,2)
End DoDot:1
+105 SET BGPVAL=$$HEPA^BGP5D37(DFN,BGPEDATE)
+106 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN60=1
+107 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN61=1
+108 ;CONTRA
IF $PIECE(BGPVAL,U,1)=4
SET BGPN62=1
+109 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+110 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+111 SET BGPVAL=$$ROTA2^BGP5D37(DFN,BGPEDATE)
+112 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN70=1
+113 ;REFUSAL
SET BGPRROT=0
IF $PIECE(BGPVAL,U,1)=3
SET BGPN71=1
SET BGPRROT=1
+114 IF $PIECE(BGPVAL,U,1)=4
SET BGPN72=1
+115 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+116 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+117 IF 'BGPN70
Begin DoDot:1
+118 SET BGPVAL=$$ROTA3^BGP5D37(DFN,BGPEDATE)
+119 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN70=1
+120 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN71=1
+121 IF $PIECE(BGPVAL,U,1)=4
SET BGPN72=1
+122 ;already put a Refusal in the list
IF $PIECE(BGPVAL,U,1)=3
IF BGPRROT
QUIT
+123 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+124 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
End DoDot:1
+125 SET BGPVAL=$$INFLU^BGP5D38(DFN,BGPEDATE)
+126 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN80=1
+127 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN81=1
+128 IF $PIECE(BGPVAL,U,1)=4
SET BGPN82=1
+129 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+130 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+131 ;
+132 ;4313314
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
IF BGPN16
IF BGPN26
SET BGPN19=1
+133 ;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
+134 ;4313314 REF
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17)!(BGPN27)
SET BGPN32=1
+135 ;4313314 CONTRA
IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18)!(BGPN28)
SET BGPN33=1
+136 ;HEDIS ONLY 1.1.8 431331
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
IF BGPN16
SET BGPN29=1
+137 ;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
+138 ;431331 REFUSALS
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17)
SET BGPN30=1
+139 ;431331 CONTRA/DX
IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18)
SET BGPN31=1
+140 ;REFUSAL OF 43133
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)
SET BGPN22=1
+141 IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)
SET BGPN23=1
+142 IF BGPN1
IF BGPN4
IF BGPN7
SET BGPN20=1
+143 ;4:3:1:3:3
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
SET BGPN21=1
+144 ;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
+145 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
IF BGPI6
IF BGPI7
SET BGPN24=1
+146 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
IF BGPI6
SET BGPN34=1
+147 ;I BGPI1,BGPI2,BGPI3 S BGPN25=1
+148 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
SET BGPN25=1
+149 ;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
+150 ;4313*313
IF BGPR1
IF BGPR2
IF BGPR3
IF BGPN90
IF BGPR5
IF BGPR6
IF BGPR8
SET BGPN43=1
+151 IF BGPRTYPE=3
IF 'BGPN41
SET BGPVALUE="DID NOT HAVE: "
Begin DoDot:1
+152 IF 'BGPR1
SET BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
+153 IF 'BGPR2
SET BGPVALUE=BGPVALUE_"3 Polio;"
+154 IF 'BGPR3
SET BGPVALUE=BGPVALUE_"MMR;"
+155 IF 'BGPR4
SET BGPVALUE=BGPVALUE_"3 Hib;"
+156 IF 'BGPR5
SET BGPVALUE=BGPVALUE_"3 HEP;"
+157 IF 'BGPR6
SET BGPVALUE=BGPVALUE_"VAR;"
+158 IF 'BGPR7
SET BGPVALUE=BGPVALUE_"4 Pneumo"
End DoDot:1
+159 IF $GET(BGPISSO)
IF 'BGPN91
SET BGPVALUE="Immunizations Overdue for: |"
Begin DoDot:1
+160 IF 'BGPR1
SET BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
+161 IF 'BGPR2
SET BGPVALUE=BGPVALUE_"3 Polio;"
+162 IF 'BGPR3
SET BGPVALUE=BGPVALUE_"1 MMR;"
+163 IF 'BGPR4
SET BGPVALUE=BGPVALUE_"3 Hib;"
+164 IF 'BGPR5
SET BGPVALUE=BGPVALUE_"3 HEP;"
+165 IF 'BGPR6
SET BGPVALUE=BGPVALUE_"1 Varicella;"
+166 IF 'BGPR7
SET BGPVALUE=BGPVALUE_"4 Pneumo"
End DoDot:1
+167 SET D=""
+168 IF BGPD1
SET D="UP,AC"
+169 IF '$TEST
SET D="UP"
+170 IF BGPD3
SET D=D_",IMM"
+171 IF BGPRTYPE=3
SET D="AC"
+172 SET BGPVALUE=D_"|||"_BGPVALUE
+173 SET BGPVALUD=D_"|||"_BGPVALUD
+174 ;I BGPN19 S BGPVALUE=$P(BGPVALUE,"|||",1)_"|||4:3:1:3:3:1"
+175 ;I BGPN21,'BGPN19 S $P(BGPVALUE,"|||",2)="4:3:1:3:3"
+176 KILL BGPTET,BGPDTAP,BGPDT,BGPTD,BGPPER,BGPDIP,BGPMU,BGPME,BGPMMR,BGPMR,BGPRM,BGPOPV,BGPRUB,BGPHIB,BGPHEB,BGPVAR,BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPVAL
+177 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
