- BGP4CON1 ; IHS/CMI/LAB - measure AHR.A 30 May 2010 9:32 AM ;
- ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
- ;
- ;
- BETA ;EP - BETA BLOCKER CONTRAINDICATION/NMI REFUSAL
- I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
- I $G(EDATE)="" S EDATE=DT
- S NMIB=$G(NMIB)
- S NMIE=$G(NMIE)
- I NMIE="" S NMIE=DT
- I NMIB="" S NMIB=$$FMADD^XLFDT($S(NMIE]"":NMIE,1:DT),-365)
- ;
- NEW BGPG,BGPD,X,G,T,D,Y,N
- S X=P_"^ALL DX [BGP ASTHMA DXS;DURING "_BDATE_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
- S (X,G)=0 F S X=$O(BGPG(X)) Q:X'=+X S BGPD($P(BGPG(X),U))=""
- S (X,G)=0 F S X=$O(BGPD(X)) Q:X'=+X S G=G+1
- I G>1 Q 1_U_"2 DX asthma-Beta Blocker contraindication"
- K BGPG
- S BGPG=$$LASTDX^BGP4UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
- I $P(BGPG,U)=1 Q 1_U_"Hypotension dx-Beta Blocker contraindication" ;has hypotension dx
- S BGPG=$$LASTDX^BGP4UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
- I $P(BGPG,U)=1 Q 1_U_"heart blk dx-Beta Blocker contraindication" ;has heart block dx
- S BGPG=$$LASTDX^BGP4UTL1(P,"BGP SINUS BRADYCARDIA DXS",BDATE,EDATE)
- I $P(BGPG,U)=1 Q 1_U_"sinus bradycardia-Beta Blocker contraindication"
- K BGPG,BGPD
- S X=P_"^ALL DX [BGP COPD DXS BB CONT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
- S (X,G)=0 F S X=$O(BGPG(X)) Q:X'=+X S BGPD($P(BGPG(X),U))=""
- S (X,G)=0 F S X=$O(BGPD(X)) Q:X'=+X S G=G+1
- I G>1 Q 1_U_"COPD dx-Beta Blocker contraindication"
- ;
- ;now check for NMI of beta blocker NMIB-NMIE
- ;
- S T=$O(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
- S X=0,G="" F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X!(G) D
- .Q:'$D(^ATXAX(T,21,"B",X)) ;not a Beta Blocker
- .S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D!(G) D
- ..S Y=9999999-D I Y<NMIB Q ;documented more than 1 year before edate
- ..I Y>NMIE Q ;documented after edate
- ..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N!(G) D
- ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
- ...S G=1_U_"Beta Blocker contra NMI med "_$$DATE^BGP4UTL(Y)
- ..Q
- .Q
- I G Q G
- ;now cpt 8011 BETWEEN NMIB,NMIE
- S X=$$CPTI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8011"))
- I X Q "1^Beta Blocker Contra CPT code G8011: "_$$DATE^BGP4UTL($P(X,U,2))
- S X=$$TRANI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8011"))
- I X Q "1^Beta Blocker Contra TRAN code G8011: "_$$DATE^BGP4UTL($P(X,U,2))
- Q ""
- ;
- ASA ;EP - ASA CONTRAINDICATIONS
- I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
- I $G(EDATE)="" S EDATE=DT
- S NMIB=$G(NMIB)
- S NMIE=$G(NMIE)
- I NMIE="" S NMIE=DT
- I NMIB="" S NMIB=$$FMADD^XLFDT($S(NMIE]"":NMIE,1:DT),-365)
- ;
- ;
- NEW BGPMEDS1,K,R,BGPG,T,X,Y,D,G,N,J,V,S,E
- K BGPMEDS1
- S K=0,R="",BGPG=""
- D GETMEDS^BGP4UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
- I '$D(BGPMEDS1) Q ""
- S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
- S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X!(BGPG) S Y=+$P(BGPMEDS1(X),U,4) D
- .Q:'$D(^AUPNVMED(Y,0))
- .S G=0
- .S D=$P(^AUPNVMED(Y,0),U)
- .I T,$D(^ATXAX(T,21,"B",D)) S G=1 G WAR71
- .S N=$P($G(^PSDRUG(D,0)),U,1)
- .I N["WARFARIN" S G=1 G WAR71
- .Q:'G
- WAR71 .;
- .S J=$P(^AUPNVMED(Y,0),U,8)
- .S V=$P(^AUPNVMED(Y,0),U,3)
- .Q:'V
- .Q:'$D(^AUPNVSIT(V,0))
- .;S IS DAYS SUPPLY, J IS DATE DISCONTINUED
- .I J]"" Q:J<BDATE ;discontinued before beginning date
- I BGPG Q 1_U_"asa Contra warfarin rx "_$P(BGPG,U,2)_" "_$P(BGPG,U,3)
- ;now check for dx 459
- K BGPG S BGPG=$$LASTDX^BGP4UTL1(P,"BGP HEMORRHAGE DXS",$$DOB^AUPNPAT(P),EDATE)
- I BGPG Q 1_U_"asa Contra "_$P(BGPG,U,2)_" "_$$DATE^BGP4UTL($P(BGPG,U,3))
- ;
- ;nmi in Refusal file for aspirin
- S BGPG=""
- S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
- S X=0 F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X D
- .Q:'$D(^ATXAX(T,21,"B",X)) ;not an aspirin
- .S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D D
- ..I Y<NMIB Q ;before date
- ..I Y>NMIE Q ;after date
- ..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N D
- ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
- ...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)
- ..Q
- .Q
- I BGPG Q BGPG
- ;now check for CPT code G8008
- S X=$$CPTI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8008"))
- I X Q 1_U_"asa Contra CPT code G8008: "_$$DATE^BGP4UTL($P(X,U,2))
- S X=$$TRANI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8008"))
- I X Q 1_U_"asa Contra Tran Code G8008: "_$$DATE^BGP4UTL($P(X,U,2))
- Q ""
- ;
- ACEI ;EP does patient have an ACEI Contraidication
- I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
- I $G(EDATE)="" S EDATE=DT
- S NMIB=$G(NMIB)
- S NMIE=$G(NMIE)
- I NMIE="" S NMIE=DT
- I NMIB="" S NMIB=$$FMADD^XLFDT($S(NMIE]"":NMIE,1:DT),-365)
- ;
- NEW BGPG,BGPC,X,Y,Z,N,E
- 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)
- 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)
- ;
- ;nmi in Refusal file for ACEI
- S BGPG=""
- S T=$O(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
- S X=0 F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X D
- .Q:'$D(^ATXAX(T,21,"B",X)) ;not an ACEI
- .S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D D
- ..S Y=9999999-D I Y<NMIB Q ;documented more than 1 year before discharge
- ..I Y>NMIE Q ;documented after End date
- ..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N D
- ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
- ...S BGPG=1_U_"NMI ACEI: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($P(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
- ..Q
- .Q
- I BGPG Q BGPG
- ;nmi in Refusal file for ACEI
- S BGPG=""
- S T=$O(^ATXAX("B","BGP HEDIS ARB MEDS",0))
- S X=0 F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X D
- .Q:'$D(^ATXAX(T,21,"B",X)) ;not an ACEI
- .S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D D
- ..S Y=9999999-D I Y<NMIB Q
- ..I Y>NMIE Q ;documented after End date
- ..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N D
- ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
- ...S BGPG=1_U_"NMI ARB: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($P(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
- ..Q
- .Q
- I BGPG Q BGPG
- Q ""
- ;
- STATIN ;EP does patient have an STATIN Contraidication
- I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
- I $G(EDATE)="" S EDATE=DT
- S NMIB=$G(NMIB)
- S NMIE=$G(NMIE)
- I NMIE="" S NMIE=DT
- I NMIB="" S NMIB=$$FMADD^XLFDT($S(NMIE]"":NMIE,1:DT),-365)
- ;
- NEW ED,BD,BGPG,BGPC,X,Y,Z,N,E,T
- ;
- ;pregnant
- S X=$$PREG^BGP4D7(P,BDATE,EDATE,0,1) I X Q 1_U_"Contra pregnant"
- ;nmi in Refusal file for STATI
- S BGPG=""
- S T=$O(^ATXAX("B","BGP HEDIS STATIN MEDS",0))
- S X=0 F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X D
- .Q:'$D(^ATXAX(T,21,"B",X)) ;not an STATI
- .S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D D
- ..S Y=9999999-D I Y<NMIB Q ;documented more than 1 year before discharge
- ..I Y>NMIE Q ;documented after End date
- ..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N D
- ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
- ...S BGPG=1_U_"NMI STATIN: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($P(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
- ..Q
- .Q
- I BGPG Q BGPG
- ;breastfeeding
- 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)
- 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)
- ;now check education
- K BGPG
- S Y="BGPG("
- S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
- S (X,D)=0,%="",T="" F S X=$O(BGPG(X)) Q:X'=+X!(%]"") D
- .S T=$P(^AUPNVPED(+$P(BGPG(X),U,4),0),U)
- .Q:'T
- .Q:'$D(^AUTTEDT(T,0))
- .S T=$P(^AUTTEDT(T,0),U,2)
- .I T="BF-BC" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
- .I T="BF-BP" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
- .I T="BF-CS" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
- .I T="BF-EQ" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
- .I T="BF-FU" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
- .I T="BF-HC" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
- .I T="BF-ON" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
- .I T="BF-M" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
- .I T="BF-MK" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
- .I T="BF-N" S %=T_" "_$$DATE^BGP4UTL($P(BGPG(X),U)) Q
- I %]"" Q 1_U_"Statin Contra "_%
- ;NOW CHECK ALCOHOL HEPATITIS
- 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)
- 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)
- Q ""
- BGP4CON1 ; IHS/CMI/LAB - measure AHR.A 30 May 2010 9:32 AM ;
- +1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
- +2 ;
- +3 ;
- BETA ;EP - BETA BLOCKER CONTRAINDICATION/NMI REFUSAL
- +1 IF $GET(BDATE)=""
- SET BDATE=$$DOB^AUPNPAT(P)
- +2 IF $GET(EDATE)=""
- SET EDATE=DT
- +3 SET NMIB=$GET(NMIB)
- +4 SET NMIE=$GET(NMIE)
- +5 IF NMIE=""
- SET NMIE=DT
- +6 IF NMIB=""
- SET NMIB=$$FMADD^XLFDT($SELECT(NMIE]"":NMIE,1:DT),-365)
- +7 ;
- +8 NEW BGPG,BGPD,X,G,T,D,Y,N
- +9 SET X=P_"^ALL DX [BGP ASTHMA DXS;DURING "_BDATE_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(X,"BGPG(")
- +10 SET (X,G)=0
- FOR
- SET X=$ORDER(BGPG(X))
- IF X'=+X
- QUIT
- SET BGPD($PIECE(BGPG(X),U))=""
- +11 SET (X,G)=0
- FOR
- SET X=$ORDER(BGPD(X))
- IF X'=+X
- QUIT
- SET G=G+1
- +12 IF G>1
- QUIT 1_U_"2 DX asthma-Beta Blocker contraindication"
- +13 KILL BGPG
- +14 SET BGPG=$$LASTDX^BGP4UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
- +15 ;has hypotension dx
- IF $PIECE(BGPG,U)=1
- QUIT 1_U_"Hypotension dx-Beta Blocker contraindication"
- +16 SET BGPG=$$LASTDX^BGP4UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
- +17 ;has heart block dx
- IF $PIECE(BGPG,U)=1
- QUIT 1_U_"heart blk dx-Beta Blocker contraindication"
- +18 SET BGPG=$$LASTDX^BGP4UTL1(P,"BGP SINUS BRADYCARDIA DXS",BDATE,EDATE)
- +19 IF $PIECE(BGPG,U)=1
- QUIT 1_U_"sinus bradycardia-Beta Blocker contraindication"
- +20 KILL BGPG,BGPD
- +21 SET X=P_"^ALL DX [BGP COPD DXS BB CONT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(X,"BGPG(")
- +22 SET (X,G)=0
- FOR
- SET X=$ORDER(BGPG(X))
- IF X'=+X
- QUIT
- SET BGPD($PIECE(BGPG(X),U))=""
- +23 SET (X,G)=0
- FOR
- SET X=$ORDER(BGPD(X))
- IF X'=+X
- QUIT
- SET G=G+1
- +24 IF G>1
- QUIT 1_U_"COPD dx-Beta Blocker contraindication"
- +25 ;
- +26 ;now check for NMI of beta blocker NMIB-NMIE
- +27 ;
- +28 SET T=$ORDER(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
- +29 SET X=0
- SET G=""
- FOR
- SET X=$ORDER(^AUPNPREF("AA",P,50,X))
- IF X'=+X!(G)
- QUIT
- Begin DoDot:1
- +30 ;not a Beta Blocker
- IF '$DATA(^ATXAX(T,21,"B",X))
- QUIT
- +31 SET D=0
- FOR
- SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
- IF D'=+D!(G)
- QUIT
- Begin DoDot:2
- +32 ;documented more than 1 year before edate
- SET Y=9999999-D
- IF Y<NMIB
- QUIT
- +33 ;documented after edate
- IF Y>NMIE
- QUIT
- +34 SET N=0
- FOR
- SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
- IF N'=+N!(G)
- QUIT
- Begin DoDot:3
- +35 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
- QUIT
- +36 SET G=1_U_"Beta Blocker contra NMI med "_$$DATE^BGP4UTL(Y)
- End DoDot:3
- +37 QUIT
- End DoDot:2
- +38 QUIT
- End DoDot:1
- +39 IF G
- QUIT G
- +40 ;now cpt 8011 BETWEEN NMIB,NMIE
- +41 SET X=$$CPTI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8011"))
- +42 IF X
- QUIT "1^Beta Blocker Contra CPT code G8011: "_$$DATE^BGP4UTL($PIECE(X,U,2))
- +43 SET X=$$TRANI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8011"))
- +44 IF X
- QUIT "1^Beta Blocker Contra TRAN code G8011: "_$$DATE^BGP4UTL($PIECE(X,U,2))
- +45 QUIT ""
- +46 ;
- ASA ;EP - ASA CONTRAINDICATIONS
- +1 IF $GET(BDATE)=""
- SET BDATE=$$DOB^AUPNPAT(P)
- +2 IF $GET(EDATE)=""
- SET EDATE=DT
- +3 SET NMIB=$GET(NMIB)
- +4 SET NMIE=$GET(NMIE)
- +5 IF NMIE=""
- SET NMIE=DT
- +6 IF NMIB=""
- SET NMIB=$$FMADD^XLFDT($SELECT(NMIE]"":NMIE,1:DT),-365)
- +7 ;
- +8 ;
- +9 NEW BGPMEDS1,K,R,BGPG,T,X,Y,D,G,N,J,V,S,E
- +10 KILL BGPMEDS1
- +11 SET K=0
- SET R=""
- SET BGPG=""
- +12 DO GETMEDS^BGP4UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
- +13 IF '$DATA(BGPMEDS1)
- QUIT ""
- +14 SET T=$ORDER(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
- +15 SET X=0
- FOR
- SET X=$ORDER(BGPMEDS1(X))
- IF X'=+X!(BGPG)
- QUIT
- SET Y=+$PIECE(BGPMEDS1(X),U,4)
- Begin DoDot:1
- +16 IF '$DATA(^AUPNVMED(Y,0))
- QUIT
- +17 SET G=0
- +18 SET D=$PIECE(^AUPNVMED(Y,0),U)
- +19 IF T
- IF $DATA(^ATXAX(T,21,"B",D))
- SET G=1
- GOTO WAR71
- +20 SET N=$PIECE($GET(^PSDRUG(D,0)),U,1)
- +21 IF N["WARFARIN"
- SET G=1
- GOTO WAR71
- +22 IF 'G
- QUIT
- WAR71 ;
- +1 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
- +2 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
- +3 IF 'V
- QUIT
- +4 IF '$DATA(^AUPNVSIT(V,0))
- QUIT
- +5 ;S IS DAYS SUPPLY, J IS DATE DISCONTINUED
- +6 ;discontinued before beginning date
- IF J]""
- IF J<BDATE
- QUIT
- End DoDot:1
- +7 IF BGPG
- QUIT 1_U_"asa Contra warfarin rx "_$PIECE(BGPG,U,2)_" "_$PIECE(BGPG,U,3)
- +8 ;now check for dx 459
- +9 KILL BGPG
- SET BGPG=$$LASTDX^BGP4UTL1(P,"BGP HEMORRHAGE DXS",$$DOB^AUPNPAT(P),EDATE)
- +10 IF BGPG
- QUIT 1_U_"asa Contra "_$PIECE(BGPG,U,2)_" "_$$DATE^BGP4UTL($PIECE(BGPG,U,3))
- +11 ;
- +12 ;nmi in Refusal file for aspirin
- +13 SET BGPG=""
- +14 SET T=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
- +15 SET X=0
- FOR
- SET X=$ORDER(^AUPNPREF("AA",P,50,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +16 ;not an aspirin
- IF '$DATA(^ATXAX(T,21,"B",X))
- QUIT
- +17 SET D=0
- FOR
- SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
- IF D'=+D
- QUIT
- Begin DoDot:2
- +18 ;before date
- IF Y<NMIB
- QUIT
- +19 ;after date
- IF Y>NMIE
- QUIT
- +20 SET N=0
- FOR
- SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
- IF N'=+N
- QUIT
- Begin DoDot:3
- +21 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
- QUIT
- +22 SET BGPG=1_U_"asa Contra NMI Aspirin: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($PIECE(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
- End DoDot:3
- +23 QUIT
- End DoDot:2
- +24 QUIT
- End DoDot:1
- +25 IF BGPG
- QUIT BGPG
- +26 ;now check for CPT code G8008
- +27 SET X=$$CPTI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8008"))
- +28 IF X
- QUIT 1_U_"asa Contra CPT code G8008: "_$$DATE^BGP4UTL($PIECE(X,U,2))
- +29 SET X=$$TRANI^BGP4DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8008"))
- +30 IF X
- QUIT 1_U_"asa Contra Tran Code G8008: "_$$DATE^BGP4UTL($PIECE(X,U,2))
- +31 QUIT ""
- +32 ;
- ACEI ;EP does patient have an ACEI Contraidication
- +1 IF $GET(BDATE)=""
- SET BDATE=$$DOB^AUPNPAT(P)
- +2 IF $GET(EDATE)=""
- SET EDATE=DT
- +3 SET NMIB=$GET(NMIB)
- +4 SET NMIE=$GET(NMIE)
- +5 IF NMIE=""
- SET NMIE=DT
- +6 IF NMIB=""
- SET NMIB=$$FMADD^XLFDT($SELECT(NMIE]"":NMIE,1:DT),-365)
- +7 ;
- +8 NEW BGPG,BGPC,X,Y,Z,N,E
- +9 KILL BGPG
- SET Y="BGPG("
- SET X=P_"^LAST DX [BGP CMS AORTIC STENOSIS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(X,Y)
- +10 IF $DATA(BGPG(1))
- QUIT 1_U_"ACEI Contra POV: "_$$DATE^BGP4UTL($PIECE(BGPG(1),U))_" ["_$PIECE(BGPG(1),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(1),U,4),.04)
- +11 ;
- +12 ;nmi in Refusal file for ACEI
- +13 SET BGPG=""
- +14 SET T=$ORDER(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
- +15 SET X=0
- FOR
- SET X=$ORDER(^AUPNPREF("AA",P,50,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +16 ;not an ACEI
- IF '$DATA(^ATXAX(T,21,"B",X))
- QUIT
- +17 SET D=0
- FOR
- SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
- IF D'=+D
- QUIT
- Begin DoDot:2
- +18 ;documented more than 1 year before discharge
- SET Y=9999999-D
- IF Y<NMIB
- QUIT
- +19 ;documented after End date
- IF Y>NMIE
- QUIT
- +20 SET N=0
- FOR
- SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
- IF N'=+N
- QUIT
- Begin DoDot:3
- +21 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
- QUIT
- +22 SET BGPG=1_U_"NMI ACEI: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($PIECE(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
- End DoDot:3
- +23 QUIT
- End DoDot:2
- +24 QUIT
- End DoDot:1
- +25 IF BGPG
- QUIT BGPG
- +26 ;nmi in Refusal file for ACEI
- +27 SET BGPG=""
- +28 SET T=$ORDER(^ATXAX("B","BGP HEDIS ARB MEDS",0))
- +29 SET X=0
- FOR
- SET X=$ORDER(^AUPNPREF("AA",P,50,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +30 ;not an ACEI
- IF '$DATA(^ATXAX(T,21,"B",X))
- QUIT
- +31 SET D=0
- FOR
- SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
- IF D'=+D
- QUIT
- Begin DoDot:2
- +32 SET Y=9999999-D
- IF Y<NMIB
- QUIT
- +33 ;documented after End date
- IF Y>NMIE
- QUIT
- +34 SET N=0
- FOR
- SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
- IF N'=+N
- QUIT
- Begin DoDot:3
- +35 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
- QUIT
- +36 SET BGPG=1_U_"NMI ARB: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($PIECE(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
- End DoDot:3
- +37 QUIT
- End DoDot:2
- +38 QUIT
- End DoDot:1
- +39 IF BGPG
- QUIT BGPG
- +40 QUIT ""
- +41 ;
- STATIN ;EP does patient have an STATIN Contraidication
- +1 IF $GET(BDATE)=""
- SET BDATE=$$DOB^AUPNPAT(P)
- +2 IF $GET(EDATE)=""
- SET EDATE=DT
- +3 SET NMIB=$GET(NMIB)
- +4 SET NMIE=$GET(NMIE)
- +5 IF NMIE=""
- SET NMIE=DT
- +6 IF NMIB=""
- SET NMIB=$$FMADD^XLFDT($SELECT(NMIE]"":NMIE,1:DT),-365)
- +7 ;
- +8 NEW ED,BD,BGPG,BGPC,X,Y,Z,N,E,T
- +9 ;
- +10 ;pregnant
- +11 SET X=$$PREG^BGP4D7(P,BDATE,EDATE,0,1)
- IF X
- QUIT 1_U_"Contra pregnant"
- +12 ;nmi in Refusal file for STATI
- +13 SET BGPG=""
- +14 SET T=$ORDER(^ATXAX("B","BGP HEDIS STATIN MEDS",0))
- +15 SET X=0
- FOR
- SET X=$ORDER(^AUPNPREF("AA",P,50,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +16 ;not an STATI
- IF '$DATA(^ATXAX(T,21,"B",X))
- QUIT
- +17 SET D=0
- FOR
- SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
- IF D'=+D
- QUIT
- Begin DoDot:2
- +18 ;documented more than 1 year before discharge
- SET Y=9999999-D
- IF Y<NMIB
- QUIT
- +19 ;documented after End date
- IF Y>NMIE
- QUIT
- +20 SET N=0
- FOR
- SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
- IF N'=+N
- QUIT
- Begin DoDot:3
- +21 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
- QUIT
- +22 SET BGPG=1_U_"NMI STATIN: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP4UTL($PIECE(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
- End DoDot:3
- +23 QUIT
- End DoDot:2
- +24 QUIT
- End DoDot:1
- +25 IF BGPG
- QUIT BGPG
- +26 ;breastfeeding
- +27 KILL BGPG
- SET Y="BGPG("
- SET X=P_"^LAST DX [BGP BREASTFEEDING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(X,Y)
- +28 IF $DATA(BGPG(1))
- QUIT 1_U_"STATIN Contra POV: "_$$DATE^BGP4UTL($PIECE(BGPG(1),U))_" ["_$PIECE(BGPG(1),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(1),U,4),.04)
- +29 ;now check education
- +30 KILL BGPG
- +31 SET Y="BGPG("
- +32 SET X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(X,Y)
- +33 SET (X,D)=0
- SET %=""
- SET T=""
- FOR
- SET X=$ORDER(BGPG(X))
- IF X'=+X!(%]"")
- QUIT
- Begin DoDot:1
- +34 SET T=$PIECE(^AUPNVPED(+$PIECE(BGPG(X),U,4),0),U)
- +35 IF 'T
- QUIT
- +36 IF '$DATA(^AUTTEDT(T,0))
- QUIT
- +37 SET T=$PIECE(^AUTTEDT(T,0),U,2)
- +38 IF T="BF-BC"
- SET %=T_" "_$$DATE^BGP4UTL($PIECE(BGPG(X),U))
- QUIT
- +39 IF T="BF-BP"
- SET %=T_" "_$$DATE^BGP4UTL($PIECE(BGPG(X),U))
- QUIT
- +40 IF T="BF-CS"
- SET %=T_" "_$$DATE^BGP4UTL($PIECE(BGPG(X),U))
- QUIT
- +41 IF T="BF-EQ"
- SET %=T_" "_$$DATE^BGP4UTL($PIECE(BGPG(X),U))
- QUIT
- +42 IF T="BF-FU"
- SET %=T_" "_$$DATE^BGP4UTL($PIECE(BGPG(X),U))
- QUIT
- +43 IF T="BF-HC"
- SET %=T_" "_$$DATE^BGP4UTL($PIECE(BGPG(X),U))
- QUIT
- +44 IF T="BF-ON"
- SET %=T_" "_$$DATE^BGP4UTL($PIECE(BGPG(X),U))
- QUIT
- +45 IF T="BF-M"
- SET %=T_" "_$$DATE^BGP4UTL($PIECE(BGPG(X),U))
- QUIT
- +46 IF T="BF-MK"
- SET %=T_" "_$$DATE^BGP4UTL($PIECE(BGPG(X),U))
- QUIT
- +47 IF T="BF-N"
- SET %=T_" "_$$DATE^BGP4UTL($PIECE(BGPG(X),U))
- QUIT
- End DoDot:1
- +48 IF %]""
- QUIT 1_U_"Statin Contra "_%
- +49 ;NOW CHECK ALCOHOL HEPATITIS
- +50 KILL BGPG
- SET Y="BGPG("
- SET X=P_"^LAST DX [BGP ALCOHOL HEPATITIS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(X,Y)
- +51 IF $DATA(BGPG(1))
- QUIT 1_U_"STATIN Contra POV: "_$$DATE^BGP4UTL($PIECE(BGPG(1),U))_" ["_$PIECE(BGPG(1),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(1),U,4),.04)
- +52 QUIT ""