Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP0D85

BGP0D85.m

Go to the documentation of this file.
BGP0D85 ; IHS/CMI/LAB - measure C ; 09 Jun 2010  5:18 PM
 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
 ;
I28 ;EP
 ;3 denominators, 24 numerators
 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)=0
 S (BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6)=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=$$MMR(DFN,BGPEDATE)
 I $P(BGPVAL,U,1) S BGPN7=1  ;any hit
 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_";"_$P(BGPVAL,U,2)
 S BGPVAL=$$HEP^BGP0D35(DFN,BGPEDATE)
 I $P(BGPVAL,U,1) S BGPN13=1  ;any hit
 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_";"_$P(BGPVAL,U,2)
 S BGPVAL=$$VAR^BGP0D35(DFN,BGPEDATE)
 I $P(BGPVAL,U,1) S BGPN16=1  ;any hit
 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_";"_$P(BGPVAL,U,2)
 S BGPVAL=$$TDAP^BGP0D86(DFN,BGPEDATE)
 I $P(BGPVAL,U,1) S BGPN10=1  ;any hit
 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,2)["Tdap" S BGPN6=1  ;tdap
 ;I DUZ=5634,BGPTIME=1 W !,DFN," ",BGPN10,"  ",BGPN6,"  ",BGPVAL
 I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_";"_$P(BGPVAL,U,2)
 S BGPVAL=$$MEN^BGP0D36(DFN,BGPEDATE)
 I $P(BGPVAL,U,1) S BGPN1=1  ;any hit
 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=BGPVALUE_";"_$P(BGPVAL,U,2)
 S BGPVAL=$$HPV^BGP0D36(DFN,BGPEDATE)
 I $P(BGPVAL,U,1) S BGPN4=1  ;any hit
 I $P(BGPVAL,U,1)=3 S BGPN5=1 ;refusal
 I $P(BGPVAL,U,1)=4 S BGPN27=1 ;evid disease, nmi, contraindication
 I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_";"_$P(BGPVAL,U,2)
 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 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
MMR(P,EDATE) ;EP
 K BGPC,BGPG,BGPX,BGPMMR
 K ^TMP($J,"CPT")
 ;first gather up all cpt codes that relate in any way to dtap and store in ^TMP
 S ED=9999999-EDATE,BD=9999999-$$DOB^AUPNPAT(P),G=0
 F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)  D
 .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V  D
 ..Q:'$D(^AUPNVSIT(V,0))
 ..S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X  D
 ...S Y=$P(^AUPNVCPT(X,0),U),Y=$P($$CPT^ICPTCOD(Y),U,2) I Y=+Y,$T(@Y)]"" S ^TMP($J,"CPT",9999999-ED,Y)=""
 ..S X=0 F  S X=$O(^AUPNVTC("AD",V,X)) Q:X'=+X  D
 ...S Y=$P(^AUPNVTC(X,0),U,7) Q:'Y  S Y=$P($$CPT^ICPTCOD(Y),U,2) I Y=+Y,$T(@Y)]"" S ^TMP($J,"CPT",9999999-ED,Y)=""
 S BGPMMR=0
 ;get all immunizations
 S C="3^94"
 K BGPX D GETIMMS^BGP0D32(P,EDATE,C,.BGPMMR)
 S X=0 F  S X=$O(BGPX(X)) Q:X'=+X  S BGPMMR(X)=""
 S D=0 F  S D=$O(^TMP($J,"CPT",D)) Q:D'=+D  S Y="" F  S Y=$O(^TMP($J,"CPT",D,Y)) Q:Y=""  D
 .I Y=90707!(Y=90710) S BGPMMR(D)=""
 ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
 S X="",Y="",C=0 F  S X=$O(BGPMMR(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPMMR(X) Q
 .S Y=X
 ;now count them and see if there are 4 of them
 S BGPMMR=0,X=0 F  S X=$O(BGPMMR(X)) Q:X'=+X  S BGPMMR=BGPMMR+1
 I BGPMMR>1 Q 1_U_"2 MMR"
MR ;see if one M/R, Mumps or R/M
 S (BGPMR,BGPRM,BGPME,BGPMU,BGPRUB)=0
 S C=4
 K BGPX D GETIMMS^BGP0D32(P,EDATE,C,.BGPX)
 S X=0 F  S X=$O(BGPX(X)) Q:X'=+X  S BGPMR(X)=""
 S D=0 F  S D=$O(^TMP($J,"CPT",D)) Q:D'=+D  S Y="" F  S Y=$O(^TMP($J,"CPT",D,Y)) Q:Y=""  D
 .I Y=90708 S BGPMR(D)=""
  ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
 S X="",Y="",C=0 F  S X=$O(BGPMR(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPMR(X) Q
 .S Y=X
 ;count them
 S X=0 F  S X=$O(BGPMR(X)) Q:X'=+X  S BGPMR=BGPMR+1
RM ;
 S C=38
 K BGPX D GETIMMS^BGP0D32(P,EDATE,C,.BGPX)
 S X=0 F  S X=$O(BGPX(X)) Q:X'=+X  S BGPRM(X)=""
 S D=0 F  S D=$O(^TMP($J,"CPT",D)) Q:D'=+D  S Y="" F  S Y=$O(^TMP($J,"CPT",D,Y)) Q:Y=""  D
 .I Y=90709 S BGPRM(D)=""
  ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
 S X="",Y="",C=0 F  S X=$O(BGPRM(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPRM(X) Q
 .S Y=X
 ;count them
 S X=0 F  S X=$O(BGPRM(X)) Q:X'=+X  S BGPRM=BGPRM+1
ME S C=5
 K BGPX D GETIMMS^BGP0D32(P,EDATE,C,.BGPX)
 S X=0 F  S X=$O(BGPX(X)) Q:X'=+X  S BGPME(X)=""
 S D=0 F  S D=$O(^TMP($J,"CPT",D)) Q:D'=+D  S Y="" F  S Y=$O(^TMP($J,"CPT",D,Y)) Q:Y=""  D
 .I Y=90705 S BGPME(D)=""
 ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
 S X="",Y="",C=0 F  S X=$O(BGPME(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPME(X) Q
 .S Y=X
 ;count them
 S X=0 F  S X=$O(BGPME(X)) Q:X'=+X  S BGPME=BGPME+1
MU S C=7
 K BGPX D GETIMMS^BGP0D32(P,EDATE,C,.BGPX)
 S X=0 F  S X=$O(BGPX(X)) Q:X'=+X  S BGPMU(X)=""
 S D=0 F  S D=$O(^TMP($J,"CPT",D)) Q:D'=+D  S Y="" F  S Y=$O(^TMP($J,"CPT",D,Y)) Q:Y=""  D
 .I Y=90704 S BGPMU(D)=""
  ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
 S X="",Y="",C=0 F  S X=$O(BGPMU(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPMU(X) Q
 .S Y=X
 ;count them
 S X=0 F  S X=$O(BGPMU(X)) Q:X'=+X  S BGPMU=BGPMU+1
RUB S C=6
 K BGPX D GETIMMS^BGP0D32(P,EDATE,C,.BGPX)
 S X=0 F  S X=$O(BGPX(X)) Q:X'=+X  S BGPRUB(X)=""
 S D=0 F  S D=$O(^TMP($J,"CPT",D)) Q:D'=+D  S Y="" F  S Y=$O(^TMP($J,"CPT",D,Y)) Q:Y=""  D
 .I Y=90706 S BGPRUB(D)=""
 ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
 S X="",Y="",C=0 F  S X=$O(BGPRUB(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPRUB(X) Q
 .S Y=X
 ;count them
 S X=0 F  S X=$O(BGPRUB(X)) Q:X'=+X  S BGPRUB=BGPRUB+1
 I BGPMR>1,BGPMU>1 Q 1_U_"2 m/r 2 mu"
 I BGPRM>1,BGPME>1 Q 1_U_"2 r/m 2 me"
 I BGPME>1,BGPMU>1,BGPRUB>1 Q 1_U_"2 me 2 mu 2 rub"
 ;now add diagnoses and proc codes for code 2
PVS ;
 K BGPG S %=P_"^ALL DX V06.4;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
 S X=0 F  S X=$O(BGPG(X)) Q:X'=+X  S BGPMMR($P(BGPG(X),U))=""
 S X="",Y="",C=0 F  S X=$O(BGPMMR(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPMMR(X) Q
 .S Y=X
 ;now count them and see if there are 4 of them
 S BGPMMR=0,X=0 F  S X=$O(BGPMMR(X)) Q:X'=+X  S BGPMMR=BGPMMR+1
 I BGPMMR>1 Q 2_U_"2 MMR (DX/IMM)"
 K BGPG S %=P_"^ALL PROCEDURE 99.48;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
 S X=0 F  S X=$O(BGPG(X)) Q:X'=+X  S BGPMMR($P(BGPG(X),U))=""
 S X="",Y="",C=0 F  S X=$O(BGPMMR(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPMMR(X) Q
 .S Y=X
 ;now count them and see if there are 4 of them
 S BGPMMR=0,X=0 F  S X=$O(BGPMMR(X)) Q:X'=+X  S BGPMMR=BGPMMR+1
 I BGPMMR>1 Q 2_U_"2 MMR (PROC/IMM)"
MEPV ;
 K BGPG S %=P_"^ALL DX V04.2;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
 S X=0 F  S X=$O(BGPG(X)) Q:X'=+X  S BGPME($P(BGPG(X),U))=""
 S X="",Y="",C=0 F  S X=$O(BGPME(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPME(X) Q
 .S Y=X
 ;now count them and see if there are 4 of them
 S BGPME=0,X=0 F  S X=$O(BGPME(X)) Q:X'=+X  S BGPME=BGPME+1
 K BGPG S %=P_"^ALL PROCEDURE 99.45;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
 S X=0 F  S X=$O(BGPG(X)) Q:X'=+X  S BGPME($P(BGPG(X),U))=""
 S X="",Y="",C=0 F  S X=$O(BGPME(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPME(X) Q
 .S Y=X
 ;now count them and see if there are 4 of them
 S BGPME=0,X=0 F  S X=$O(BGPME(X)) Q:X'=+X  S BGPME=BGPME+1
MUPV ;
 K BGPG S %=P_"^ALL DX V04.6;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
 S X=0 F  S X=$O(BGPG(X)) Q:X'=+X  S BGPMU($P(BGPG(X),U))=""
 S X="",Y="",C=0 F  S X=$O(BGPMU(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPMU(X) Q
 .S Y=X
 ;now count them and see if there are 4 of them
 S BGPMU=0,X=0 F  S X=$O(BGPMU(X)) Q:X'=+X  S BGPMU=BGPMU+1
 K BGPG S %=P_"^ALL PROCEDURE 99.46;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
 S X=0 F  S X=$O(BGPG(X)) Q:X'=+X  S BGPMU($P(BGPG(X),U))=""
 S X="",Y="",C=0 F  S X=$O(BGPMU(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPMU(X) Q
 .S Y=X
 ;now count them and see if there are 4 of them
 S BGPMU=0,X=0 F  S X=$O(BGPMU(X)) Q:X'=+X  S BGPMU=BGPMU+1
RUBPV ;
 K BGPG S %=P_"^ALL DX V04.3;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
 S X=0 F  S X=$O(BGPG(X)) Q:X'=+X  S BGPRUB($P(BGPG(X),U))=""
 S X="",Y="",C=0 F  S X=$O(BGPRUB(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPRUB(X) Q
 .S Y=X
 ;now count them and see if there are 4 of them
 S BGPRUB=0,X=0 F  S X=$O(BGPRUB(X)) Q:X'=+X  S BGPRUB=BGPRUB+1
 K BGPG S %=P_"^ALL PROCEDURE 99.47;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
 S X=0 F  S X=$O(BGPG(X)) Q:X'=+X  S BGPRUB($P(BGPG(X),U))=""
 S X="",Y="",C=0 F  S X=$O(BGPRUB(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPRUB(X) Q
 .S Y=X
 ;now count them and see if there are 4 of them
 S BGPRUB=0,X=0 F  S X=$O(BGPRUB(X)) Q:X'=+X  S BGPRUB=BGPRUB+1
 ;
 I BGPMR>1,BGPMU>1 Q 2_U_"m/r mu"
 I BGPRM>1,BGPME>1 Q 2_U_"r/m me"
 I BGPME>1,BGPMU>1,BGPRUB>1 Q 2_U_"me mu rub"
REF ;
 ;now get a refusal of MMR if there is one
 S B=$$DOB^AUPNPAT(P),E=EDATE,BGPNMI="",BGPMMR=0,R=""
 F BGPIMM=3,94 D
 .S I=$O(^AUTTIMM("C",BGPIMM,0)) Q:'I
 .S X=0 F  S X=$O(^AUPNPREF("AA",P,9999999.14,I,X)) Q:X'=+X  S Y=0 F  S Y=$O(^AUPNPREF("AA",P,9999999.14,I,X,Y)) Q:Y'=+Y  S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S:$P(^AUPNPREF(Y,0),U,7)="N" BGPNMI=1 S R=1
 I R Q $S(BGPNMI:4,1:3)_U_$S(BGPNMI:"NMI MMR",1:"ref MMR")
 ;now check refusals in imm pkg
 S R="" F BGPIMM=3,94 S R=$$IMMREF^BGP0D32(P,BGPIMM,$$DOB^AUPNPAT(P),EDATE)+R
 I R Q 3_U_"ref mmr"
MMRC K BGPG S %=P_"^LAST DX [BGP MMR CONTRAINDICATIONS;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
 I $D(BGPG(1)) Q 4_U_"contra mmr"
 I $$PLTAX^BGP0DU(P,"BGP MMR CONTRAINDICATIONS") Q 4_U_"contra MMR"
 F BGPZ=3,94 S X=$$MMRCONT^BGP0D31(P,BGPZ,EDATE) Q:X]""
 I X]"" Q 4_U_"contra mmr"
REFMR ;
 I BGPMR=0 D
 .S B=$$DOB^AUPNPAT(P),E=EDATE,BGPNMI=""
 .F BGPIMM=4 D
 .S I=$O(^AUTTIMM("C",BGPIMM,0)) Q:'I
 .S X=0 F  S X=$O(^AUPNPREF("AA",P,9999999.14,I,X)) Q:X'=+X  S Y=0 F  S Y=$O(^AUPNPREF("AA",P,9999999.14,I,X,Y)) Q:Y'=+Y  S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S BGPMR=$S($P(^AUPNPREF(Y,0),U,7)="N":4,1:3)
 ;now check refusals in imm pkg
 F BGPIMM=4 I $$IMMREF^BGP0D32(P,BGPIMM,$$DOB^AUPNPAT(P),EDATE) S BGPMR=3
REFRM I BGPRM=0 D
 .S B=$$DOB^AUPNPAT(P),E=EDATE
 .F BGPIMM=38 D
 .S I=$O(^AUTTIMM("C",BGPIMM,0)) Q:'I
 .S X=0 F  S X=$O(^AUPNPREF("AA",P,9999999.14,I,X)) Q:X'=+X  S Y=0 F  S Y=$O(^AUPNPREF("AA",P,9999999.14,I,X,Y)) Q:Y'=+Y  S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S BGPRM=$S($P(^AUPNPREF(Y,0),U,7)="N":4,1:3)
 F BGPIMM=38 I $$IMMREF^BGP0D32(P,BGPIMM,$$DOB^AUPNPAT(P),EDATE) S BGPRM=3
MEX ;
 I BGPME=0 K BGPG S %=P_"^LAST DX [BGP MEASLES EVIDENCE;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(") I $D(BGPG(1)) S BGPME=1
 I $$PLTAX^BGP0DU(P,"BGP MEASLES EVIDENCE") S BGPME=1
 I BGPME=0 D
 .S B=$$DOB^AUPNPAT(P),E=EDATE
 .F BGPIMM=5 D
 .S I=$O(^AUTTIMM("C",BGPIMM,0)) Q:'I
 .S X=0 F  S X=$O(^AUPNPREF("AA",P,9999999.14,I,X)) Q:X'=+X  S Y=0 F  S Y=$O(^AUPNPREF("AA",P,9999999.14,I,X,Y)) Q:Y'=+Y  S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S BGPME=$S($P(^AUPNPREF(Y,0),U,7)="N":4,1:3)
 F BGPIMM=7 I $$IMMREF^BGP0D32(P,BGPIMM,$$DOB^AUPNPAT(P),EDATE) S BGPME=3
MUX ;
 I BGPMU=0 K BGPG S %=P_"^LAST DX [BGP MUMPS EVIDENCE;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(") I $D(BGPG(1)) S BGPMU=1
 I $$PLTAX^BGP0DU(P,"BGP MUMPS EVIDENCE") S BGPMU=1
 I BGPMU=0 D
 .S B=$$DOB^AUPNPAT(P),E=EDATE
 .F BGPIMM=7 D
 .S I=$O(^AUTTIMM("C",BGPIMM,0)) Q:'I
 .S X=0 F  S X=$O(^AUPNPREF("AA",P,9999999.14,I,X)) Q:X'=+X  S Y=0 F  S Y=$O(^AUPNPREF("AA",P,9999999.14,I,X,Y)) Q:Y'=+Y  S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S BGPMU=$S($P(^AUPNPREF(Y,0),U,7)="N":4,1:3)
 ;now check refusals in imm pkg
 F BGPIMM="7" I $$IMMREF^BGP0D32(P,BGPIMM,$$DOB^AUPNPAT(P),EDATE) S BGPMU=3
RUBX ;
 I BGPRUB=0 K BGPG S %=P_"^LAST DX [BGP RUBELLA EVIDENCE;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(") I $D(BGPG(1)) S BGPRUB=1
 I $$PLTAX^BGP0DU(P,"BGP RUBELLA EVIDENCE") S BGPRUB=1
 I BGPRUB=0 D
 .S B=$$DOB^AUPNPAT(P),E=EDATE
 .F BGPIMM=6 D
 .S I=$O(^AUTTIMM("C",BGPIMM,0)) Q:'I
 .S X=0 F  S X=$O(^AUPNPREF("AA",P,9999999.14,I,X)) Q:X'=+X  S Y=0 F  S Y=$O(^AUPNPREF("AA",P,9999999.14,I,X,Y)) Q:Y'=+Y  S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S BGPRUB=$S($P(^AUPNPREF(Y,0),U,7)="N":4,1:3)
 F BGPIMM=6 I $$IMMREF^BGP0D32(P,BGPIMM,$$DOB^AUPNPAT(P),EDATE) S BGPMU=3
 I BGPMR,BGPMU S X=1 S:BGPMR=3 X=3 S:BGPMU=3 X=3 S:BGPMR=4 X=4 S:BGPMU=4 X=4 Q X_U_"mr & mu"_$S(X=4:" NMI",X=3:" ref",1:"")
 I BGPRM,BGPME S X=1 S:BGPRM=3 X=3 S:BGPME=3 X=3 S:BGPRM=4 X=4 S:BGPME=4 X=4 Q X_U_"RM & ME"_$S(X=4:" NMI",X=3:" ref",1:"")
 I BGPME,BGPMU,BGPRUB S X=1 S:BGPME=3 X=3 S:BGPMU=3 X=3 S:BGPRUB=3 X=3 S:BGPME=4 X=4 S:BGPMU=4 X=4 S:BGPRUB=4 X=4 Q X_U_"ME&MU&RUB"_$S(X=4:" NMI",X=3:" ref",1:"")
 Q ""
90707 ;;
90710 ;;
90708 ;;
90709 ;;
90705 ;;
90704 ;;
90706 ;;