BGP8D75 ; IHS/CMI/LAB - measure 31 ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
;
IAMT ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17)=0
S BGPVALUE="" K BGPBETA
I BGPAGEB<35 S BGPSTOP=1 Q
I 'BGPACTCL S BGPSTOP=1 Q
S BGPAMI=$$AMIH(DFN,BGPBDATE,$$FMADD^XLFDT(BGPBDATE,(51*7)))
I '$P(BGPAMI,U) S BGPSTOP=1 Q ;no ami
I $$READM(DFN,$P(BGPAMI,U,4),$P(BGPAMI,U,3)) S BGPSTOP=1 Q
S BGPV=$P(BGPAMI,U,3)
S BGPD1=1
I $P(^DPT(DFN,0),U,2)="M" S BGPD2=1
I $P(^DPT(DFN,0),U,2)="F" S BGPD3=1
K BGPBETA
S BGPBETA("RX")=$$RX7(DFN,$$FMADD^XLFDT($P(BGPAMI,U,2),-180),$$FMADD^XLFDT($P(BGPAMI,U,4),7),$P(BGPAMI,U,4),$O(^ATXAX("B","BGP PQA BETA BLOCKER MEDS",0)),,,$O(^ATXAX("B","BGP PQA BETA BLOCKER NDC",0)))
I BGPBETA("RX") S BGPN2=1,BGPN3=0,BGPN4=0
;I 'BGPN2 S BGPBETA("REF")=$$BETAREF^BGP8D721(DFN,$P(BGPAMI,U,2),$$FMADD^XLFDT($P(BGPAMI,U,4),7)) I BGPBETA("REF") S BGPN3=1
I 'BGPN2 S BGPBETA("CONTRA")=$$BETACONT^BGP8D721(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,$P(BGPAMI,U,2),$$FMADD^XLFDT($P(BGPAMI,U,4),7)) I BGPBETA("CONTRA") S BGPN4=1 ;beta Contraindication
I 'BGPN2,'BGPN4 S BGPBETA("ADR")=$$BETAALG1^BGP8D72(DFN,BGPEDATE) I BGPBETA("ADR") S BGPN4=1
I (BGPN2+BGPN4) S BGPN1=1
;
K BGPASA
S C=$O(^ATXAX("B","BGP CMS ANTI-PLATELET CLASS",0))
S BGPASA("RX")=$$RX7(DFN,$$FMADD^XLFDT($P(BGPAMI,U,2),-180),$$FMADD^XLFDT($P(BGPAMI,U,4),7),$P(BGPAMI,U,4),$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0)),$O(^ATXAX("B","BGP ANTI-PLATELET DRUGS",0)),,,,C)
I BGPASA("RX") S BGPN6=1
;I 'BGPN6 S BGPASA("REF")=$$ASAREF^BGP8D721(DFN,$P(BGPAMI,U,2),$$FMADD^XLFDT($P(BGPAMI,U,4),7)) I BGPASA("REF") S BGPN7=1
I 'BGPN6 S BGPASA("CONTRA")=$$ASACONTR(DFN,BGPBDATE,BGPEDATE,$P(BGPAMI,U,2),$$FMADD^XLFDT($P(BGPAMI,U,4),7)) I BGPASA("CONTRA") S BGPN8=1 ;beta Contraindication
I 'BGPN6 S BGPASA("ADR")=$$ASAALLEG^BGP8D721(DFN,BGPEDATE) I BGPASA("ADR") S BGPN8=1
I (BGPN6+BGPN8) S BGPN5=1
K BGPACE
S T=$O(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
S BGPACE("RX")=$$RX7(DFN,$$FMADD^XLFDT($P(BGPAMI,U,2),-180),$$FMADD^XLFDT($P(BGPAMI,U,4),7),$P(BGPAMI,U,4),T,,$O(^ATXAX("B","BGP HEDIS ACEI NDC",0)),$O(^ATXAX("B","BGP HEDIS ARB MEDS",0)),$O(^ATXAX("B","BGP HEDIS ARB NDC",0)))
I BGPACE("RX") S BGPN10=1
;I 'BGPN10 S BGPACE("REF")=$$ACEREF^BGP8D722(DFN,$P(BGPAMI,U,2),$$FMADD^XLFDT($P(BGPAMI,U,4),7)) I BGPACE("REF") S BGPN11=1
I 'BGPN10 S BGPACE("CONTRA")=$$ACECONT(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,$P(BGPAMI,U,2),$$FMADD^XLFDT($P(BGPAMI,U,4),7),BGPBDATE) I BGPACE("CONTRA") S BGPN12=1 ;beta Contraindication
I 'BGPN10 S BGPACE("ADR")=$$ACEALG^BGP8D722(DFN,BGPBDATE,BGPEDATE) I BGPACE("ADR") S BGPN12=1
I (BGPN10+BGPN12) S BGPN9=1
K BGPSTAT
S BGPSTAT("RX")=$$RX7(DFN,$$FMADD^XLFDT($P(BGPAMI,U,2),-180),$$FMADD^XLFDT($P(BGPAMI,U,4),7),$P(BGPAMI,U,4),$O(^ATXAX("B","BGP PQA STATIN MEDS",0)),,,$O(^ATXAX("B","BGP HEDIS STATIN NDC",0)))
I BGPSTAT("RX") S BGPN14=1
I 'BGPN14 S BGPSTAT("CONTRA")=$$STATCON^BGP8D722(DFN,BGPBDATE,BGPEDATE,$P(BGPAMI,U,2),$$FMADD^XLFDT($P(BGPAMI,U,4),7)) I BGPSTAT("CONTRA") S BGPN16=1 ;beta Contraindication
I 'BGPN14 S BGPSTAT("ADR")=$$STATALG^BGP8D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE) I BGPSTAT("ADR") S BGPN16=1
I (BGPN14+BGPN16) S BGPN13=1
I BGPN1,BGPN5,BGPN9,BGPN13 S BGPN17=1
S BGPVALUE="AC|||"
S BGPVALUE=BGPVALUE_$S(BGPN17:"ALL MEDS: ",1:"")
I BGPN2!(BGPN3)!(BGPN4) S BGPVALUE=BGPVALUE_$S($P(BGPVALUE,"|||",2)]"":" ",1:"") S BGPVALUE=BGPVALUE_"BETA: " F X="RX","REF","CONTRA","ADR" I $P($G(BGPBETA(X)),U,1),$P($G(BGPBETA(X)),U,2)]"" D
.S BGPVALUE=BGPVALUE_$P(BGPBETA(X),U,2)_$S($P(BGPBETA(X),U,3)]"":" "_$P(BGPBETA(X),U,3),1:"")
I BGPN6!(BGPN7)!(BGPN8) S BGPVALUE=BGPVALUE_$S($P(BGPVALUE,"|||",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)]"" D
.S BGPVALUE=BGPVALUE_$P(BGPASA(X),U,2)_$S($P(BGPASA(X),U,3)]"":" "_$P(BGPASA(X),U,3),1:"")
I BGPN10!(BGPN11)!(BGPN12) S BGPVALUE=BGPVALUE_$S($P(BGPVALUE,"|||",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)]"" D
.S BGPVALUE=BGPVALUE_$P(BGPACE(X),U,2)_$S($P(BGPACE(X),U,3)]"":" "_$P(BGPACE(X),U,3),1:"")
I BGPN14!(BGPN15)!(BGPN16) S BGPVALUE=BGPVALUE_$S($P(BGPVALUE,"|||",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)]"" D
.S BGPVALUE=BGPVALUE_$P(BGPSTAT(X),U,2)_$S($P(BGPSTAT(X),U,3)]"":" "_$P(BGPSTAT(X),U,3),1:"")
K BGPIHD,BGPBETA,BGPMEDS1,BGPASA,BGPACE,BGPSTAT
K ^TMP($J)
Q
AMIH(P,BDATE,EDATE) ;
;look for any H with AMI discharge dx
K ^TMP($J,"A"),G
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 0 ;no HOSP
S T=$O(^ATXAX("B","BGP AMI DXS PAMT",0))
S (BGPX,G,M,D,E)=0 F S BGPX=$O(^TMP($J,"A",BGPX)) Q:BGPX'=+BGPX S V=$P(^TMP($J,"A",BGPX),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:$P(^AUPNVSIT(V,0),U,7)'="H"
.;Q:"CV"[$P(^AUPNVSIT(V,0),U,3)
.S H=0
.S H=$O(^AUPNVINP("AD",V,0)) D Q:'B
..S B=0
..I 'H Q
..Q:$P($P(^AUPNVINP(H,0),U),".")>EDATE
..Q:$$AMA(H) ;ama
..Q:$$TRANS(H) ;transferred
..Q:$$EXPIRED(H) ;died
..S B=1
.S (D,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D) I $D(^AUPNVPOV(Y,0)) D
..S %=$P(^AUPNVPOV(Y,0),U) Q:'$$ICD^BGP8UTL2(%,T,9)
..I $P(^AUPNVPOV(Y,0),U,6)]"",$P(^AUPNVPOV(Y,0),U,6)'="F" Q ;modifier
..S N=$$VAL^XBDIQ1(9000010.07,Y,.04)
..S N=$$UP^XLFSTR(N)
..I $E(N,1,8)="CONSIDER" Q
..I $E(N,1,8)="DOUBTFUL" Q
..I $E(N,1,5)="MAYBE" Q
..I $E(N,1,8)="POSSIBLE" Q
..I $E(N,1,7)="PERHAPS" Q
..I $E(N,1,8)="RULE OUT" Q
..I $E(N,1,3)="R/O" Q
..I $E(N,1,8)="PROBABLE" Q
..I $E(N,1,8)="RESOLVED" Q
..I $E(N,1,7)="SUSPECT" Q
..I $E(N,1,10)="SUSPICIOUS" Q
..I $E(N,1,11)="STATUS POST" Q
..S D=1
.I D S G=G+1,G($P($P(^AUPNVSIT(V,0),U),"."))=V ;got one visit
I 'G Q G
S D=$O(G(0)),V=G(D),H=$O(^AUPNVINP("AD",V,0))
Q 1_U_$O(G(0))_U_V_U_$S(H:$P($P(^AUPNVINP(H,0),U),"."),1:"")_U_H
READM(P,D,PV) ;EP
NEW ED,G,X,V,E
S ED=$$FMADD^XLFDT(D,7),G=0,D1=$$FMADD^XLFDT(D,1)
S X=0,V=0 F S X=$O(^AUPNVSIT("AAH",P,X)) Q:X'=+X D
.S V=0 F S V=$O(^AUPNVSIT("AAH",P,X,V)) Q:V'=+V D
..Q:V=PV ;same visit
..S E=$P($P($G(^AUPNVSIT(V,0)),U),".")
..Q:E<D
..Q:E>ED
..S G=1
Q G
AMA(H) ;EP
S X=$P(^AUPNVINP(H,0),U,6)
I X="" Q 0
S X=$P($G(^DG(405.1,X,"IHS")),U,1)
I X=3 Q 1
Q 0
EXPIRED(H) ;
S X=$P(^AUPNVINP(H,0),U,6)
I X="" Q 0
S X=$P($G(^DG(405.1,X,"IHS")),U,1)
I X=4!(X=5)!(X=6)!(X=7) Q 1
Q 0
DSCH(H) ;
Q $P($P(^AUPNVINP(H,0),U),".")
TRANS(H) ;
S X=$P(^AUPNVINP(H,0),U,6)
I X="" Q 0
S X=$P($G(^DG(405.1,X,"IHS")),U,1)
I X=2 Q 1
Q 0
RX7(P,BDATE,EDATE,BGPDD,BGPTD1,BGPTD2,BGPTD3,BGPTN1,BGPTN2,BGPTN3,BGPTC1,BGPTC2,BGPTC3,BGPDN1,BGPDN2) ;
;see if there ACTIVE PRESCRIPTION of these meds in time window
K BGPMEDS1
S K=0,R="",BGPG=""
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S BGPG="",X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X!($P(BGPG,U)) S Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S G=0
.S D=$P(^AUPNVMED(Y,0),U)
.I $G(BGPTD1),$D(^ATXAX(BGPTD1,21,"B",D)) S G=1 G RX71
.I $G(BGPTD2),$D(^ATXAX(BGPTD2,21,"B",D)) S G=1 G RX71
.I $G(BGPTD3),$D(^ATXAX(BGPTD3,21,"B",D)) S G=1 G RX71
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",$G(BGPTN1),$D(^ATXAX(BGPTN1,21,"B",N)) S G=1 G RX71
.I N]"",$G(BGPTN2),$D(^ATXAX(BGPTN2,21,"B",N)) S G=1 G RX71
.I N]"",$G(BGPTN3),$D(^ATXAX(BGPTN3,21,"B",N)) S G=1 G RX71
.S C=$P($G(^PSDRUG(D,0)),U,2)
.I C]"",$G(BGPTC1),$D(^ATXAX(BGPTC1,21,"B",C)) S G=1 G RX71
.I C]"",$G(BGPTC2),$D(^ATXAX(BGPTC2,21,"B",C)) S G=1 G RX71
.I C]"",$G(BGPTC3),$D(^ATXAX(BGPTC3,21,"B",C)) S G=1 G RX71
.S N=$P($G(^PSDRUG(D,0)),U,1)
.I $G(BGPDN1)]"",N[BGPDN1 S G=1 G RX71
.I $G(BGPDN2)]"",N[BGPDN2 S G=1 G RX71
.Q:'G ;NOT A DRUG OF INTEREST
RX71 .;
.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<EDATE ;discontinued W/IN 7 days of discharge date
.S S=$P(^AUPNVMED(Y,0),U,7)
.S Z=$$FMDIFF^XLFDT(EDATE,$P($P(^AUPNVSIT(V,0),U),"."))
.I S>Z S BGPG=1_U_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_U_$P(^PSDRUG(D,0),U)
.Q
Q BGPG
ASACONTR(P,BDATE,EDATE,BGPADM,BGPDD) ;does patient have an aspirin allergy
K BGPMEDS1
S K=0,R="",BGPG=""
D GETMEDS^BGP8UTL2(P,$$FMADD^XLFDT(BGPADM,-180),BGPDD,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) G HEM
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))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.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
.I $$VAPI^BGP8D81(D,$O(^ATXAX("B","BGP CMS WARFARIN VAPI",0))) 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<BGPDD ;discontinued W/IN 7 days of discharge date
.S S=$P(^AUPNVMED(Y,0),U,7)
.S E=$P($P(^AUPNVSIT(V,0),U),".")
.;was it prescribed on discharge date? if so, a hit
.I E=BGPDD S BGPG=1_U_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_U_$P(^PSDRUG(D,0),U) Q
.S Z=$$FMDIFF^XLFDT(BGPDD,$P($P(^AUPNVSIT(V,0),U),"."))
.I S>Z S BGPG=1_U_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_U_$P(^PSDRUG(D,0),U)
.Q
I BGPG Q 1_U_$P(BGPG,U,2)_" Contra warfarin rx "_$P(BGPG,U,3)
HEM ;now check for dx 459
K BGPG S BGPG=$$LASTDX^BGP8UTL1(P,"BGP HEMORRHAGE DXS",$$DOB^AUPNPAT(P),EDATE)
I BGPG Q 1_U_"asa Contra "_$P(BGPG,U,2)_" "_$$DATE^BGP8UTL($P(BGPG,U,3))
S X=$$PLTAXND^BGP8DU(P,"BGP HEMORRHAGE DXS",EDATE) I X Q 1_U_"Contra "_$P(X,U,2)_" "_$$DATE^BGP8UTL($P(X,U,3)) ;V17
S X=$$IPLSNOND^BGP8DU(P,"PXRM BGP HEMORRHAGE",EDATE) I X Q 1_U_"Contra "_$P(X,U,2)_" "_$$DATE^BGP8UTL($P(X,U,3))_U_$P(X,U,2) ;V17
;
;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<BGPADM Q ;before admission
..I Y>BGPDD Q ;documented EDATE OF 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_$$DATE^BGP8UTL($P(^AUPNPREF(N,0),U,3))_" Contra NMI Aspirin "_$$VAL^XBDIQ1(9000022,N,.04) ;_" "__" "_$$VAL^XBDIQ1(9000022,X,1101)
..Q
.Q
I BGPG Q BGPG
;now check for CPT code G8008
S X=$$CPTI^BGP8DU(P,BGPADM,BGPDD,+$$CODEN^ICPTCOD("G8008"))
I X Q 1_U_$$DATE^BGP8UTL($P(X,U,2))_" Contra CPT G8008"
S X=$$TRANI^BGP8DU(P,BGPADM,BGPDD,+$$CODEN^ICPTCOD("G8008"))
I X Q 1_U_$$DATE^BGP8UTL($P(X,U,2))_" Contra Tran G8008"
Q ""
ACECONT(P,BDATE,EDATE,NMIB,NMIE,RPBD) ;EP does patient have an ACEI Contra
NEW ED,BD,BGPG,BGPC,X,Y,Z,N,E,SN
S RPBD=$G(RPBD)
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_$$DATE^BGP8UTL($P(BGPG(1),U))_" Contra POV "_$P(BGPG(1),U,2) ;_"]" ;_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(1),U,4),.04)
S X=$$PLTAXND^BGP8DU(P,"BGP CMS AORTIC STENOSIS DXS",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"Contra "_$P(X,U,2) ;V17
S X=$$IPLSNOND^BGP8DU(P,"PXRM BGP MOD SEV AORTIC STEN",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"Contra "_$P(X,U,2) ;V17
;
;nmi in Refusal
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
..I Y>NMIE Q
..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_$$DATE^BGP8UTL($P(^AUPNPREF(N,0),U,3))_" Contra NMI "_$$VAL^XBDIQ1(9000022,N,.04) ;_" "__" "_$$VAL^XBDIQ1(9000022,X,1101)
..Q
.Q
I BGPG Q BGPG
;nmi
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
..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_$$DATE^BGP8UTL($P(^AUPNPREF(N,0),U,3))_" Contra NMI "_$$VAL^XBDIQ1(9000022,N,.04) ;_" "_" "_$$VAL^XBDIQ1(9000022,X,1101)
..Q
.Q
I BGPG Q BGPG
;PREGNANCY
S X=$$PREG^BGP8D715(P,$S($G(RPBD):RPBD,1:NMIB),EDATE,0,1,,RPBD,EDATE) I X Q 1_U_"Contra pregnant" ;V17.1 CMI/LAB ADDED DATES FOR CURRENTLY PREGNANT
;breastfeeding
K BGPG S Y="BGPG(",X=P_"^LAST DX [BGP BREASTFEEDING DXS;DURING "_$$FMTE^XLFDT($S(RPBD:RPBD,1:NMIB))_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(BGPG(1)) Q 1_U_$$DATE^BGP8UTL($P(BGPG(1),U))_" Contra POV "_$P(BGPG(1),U,2) ;_"]" ;_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(1),U,4),.04)
K BGPG
S Y="BGPG("
S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT($S(RPBD:RPBD,1:NMIB))_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S SN=$O(^BGPSNOMR("B","BREASTFEEDING PATIENT ED",0))
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_U_$P(BGPG(X),U) Q
.I T="BF-BP" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-CS" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-EQ" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-FU" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-HC" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-ON" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-M" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-MK" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-N" S %=T_U_$P(BGPG(X),U) Q
.I $P(T,"-")]"",$D(^BGPSNOMR(SN,11,"B",$P(T,"-"))) S %=T_U_$P(BGPG(X),U) Q
I %]"" Q 1_U_$$DATE^BGP8UTL($P(%,U,2))_" Contra "_$P(%,U,1)
Q ""
BGP8D75 ; IHS/CMI/LAB - measure 31 ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
+3 ;
IAMT ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
+2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17)=0
+3 SET BGPVALUE=""
KILL BGPBETA
+4 IF BGPAGEB<35
SET BGPSTOP=1
QUIT
+5 IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+6 SET BGPAMI=$$AMIH(DFN,BGPBDATE,$$FMADD^XLFDT(BGPBDATE,(51*7)))
+7 ;no ami
IF '$PIECE(BGPAMI,U)
SET BGPSTOP=1
QUIT
+8 IF $$READM(DFN,$PIECE(BGPAMI,U,4),$PIECE(BGPAMI,U,3))
SET BGPSTOP=1
QUIT
+9 SET BGPV=$PIECE(BGPAMI,U,3)
+10 SET BGPD1=1
+11 IF $PIECE(^DPT(DFN,0),U,2)="M"
SET BGPD2=1
+12 IF $PIECE(^DPT(DFN,0),U,2)="F"
SET BGPD3=1
+13 KILL BGPBETA
+14 SET BGPBETA("RX")=$$RX7(DFN,$$FMADD^XLFDT($PIECE(BGPAMI,U,2),-180),$$FMADD^XLFDT($PIECE(BGPAMI,U,4),7),$PIECE(BGPAMI,U,4),$ORDER(^ATXAX("B","BGP PQA BETA BLOCKER MEDS",0)),,,$ORDER(^ATXAX("B","BGP PQA BETA BLOCKER NDC",0)))
+15 IF BGPBETA("RX")
SET BGPN2=1
SET BGPN3=0
SET BGPN4=0
+16 ;I 'BGPN2 S BGPBETA("REF")=$$BETAREF^BGP8D721(DFN,$P(BGPAMI,U,2),$$FMADD^XLFDT($P(BGPAMI,U,4),7)) I BGPBETA("REF") S BGPN3=1
+17 ;beta Contraindication
IF 'BGPN2
SET BGPBETA("CONTRA")=$$BETACONT^BGP8D721(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,$PIECE(BGPAMI,U,2),$$FMADD^XLFDT($PIECE(BGPAMI,U,4),7))
IF BGPBETA("CONTRA")
SET BGPN4=1
+18 IF 'BGPN2
IF 'BGPN4
SET BGPBETA("ADR")=$$BETAALG1^BGP8D72(DFN,BGPEDATE)
IF BGPBETA("ADR")
SET BGPN4=1
+19 IF (BGPN2+BGPN4)
SET BGPN1=1
+20 ;
+21 KILL BGPASA
+22 SET C=$ORDER(^ATXAX("B","BGP CMS ANTI-PLATELET CLASS",0))
+23 SET BGPASA("RX")=$$RX7(DFN,$$FMADD^XLFDT($PIECE(BGPAMI,U,2),-180),$$FMADD^XLFDT($PIECE(BGPAMI,U,4),7),$PIECE(BGPAMI,U,4),$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0)),$ORDER(^ATXAX("B","BGP ANTI-PLATELET DRUGS",0)),,,,C)
+24 IF BGPASA("RX")
SET BGPN6=1
+25 ;I 'BGPN6 S BGPASA("REF")=$$ASAREF^BGP8D721(DFN,$P(BGPAMI,U,2),$$FMADD^XLFDT($P(BGPAMI,U,4),7)) I BGPASA("REF") S BGPN7=1
+26 ;beta Contraindication
IF 'BGPN6
SET BGPASA("CONTRA")=$$ASACONTR(DFN,BGPBDATE,BGPEDATE,$PIECE(BGPAMI,U,2),$$FMADD^XLFDT($PIECE(BGPAMI,U,4),7))
IF BGPASA("CONTRA")
SET BGPN8=1
+27 IF 'BGPN6
SET BGPASA("ADR")=$$ASAALLEG^BGP8D721(DFN,BGPEDATE)
IF BGPASA("ADR")
SET BGPN8=1
+28 IF (BGPN6+BGPN8)
SET BGPN5=1
+29 KILL BGPACE
+30 SET T=$ORDER(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
+31 SET BGPACE("RX")=$$RX7(DFN,$$FMADD^XLFDT($PIECE(BGPAMI,U,2),-180),$$FMADD^XLFDT($PIECE(BGPAMI,U,4),7),$PIECE(BGPAMI,U,4),T,,$ORDER(^ATXAX("B","BGP HEDIS ACEI NDC",0)),$ORDER(^ATXAX("B","BGP HEDIS ARB MEDS",0)),$ORDER(^ATXAX("B","BGP HEDIS ARB N
DC",0)))
+32 IF BGPACE("RX")
SET BGPN10=1
+33 ;I 'BGPN10 S BGPACE("REF")=$$ACEREF^BGP8D722(DFN,$P(BGPAMI,U,2),$$FMADD^XLFDT($P(BGPAMI,U,4),7)) I BGPACE("REF") S BGPN11=1
+34 ;beta Contraindication
IF 'BGPN10
SET BGPACE("CONTRA")=$$ACECONT(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,$PIECE(BGPAMI,U,2),$$FMADD^XLFDT($PIECE(BGPAMI,U,4),7),BGPBDATE)
IF BGPACE("CONTRA")
SET BGPN12=1
+35 IF 'BGPN10
SET BGPACE("ADR")=$$ACEALG^BGP8D722(DFN,BGPBDATE,BGPEDATE)
IF BGPACE("ADR")
SET BGPN12=1
+36 IF (BGPN10+BGPN12)
SET BGPN9=1
+37 KILL BGPSTAT
+38 SET BGPSTAT("RX")=$$RX7(DFN,$$FMADD^XLFDT($PIECE(BGPAMI,U,2),-180),$$FMADD^XLFDT($PIECE(BGPAMI,U,4),7),$PIECE(BGPAMI,U,4),$ORDER(^ATXAX("B","BGP PQA STATIN MEDS",0)),,,$ORDER(^ATXAX("B","BGP HEDIS STATIN NDC",0)))
+39 IF BGPSTAT("RX")
SET BGPN14=1
+40 ;beta Contraindication
IF 'BGPN14
SET BGPSTAT("CONTRA")=$$STATCON^BGP8D722(DFN,BGPBDATE,BGPEDATE,$PIECE(BGPAMI,U,2),$$FMADD^XLFDT($PIECE(BGPAMI,U,4),7))
IF BGPSTAT("CONTRA")
SET BGPN16=1
+41 IF 'BGPN14
SET BGPSTAT("ADR")=$$STATALG^BGP8D722(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE)
IF BGPSTAT("ADR")
SET BGPN16=1
+42 IF (BGPN14+BGPN16)
SET BGPN13=1
+43 IF BGPN1
IF BGPN5
IF BGPN9
IF BGPN13
SET BGPN17=1
+44 SET BGPVALUE="AC|||"
+45 SET BGPVALUE=BGPVALUE_$SELECT(BGPN17:"ALL MEDS: ",1:"")
+46 IF BGPN2!(BGPN3)!(BGPN4)
SET BGPVALUE=BGPVALUE_$SELECT($PIECE(BGPVALUE,"|||",2)]"":" ",1:"")
SET BGPVALUE=BGPVALUE_"BETA: "
FOR X="RX","REF","CONTRA","ADR"
IF $PIECE($GET(BGPBETA(X)),U,1)
IF $PIECE($GET(BGPBETA(X)),U,2)]""
Begin DoDot:1
+47 SET BGPVALUE=BGPVALUE_$PIECE(BGPBETA(X),U,2)_$SELECT($PIECE(BGPBETA(X),U,3)]"":" "_$PIECE(BGPBETA(X),U,3),1:"")
End DoDot:1
+48 IF BGPN6!(BGPN7)!(BGPN8)
SET BGPVALUE=BGPVALUE_$SELECT($PIECE(BGPVALUE,"|||",2)]"":"; ",1:"")
SET BGPVALUE=BGPVALUE_"ASA: "
FOR X="RX","REF","CONTRA","ADR"
IF $PIECE($GET(BGPASA(X)),U,1)
IF $PIECE($GET(BGPASA(X)),U,2)]""
Begin DoDot:1
+49 SET BGPVALUE=BGPVALUE_$PIECE(BGPASA(X),U,2)_$SELECT($PIECE(BGPASA(X),U,3)]"":" "_$PIECE(BGPASA(X),U,3),1:"")
End DoDot:1
+50 IF BGPN10!(BGPN11)!(BGPN12)
SET BGPVALUE=BGPVALUE_$SELECT($PIECE(BGPVALUE,"|||",2)]"":"; ",1:"")
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)]""
Begin DoDot:1
+51 SET BGPVALUE=BGPVALUE_$PIECE(BGPACE(X),U,2)_$SELECT($PIECE(BGPACE(X),U,3)]"":" "_$PIECE(BGPACE(X),U,3),1:"")
End DoDot:1
+52 IF BGPN14!(BGPN15)!(BGPN16)
SET BGPVALUE=BGPVALUE_$SELECT($PIECE(BGPVALUE,"|||",2)]"":"; ",1:"")
SET BGPVALUE=BGPVALUE_"STATIN: "
FOR X="RX","REF","CONTRA","ADR"
IF $PIECE($GET(BGPSTAT(X)),U,1)
IF $PIECE($GET(BGPSTAT(X)),U,2)]""
Begin DoDot:1
+53 SET BGPVALUE=BGPVALUE_$PIECE(BGPSTAT(X),U,2)_$SELECT($PIECE(BGPSTAT(X),U,3)]"":" "_$PIECE(BGPSTAT(X),U,3),1:"")
End DoDot:1
+54 KILL BGPIHD,BGPBETA,BGPMEDS1,BGPASA,BGPACE,BGPSTAT
+55 KILL ^TMP($JOB)
+56 QUIT
AMIH(P,BDATE,EDATE) ;
+1 ;look for any H with AMI discharge dx
+2 KILL ^TMP($JOB,"A"),G
+3 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+4 ;no HOSP
IF '$DATA(^TMP($JOB,"A",1))
QUIT 0
+5 SET T=$ORDER(^ATXAX("B","BGP AMI DXS PAMT",0))
+6 SET (BGPX,G,M,D,E)=0
FOR
SET BGPX=$ORDER(^TMP($JOB,"A",BGPX))
IF BGPX'=+BGPX
QUIT
SET V=$PIECE(^TMP($JOB,"A",BGPX),U,5)
Begin DoDot:1
+7 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+8 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+9 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,7)'="H"
QUIT
+11 ;Q:"CV"[$P(^AUPNVSIT(V,0),U,3)
+12 SET H=0
+13 SET H=$ORDER(^AUPNVINP("AD",V,0))
Begin DoDot:2
+14 SET B=0
+15 IF 'H
QUIT
+16 IF $PIECE($PIECE(^AUPNVINP(H,0),U),".")>EDATE
QUIT
+17 ;ama
IF $$AMA(H)
QUIT
+18 ;transferred
IF $$TRANS(H)
QUIT
+19 ;died
IF $$EXPIRED(H)
QUIT
+20 SET B=1
End DoDot:2
IF 'B
QUIT
+21 SET (D,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(D)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
Begin DoDot:2
+22 SET %=$PIECE(^AUPNVPOV(Y,0),U)
IF '$$ICD^BGP8UTL2(%,T,9)
QUIT
+23 ;modifier
IF $PIECE(^AUPNVPOV(Y,0),U,6)]""
IF $PIECE(^AUPNVPOV(Y,0),U,6)'="F"
QUIT
+24 SET N=$$VAL^XBDIQ1(9000010.07,Y,.04)
+25 SET N=$$UP^XLFSTR(N)
+26 IF $EXTRACT(N,1,8)="CONSIDER"
QUIT
+27 IF $EXTRACT(N,1,8)="DOUBTFUL"
QUIT
+28 IF $EXTRACT(N,1,5)="MAYBE"
QUIT
+29 IF $EXTRACT(N,1,8)="POSSIBLE"
QUIT
+30 IF $EXTRACT(N,1,7)="PERHAPS"
QUIT
+31 IF $EXTRACT(N,1,8)="RULE OUT"
QUIT
+32 IF $EXTRACT(N,1,3)="R/O"
QUIT
+33 IF $EXTRACT(N,1,8)="PROBABLE"
QUIT
+34 IF $EXTRACT(N,1,8)="RESOLVED"
QUIT
+35 IF $EXTRACT(N,1,7)="SUSPECT"
QUIT
+36 IF $EXTRACT(N,1,10)="SUSPICIOUS"
QUIT
+37 IF $EXTRACT(N,1,11)="STATUS POST"
QUIT
+38 SET D=1
End DoDot:2
+39 ;got one visit
IF D
SET G=G+1
SET G($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))=V
End DoDot:1
+40 IF 'G
QUIT G
+41 SET D=$ORDER(G(0))
SET V=G(D)
SET H=$ORDER(^AUPNVINP("AD",V,0))
+42 QUIT 1_U_$ORDER(G(0))_U_V_U_$SELECT(H:$PIECE($PIECE(^AUPNVINP(H,0),U),"."),1:"")_U_H
READM(P,D,PV) ;EP
+1 NEW ED,G,X,V,E
+2 SET ED=$$FMADD^XLFDT(D,7)
SET G=0
SET D1=$$FMADD^XLFDT(D,1)
+3 SET X=0
SET V=0
FOR
SET X=$ORDER(^AUPNVSIT("AAH",P,X))
IF X'=+X
QUIT
Begin DoDot:1
+4 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AAH",P,X,V))
IF V'=+V
QUIT
Begin DoDot:2
+5 ;same visit
IF V=PV
QUIT
+6 SET E=$PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
+7 IF E<D
QUIT
+8 IF E>ED
QUIT
+9 SET G=1
End DoDot:2
End DoDot:1
+10 QUIT G
AMA(H) ;EP
+1 SET X=$PIECE(^AUPNVINP(H,0),U,6)
+2 IF X=""
QUIT 0
+3 SET X=$PIECE($GET(^DG(405.1,X,"IHS")),U,1)
+4 IF X=3
QUIT 1
+5 QUIT 0
EXPIRED(H) ;
+1 SET X=$PIECE(^AUPNVINP(H,0),U,6)
+2 IF X=""
QUIT 0
+3 SET X=$PIECE($GET(^DG(405.1,X,"IHS")),U,1)
+4 IF X=4!(X=5)!(X=6)!(X=7)
QUIT 1
+5 QUIT 0
DSCH(H) ;
+1 QUIT $PIECE($PIECE(^AUPNVINP(H,0),U),".")
TRANS(H) ;
+1 SET X=$PIECE(^AUPNVINP(H,0),U,6)
+2 IF X=""
QUIT 0
+3 SET X=$PIECE($GET(^DG(405.1,X,"IHS")),U,1)
+4 IF X=2
QUIT 1
+5 QUIT 0
RX7(P,BDATE,EDATE,BGPDD,BGPTD1,BGPTD2,BGPTD3,BGPTN1,BGPTN2,BGPTN3,BGPTC1,BGPTC2,BGPTC3,BGPDN1,BGPDN2) ;
+1 ;see if there ACTIVE PRESCRIPTION of these meds in time window
+2 KILL BGPMEDS1
+3 SET K=0
SET R=""
SET BGPG=""
+4 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+5 IF '$DATA(BGPMEDS1)
QUIT ""
+6 SET BGPG=""
SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X!($PIECE(BGPG,U))
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+7 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+8 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+9 SET G=0
+10 SET D=$PIECE(^AUPNVMED(Y,0),U)
+11 IF $GET(BGPTD1)
IF $DATA(^ATXAX(BGPTD1,21,"B",D))
SET G=1
GOTO RX71
+12 IF $GET(BGPTD2)
IF $DATA(^ATXAX(BGPTD2,21,"B",D))
SET G=1
GOTO RX71
+13 IF $GET(BGPTD3)
IF $DATA(^ATXAX(BGPTD3,21,"B",D))
SET G=1
GOTO RX71
+14 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+15 IF N]""
IF $GET(BGPTN1)
IF $DATA(^ATXAX(BGPTN1,21,"B",N))
SET G=1
GOTO RX71
+16 IF N]""
IF $GET(BGPTN2)
IF $DATA(^ATXAX(BGPTN2,21,"B",N))
SET G=1
GOTO RX71
+17 IF N]""
IF $GET(BGPTN3)
IF $DATA(^ATXAX(BGPTN3,21,"B",N))
SET G=1
GOTO RX71
+18 SET C=$PIECE($GET(^PSDRUG(D,0)),U,2)
+19 IF C]""
IF $GET(BGPTC1)
IF $DATA(^ATXAX(BGPTC1,21,"B",C))
SET G=1
GOTO RX71
+20 IF C]""
IF $GET(BGPTC2)
IF $DATA(^ATXAX(BGPTC2,21,"B",C))
SET G=1
GOTO RX71
+21 IF C]""
IF $GET(BGPTC3)
IF $DATA(^ATXAX(BGPTC3,21,"B",C))
SET G=1
GOTO RX71
+22 SET N=$PIECE($GET(^PSDRUG(D,0)),U,1)
+23 IF $GET(BGPDN1)]""
IF N[BGPDN1
SET G=1
GOTO RX71
+24 IF $GET(BGPDN2)]""
IF N[BGPDN2
SET G=1
GOTO RX71
+25 ;NOT A DRUG OF INTEREST
IF 'G
QUIT
RX71 ;
+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 W/IN 7 days of discharge date
IF J]""
IF J<EDATE
QUIT
+7 SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+8 SET Z=$$FMDIFF^XLFDT(EDATE,$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
+9 IF S>Z
SET BGPG=1_U_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_U_$PIECE(^PSDRUG(D,0),U)
+10 QUIT
End DoDot:1
+11 QUIT BGPG
ASACONTR(P,BDATE,EDATE,BGPADM,BGPDD) ;does patient have an aspirin allergy
+1 KILL BGPMEDS1
+2 SET K=0
SET R=""
SET BGPG=""
+3 DO GETMEDS^BGP8UTL2(P,$$FMADD^XLFDT(BGPADM,-180),BGPDD,,,,,.BGPMEDS1)
+4 IF '$DATA(BGPMEDS1)
GOTO HEM
+5 SET T=$ORDER(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
+6 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X!(BGPG)
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+7 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+8 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
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 WAR71
+12 SET N=$PIECE($GET(^PSDRUG(D,0)),U,1)
+13 IF N["WARFARIN"
SET G=1
GOTO WAR71
+14 IF $$VAPI^BGP8D81(D,$ORDER(^ATXAX("B","BGP CMS WARFARIN VAPI",0)))
SET G=1
GOTO WAR71
+15 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 W/IN 7 days of discharge date
IF J]""
IF J<BGPDD
QUIT
+7 SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+8 SET E=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
+9 ;was it prescribed on discharge date? if so, a hit
+10 IF E=BGPDD
SET BGPG=1_U_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_U_$PIECE(^PSDRUG(D,0),U)
QUIT
+11 SET Z=$$FMDIFF^XLFDT(BGPDD,$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
+12 IF S>Z
SET BGPG=1_U_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_U_$PIECE(^PSDRUG(D,0),U)
+13 QUIT
End DoDot:1
+14 IF BGPG
QUIT 1_U_$PIECE(BGPG,U,2)_" Contra warfarin rx "_$PIECE(BGPG,U,3)
HEM ;now check for dx 459
+1 KILL BGPG
SET BGPG=$$LASTDX^BGP8UTL1(P,"BGP HEMORRHAGE DXS",$$DOB^AUPNPAT(P),EDATE)
+2 IF BGPG
QUIT 1_U_"asa Contra "_$PIECE(BGPG,U,2)_" "_$$DATE^BGP8UTL($PIECE(BGPG,U,3))
+3 ;V17
SET X=$$PLTAXND^BGP8DU(P,"BGP HEMORRHAGE DXS",EDATE)
IF X
QUIT 1_U_"Contra "_$PIECE(X,U,2)_" "_$$DATE^BGP8UTL($PIECE(X,U,3))
+4 ;V17
SET X=$$IPLSNOND^BGP8DU(P,"PXRM BGP HEMORRHAGE",EDATE)
IF X
QUIT 1_U_"Contra "_$PIECE(X,U,2)_" "_$$DATE^BGP8UTL($PIECE(X,U,3))_U_$PIECE(X,U,2)
+5 ;
+6 ;nmi in Refusal file for aspirin
+7 SET BGPG=""
+8 SET T=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
+9 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X
QUIT
Begin DoDot:1
+10 ;not an aspirin
IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+11 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D
QUIT
Begin DoDot:2
+12 ;before admission
IF Y<BGPADM
QUIT
+13 ;documented EDATE OF REPORT PERIOD
IF Y>BGPDD
QUIT
+14 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N
QUIT
Begin DoDot:3
+15 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+16 ;_" "__" "_$$VAL^XBDIQ1(9000022,X,1101)
SET BGPG=1_U_$$DATE^BGP8UTL($PIECE(^AUPNPREF(N,0),U,3))_" Contra NMI Aspirin "_$$VAL^XBDIQ1(9000022,N,.04)
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 IF BGPG
QUIT BGPG
+20 ;now check for CPT code G8008
+21 SET X=$$CPTI^BGP8DU(P,BGPADM,BGPDD,+$$CODEN^ICPTCOD("G8008"))
+22 IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,2))_" Contra CPT G8008"
+23 SET X=$$TRANI^BGP8DU(P,BGPADM,BGPDD,+$$CODEN^ICPTCOD("G8008"))
+24 IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,2))_" Contra Tran G8008"
+25 QUIT ""
ACECONT(P,BDATE,EDATE,NMIB,NMIE,RPBD) ;EP does patient have an ACEI Contra
+1 NEW ED,BD,BGPG,BGPC,X,Y,Z,N,E,SN
+2 SET RPBD=$GET(RPBD)
+3 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)
+4 ;_"]" ;_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(1),U,4),.04)
IF $DATA(BGPG(1))
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPG(1),U))_" Contra POV "_$PIECE(BGPG(1),U,2)
+5 ;V17
SET X=$$PLTAXND^BGP8DU(P,"BGP CMS AORTIC STENOSIS DXS",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"Contra "_$PIECE(X,U,2)
+6 ;V17
SET X=$$IPLSNOND^BGP8DU(P,"PXRM BGP MOD SEV AORTIC STEN",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"Contra "_$PIECE(X,U,2)
+7 ;
+8 ;nmi in Refusal
+9 SET BGPG=""
+10 SET T=$ORDER(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
+11 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X
QUIT
Begin DoDot:1
+12 ;not an ACEI
IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+13 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D
QUIT
Begin DoDot:2
+14 SET Y=9999999-D
IF Y<NMIB
QUIT
+15 IF Y>NMIE
QUIT
+16 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N
QUIT
Begin DoDot:3
+17 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+18 ;_" "__" "_$$VAL^XBDIQ1(9000022,X,1101)
SET BGPG=1_U_$$DATE^BGP8UTL($PIECE(^AUPNPREF(N,0),U,3))_" Contra NMI "_$$VAL^XBDIQ1(9000022,N,.04)
End DoDot:3
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 IF BGPG
QUIT BGPG
+22 ;nmi
+23 SET BGPG=""
+24 SET T=$ORDER(^ATXAX("B","BGP HEDIS ARB MEDS",0))
+25 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X
QUIT
Begin DoDot:1
+26 ;not an ACEI
IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+27 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D
QUIT
Begin DoDot:2
+28 SET Y=9999999-D
IF Y<NMIB
QUIT
+29 IF Y>NMIE
QUIT
+30 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N
QUIT
Begin DoDot:3
+31 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+32 ;_" "_" "_$$VAL^XBDIQ1(9000022,X,1101)
SET BGPG=1_U_$$DATE^BGP8UTL($PIECE(^AUPNPREF(N,0),U,3))_" Contra NMI "_$$VAL^XBDIQ1(9000022,N,.04)
End DoDot:3
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 IF BGPG
QUIT BGPG
+36 ;PREGNANCY
+37 ;V17.1 CMI/LAB ADDED DATES FOR CURRENTLY PREGNANT
SET X=$$PREG^BGP8D715(P,$SELECT($GET(RPBD):RPBD,1:NMIB),EDATE,0,1,,RPBD,EDATE)
IF X
QUIT 1_U_"Contra pregnant"
+38 ;breastfeeding
+39 KILL BGPG
SET Y="BGPG("
SET X=P_"^LAST DX [BGP BREASTFEEDING DXS;DURING "_$$FMTE^XLFDT($SELECT(RPBD:RPBD,1:NMIB))_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+40 ;_"]" ;_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(1),U,4),.04)
IF $DATA(BGPG(1))
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPG(1),U))_" Contra POV "_$PIECE(BGPG(1),U,2)
+41 KILL BGPG
+42 SET Y="BGPG("
+43 SET X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT($SELECT(RPBD:RPBD,1:NMIB))_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+44 SET SN=$ORDER(^BGPSNOMR("B","BREASTFEEDING PATIENT ED",0))
+45 SET (X,D)=0
SET %=""
SET T=""
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X!(%]"")
QUIT
Begin DoDot:1
+46 SET T=$PIECE(^AUPNVPED(+$PIECE(BGPG(X),U,4),0),U)
+47 IF 'T
QUIT
+48 IF '$DATA(^AUTTEDT(T,0))
QUIT
+49 SET T=$PIECE(^AUTTEDT(T,0),U,2)
+50 IF T="BF-BC"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+51 IF T="BF-BP"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+52 IF T="BF-CS"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+53 IF T="BF-EQ"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+54 IF T="BF-FU"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+55 IF T="BF-HC"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+56 IF T="BF-ON"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+57 IF T="BF-M"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+58 IF T="BF-MK"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+59 IF T="BF-N"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+60 IF $PIECE(T,"-")]""
IF $DATA(^BGPSNOMR(SN,11,"B",$PIECE(T,"-")))
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
End DoDot:1
+61 IF %]""
QUIT 1_U_$$DATE^BGP8UTL($PIECE(%,U,2))_" Contra "_$PIECE(%,U,1)
+62 QUIT ""
