BGP3D32 ; IHS/CMI/LAB - measure C ;
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;
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,BGP30N,BGPN30,BGPN31,BGPN32,BGPN33,BGPN34,BGPN40,BGPN41,BGPN42)=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^BGP3D34(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^BGP3D33(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^BGP3D33(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^BGP3D35(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^BGP3D38(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^BGP3D38(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^BGP3D35(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^BGP3D35(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^BGP3D35(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)
S BGPVAL=$$PNEUMO^BGP3D35(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
I BGPRTYPE='3,$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=$$HEPA^BGP3D37(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^BGP3D37(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^BGP3D37(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^BGP3D38(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 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
BGP3D32 ; IHS/CMI/LAB - measure C ;
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+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,BGP30N,BGPN30,BGPN31,BGPN32,BGPN33,BGPN34,BGPN40,BGPN41,BGPN42)=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^BGP3D34(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^BGP3D33(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^BGP3D33(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^BGP3D35(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^BGP3D38(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^BGP3D38(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^BGP3D35(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^BGP3D35(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^BGP3D35(DFN,BGPEDATE,4)
+85 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN26=1
+86 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR7=1
+87 IF $PIECE(BGPVAL,U,1)=1
SET BGPI7=1
+88 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN27=1
+89 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN28=1
+90 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+91 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+92 SET BGPVAL=$$PNEUMO^BGP3D35(DFN,BGPEDATE,3)
+93 ;any hit
IF $PIECE(BGPVAL,U,1)
SET BGPN50=1
+94 IF $PIECE(BGPVAL,U,1)=1
SET BGPI50=1
+95 ;Refusal
IF $PIECE(BGPVAL,U,1)=3
SET BGPN51=1
+96 ;Evid disease, nmi, Contraindication
IF $PIECE(BGPVAL,U,1)=4
SET BGPN52=1
+97 IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPR8=1
+98 IF BGPRTYPE='3
IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+99 SET BGPVAL=$$HEPA^BGP3D37(DFN,BGPEDATE)
+100 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN60=1
+101 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN61=1
+102 ;CONTRA
IF $PIECE(BGPVAL,U,1)=4
SET BGPN62=1
+103 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+104 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+105 SET BGPVAL=$$ROTA2^BGP3D37(DFN,BGPEDATE)
+106 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN70=1
+107 ;REFUSAL
SET BGPRROT=0
IF $PIECE(BGPVAL,U,1)=3
SET BGPN71=1
SET BGPRROT=1
+108 IF $PIECE(BGPVAL,U,1)=4
SET BGPN72=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 IF 'BGPN70
Begin DoDot:1
+112 SET BGPVAL=$$ROTA3^BGP3D37(DFN,BGPEDATE)
+113 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN70=1
+114 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN71=1
+115 IF $PIECE(BGPVAL,U,1)=4
SET BGPN72=1
+116 ;already put a Refusal in the list
IF $PIECE(BGPVAL,U,1)=3
IF BGPRROT
QUIT
+117 IF $PIECE(BGPVAL,U,1)
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
+118 IF $PIECE(BGPVAL,U,1)
SET BGPVALUD=BGPVALUD_$SELECT(BGPVALUD]"":"; ",1:"")_$PIECE(BGPVAL,U,2)
End DoDot:1
+119 SET BGPVAL=$$INFLU^BGP3D38(DFN,BGPEDATE)
+120 ;any hit
IF $PIECE(BGPVAL,U,1)=1!($PIECE(BGPVAL,U,1)=4)
SET BGPN80=1
+121 ;REFUSAL
IF $PIECE(BGPVAL,U,1)=3
SET BGPN81=1
+122 IF $PIECE(BGPVAL,U,1)=4
SET BGPN82=1
+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)
+125 ;
+126 ;4313314
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
IF BGPN16
IF BGPN26
SET BGPN19=1
+127 ;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
+128 ;4313314 REF
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17)!(BGPN27)
SET BGPN32=1
+129 ;4313314 CONTRA
IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18)!(BGPN28)
SET BGPN33=1
+130 ;HEDIS ONLY 1.1.8 431331
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
IF BGPN16
SET BGPN29=1
+131 ;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
+132 ;431331 REFUSALS
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17)
SET BGPN30=1
+133 ;431331 CONTRA/DX
IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18)
SET BGPN31=1
+134 ;REFUSAL OF 43133
IF BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)
SET BGPN22=1
+135 IF BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)
SET BGPN23=1
+136 IF BGPN1
IF BGPN4
IF BGPN7
SET BGPN20=1
+137 ;4:3:1:3:3
IF BGPN1
IF BGPN4
IF BGPN7
IF BGPN10
IF BGPN13
SET BGPN21=1
+138 ;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
+139 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
IF BGPI6
IF BGPI7
SET BGPN24=1
+140 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
IF BGPI6
SET BGPN34=1
+141 ;I BGPI1,BGPI2,BGPI3 S BGPN25=1
+142 IF BGPI1
IF BGPI2
IF BGPI3
IF BGPI4
IF BGPI5
SET BGPN25=1
+143 ;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
+144 IF BGPRTYPE=3
IF 'BGPN41
SET BGPVALUE="DID NOT HAVE: "
Begin DoDot:1
+145 IF 'BGPR1
SET BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
+146 IF 'BGPR2
SET BGPVALUE=BGPVALUE_"3 Polio;"
+147 IF 'BGPR3
SET BGPVALUE=BGPVALUE_"MMR;"
+148 IF 'BGPR4
SET BGPVALUE=BGPVALUE_"3 Hib;"
+149 IF 'BGPR5
SET BGPVALUE=BGPVALUE_"3 HEP;"
+150 IF 'BGPR6
SET BGPVALUE=BGPVALUE_"VAR;"
+151 IF 'BGPR7
SET BGPVALUE=BGPVALUE_"4 Pneumo"
End DoDot:1
+152 IF $GET(BGPISSO)
IF 'BGPN40
SET BGPVALUE="Immunizations Overdue for: |"
Begin DoDot:1
+153 IF 'BGPR1
SET BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
+154 IF 'BGPR2
SET BGPVALUE=BGPVALUE_"3 Polio;"
+155 IF 'BGPR3
SET BGPVALUE=BGPVALUE_"1 MMR;"
+156 IF 'BGPR4
SET BGPVALUE=BGPVALUE_"3 Hib;"
+157 IF 'BGPR5
SET BGPVALUE=BGPVALUE_"3 HEP;"
End DoDot:1
+158 SET D=""
+159 IF BGPD1
SET D="UP,AC"
+160 IF '$TEST
SET D="UP"
+161 IF BGPD3
SET D=D_",IMM"
+162 IF BGPRTYPE=3
SET D="AC"
+163 SET BGPVALUE=D_"|||"_BGPVALUE
+164 SET BGPVALUD=D_"|||"_BGPVALUD
+165 ;I BGPN19 S BGPVALUE=$P(BGPVALUE,"|||",1)_"|||4:3:1:3:3:1"
+166 ;I BGPN21,'BGPN19 S $P(BGPVALUE,"|||",2)="4:3:1:3:3"
+167 KILL BGPTET,BGPDTAP,BGPDT,BGPTD,BGPPER,BGPDIP,BGPMU,BGPME,BGPMMR,BGPMR,BGPRM,BGPOPV,BGPRUB,BGPHIB,BGPHEB,BGPVAR,BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPVAL
+168 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
