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

BGP0D721.m

Go to the documentation of this file.
  1. BGP0D721 ; IHS/CMI/LAB - measure AHR.A ;
  1. ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
  1. ;
  1. ;
  1. IAHRA ;EP
  1. 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
  1. S BGPVALUE=""
  1. I BGPAGEB<22 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q ;must be active clinical
  1. S BGPIHD=$$IHD(DFN,BGPBDATE,BGPEDATE)
  1. I 'BGPIHD S BGPSTOP=1 Q ;no IHD
  1. S BGPD1=1
  1. I BGPDMD2 S BGPD3=1
  1. I 'BGPDMD2 S BGPD2=1
  1. K BGPBETA
  1. S BGPBETA("RX")=$$BETA(DFN,BGPBDATE,BGPEDATE,179) ;get 1_U_# days
  1. I BGPBETA("RX") S BGPN2=1 ;pt has 180 days of beta blocker
  1. I 'BGPN2 S BGPBETA("REF")=$$BETAREF(DFN,BGPBDATE,BGPEDATE) I BGPBETA("REF") S BGPN3=1
  1. I 'BGPN2 S BGPBETA("CONTRA")=$$BETACONT(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE) I BGPBETA("CONTRA") S BGPN4=1 ;beta contraindication
  1. I 'BGPN2 S BGPBETA("ADR")=$$BETAALG1^BGP0D72(DFN,BGPEDATE) I BGPBETA("ADR") S BGPN4=1
  1. I (BGPN2+BGPN3+BGPN4) S BGPN1=1
  1. K BGPASA
  1. S BGPASA("RX")=$$ASA(DFN,BGPBDATE,BGPEDATE,179) ;get 1_U_# days
  1. I BGPASA("RX") S BGPN6=1 ;pt has 180 days of beta blocker
  1. I 'BGPN6 S BGPASA("REF")=$$ASAREF(DFN,BGPBDATE,BGPEDATE) I BGPASA("REF") S BGPN7=1
  1. I 'BGPN6 S BGPASA("CONTRA")=$$ASACONTR(DFN,BGPBDATE,BGPEDATE,179) I BGPASA("CONTRA") S BGPN8=1 ;beta contraindication
  1. I 'BGPN6 S BGPASA("ADR")=$$ASAALLEG(DFN,BGPEDATE) I BGPASA("ADR") S BGPN8=1
  1. I (BGPN6+BGPN7+BGPN8) S BGPN5=1
  1. K BGPACE
  1. S BGPACE("RX")=$$ACERX^BGP0D722(DFN,BGPBDATE,BGPEDATE,179) ;get 1_U_# days
  1. I BGPACE("RX") S BGPN10=1 ;pt has 180 days of ACE
  1. I 'BGPN10 S BGPACE("REF")=$$ACEREF^BGP0D722(DFN,BGPBDATE,BGPEDATE) I BGPACE("REF") S BGPN11=1
  1. I 'BGPN10 S BGPACE("CONTRA")=$$ACECONT^BGP0D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE,BGPBDATE) I BGPACE("CONTRA") S BGPN12=1 ;beta contraindication
  1. I 'BGPN10 S BGPACE("ADR")=$$ACEALG^BGP0D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) I BGPACE("ADR") S BGPN12=1
  1. I (BGPN10+BGPN11+BGPN12) S BGPN9=1
  1. K BGPSTAT
  1. S BGPSTAT("RX")=$$STATRX^BGP0D722(DFN,BGPBDATE,BGPEDATE,179) ;get 1_U_# days
  1. I BGPSTAT("RX") S BGPN14=1 ;pt has 180 days of STAT
  1. I 'BGPN14 S BGPSTAT("REF")=$$STATREF^BGP0D722(DFN,BGPBDATE,BGPEDATE) I BGPSTAT("REF") S BGPN15=1
  1. I 'BGPN14 S BGPSTAT("CONTRA")=$$STATCON^BGP0D722(DFN,BGPBDATE,BGPEDATE,BGPBDATE,BGPEDATE) I BGPSTAT("CONTRA") S BGPN16=1 ;beta contraindication
  1. I 'BGPN14 S BGPSTAT("ADR")=$$STATALG^BGP0D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE) I BGPSTAT("ADR") S BGPN16=1
  1. I (BGPN14+BGPN15+BGPN16) S BGPN13=1
  1. I BGPN1,BGPN5,BGPN9,BGPN13 S BGPN17=1
  1. S BGPVALUE="IHD"_$S(BGPD3:";AD",1:"")_"|||"
  1. S BGPVALUE=BGPVALUE_$S(BGPN17:"ALL MEDS; ",1:"")
  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)_" "
  1. 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)_" "
  1. 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)_" "
  1. 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)_" "
  1. K BGPIHD,BGPBETA,BGPMEDS1,BGPASA,BGPACE,BGPSTAT
  1. K ^TMP($J)
  1. Q
  1. IHD(P,BDATE,EDATE) ;EP
  1. ;first dx prior to report period
  1. ;at least 2 visits during report period
  1. ;at least 2 ihd dxs ever
  1. I '$$V2^BGP0D1(P,BDATE,EDATE) Q "" ;not 2 visits during report period
  1. K ^TMP($J)
  1. I '$$FIRSTIHD(P,EDATE) Q "" ;first dx not prior to report period
  1. I '$$V2IHD(P,$$DOB^AUPNPAT(P),EDATE) Q "" ;at least 2 IHD dxs ever
  1. Q 1
  1. FIRSTIHD(P,EDATE) ;EP
  1. I $G(P)="" Q ""
  1. NEW BGPG,Y,X,E
  1. K BGPG
  1. S Y="BGPG("
  1. S X=P_"^FIRST DX [BGP IHD DXS" S E=$$START1^APCLDF(X,Y)
  1. I '$D(BGPG(1)) Q ""
  1. S X=$$FMDIFF^XLFDT(EDATE,$P(BGPG(1),U))
  1. Q $S(X>365:1,1:"")
  1. ;
  1. V2IHD(P,BDATE,EDATE) ;EP
  1. I '$G(P) Q ""
  1. I '$D(^AUPNVSIT("AC",P)) Q ""
  1. NEW A,B,E,T,X,G,V,Y,%,G
  1. K ^TMP($J,"A")
  1. S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1. I '$D(^TMP($J,"A",1)) Q ""
  1. S T=$O(^ATXAX("B","BGP IHD DXS",0))
  1. I 'T Q ""
  1. 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
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1. .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1. .Q:$P(^AUPNVSIT(V,0),U,6)=""
  1. .I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
  1. .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
  1. .Q:'D
  1. .S G=G+1
  1. .Q
  1. K ^TMP($J,"A")
  1. Q $S(G<2:"",1:1)
  1. ;
  1. BETA(P,BDATE,EDATE,BGPNDAYS) ;EP
  1. NEW BGPMEDS1,K,R,T,T1,X,Y,G,D,N,J,V,S
  1. K BGPMEDS1
  1. S K=0,R=""
  1. D GETMEDS^BGP0UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
  1. I '$D(BGPMEDS1) Q ""
  1. S T=$O(^ATXAX("B","BGP HEDIS BETA BLOCKER MEDS",0))
  1. S T1=$O(^ATXAX("B","BGP HEDIS BETA BLOCKER NDC",0))
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 BETA1
  1. .S N=$P($G(^PSDRUG(D,2)),U,4)
  1. .I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1
  1. .Q:'G
  1. BETA1 .;
  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 S=$$DAYS^BGP0D82(Y,V,EDATE)
  1. .S K=S+K ;TOTAL DAYS SUPPLY
  1. .I R]"" S R=R_";"
  1. .S R=R_$$DATE^BGP0UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
  1. I K>BGPNDAYS Q 1_U_" total days beta blocker: "_K
  1. BETAPRIO ;now add in any before BEG DATE
  1. K BGPMEDS1
  1. D GETMEDS^BGP0UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
  1. I '$D(BGPMEDS1) Q ""
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 BETA2
  1. .S N=$P($G(^PSDRUG(D,2)),U,4)
  1. .I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1
  1. .Q:'G
  1. BETA2 .;
  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. .Q:J]"" ;don't use if discontinued
  1. .S D=$$FMDIFF^XLFDT(BDATE,$P($P(^AUPNVSIT(V,0),U),"."))
  1. .S S=$P(^AUPNVMED(Y,0),U,7)
  1. .S S=S-D
  1. .S:S<0 S=0
  1. .S K=S+K
  1. .I R]"" S R=R_";"
  1. .S R=R_$$DATE^BGP0UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
  1. I K>BGPNDAYS Q 1_U_" total days beta blocker: "_K
  1. Q 0_U_" total days beta blocker: "_K
  1. ;
  1. BETAREF(P,BDATE,EDATE) ;EP
  1. NEW T,X,G,D,Y,N
  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<BDATE Q
  1. ..I Y>EDATE 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)'="R"
  1. ...S G=1_U_"Beta Blocker Refusal "_$$DATE^BGP0UTL(Y)
  1. ..Q
  1. .Q
  1. Q G
  1. BETACONT(P,BDATE,EDATE,NMIBD,NMIED) ;EP - BETA BLOCKER CONTRAINDICATION
  1. NEW X,Y,BGPG,BGPD,G,N
  1. I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
  1. S NMIBD=$G(NMIBD),NMIED=$G(NMIED)
  1. K BGPG,BGPD
  1. S Y="BGPG("
  1. S X=P_"^ALL DX [BGP ASTHMA DXS;DURING "_BDATE_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  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 contra"
  1. S BGPG=$$LASTDX^BGP0UTL1(P,"BGP HYPOTENSION DXS",BDATE,EDATE)
  1. I $P(BGPG,U)=1 Q 1_U_"hypotension dx contra" ;has hypotension dx
  1. S BGPG=$$LASTDX^BGP0UTL1(P,"BGP CMS 2/3 HEART BLOCK DXS",BDATE,EDATE)
  1. I $P(BGPG,U)=1 Q 1_U_"heart blk contra" ;has heart block dx
  1. S BGPG=$$LASTDXI^BGP0UTL1(P,"427.81",BDATE,EDATE)
  1. I $P(BGPG,U)=1 Q 1_U_"sinus brady contra"
  1. K BGPG,BGPD
  1. S Y="BGPG("
  1. S X=P_"^ALL DX [BGP COPD DXS BB CONT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  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 contra"
  1. ;now check for NMI of beta blocker during report period
  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<NMIBD Q ;documented more than 1 year before edate
  1. ..I Y>NMIED 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^BGP0UTL(Y)
  1. ..Q
  1. .Q
  1. I G Q G
  1. ;now cpt 8011 in past year
  1. S X=$$CPTI^BGP0DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
  1. I X Q "1^Beta Blocker contra CPT code G8011: "_$$DATE^BGP0UTL($P(X,U,2))
  1. S X=$$TRANI^BGP0DU(P,NMIBD,NMIED,+$$CODEN^ICPTCOD("G8011"))
  1. I X Q "1^Beta Blocker contra TRAN code G8011: "_$$DATE^BGP0UTL($P(X,U,2))
  1. Q 0
  1. ASA(P,BDATE,EDATE,BGPNDAYS) ;EP
  1. K BGPMEDS1
  1. S K=0,R=""
  1. D GETMEDS^BGP0UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
  1. I '$D(BGPMEDS1) Q ""
  1. S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
  1. S T1=$O(^ATXAX("B","BGP ANTI-PLATELET DRUGS",0))
  1. S T2=$O(^ATXAX("B","BGP CMS ANTI-PLATELET CLASS",0))
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 ASA1
  1. .S N=$P($G(^PSDRUG(D,2)),U,4)
  1. .I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1 G ASA1
  1. .S C=$P($G(^PSDRUG(D,0)),U,2)
  1. .I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S G=1
  1. .Q:'G
  1. ASA1 .;
  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 S=$$DAYS^BGP0D82(Y,V,EDATE)
  1. .S K=S+K ;TOTAL DAYS SUPPLY
  1. .I R]"" S R=R_";"
  1. .S R=R_$$DATE^BGP0UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
  1. I K>BGPNDAYS Q 1_U_" total days aspirin: "_K
  1. ASAPRIO ;now add in any before BEG DATE
  1. K BGPMEDS1
  1. D GETMEDS^BGP0UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
  1. I '$D(BGPMEDS1) Q ""
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 ASA2
  1. .S N=$P($G(^PSDRUG(D,2)),U,4)
  1. .I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1 G ASA2
  1. .S C=$P($G(^PSDRUG(D,0)),U,2)
  1. .I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S G=1
  1. .Q:'G
  1. ASA2 .;
  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. .Q:J]"" ;don't use if discontinued
  1. .S D=$$FMDIFF^XLFDT(BDATE,$P($P(^AUPNVSIT(V,0),U),".")) ;difference between dsch date and date prescribed
  1. .S S=$P(^AUPNVMED(Y,0),U,7)
  1. .S S=S-D ;subtract the number of days used
  1. .I S<0 S S=0
  1. .S K=S+K ;TOTAL DAYS SUPPLY
  1. .I R]"" S R=R_";"
  1. .S R=R_$$DATE^BGP0UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
  1. I K>BGPNDAYS Q 1_U_" total days aspirin: "_K
  1. Q 0_U_" total days aspirin: "_K
  1. ;
  1. ASAREF(P,BDATE,EDATE) ;EP
  1. ;did patient have a refusal in time period?
  1. S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",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))
  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<BDATE Q ;documented more than 1 year before edate
  1. ..I Y>EDATE Q ;documented after end date
  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)'="R"
  1. ...S G=1_U_"Aspirin Refusal "_$$DATE^BGP0UTL(Y)
  1. ..Q
  1. .Q
  1. I G Q G
  1. S T=$O(^ATXAX("B","BGP ANTI-PLATELET DRUGS",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))
  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<BDATE Q ;documented more than 1 year before edate
  1. ..I Y>EDATE Q ;documented after end date
  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)'="R"
  1. ...S G=1_U_"Anti-Platelet Refusal "_$$DATE^BGP0UTL(Y)
  1. ..Q
  1. .Q
  1. Q G
  1. ASACONTR(P,BDATE,EDATE,BGPNDAYS) ;does patient have an aspirin allergy
  1. K BGPMEDS1
  1. S K=0,R=""
  1. D GETMEDS^BGP0UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
  1. I '$D(BGPMEDS1) G ASAC2
  1. S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 WAR1
  1. .S N=$P($G(^PSDRUG(D,0)),U,1)
  1. .I N["WARFARIN" S G=1 G WAR1
  1. .Q:'G
  1. WAR1 .;
  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 S=$$DAYS^BGP0D82(Y,V,EDATE)
  1. .S K=S+K ;TOTAL DAYS SUPPLY
  1. .I R]"" S R=R_";"
  1. .S R=R_$$DATE^BGP0UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
  1. I K>BGPNDAYS Q 1_U_" aspirin contra total days WARFARIN: "_K
  1. WARPRIO ;now add in any before BEG DATE
  1. K BGPMEDS1
  1. D GETMEDS^BGP0UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
  1. I '$D(BGPMEDS1) G ASAC2
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X 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 WAR2
  1. .S N=$P($G(^PSDRUG(D,0)),U,1)
  1. .I N["WARFARIN" S G=1 G WAR2
  1. .Q:'G
  1. WAR2 .;
  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. .Q:J]"" ;don't use if discontinued
  1. .S D=$$FMDIFF^XLFDT(EDATE,$P($P(^AUPNVSIT(V,0),U),"."))
  1. .S S=$P(^AUPNVMED(Y,0),U,7)
  1. .S S=S-D ;subtract the number of days used
  1. .I S<0 S S=0
  1. .S K=S+K ;TOTAL DAYS SUPPLY
  1. .I R]"" S R=R_";"
  1. .S R=R_$$DATE^BGP0UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
  1. I K>BGPNDAYS Q 1_U_"asp contra total days WARFARIN: "_K
  1. ASAC2 ;now check for dx 459
  1. K BGPG S BGPG=$$LASTDXI^BGP0UTL1(P,"459.0",$$DOB^AUPNPAT(P),EDATE)
  1. I BGPG Q 1_U_"asa contra 459.0 "_$$DATE^BGP0UTL($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 (9999999-D)<BDATE Q ;before report period
  1. ..I (9999999-D)>EDATE Q ;documented after report period
  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^BGP0UTL($P(^AUPNPREF(N,0),U,3))_" "_$$VAL^XBDIQ1(9000022,X,1101)
  1. ..Q
  1. .Q
  1. I BGPG Q BGPG
  1. S X=$$CPTI^BGP0DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8008"))
  1. I X Q 1_U_"asa contra CPT code G8008: "_$$DATE^BGP0UTL($P(X,U,2))
  1. S X=$$TRANI^BGP0DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8008"))
  1. I X Q 1_U_"asa contra Tran Code G8008: "_$$DATE^BGP0UTL($P(X,U,2))
  1. Q ""
  1. ASAALLEG(P,EDATE) ;EP
  1. K BGPG
  1. S X=$$ASAALLEG^BGP0CU1(P,$$DOB^AUPNPAT(P),EDATE)
  1. I 'X Q 0
  1. Q X
  1. ;