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

BGP1D32.m

Go to the documentation of this file. 
  1. BGP1D32 ; IHS/CMI/LAB - measure C ;
  1.  ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
  1.  ;
  1. I14 ;EP
  1.  ;3 denominators, 32 numerators
  1.  ;F X=1:1:42,50:1:52,60:1:62,70:1:72,80:1:82 NEW @("BGPN"_X)
  1.  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
  1.  S (BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPI7,BGPN28,BGPN29,BGP30N,BGPN30,BGPN31,BGPN32,BGPN33,BGPN34,BGPN40,BGPN41,BGPN42)=0
  1.  S (BGPN50,BGPN51,BGPN52,BGPI50)=""
  1.  S (BGPN60,BGPN61,BGPN62)=""
  1.  S (BGPN70,BGPN71,BGPN72)=""
  1.  S (BGPN80,BGPN81,BGPN82)=""
  1.  S (BGPN90,BGPN91)=""
  1.  S (BGPR1,BGPR2,BGPR3,BGPR4,BGPR5,BGPR6,BGPR7,BGPR8,BGPR9)=""
  1.  S BGPVALUE="",BGPVALUD=""
  1.  K BGPDTAP,BGPOPV,BGPMMR,BGPD,BGPT,BGPPER,BGPTET,BGPM,BGPMU,BGPME,BGPHIB,BGPHEP,BGPVAR
  1.  I 'BGPACTUP S BGPSTOP=1 Q
  1.  S BGPDAYS=$$FMDIFF^XLFDT(BGPBDATE,$$DOB^AUPNPAT(DFN))
  1.  S BGPMON=BGPDAYS/30.5
  1.  I BGPMON<7 S BGPSTOP=1 Q  ;no one less than 7 months
  1.  I BGPMON>23 S BGPSTOP=1 Q  ;no one less than 23 months on 1st day of time frame
  1.  I BGPACTUP S BGPD2=1
  1.  I BGPACTCL S BGPD1=1
  1.  I BGPACTUP,$$ACTIM(DFN,BGPBDATE,BGPEDATE),BGPTIME=1 S BGPD3=1
  1.  I 'BGPD1,'BGPD2,'BGPD3 S BGPSTOP=1 Q
  1.  ;BGPN1 - patients with 4 DTaP or various combinations
  1.  K ^TMP($J,"CPT")
  1.  S BGPVAL=$$DTAP^BGP1D34(DFN,BGPEDATE)  ;1 IS had immunizations, 3 is had refusal, 4 is disease or NMI or contraindication
  1.  I $P(BGPVAL,U,1) S BGPN1=1  ;any hit
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR1=1
  1.  I $P(BGPVAL,U,1)=1 S BGPI1=1 ;had all imms
  1.  I $P(BGPVAL,U,1)=3 S BGPN2=1 ;refusal
  1.  I $P(BGPVAL,U,1)=4 S BGPN3=1 ;evid disease, nmi, contraindication
  1.  I $P(BGPVAL,U,1) S BGPVALUE=$P(BGPVAL,U,2)
  1.  I $P(BGPVAL,U,1) S BGPVALUD=$P(BGPVAL,U,2)
  1.  K ^TMP($J,"CPT")
  1.  S BGPVAL=$$OPV^BGP1D33(DFN,BGPEDATE)
  1.  I $P(BGPVAL,U,1) S BGPN4=1  ;any hit
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR2=1
  1.  I $P(BGPVAL,U,1)=1 S BGPI2=1 ;had all imms
  1.  I $P(BGPVAL,U,1)=3 S BGPN5=1 ;refusal
  1.  I $P(BGPVAL,U,1)=4 S BGPN6=1 ;evid disease, nmi, contraindication
  1.  I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  S BGPVAL=$$MMR^BGP1D33(DFN,BGPEDATE)
  1.  I $P(BGPVAL,U,1) S BGPN7=1  ;any hit
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR3=1
  1.  I $P(BGPVAL,U,1)=1 S BGPI3=1
  1.  I $P(BGPVAL,U,1)=3 S BGPN8=1 ;refusal
  1.  I $P(BGPVAL,U,1)=4 S BGPN9=1 ;evid disease, nmi, contraindication
  1.  I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  S BGPVAL=$$HIB^BGP1D35(DFN,BGPEDATE)
  1.  I $P(BGPVAL,U,1) S BGPN10=1  ;any hit
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR4=1
  1.  I $P(BGPVAL,U,1)=1 S BGPI4=1
  1.  I $P(BGPVAL,U,1)=3 S BGPN11=1 ;refusal
  1.  I $P(BGPVAL,U,1)=4 S BGPN12=1 ;evid disease, nmi, contraindication
  1.  I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  S BGPVAL=$$HEP^BGP1D35(DFN,BGPEDATE)
  1.  I $P(BGPVAL,U,1) S BGPN13=1  ;any hit
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR5=1
  1.  I $P(BGPVAL,U,1)=1 S BGPI5=1
  1.  I $P(BGPVAL,U,1)=3 S BGPN14=1 ;refusal
  1.  I $P(BGPVAL,U,1)=4 S BGPN15=1 ;evid disease, nmi, contraindication
  1.  I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  S BGPVAL=$$VAR^BGP1D35(DFN,BGPEDATE)
  1.  I $P(BGPVAL,U,1) S BGPN16=1  ;any hit
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR6=1
  1.  I $P(BGPVAL,U,1)=1 S BGPI6=1
  1.  I $P(BGPVAL,U,1)=3 S BGPN17=1 ;refusal
  1.  I $P(BGPVAL,U,1)=4 S BGPN18=1 ;evid disease, nmi, contraindication
  1.  I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  S BGPVAL=$$PNEUMO^BGP1D35(DFN,BGPEDATE,4)
  1.  I $P(BGPVAL,U,1) S BGPN26=1  ;any hit
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR7=1
  1.  I $P(BGPVAL,U,1)=1 S BGPI7=1
  1.  I $P(BGPVAL,U,1)=3 S BGPN27=1 ;refusal
  1.  I $P(BGPVAL,U,1)=4 S BGPN28=1 ;evid disease, nmi, contraindication
  1.  I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  S BGPVAL=$$PNEUMO^BGP1D35(DFN,BGPEDATE,3)
  1.  I $P(BGPVAL,U,1) S BGPN50=1  ;any hit
  1.  I $P(BGPVAL,U,1)=1 S BGPI50=1
  1.  I $P(BGPVAL,U,1)=3 S BGPN51=1 ;refusal
  1.  I $P(BGPVAL,U,1)=4 S BGPN52=1 ;evid disease, nmi, contraindication
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPR8=1
  1.  I BGPRTYPE='3,$P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  S BGPVAL=$$HEPA^BGP1D37(DFN,BGPEDATE)
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN60=1  ;any hit
  1.  I $P(BGPVAL,U,1)=3 S BGPN61=1 ;REFUSAL
  1.  I $P(BGPVAL,U,1)=4 S BGPN62=1  ;CONTRA
  1.  I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  S BGPVAL=$$ROTA2^BGP1D37(DFN,BGPEDATE)
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN70=1  ;any hit
  1.  S BGPRROT=0 I $P(BGPVAL,U,1)=3 S BGPN71=1,BGPRROT=1 ;REFUSAL
  1.  I $P(BGPVAL,U,1)=4 S BGPN72=1
  1.  I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  I 'BGPN70 D
  1.  .S BGPVAL=$$ROTA3^BGP1D37(DFN,BGPEDATE)
  1.  .I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN70=1  ;any hit
  1.  .I $P(BGPVAL,U,1)=3 S BGPN71=1 ;REFUSAL
  1.  .I $P(BGPVAL,U,1)=4 S BGPN72=1
  1.  .I $P(BGPVAL,U,1)=3,BGPRROT Q  ;already put a refusal in the list
  1.  .I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  .I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  S BGPVAL=$$INFLU^BGP1D38(DFN,BGPEDATE)
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN80=1  ;any hit
  1.  I $P(BGPVAL,U,1)=3 S BGPN81=1 ;REFUSAL
  1.  I $P(BGPVAL,U,1)=4 S BGPN82=1
  1.  I $P(BGPVAL,U,1) S BGPVALUE=BGPVALUE_"; "_$P(BGPVAL,U,2)
  1.  I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  S BGPVAL=$$HIB3^BGP1D38(DFN,BGPEDATE)
  1.  I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN90=1  ;any hit
  1.  I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  I 'BGPN90 D
  1.  .S BGPVAL=$$HIB4^BGP1D38(DFN,BGPEDATE)
  1.  .I $P(BGPVAL,U,1)=1!($P(BGPVAL,U,1)=4) S BGPN90=1  ;any hit
  1.  .I $P(BGPVAL,U,1) S BGPVALUD=BGPVALUD_"; "_$P(BGPVAL,U,2)
  1.  I BGPN1,BGPN4,BGPN7,BGPN10,BGPN13,BGPN16,BGPN26 S BGPN19=1  ;4313314
  1.  I BGPN1,'BGPN2,BGPN4,'BGPN5,BGPN7,'BGPN8,BGPN10,'BGPN11,BGPN13,'BGPN14,BGPN16,'BGPN17,BGPN26,'BGPN27 S BGPN42=1  ;4313314
  1.  I BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17)!(BGPN27) S BGPN32=1  ;4313314 REF
  1.  I BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18)!(BGPN28) S BGPN33=1  ;4313314 CONTRA
  1.  I BGPN1,BGPN4,BGPN7,BGPN10,BGPN13,BGPN16 S BGPN29=1  ;HEDIS ONLY 1.1.8 431331
  1.  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
  1.  I BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14)!(BGPN17) S BGPN30=1  ;431331 REFUSALS
  1.  I BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15)!(BGPN18) S BGPN31=1  ;431331 CONTRA/DX
  1.  I BGPN2!(BGPN5)!(BGPN8)!(BGPN11)!(BGPN14) S BGPN22=1  ;REFUSAL OF 43133
  1.  I BGPN3!(BGPN6)!(BGPN9)!(BGPN12)!(BGPN15) S BGPN23=1
  1.  I BGPN1,BGPN4,BGPN7 S BGPN20=1
  1.  I BGPN1,BGPN4,BGPN7,BGPN10,BGPN13 S BGPN21=1  ;4:3:1:3:3
  1.  I BGPN1,'BGPN2,BGPN4,'BGPN5,BGPN7,'BGPN8,BGPN10,'BGPN11,BGPN13,'BGPN14 S BGPN40=1  ;4:3:1:3:3 - no 
  1.  I BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPI7 S BGPN24=1
  1.  I BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6 S BGPN34=1
  1.  ;I BGPI1,BGPI2,BGPI3 S BGPN25=1
  1.  I BGPI1,BGPI2,BGPI3,BGPI4,BGPI5 S BGPN25=1
  1.  I BGPN1,'BGPN2,BGPN4,'BGPN5,BGPN7,'BGPN8,BGPN90,BGPN13,'BGPN14,BGPN16,'BGPN17,BGPN26,'BGPN27 S BGPN91=1  ;4313314  GPRA DEV
  1.  I BGPRTYPE=3,'BGPN41 S BGPVALUE="DID NOT HAVE: " D
  1.  .I 'BGPR1 S BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
  1.  .I 'BGPR2 S BGPVALUE=BGPVALUE_"3 Polio;"
  1.  .I 'BGPR3 S BGPVALUE=BGPVALUE_"MMR;"
  1.  .I 'BGPR4 S BGPVALUE=BGPVALUE_"3 HIB;"
  1.  .I 'BGPR5 S BGPVALUE=BGPVALUE_"3 HEP;"
  1.  .I 'BGPR6 S BGPVALUE=BGPVALUE_"VAR;"
  1.  .I 'BGPR7 S BGPVALUE=BGPVALUE_"4 PNEUMO"
  1.  I $G(BGPISSO),'BGPN40 S BGPVALUE="Immunizations Overdue for: |" D
  1.  .I 'BGPR1 S BGPVALUE=BGPVALUE_"4 Dtap/DTP;"
  1.  .I 'BGPR2 S BGPVALUE=BGPVALUE_"3 Polio;"
  1.  .I 'BGPR3 S BGPVALUE=BGPVALUE_"1 MMR;"
  1.  .I 'BGPR4 S BGPVALUE=BGPVALUE_"3 HIB;"
  1.  .I 'BGPR5 S BGPVALUE=BGPVALUE_"3 HEP;"
  1.  S D=""
  1.  I BGPD1 S D="UP,AC"
  1.  E  S D="UP"
  1.  I BGPD3 S D=D_",IMM"
  1.  I BGPRTYPE=3 S D="AC"
  1.  S BGPVALUE=D_"|||"_BGPVALUE
  1.  S BGPVALUD=D_"|||"_BGPVALUD
  1.  ;I BGPN19 S BGPVALUE=$P(BGPVALUE,"|||",1)_"|||4:3:1:3:3:1"
  1.  ;I BGPN21,'BGPN19 S $P(BGPVALUE,"|||",2)="4:3:1:3:3"
  1.  K BGPTET,BGPDTAP,BGPDT,BGPTD,BGPPER,BGPDIP,BGPMU,BGPME,BGPMMR,BGPMR,BGPRM,BGPOPV,BGPRUB,BGPHIB,BGPHEB,BGPVAR,BGPI1,BGPI2,BGPI3,BGPI4,BGPI5,BGPI6,BGPVAL
  1.  Q
  1. ACTIM(P,BDATE,EDATE) ;EP is patient active on imm register as of EDATE?
  1.  I '$G(P) Q ""
  1.  I '$D(^BIP(P,0)) Q ""
  1.  I $P(^BIP(P,0),U,8)="" Q 1
  1.  I $P(^BIP(P,0),U,8)<EDATE Q ""
  1.  I $P(^BIP(P,0),U,8)=EDATE Q ""
  1.  Q 1
  1. GETIMMS(P,EDATE,C,BGPX) ;EP
  1.  K BGPX
  1.  NEW X,Y,I,Z,V
  1.  S X=0 F  S X=$O(^AUPNVIMM("AC",P,X)) Q:X'=+X  D
  1.  .Q:'$D(^AUPNVIMM(X,0))  ;happens
  1.  .S Y=$P(^AUPNVIMM(X,0),U)
  1.  .Q:'Y  ;happens too
  1.  .S I=$P($G(^AUTTIMM(Y,0)),U,3)  ;get HL7/CVX code
  1.  .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
  1.  .Q
  1.  Q
  1. IMMREF(P,IMM,BD,ED) ;EP
  1.  NEW X,Y,G,D,R
  1.  I 'IMM Q ""
  1.  S (X,G)=0,Y=$O(^AUTTIMM("C",IMM,0))
  1.  I 'Y Q ""
  1.  F  S X=$O(^BIPC("AC",P,Y,X)) Q:X'=+X  D
  1.  .S R=$P(^BIPC(X,0),U,3)
  1.  .Q:R=""
  1.  .Q:'$D(^BICONT(R,0))
  1.  .Q:$P(^BICONT(R,0),U,1)'["Refusal"
  1.  .S D=$P(^BIPC(X,0),U,4)
  1.  .Q:D=""
  1.  .Q:$P(^BIPC(X,0),U,4)<BD
  1.  .Q:$P(^BIPC(X,0),U,4)>ED
  1.  .S G=G+1
  1.  Q G