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

BGP4CON1.m

Go to the documentation of this file.
  1. BGP4CON1 ; IHS/CMI/LAB - measure AHR.A 30 May 2010 9:32 AM ;
  1. ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
  1. ;
  1. ;
  1. BETA ;EP - BETA BLOCKER CONTRAINDICATION/NMI REFUSAL
  1. I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
  1. I $G(EDATE)="" S EDATE=DT
  1. S NMIB=$G(NMIB)
  1. S NMIE=$G(NMIE)
  1. I NMIE="" S NMIE=DT
  1. I NMIB="" S NMIB=$$FMADD^XLFDT($S(NMIE]"":NMIE,1:DT),-365)
  1. ;
  1. NEW BGPG,BGPD,X,G,T,D,Y,N
  1. S X=P_"^ALL DX [BGP ASTHMA DXS;DURING "_BDATE_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
  1. S (X,G)=0 F S X=$O(BGPG(X)) Q:X'=+X S BGPD($P(BGPG(X),U))=""
  1. S (X,G)=0 F S X=$O(BGPD(X)) Q:X'=+X S G=G+1
  1. I G>1 Q 1_U_"2 DX asthma-Beta Blocker contraindication"
  1. K BGPG
  1. S BGPG=$$LASTDX^BGP4UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
  1. I $P(BGPG,U)=1 Q 1_U_"Hypotension dx-Beta Blocker contraindication" ;has hypotension dx
  1. S BGPG=$$LASTDX^BGP4UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
  1. I $P(BGPG,U)=1 Q 1_U_"heart blk dx-Beta Blocker contraindication" ;has heart block dx
  1. S BGPG=$$LASTDX^BGP4UTL1(P,"BGP SINUS BRADYCARDIA DXS",BDATE,EDATE)
  1. I $P(BGPG,U)=1 Q 1_U_"sinus bradycardia-Beta Blocker contraindication"
  1. K BGPG,BGPD
  1. S X=P_"^ALL DX [BGP COPD DXS BB CONT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
  1. S (X,G)=0 F S X=$O(BGPG(X)) Q:X'=+X S BGPD($P(BGPG(X),U))=""
  1. S (X,G)=0 F S X=$O(BGPD(X)) Q:X'=+X S G=G+1
  1. I G>1 Q 1_U_"COPD dx-Beta Blocker contraindication"
  1. ;
  1. ;now check for NMI of beta blocker NMIB-NMIE
  1. ;
  1. S T=$O(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
  1. S X=0,G="" F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X!(G) D
  1. .Q:'$D(^ATXAX(T,21,"B",X)) ;not a Beta Blocker
  1. .S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D!(G) D
  1. ..S Y=9999999-D I Y<NMIB Q ;documented more than 1 year before edate
  1. ..I Y>NMIE Q ;documented after edate
  1. ..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N!(G) D
  1. ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
  1. ...S G=1_U_"Beta Blocker contra NMI med "_$$DATE^BGP4UTL(Y)
  1. ..Q
  1. .Q
  1. I G Q G
  1. ;now cpt 8011 BETWEEN NMIB,NMIE
  1. S X=$$CPTI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8011"))
  1. I X Q "1^Beta Blocker Contra CPT code G8011: "_$$DATE^BGP4UTL($P(X,U,2))
  1. S X=$$TRANI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8011"))
  1. I X Q "1^Beta Blocker Contra TRAN code G8011: "_$$DATE^BGP4UTL($P(X,U,2))
  1. Q ""
  1. ;
  1. ASA ;EP - ASA CONTRAINDICATIONS
  1. I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
  1. I $G(EDATE)="" S EDATE=DT
  1. S NMIB=$G(NMIB)
  1. S NMIE=$G(NMIE)
  1. I NMIE="" S NMIE=DT
  1. I NMIB="" S NMIB=$$FMADD^XLFDT($S(NMIE]"":NMIE,1:DT),-365)
  1. ;
  1. ;
  1. NEW BGPMEDS1,K,R,BGPG,T,X,Y,D,G,N,J,V,S,E
  1. K BGPMEDS1
  1. S K=0,R="",BGPG=""
  1. D GETMEDS^BGP4UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
  1. I '$D(BGPMEDS1) Q ""
  1. S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X!(BGPG) S Y=+$P(BGPMEDS1(X),U,4) D
  1. .Q:'$D(^AUPNVMED(Y,0))
  1. .S G=0
  1. .S D=$P(^AUPNVMED(Y,0),U)
  1. .I T,$D(^ATXAX(T,21,"B",D)) S G=1 G WAR71
  1. .S N=$P($G(^PSDRUG(D,0)),U,1)
  1. .I N["WARFARIN" S G=1 G WAR71
  1. .Q:'G
  1. WAR71 .;
  1. .S J=$P(^AUPNVMED(Y,0),U,8)
  1. .S V=$P(^AUPNVMED(Y,0),U,3)
  1. .Q:'V
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .;S IS DAYS SUPPLY, J IS DATE DISCONTINUED
  1. .I J]"" Q:J<BDATE ;discontinued before beginning date
  1. I BGPG Q 1_U_"asa Contra warfarin rx "_$P(BGPG,U,2)_" "_$P(BGPG,U,3)
  1. ;now check for dx 459
  1. K BGPG S BGPG=$$LASTDX^BGP4UTL1(P,"BGP HEMORRHAGE DXS",$$DOB^AUPNPAT(P),EDATE)
  1. I BGPG Q 1_U_"asa Contra "_$P(BGPG,U,2)_" "_$$DATE^BGP4UTL($P(BGPG,U,3))
  1. ;
  1. ;nmi in Refusal file for aspirin
  1. S BGPG=""
  1. S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
  1. S X=0 F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X D
  1. .Q:'$D(^ATXAX(T,21,"B",X)) ;not an aspirin
  1. .S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D D
  1. ..I Y<NMIB Q ;before date
  1. ..I Y>NMIE Q ;after date
  1. ..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N D
  1. ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
  1. ...S BGPG=1_U_"asa Contra NMI Aspirin: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($P(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
  1. ..Q
  1. .Q
  1. I BGPG Q BGPG
  1. ;now check for CPT code G8008
  1. S X=$$CPTI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8008"))
  1. I X Q 1_U_"asa Contra CPT code G8008: "_$$DATE^BGP4UTL($P(X,U,2))
  1. S X=$$TRANI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8008"))
  1. I X Q 1_U_"asa Contra Tran Code G8008: "_$$DATE^BGP4UTL($P(X,U,2))
  1. Q ""
  1. ;
  1. ACEI ;EP does patient have an ACEI Contraidication
  1. I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
  1. I $G(EDATE)="" S EDATE=DT
  1. S NMIB=$G(NMIB)
  1. S NMIE=$G(NMIE)
  1. I NMIE="" S NMIE=DT
  1. I NMIB="" S NMIB=$$FMADD^XLFDT($S(NMIE]"":NMIE,1:DT),-365)
  1. ;
  1. NEW BGPG,BGPC,X,Y,Z,N,E
  1. K BGPG S Y="BGPG(",X=P_"^LAST DX [BGP CMS AORTIC STENOSIS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. I $D(BGPG(1)) Q 1_U_"ACEI Contra POV: "_$$DATE^BGP4UTL($P(BGPG(1),U))_" ["_$P(BGPG(1),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(1),U,4),.04)
  1. ;
  1. ;nmi in Refusal file for ACEI
  1. S BGPG=""
  1. S T=$O(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
  1. S X=0 F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X D
  1. .Q:'$D(^ATXAX(T,21,"B",X)) ;not an ACEI
  1. .S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D D
  1. ..S Y=9999999-D I Y<NMIB Q ;documented more than 1 year before discharge
  1. ..I Y>NMIE Q ;documented after End date
  1. ..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N D
  1. ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
  1. ...S BGPG=1_U_"NMI ACEI: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($P(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
  1. ..Q
  1. .Q
  1. I BGPG Q BGPG
  1. ;nmi in Refusal file for ACEI
  1. S BGPG=""
  1. S T=$O(^ATXAX("B","BGP HEDIS ARB MEDS",0))
  1. S X=0 F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X D
  1. .Q:'$D(^ATXAX(T,21,"B",X)) ;not an ACEI
  1. .S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D D
  1. ..S Y=9999999-D I Y<NMIB Q
  1. ..I Y>NMIE Q ;documented after End date
  1. ..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N D
  1. ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
  1. ...S BGPG=1_U_"NMI ARB: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($P(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
  1. ..Q
  1. .Q
  1. I BGPG Q BGPG
  1. Q ""
  1. ;
  1. STATIN ;EP does patient have an STATIN Contraidication
  1. I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
  1. I $G(EDATE)="" S EDATE=DT
  1. S NMIB=$G(NMIB)
  1. S NMIE=$G(NMIE)
  1. I NMIE="" S NMIE=DT
  1. I NMIB="" S NMIB=$$FMADD^XLFDT($S(NMIE]"":NMIE,1:DT),-365)
  1. ;
  1. NEW ED,BD,BGPG,BGPC,X,Y,Z,N,E,T
  1. ;
  1. ;pregnant
  1. S X=$$PREG^BGP4D7(P,BDATE,EDATE,0,1) I X Q 1_U_"Contra pregnant"
  1. ;nmi in Refusal file for STATI
  1. S BGPG=""
  1. S T=$O(^ATXAX("B","BGP HEDIS STATIN MEDS",0))
  1. S X=0 F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X D
  1. .Q:'$D(^ATXAX(T,21,"B",X)) ;not an STATI
  1. .S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D D
  1. ..S Y=9999999-D I Y<NMIB Q ;documented more than 1 year before discharge
  1. ..I Y>NMIE Q ;documented after End date
  1. ..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N D
  1. ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
  1. ...S BGPG=1_U_"NMI STATIN: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($P(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
  1. ..Q
  1. .Q
  1. I BGPG Q BGPG
  1. ;breastfeeding
  1. K BGPG S Y="BGPG(",X=P_"^LAST DX [BGP BREASTFEEDING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. I $D(BGPG(1)) Q 1_U_"STATIN Contra POV: "_$$DATE^BGP4UTL($P(BGPG(1),U))_" ["_$P(BGPG(1),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(1),U,4),.04)
  1. ;now check education
  1. K BGPG
  1. S Y="BGPG("
  1. S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. S (X,D)=0,%="",T="" F S X=$O(BGPG(X)) Q:X'=+X!(%]"") D
  1. .S T=$P(^AUPNVPED(+$P(BGPG(X),U,4),0),U)
  1. .Q:'T
  1. .Q:'$D(^AUTTEDT(T,0))
  1. .S T=$P(^AUTTEDT(T,0),U,2)
  1. .I T="BF-BC" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
  1. .I T="BF-BP" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
  1. .I T="BF-CS" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
  1. .I T="BF-EQ" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
  1. .I T="BF-FU" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
  1. .I T="BF-HC" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
  1. .I T="BF-ON" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
  1. .I T="BF-M" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
  1. .I T="BF-MK" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
  1. .I T="BF-N" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
  1. I %]"" Q 1_U_"Statin Contra "_%
  1. ;NOW CHECK ALCOHOL HEPATITIS
  1. K BGPG S Y="BGPG(",X=P_"^LAST DX [BGP ALCOHOL HEPATITIS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. I $D(BGPG(1)) Q 1_U_"STATIN Contra POV: "_$$DATE^BGP4UTL($P(BGPG(1),U))_" ["_$P(BGPG(1),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(1),U,4),.04)
  1. Q ""