BGP1CON1 ; IHS/CMI/LAB - measure AHR.A 30 May 2010 9:32 AM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
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^BGP1UTL1(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^BGP1UTL1(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=$$LASTDXI^BGP1UTL1(P,"427.81",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^BGP1UTL(Y)
..Q
.Q
I G Q G
;now cpt 8011 BETWEEN NMIB,NMIE
S X=$$CPTI^BGP1DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8011"))
I X Q "1^Beta Blocker contra CPT code G8011: "_$$DATE^BGP1UTL($P(X,U,2))
S X=$$TRANI^BGP1DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8011"))
I X Q "1^Beta Blocker contra TRAN code G8011: "_$$DATE^BGP1UTL($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^BGP1UTL2(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=$$LASTDXI^BGP1UTL1(P,"459.0",$$DOB^AUPNPAT(P),EDATE)
I BGPG Q 1_U_"asa contra 459.0 "_$$DATE^BGP1UTL($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^BGP1UTL($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^BGP1DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8008"))
I X Q 1_U_"asa contra CPT code G8008: "_$$DATE^BGP1UTL($P(X,U,2))
S X=$$TRANI^BGP1DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8008"))
I X Q 1_U_"asa contra Tran Code G8008: "_$$DATE^BGP1UTL($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^BGP1UTL($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^BGP1UTL($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^BGP1UTL($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^BGP1D7(P,BDATE,EDATE,0,1) I X Q 1_U_"contra statin - 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^BGP1UTL($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 V24.1;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(BGPG(1)) Q 1_U_"STATIN contra POV: "_$$DATE^BGP1UTL($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^BGP1UTL($P(BGPG(X),U)) Q
.I T="BF-BP" S %=T_" "_$$DATE^BGP1UTL($P(BGPG(X),U)) Q
.I T="BF-CS" S %=T_" "_$$DATE^BGP1UTL($P(BGPG(X),U)) Q
.I T="BF-EQ" S %=T_" "_$$DATE^BGP1UTL($P(BGPG(X),U)) Q
.I T="BF-FU" S %=T_" "_$$DATE^BGP1UTL($P(BGPG(X),U)) Q
.I T="BF-HC" S %=T_" "_$$DATE^BGP1UTL($P(BGPG(X),U)) Q
.I T="BF-ON" S %=T_" "_$$DATE^BGP1UTL($P(BGPG(X),U)) Q
.I T="BF-M" S %=T_" "_$$DATE^BGP1UTL($P(BGPG(X),U)) Q
.I T="BF-MK" S %=T_" "_$$DATE^BGP1UTL($P(BGPG(X),U)) Q
.I T="BF-N" S %=T_" "_$$DATE^BGP1UTL($P(BGPG(X),U)) Q
.;I $P(T,"-")="V24.1" S %=T_U_$P(BGPG(X),U) Q
I %]"" Q 1_U_"Statin contra - "_%
;NOW CHECK ALCOHOL HEPATITIS
K BGPG S Y="BGPG(",X=P_"^LAST DX 571.1;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(BGPG(1)) Q 1_U_"STATIN contra POV: "_$$DATE^BGP1UTL($P(BGPG(1),U))_" ["_$P(BGPG(1),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(1),U,4),.04)
Q ""
BGP1CON1 ; IHS/CMI/LAB - measure AHR.A 30 May 2010 9:32 AM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+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^BGP1UTL1(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^BGP1UTL1(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=$$LASTDXI^BGP1UTL1(P,"427.81",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^BGP1UTL(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^BGP1DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8011"))
+42 IF X
QUIT "1^Beta Blocker contra CPT code G8011: "_$$DATE^BGP1UTL($PIECE(X,U,2))
+43 SET X=$$TRANI^BGP1DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8011"))
+44 IF X
QUIT "1^Beta Blocker contra TRAN code G8011: "_$$DATE^BGP1UTL($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^BGP1UTL2(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=$$LASTDXI^BGP1UTL1(P,"459.0",$$DOB^AUPNPAT(P),EDATE)
+10 IF BGPG
QUIT 1_U_"asa contra 459.0 "_$$DATE^BGP1UTL($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^BGP1UTL($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^BGP1DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8008"))
+28 IF X
QUIT 1_U_"asa contra CPT code G8008: "_$$DATE^BGP1UTL($PIECE(X,U,2))
+29 SET X=$$TRANI^BGP1DU(P,NMIB,NMIE,+$$CODEN^ICPTCOD("G8008"))
+30 IF X
QUIT 1_U_"asa contra Tran Code G8008: "_$$DATE^BGP1UTL($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^BGP1UTL($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^BGP1UTL($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^BGP1UTL($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^BGP1D7(P,BDATE,EDATE,0,1)
IF X
QUIT 1_U_"contra statin - 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^BGP1UTL($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 V24.1;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^BGP1UTL($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^BGP1UTL($PIECE(BGPG(X),U))
QUIT
+39 IF T="BF-BP"
SET %=T_" "_$$DATE^BGP1UTL($PIECE(BGPG(X),U))
QUIT
+40 IF T="BF-CS"
SET %=T_" "_$$DATE^BGP1UTL($PIECE(BGPG(X),U))
QUIT
+41 IF T="BF-EQ"
SET %=T_" "_$$DATE^BGP1UTL($PIECE(BGPG(X),U))
QUIT
+42 IF T="BF-FU"
SET %=T_" "_$$DATE^BGP1UTL($PIECE(BGPG(X),U))
QUIT
+43 IF T="BF-HC"
SET %=T_" "_$$DATE^BGP1UTL($PIECE(BGPG(X),U))
QUIT
+44 IF T="BF-ON"
SET %=T_" "_$$DATE^BGP1UTL($PIECE(BGPG(X),U))
QUIT
+45 IF T="BF-M"
SET %=T_" "_$$DATE^BGP1UTL($PIECE(BGPG(X),U))
QUIT
+46 IF T="BF-MK"
SET %=T_" "_$$DATE^BGP1UTL($PIECE(BGPG(X),U))
QUIT
+47 IF T="BF-N"
SET %=T_" "_$$DATE^BGP1UTL($PIECE(BGPG(X),U))
QUIT
+48 ;I $P(T,"-")="V24.1" S %=T_U_$P(BGPG(X),U) Q
End DoDot:1
+49 IF %]""
QUIT 1_U_"Statin contra - "_%
+50 ;NOW CHECK ALCOHOL HEPATITIS
+51 KILL BGPG
SET Y="BGPG("
SET X=P_"^LAST DX 571.1;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+52 IF $DATA(BGPG(1))
QUIT 1_U_"STATIN contra POV: "_$$DATE^BGP1UTL($PIECE(BGPG(1),U))_" ["_$PIECE(BGPG(1),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(1),U,4),.04)
+53 QUIT ""
