BGP9D721 ; IHS/CMI/LAB - measure AHR.A ;
;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
;
;
IAHRA ;EP
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
S BGPVALUE=""
I BGPAGEB<22 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q ;must be active clinical
S BGPIHD=$$IHD(DFN,BGPBDATE,BGPEDATE)
I 'BGPIHD S BGPSTOP=1 Q ;no IHD
S BGPD1=1
I BGPDMD2 S BGPD3=1
I 'BGPDMD2 S BGPD2=1
K BGPBETA
S BGPBETA("RX")=$$BETA(DFN,BGPBDATE,BGPEDATE,179) ;get 1_U_# days
I BGPBETA("RX") S BGPN2=1 ;pt has 180 days of beta blocker
I 'BGPN2 S BGPBETA("REF")=$$BETAREF(DFN,BGPBDATE,BGPEDATE) I BGPBETA("REF") S BGPN3=1
I 'BGPN2 S BGPBETA("CONTRA")=$$BETACONT(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE) I BGPBETA("CONTRA") S BGPN4=1 ;beta contraindication
I 'BGPN2 S BGPBETA("ADR")=$$BETAALG1^BGP9D72(DFN,BGPEDATE) I BGPBETA("ADR") S BGPN4=1
I (BGPN2+BGPN3+BGPN4) S BGPN1=1
K BGPASA
S BGPASA("RX")=$$ASA(DFN,BGPBDATE,BGPEDATE,179) ;get 1_U_# days
I BGPASA("RX") S BGPN6=1 ;pt has 180 days of beta blocker
I 'BGPN6 S BGPASA("REF")=$$ASAREF(DFN,BGPBDATE,BGPEDATE) I BGPASA("REF") S BGPN7=1
I 'BGPN6 S BGPASA("CONTRA")=$$ASACONTR(DFN,BGPBDATE,BGPEDATE,179) I BGPASA("CONTRA") S BGPN8=1 ;beta contraindication
I 'BGPN6 S BGPASA("ADR")=$$ASAALLEG(DFN,BGPEDATE) I BGPASA("ADR") S BGPN8=1
I (BGPN6+BGPN7+BGPN8) S BGPN5=1
K BGPACE
S BGPACE("RX")=$$ACERX^BGP9D722(DFN,BGPBDATE,BGPEDATE,179) ;get 1_U_# days
I BGPACE("RX") S BGPN10=1 ;pt has 180 days of ACE
I 'BGPN10 S BGPACE("REF")=$$ACEREF^BGP9D722(DFN,BGPBDATE,BGPEDATE) I BGPACE("REF") S BGPN11=1
I 'BGPN10 S BGPACE("CONTRA")=$$ACECONT^BGP9D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE) I BGPACE("CONTRA") S BGPN12=1 ;beta contraindication
I 'BGPN10 S BGPACE("ADR")=$$ACEALG^BGP9D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) I BGPACE("ADR") S BGPN12=1
I (BGPN10+BGPN11+BGPN12) S BGPN9=1
K BGPSTAT
S BGPSTAT("RX")=$$STATRX^BGP9D722(DFN,BGPBDATE,BGPEDATE,179) ;get 1_U_# days
I BGPSTAT("RX") S BGPN14=1 ;pt has 180 days of STAT
I 'BGPN14 S BGPSTAT("REF")=$$STATREF^BGP9D722(DFN,BGPBDATE,BGPEDATE) I BGPSTAT("REF") S BGPN15=1
I 'BGPN14 S BGPSTAT("CONTRA")=$$STATCON^BGP9D722(DFN,BGPBDATE,BGPEDATE,BGPBDATE,BGPEDATE) I BGPSTAT("CONTRA") S BGPN16=1 ;beta contraindication
I 'BGPN14 S BGPSTAT("ADR")=$$STATALG^BGP9D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE) I BGPSTAT("ADR") S BGPN16=1
I (BGPN14+BGPN15+BGPN16) S BGPN13=1
I BGPN1,BGPN5,BGPN9,BGPN13 S BGPN17=1
S BGPVALUE="IHD"_$S(BGPD3:";AD",1:"")_"|||"
S BGPVALUE=BGPVALUE_$S(BGPN17:"ALL MEDS; ",1:"")
S BGPVALUE=BGPVALUE_" BETA: " F X="RX","REF","CONTRA","ADR" I $P($G(BGPBETA(X)),U,1),$P($G(BGPBETA(X)),U,2)]"" S BGPVALUE=BGPVALUE_$P(BGPBETA(X),U,2)_" "
S BGPVALUE=BGPVALUE_" ; ASA: " F X="RX","REF","CONTRA","ADR" I $P($G(BGPASA(X)),U,1),$P($G(BGPASA(X)),U,2)]"" S BGPVALUE=BGPVALUE_$P(BGPASA(X),U,2)_" "
S BGPVALUE=BGPVALUE_" ; ACEI/ARB: " F X="RX","REF","CONTRA","ADR" I $P($G(BGPACE(X)),U,1),$P($G(BGPACE(X)),U,2)]"" S BGPVALUE=BGPVALUE_$P(BGPACE(X),U,2)_" "
S BGPVALUE=BGPVALUE_" ; STATIN: " F X="RX","REF","CONTRA","ADR" I $P($G(BGPSTAT(X)),U,1),$P($G(BGPSTAT(X)),U,2)]"" S BGPVALUE=BGPVALUE_$P(BGPSTAT(X),U,2)_" "
K BGPIHD,BGPBETA,BGPMEDS1,BGPASA,BGPACE,BGPSTAT
K ^TMP($J)
Q
IHD(P,BDATE,EDATE) ;EP
;first dx prior to report period
;at least 2 visits during report period
;at least 2 ihd dxs ever
I '$$V2^BGP9D1(P,BDATE,EDATE) Q "" ;not 2 visits during report period
K ^TMP($J)
I '$$FIRSTIHD(P,EDATE) Q "" ;first dx not prior to report period
I '$$V2IHD(P,$$DOB^AUPNPAT(P),EDATE) Q "" ;at least 2 IHD dxs ever
Q 1
FIRSTIHD(P,EDATE) ;EP
I $G(P)="" Q ""
K BGPG
S Y="BGPG("
S X=P_"^FIRST DX [BGP IHD DXS" S E=$$START1^APCLDF(X,Y)
I '$D(BGPG(1)) Q ""
S X=$$FMDIFF^XLFDT(EDATE,$P(BGPG(1),U))
Q $S(X>365:1,1:"")
;
V2IHD(P,BDATE,EDATE) ;EP
I '$G(P) Q ""
I '$D(^AUPNVSIT("AC",P)) Q ""
K ^TMP($J,"A")
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q ""
S T=$O(^ATXAX("B","BGP IHD DXS",0))
I 'T Q ""
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>2) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.Q:$P(^AUPNVSIT(V,0),U,6)=""
.I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.S (D,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D) I $D(^AUPNVPOV(Y,0)) S %=$P(^AUPNVPOV(Y,0),U) I $$ICD^ATXCHK(%,T,9) S D=1
.Q:'D
.S G=G+1
.Q
K ^TMP($J,"A")
Q $S(G<2:"",1:1)
;
BETA(P,BDATE,EDATE,BGPNDAYS) ;EP
K BGPMEDS1
S K=0,R=""
D GETMEDS^BGP9UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S T=$O(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
S T1=$O(^ATXAX("B","BGP HEDIS BETA BLOCKER NDC",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 BETA1
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1
.Q:'G
BETA1 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.S S=$$DAYS^BGP9D82(Y,V,EDATE)
.S K=S+K ;TOTAL DAYS SUPPLY
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP9UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
I K>BGPNDAYS Q 1_U_" total days beta blocker: "_K
BETAPRIO ;now add in any before BEG DATE
K BGPMEDS1
D GETMEDS^BGP9UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 BETA2
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1
.Q:'G
BETA2 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.Q:J]"" ;don't use if discontinued
.S D=$$FMDIFF^XLFDT(BDATE,$P($P(^AUPNVSIT(V,0),U),"."))
.S S=$P(^AUPNVMED(Y,0),U,7)
.S S=S-D
.S:S<0 S=0
.S K=S+K
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP9UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
I K>BGPNDAYS Q 1_U_" total days beta blocker: "_K
Q 0_U_" total days beta blocker: "_K
;
BETAREF(P,BDATE,EDATE) ;EP
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<BDATE Q
..I Y>EDATE 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)'="R"
...S G=1_U_"Beta Blocker Refusal "_$$DATE^BGP9UTL(Y)
..Q
.Q
Q G
BETACONT(P,BDATE,EDATE,NMIBD,NMIED) ;EP - BETA BLOCKER CONTRAINDICATION
I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
S NMIBD=$G(NMIBD),NMIED=$G(NMIED)
K BGPG,BGPD
S Y="BGPG("
S X=P_"^ALL DX [BGP ASTHMA DXS;DURING "_BDATE_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
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 contra"
S BGPG=$$LASTDX^BGP9UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
I $P(BGPG,U)=1 Q 1_U_"hypotension dx contra" ;has hypotension dx
S BGPG=$$LASTDX^BGP9UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
I $P(BGPG,U)=1 Q 1_U_"heart blk contra" ;has heart block dx
S BGPG=$$LASTDXI^BGP9UTL1(P,"427.81",BDATE,EDATE)
I $P(BGPG,U)=1 Q 1_U_"sinus brady contra"
K BGPG,BGPD
S Y="BGPG("
S X=P_"^ALL DX [BGP COPD DXS BB CONT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
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 contra"
;now check for NMI of beta blocker during report period
;
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<NMIBD Q ;documented more than 1 year before edate
..I Y>NMIED 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^BGP9UTL(Y)
..Q
.Q
I G Q G
;now cpt 8011 in past year
S X=$$CPTI^BGP9DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
I X Q "1^Beta Blocker contra CPT code G8011: "_$$DATE^BGP9UTL($P(X,U,2))
S X=$$TRANI^BGP9DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
I X Q "1^Beta Blocker contra TRAN code G8011: "_$$DATE^BGP9UTL($P(X,U,2))
Q 0
ASA(P,BDATE,EDATE,BGPNDAYS) ;EP
K BGPMEDS1
S K=0,R=""
D GETMEDS^BGP9UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
S T1=$O(^ATXAX("B","BGP ANTI-PLATELET DRUGS",0))
S T2=$O(^ATXAX("B","BGP CMS ANTI-PLATELET CLASS",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 ASA1
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1 G ASA1
.S C=$P($G(^PSDRUG(D,0)),U,2)
.I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S G=1
.Q:'G
ASA1 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.S S=$$DAYS^BGP9D82(Y,V,EDATE)
.S K=S+K ;TOTAL DAYS SUPPLY
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP9UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
I K>BGPNDAYS Q 1_U_" total days aspirin: "_K
ASAPRIO ;now add in any before BEG DATE
K BGPMEDS1
D GETMEDS^BGP9UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 ASA2
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1 G ASA2
.S C=$P($G(^PSDRUG(D,0)),U,2)
.I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S G=1
.Q:'G
ASA2 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.Q:J]"" ;don't use if discontinued
.S D=$$FMDIFF^XLFDT(BDATE,$P($P(^AUPNVSIT(V,0),U),".")) ;difference between dsch date and date prescribed
.S S=$P(^AUPNVMED(Y,0),U,7)
.S S=S-D ;subtract the number of days used
.I S<0 S S=0
.S K=S+K ;TOTAL DAYS SUPPLY
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP9UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
I K>BGPNDAYS Q 1_U_" total days aspirin: "_K
Q 0_U_" total days aspirin: "_K
;
ASAREF(P,BDATE,EDATE) ;EP
;did patient have a refusal in time period?
S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",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))
.S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D!(G) D
..S Y=9999999-D I Y<BDATE Q ;documented more than 1 year before edate
..I Y>EDATE Q ;documented after end date
..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)'="R"
...S G=1_U_"Aspirin Refusal "_$$DATE^BGP9UTL(Y)
..Q
.Q
I G Q G
S T=$O(^ATXAX("B","BGP ANTI-PLATELET DRUGS",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))
.S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D!(G) D
..S Y=9999999-D I Y<BDATE Q ;documented more than 1 year before edate
..I Y>EDATE Q ;documented after end date
..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)'="R"
...S G=1_U_"Anti-Platelet Refusal "_$$DATE^BGP9UTL(Y)
..Q
.Q
Q G
ASACONTR(P,BDATE,EDATE,BGPNDAYS) ;does patient have an aspirin allergy
K BGPMEDS1
S K=0,R=""
D GETMEDS^BGP9UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) G ASAC2
S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 WAR1
.S N=$P($G(^PSDRUG(D,0)),U,1)
.I N["WARFARIN" S G=1 G WAR1
.Q:'G
WAR1 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.S S=$$DAYS^BGP9D82(Y,V,EDATE)
.S K=S+K ;TOTAL DAYS SUPPLY
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP9UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
I K>BGPNDAYS Q 1_U_" aspirin contra total days WARFARIN: "_K
WARPRIO ;now add in any before BEG DATE
K BGPMEDS1
D GETMEDS^BGP9UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) G ASAC2
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 WAR2
.S N=$P($G(^PSDRUG(D,0)),U,1)
.I N["WARFARIN" S G=1 G WAR2
.Q:'G
WAR2 .;
.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
.Q:J]"" ;don't use if discontinued
.S D=$$FMDIFF^XLFDT(EDATE,$P($P(^AUPNVSIT(V,0),U),"."))
.S S=$P(^AUPNVMED(Y,0),U,7)
.S S=S-D ;subtract the number of days used
.I S<0 S S=0
.S K=S+K ;TOTAL DAYS SUPPLY
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP9UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
I K>BGPNDAYS Q 1_U_"asp contra total days WARFARIN: "_K
ASAC2 ;now check for dx 459
K BGPG S BGPG=$$LASTDXI^BGP9UTL1(P,"459.0",$$DOB^AUPNPAT(P),EDATE)
I BGPG Q 1_U_"asa contra 459.0 "_$$DATE^BGP9UTL($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 (9999999-D)<BDATE Q ;before report period
..I (9999999-D)>EDATE Q ;documented after report period
..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^BGP9UTL($P(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
..Q
.Q
I BGPG Q BGPG
S X=$$CPTI^BGP9DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8008"))
I X Q 1_U_"asa contra CPT code G8008: "_$$DATE^BGP9UTL($P(X,U,2))
S X=$$TRANI^BGP9DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8008"))
I X Q 1_U_"asa contra Tran Code G8008: "_$$DATE^BGP9UTL($P(X,U,2))
Q ""
ASAALLEG(P,EDATE) ;EP
K BGPG
S X=$$ASAALLEG^BGP9CU1(P,$$DOB^AUPNPAT(P),EDATE)
I 'X Q 0
Q X
;
BGP9D721 ; IHS/CMI/LAB - measure AHR.A ;
+1 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
+2 ;
+3 ;
IAHRA ;EP
+1 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
+2 SET BGPVALUE=""
+3 IF BGPAGEB<22
SET BGPSTOP=1
QUIT
+4 ;must be active clinical
IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+5 SET BGPIHD=$$IHD(DFN,BGPBDATE,BGPEDATE)
+6 ;no IHD
IF 'BGPIHD
SET BGPSTOP=1
QUIT
+7 SET BGPD1=1
+8 IF BGPDMD2
SET BGPD3=1
+9 IF 'BGPDMD2
SET BGPD2=1
+10 KILL BGPBETA
+11 ;get 1_U_# days
SET BGPBETA("RX")=$$BETA(DFN,BGPBDATE,BGPEDATE,179)
+12 ;pt has 180 days of beta blocker
IF BGPBETA("RX")
SET BGPN2=1
+13 IF 'BGPN2
SET BGPBETA("REF")=$$BETAREF(DFN,BGPBDATE,BGPEDATE)
IF BGPBETA("REF")
SET BGPN3=1
+14 ;beta contraindication
IF 'BGPN2
SET BGPBETA("CONTRA")=$$BETACONT(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE)
IF BGPBETA("CONTRA")
SET BGPN4=1
+15 IF 'BGPN2
SET BGPBETA("ADR")=$$BETAALG1^BGP9D72(DFN,BGPEDATE)
IF BGPBETA("ADR")
SET BGPN4=1
+16 IF (BGPN2+BGPN3+BGPN4)
SET BGPN1=1
+17 KILL BGPASA
+18 ;get 1_U_# days
SET BGPASA("RX")=$$ASA(DFN,BGPBDATE,BGPEDATE,179)
+19 ;pt has 180 days of beta blocker
IF BGPASA("RX")
SET BGPN6=1
+20 IF 'BGPN6
SET BGPASA("REF")=$$ASAREF(DFN,BGPBDATE,BGPEDATE)
IF BGPASA("REF")
SET BGPN7=1
+21 ;beta contraindication
IF 'BGPN6
SET BGPASA("CONTRA")=$$ASACONTR(DFN,BGPBDATE,BGPEDATE,179)
IF BGPASA("CONTRA")
SET BGPN8=1
+22 IF 'BGPN6
SET BGPASA("ADR")=$$ASAALLEG(DFN,BGPEDATE)
IF BGPASA("ADR")
SET BGPN8=1
+23 IF (BGPN6+BGPN7+BGPN8)
SET BGPN5=1
+24 KILL BGPACE
+25 ;get 1_U_# days
SET BGPACE("RX")=$$ACERX^BGP9D722(DFN,BGPBDATE,BGPEDATE,179)
+26 ;pt has 180 days of ACE
IF BGPACE("RX")
SET BGPN10=1
+27 IF 'BGPN10
SET BGPACE("REF")=$$ACEREF^BGP9D722(DFN,BGPBDATE,BGPEDATE)
IF BGPACE("REF")
SET BGPN11=1
+28 ;beta contraindication
IF 'BGPN10
SET BGPACE("CONTRA")=$$ACECONT^BGP9D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE)
IF BGPACE("CONTRA")
SET BGPN12=1
+29 IF 'BGPN10
SET BGPACE("ADR")=$$ACEALG^BGP9D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
IF BGPACE("ADR")
SET BGPN12=1
+30 IF (BGPN10+BGPN11+BGPN12)
SET BGPN9=1
+31 KILL BGPSTAT
+32 ;get 1_U_# days
SET BGPSTAT("RX")=$$STATRX^BGP9D722(DFN,BGPBDATE,BGPEDATE,179)
+33 ;pt has 180 days of STAT
IF BGPSTAT("RX")
SET BGPN14=1
+34 IF 'BGPN14
SET BGPSTAT("REF")=$$STATREF^BGP9D722(DFN,BGPBDATE,BGPEDATE)
IF BGPSTAT("REF")
SET BGPN15=1
+35 ;beta contraindication
IF 'BGPN14
SET BGPSTAT("CONTRA")=$$STATCON^BGP9D722(DFN,BGPBDATE,BGPEDATE,BGPBDATE,BGPEDATE)
IF BGPSTAT("CONTRA")
SET BGPN16=1
+36 IF 'BGPN14
SET BGPSTAT("ADR")=$$STATALG^BGP9D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE)
IF BGPSTAT("ADR")
SET BGPN16=1
+37 IF (BGPN14+BGPN15+BGPN16)
SET BGPN13=1
+38 IF BGPN1
IF BGPN5
IF BGPN9
IF BGPN13
SET BGPN17=1
+39 SET BGPVALUE="IHD"_$SELECT(BGPD3:";AD",1:"")_"|||"
+40 SET BGPVALUE=BGPVALUE_$SELECT(BGPN17:"ALL MEDS; ",1:"")
+41 SET BGPVALUE=BGPVALUE_" BETA: "
FOR X="RX","REF","CONTRA","ADR"
IF $PIECE($GET(BGPBETA(X)),U,1)
IF $PIECE($GET(BGPBETA(X)),U,2)]""
SET BGPVALUE=BGPVALUE_$PIECE(BGPBETA(X),U,2)_" "
+42 SET BGPVALUE=BGPVALUE_" ; ASA: "
FOR X="RX","REF","CONTRA","ADR"
IF $PIECE($GET(BGPASA(X)),U,1)
IF $PIECE($GET(BGPASA(X)),U,2)]""
SET BGPVALUE=BGPVALUE_$PIECE(BGPASA(X),U,2)_" "
+43 SET BGPVALUE=BGPVALUE_" ; ACEI/ARB: "
FOR X="RX","REF","CONTRA","ADR"
IF $PIECE($GET(BGPACE(X)),U,1)
IF $PIECE($GET(BGPACE(X)),U,2)]""
SET BGPVALUE=BGPVALUE_$PIECE(BGPACE(X),U,2)_" "
+44 SET BGPVALUE=BGPVALUE_" ; STATIN: "
FOR X="RX","REF","CONTRA","ADR"
IF $PIECE($GET(BGPSTAT(X)),U,1)
IF $PIECE($GET(BGPSTAT(X)),U,2)]""
SET BGPVALUE=BGPVALUE_$PIECE(BGPSTAT(X),U,2)_" "
+45 KILL BGPIHD,BGPBETA,BGPMEDS1,BGPASA,BGPACE,BGPSTAT
+46 KILL ^TMP($JOB)
+47 QUIT
IHD(P,BDATE,EDATE) ;EP
+1 ;first dx prior to report period
+2 ;at least 2 visits during report period
+3 ;at least 2 ihd dxs ever
+4 ;not 2 visits during report period
IF '$$V2^BGP9D1(P,BDATE,EDATE)
QUIT ""
+5 KILL ^TMP($JOB)
+6 ;first dx not prior to report period
IF '$$FIRSTIHD(P,EDATE)
QUIT ""
+7 ;at least 2 IHD dxs ever
IF '$$V2IHD(P,$$DOB^AUPNPAT(P),EDATE)
QUIT ""
+8 QUIT 1
FIRSTIHD(P,EDATE) ;EP
+1 IF $GET(P)=""
QUIT ""
+2 KILL BGPG
+3 SET Y="BGPG("
+4 SET X=P_"^FIRST DX [BGP IHD DXS"
SET E=$$START1^APCLDF(X,Y)
+5 IF '$DATA(BGPG(1))
QUIT ""
+6 SET X=$$FMDIFF^XLFDT(EDATE,$PIECE(BGPG(1),U))
+7 QUIT $SELECT(X>365:1,1:"")
+8 ;
V2IHD(P,BDATE,EDATE) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+3 KILL ^TMP($JOB,"A")
+4 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+5 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+6 SET T=$ORDER(^ATXAX("B","BGP IHD DXS",0))
+7 IF 'T
QUIT ""
+8 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G>2)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+9 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+10 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+11 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+12 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+13 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+14 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+15 IF $GET(BGPMFITI)
IF '$DATA(^ATXAX(BGPMFITI,21,"B",$PIECE(^AUPNVSIT(V,0),U,6)))
QUIT
+16 SET (D,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(D)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
SET %=$PIECE(^AUPNVPOV(Y,0),U)
IF $$ICD^ATXCHK(%,T,9)
SET D=1
+17 IF 'D
QUIT
+18 SET G=G+1
+19 QUIT
End DoDot:1
+20 KILL ^TMP($JOB,"A")
+21 QUIT $SELECT(G<2:"",1:1)
+22 ;
BETA(P,BDATE,EDATE,BGPNDAYS) ;EP
+1 KILL BGPMEDS1
+2 SET K=0
SET R=""
+3 DO GETMEDS^BGP9UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+4 IF '$DATA(BGPMEDS1)
QUIT ""
+5 SET T=$ORDER(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
+6 SET T1=$ORDER(^ATXAX("B","BGP HEDIS BETA BLOCKER NDC",0))
+7 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+8 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+9 SET G=0
+10 SET D=$PIECE(^AUPNVMED(Y,0),U)
+11 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO BETA1
+12 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+13 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1
+14 IF 'G
QUIT
BETA1 ;
+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 SET S=$$DAYS^BGP9D82(Y,V,EDATE)
+6 ;TOTAL DAYS SUPPLY
SET K=S+K
+7 IF R]""
SET R=R_";"
+8 SET R=R_$$DATE^BGP9UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
End DoDot:1
+9 IF K>BGPNDAYS
QUIT 1_U_" total days beta blocker: "_K
BETAPRIO ;now add in any before BEG DATE
+1 KILL BGPMEDS1
+2 DO GETMEDS^BGP9UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
+3 IF '$DATA(BGPMEDS1)
QUIT ""
+4 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+5 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+6 SET G=0
+7 SET D=$PIECE(^AUPNVMED(Y,0),U)
+8 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO BETA2
+9 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+10 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1
+11 IF 'G
QUIT
BETA2 ;
+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 ;don't use if discontinued
IF J]""
QUIT
+6 SET D=$$FMDIFF^XLFDT(BDATE,$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
+7 SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+8 SET S=S-D
+9 IF S<0
SET S=0
+10 SET K=S+K
+11 IF R]""
SET R=R_";"
+12 SET R=R_$$DATE^BGP9UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
End DoDot:1
+13 IF K>BGPNDAYS
QUIT 1_U_" total days beta blocker: "_K
+14 QUIT 0_U_" total days beta blocker: "_K
+15 ;
BETAREF(P,BDATE,EDATE) ;EP
+1 SET T=$ORDER(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
+2 SET X=0
SET G=""
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+3 ;not a Beta Blocker
IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+4 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D!(G)
QUIT
Begin DoDot:2
+5 SET Y=9999999-D
IF Y<BDATE
QUIT
+6 ;documented after edate
IF Y>EDATE
QUIT
+7 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N!(G)
QUIT
Begin DoDot:3
+8 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="R"
QUIT
+9 SET G=1_U_"Beta Blocker Refusal "_$$DATE^BGP9UTL(Y)
End DoDot:3
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT G
BETACONT(P,BDATE,EDATE,NMIBD,NMIED) ;EP - BETA BLOCKER CONTRAINDICATION
+1 IF $GET(BDATE)=""
SET BDATE=$$DOB^AUPNPAT(P)
+2 SET NMIBD=$GET(NMIBD)
SET NMIED=$GET(NMIED)
+3 KILL BGPG,BGPD
+4 SET Y="BGPG("
+5 SET X=P_"^ALL DX [BGP ASTHMA DXS;DURING "_BDATE_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+6 SET (X,G)=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
SET BGPD($PIECE(BGPG(X),U))=""
+7 SET (X,G)=0
FOR
SET X=$ORDER(BGPD(X))
IF X'=+X
QUIT
SET G=G+1
+8 IF G>1
QUIT 1_U_"2 dx asthma contra"
+9 SET BGPG=$$LASTDX^BGP9UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
+10 ;has hypotension dx
IF $PIECE(BGPG,U)=1
QUIT 1_U_"hypotension dx contra"
+11 SET BGPG=$$LASTDX^BGP9UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
+12 ;has heart block dx
IF $PIECE(BGPG,U)=1
QUIT 1_U_"heart blk contra"
+13 SET BGPG=$$LASTDXI^BGP9UTL1(P,"427.81",BDATE,EDATE)
+14 IF $PIECE(BGPG,U)=1
QUIT 1_U_"sinus brady contra"
+15 KILL BGPG,BGPD
+16 SET Y="BGPG("
+17 SET X=P_"^ALL DX [BGP COPD DXS BB CONT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+18 SET (X,G)=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
SET BGPD($PIECE(BGPG(X),U))=""
+19 SET (X,G)=0
FOR
SET X=$ORDER(BGPD(X))
IF X'=+X
QUIT
SET G=G+1
+20 IF G>1
QUIT 1_U_"copd dx contra"
+21 ;now check for NMI of beta blocker during report period
+22 ;
+23 SET T=$ORDER(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
+24 SET X=0
SET G=""
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+25 ;not a Beta Blocker
IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+26 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D!(G)
QUIT
Begin DoDot:2
+27 ;documented more than 1 year before edate
SET Y=9999999-D
IF Y<NMIBD
QUIT
+28 ;documented after edate
IF Y>NMIED
QUIT
+29 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N!(G)
QUIT
Begin DoDot:3
+30 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+31 SET G=1_U_"Beta Blocker contra NMI med "_$$DATE^BGP9UTL(Y)
End DoDot:3
+32 QUIT
End DoDot:2
+33 QUIT
End DoDot:1
+34 IF G
QUIT G
+35 ;now cpt 8011 in past year
+36 SET X=$$CPTI^BGP9DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
+37 IF X
QUIT "1^Beta Blocker contra CPT code G8011: "_$$DATE^BGP9UTL($PIECE(X,U,2))
+38 SET X=$$TRANI^BGP9DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
+39 IF X
QUIT "1^Beta Blocker contra TRAN code G8011: "_$$DATE^BGP9UTL($PIECE(X,U,2))
+40 QUIT 0
ASA(P,BDATE,EDATE,BGPNDAYS) ;EP
+1 KILL BGPMEDS1
+2 SET K=0
SET R=""
+3 DO GETMEDS^BGP9UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+4 IF '$DATA(BGPMEDS1)
QUIT ""
+5 SET T=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
+6 SET T1=$ORDER(^ATXAX("B","BGP ANTI-PLATELET DRUGS",0))
+7 SET T2=$ORDER(^ATXAX("B","BGP CMS ANTI-PLATELET CLASS",0))
+8 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+9 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+10 SET G=0
+11 SET D=$PIECE(^AUPNVMED(Y,0),U)
+12 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO ASA1
+13 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+14 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1
GOTO ASA1
+15 SET C=$PIECE($GET(^PSDRUG(D,0)),U,2)
+16 IF C]""
IF T2
IF $DATA(^ATXAX(T2,21,"B",C))
SET G=1
+17 IF 'G
QUIT
ASA1 ;
+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 SET S=$$DAYS^BGP9D82(Y,V,EDATE)
+6 ;TOTAL DAYS SUPPLY
SET K=S+K
+7 IF R]""
SET R=R_";"
+8 SET R=R_$$DATE^BGP9UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
End DoDot:1
+9 IF K>BGPNDAYS
QUIT 1_U_" total days aspirin: "_K
ASAPRIO ;now add in any before BEG DATE
+1 KILL BGPMEDS1
+2 DO GETMEDS^BGP9UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
+3 IF '$DATA(BGPMEDS1)
QUIT ""
+4 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+5 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+6 SET G=0
+7 SET D=$PIECE(^AUPNVMED(Y,0),U)
+8 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO ASA2
+9 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+10 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1
GOTO ASA2
+11 SET C=$PIECE($GET(^PSDRUG(D,0)),U,2)
+12 IF C]""
IF T2
IF $DATA(^ATXAX(T2,21,"B",C))
SET G=1
+13 IF 'G
QUIT
ASA2 ;
+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 ;don't use if discontinued
IF J]""
QUIT
+6 ;difference between dsch date and date prescribed
SET D=$$FMDIFF^XLFDT(BDATE,$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
+7 SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+8 ;subtract the number of days used
SET S=S-D
+9 IF S<0
SET S=0
+10 ;TOTAL DAYS SUPPLY
SET K=S+K
+11 IF R]""
SET R=R_";"
+12 SET R=R_$$DATE^BGP9UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
End DoDot:1
+13 IF K>BGPNDAYS
QUIT 1_U_" total days aspirin: "_K
+14 QUIT 0_U_" total days aspirin: "_K
+15 ;
ASAREF(P,BDATE,EDATE) ;EP
+1 ;did patient have a refusal in time period?
+2 SET T=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
+3 SET X=0
SET G=""
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+4 IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+5 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D!(G)
QUIT
Begin DoDot:2
+6 ;documented more than 1 year before edate
SET Y=9999999-D
IF Y<BDATE
QUIT
+7 ;documented after end date
IF Y>EDATE
QUIT
+8 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N!(G)
QUIT
Begin DoDot:3
+9 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="R"
QUIT
+10 SET G=1_U_"Aspirin Refusal "_$$DATE^BGP9UTL(Y)
End DoDot:3
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 IF G
QUIT G
+14 SET T=$ORDER(^ATXAX("B","BGP ANTI-PLATELET DRUGS",0))
+15 SET X=0
SET G=""
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+16 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!(G)
QUIT
Begin DoDot:2
+18 ;documented more than 1 year before edate
SET Y=9999999-D
IF Y<BDATE
QUIT
+19 ;documented after end date
IF Y>EDATE
QUIT
+20 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N!(G)
QUIT
Begin DoDot:3
+21 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="R"
QUIT
+22 SET G=1_U_"Anti-Platelet Refusal "_$$DATE^BGP9UTL(Y)
End DoDot:3
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 QUIT G
ASACONTR(P,BDATE,EDATE,BGPNDAYS) ;does patient have an aspirin allergy
+1 KILL BGPMEDS1
+2 SET K=0
SET R=""
+3 DO GETMEDS^BGP9UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+4 IF '$DATA(BGPMEDS1)
GOTO ASAC2
+5 SET T=$ORDER(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
+6 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+7 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+8 SET G=0
+9 SET D=$PIECE(^AUPNVMED(Y,0),U)
+10 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO WAR1
+11 SET N=$PIECE($GET(^PSDRUG(D,0)),U,1)
+12 IF N["WARFARIN"
SET G=1
GOTO WAR1
+13 IF 'G
QUIT
WAR1 ;
+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 SET S=$$DAYS^BGP9D82(Y,V,EDATE)
+6 ;TOTAL DAYS SUPPLY
SET K=S+K
+7 IF R]""
SET R=R_";"
+8 SET R=R_$$DATE^BGP9UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
End DoDot:1
+9 IF K>BGPNDAYS
QUIT 1_U_" aspirin contra total days WARFARIN: "_K
WARPRIO ;now add in any before BEG DATE
+1 KILL BGPMEDS1
+2 DO GETMEDS^BGP9UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
+3 IF '$DATA(BGPMEDS1)
GOTO ASAC2
+4 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+5 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+6 SET G=0
+7 SET D=$PIECE(^AUPNVMED(Y,0),U)
+8 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO WAR2
+9 SET N=$PIECE($GET(^PSDRUG(D,0)),U,1)
+10 IF N["WARFARIN"
SET G=1
GOTO WAR2
+11 IF 'G
QUIT
WAR2 ;
+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 ;don't use if discontinued
IF J]""
QUIT
+7 SET D=$$FMDIFF^XLFDT(EDATE,$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
+8 SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+9 ;subtract the number of days used
SET S=S-D
+10 IF S<0
SET S=0
+11 ;TOTAL DAYS SUPPLY
SET K=S+K
+12 IF R]""
SET R=R_";"
+13 SET R=R_$$DATE^BGP9UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
End DoDot:1
+14 IF K>BGPNDAYS
QUIT 1_U_"asp contra total days WARFARIN: "_K
ASAC2 ;now check for dx 459
+1 KILL BGPG
SET BGPG=$$LASTDXI^BGP9UTL1(P,"459.0",$$DOB^AUPNPAT(P),EDATE)
+2 IF BGPG
QUIT 1_U_"asa contra 459.0 "_$$DATE^BGP9UTL($PIECE(BGPG,U,3))
+3 ;
+4 ;nmi in refusal file for aspirin
+5 SET BGPG=""
+6 SET T=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
+7 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X
QUIT
Begin DoDot:1
+8 ;not an aspirin
IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+9 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D
QUIT
Begin DoDot:2
+10 ;before report period
IF (9999999-D)<BDATE
QUIT
+11 ;documented after report period
IF (9999999-D)>EDATE
QUIT
+12 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N
QUIT
Begin DoDot:3
+13 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+14 SET BGPG=1_U_"asa contra NMI Aspirin: "_$$VAL^XBDIQ1(9000022,N,.04)_" "_$$DATE^BGP9UTL($PIECE(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
End DoDot:3
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 IF BGPG
QUIT BGPG
+18 SET X=$$CPTI^BGP9DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8008"))
+19 IF X
QUIT 1_U_"asa contra CPT code G8008: "_$$DATE^BGP9UTL($PIECE(X,U,2))
+20 SET X=$$TRANI^BGP9DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8008"))
+21 IF X
QUIT 1_U_"asa contra Tran Code G8008: "_$$DATE^BGP9UTL($PIECE(X,U,2))
+22 QUIT ""
ASAALLEG(P,EDATE) ;EP
+1 KILL BGPG
+2 SET X=$$ASAALLEG^BGP9CU1(P,$$DOB^AUPNPAT(P),EDATE)
+3 IF 'X
QUIT 0
+4 QUIT X
+5 ;
