APCHPWH7 ; IHS/CMI/LAB - PCC HEALTH SUMMARY - MAIN DRIVER PART 2 ;
;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58
;
;EO MEASURES IN PWH
ASTHMA ;EP
NEW APCHX,APCHSTH1,APCHSTH2
Q:$$AGE^AUPNPAT(APCHSDFN)<5
I $$AGE^AUPNPAT(APCHSDFN)>56 Q
;.D S^APCHPWH1("Asthma Medication Status",1)
;.;D S^APCHPWH1("This section only reports on people ages 5-56 who have asthma.")
;.;D S^APCHPWH1("You are over 56 years of age.")
I $$EMP(DFN,$$DOB^AUPNPAT(DFN),DT) Q ;has dx of emphysema
I $$COPD(DFN,$$DOB^AUPNPAT(DFN),DT) Q ;has copd
D S^APCHPWH1("Asthma Medication Status",1)
S APCHSTH1=$$HMR5ST^APCHSMAS(APCHSDFN)
I 'APCHSTH1 D Q ;not asthma in both time periods
.K ^TMP($J,"A")
.D S^APCHPWH1("This section only reports on people who have asthma. You do not have")
.D S^APCHPWH1("asthma, so you are not included in this report. If you think you have")
.D S^APCHPWH1("asthma, talk to your doctor.")
K ^TMP($J,"A")
S APCHX=$$ASTHTHER(DFN,$$FMADD^XLFDT(DT,-365),DT)
I $P(APCHX,U)=1 D Q
.D S^APCHPWH1("This reports looks to see if you were prescribed a medicine for your asthma.")
.D S^APCHPWH1("You were prescribed at least one medication for your asthma.")
D S^APCHPWH1("This reports looks to see if you were prescribed a medicine for your asthma.")
D S^APCHPWH1("You were not prescribed any asthma medications this year. Talk to your doctor")
D S^APCHPWH1("about what asthma treatment, if any, is best for you.")
Q
EMP(P,BDATE,EDATE) ;
NEW APCHG,X,Y,E
K APCHG
S Y="APCHG("
S X=P_"^LAST DX [BGP EMPHYSEMA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(APCHG(1)) Q 1 ;has a dx
Q 0
COPD(P,BDATE,EDATE) ;
NEW APCHG,X,Y,E
K APCHG
S Y="APCHG("
S X=P_"^LAST DX [BGP COPD DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(APCHG(1)) Q 1 ;has a dx
Q 0
PERASTH(P,BDATE,EDATE) ;EP
;I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
;item 1 - one visit to er w/493 OR hospitalization
NEW A,B,E,T,X,G,V,K,Y,APCHT,S,J,M
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 0 ;not asthma or hosp or meds
S T=$O(^ATXAX("B","BGP ASTHMA DXS",0))
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G) 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)
.S K=0
.I $P(^AUPNVSIT(V,0),U,7)="H" S K=1
.I $$CLINIC^APCLV(V,"C")=30 S K=1
.Q:'K
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.S Y=$$PRIMPOV^APCLV(V,"I")
.Q:'$$ICD^ATXAPI(Y,T,9)
.S G=1_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),".")) ;got one
;
I G Q 1_U_"DX ON HOSP/OR ER ON "_$P(G,U,2) ;had prim dx on 30 or H so meets denom
PER3 ;
;now check for meds
S APCHT=$O(^ATXAX("B","BGP ASTHMA DXS",0))
S T=$O(^ATXAX("B","BGP HEDIS ASTHMA MEDS",0))
S T3=$O(^ATXAX("B","BGP HEDIS ASTHMA NDC",0))
S T1=$O(^ATXAX("B","BGP HEDIS ASTHMA INHALED MEDS",0))
S T4=$O(^ATXAX("B","BGP HEDIS ASTHMA INHALED NDC",0))
S T2=$O(^ATXAX("B","BGP HEDIS ASTHMA LEUK MEDS",0))
S T5=$O(^ATXAX("B","BGP HEDIS ASTHMA LEUK NDC",0))
S (X,G,M,D,E)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X 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:"AOS"'[$P(^AUPNVSIT(V,0),U,7)
.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^ATXAPI(%,APCHT,9) S D=1
.I D S G=G+1 ;got one visit
.S Y=0 F S Y=$O(^AUPNVMED("AD",V,Y)) Q:Y'=+Y D
..S S=0
..S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
..I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)),$P(^AUPNVMED(Y,0),U,8)="" S M=M+1 Q ;it is an inhaled steroid that wasn't d/c'ed so 1 dispensing event
..I $D(^ATXAX(T,21,"B",Z))!($$NDC(Z,T3)) D
...Q:$$LEUK(Z,T2,T5) ;don't count if it is a leukotriene
...S J=$P(^AUPNVMED(Y,0),U,8)
...I J]"" S S=$$FMADD^XLFDT(J,$P($P(^AUPNVSIT(V,0),U),"."))
...I J="" S S=$P(^AUPNVMED(Y,0),U,7)
...S K=S/30,M=M+K
..I $D(^ATXAX(T2,21,"B",Z))!($$NDC(Z,T5)) D Q
...S J=$P(^AUPNVMED(Y,0),U,8)
...I J]"" S S=$$FMADD^XLFDT(J,$P($P(^AUPNVSIT(V,0),U),"."))
...I J="" S S=$P(^AUPNVMED(Y,0),U,7)
...S K=S/30,M=M+K,E=E+K
I G>3,M>1 Q 1_U_"4 POVS AND 2 MEDS" ;had 4 povs and 2 dispensing events
I M>3,E<M Q 1_U_"4 meds" ;had 4 meds, not all were leuko
I M>3,E=M,G>0 Q 1_U_"LEUKOTRIENE AND 1 DX" ;had all leuk and 1 dx
Q ""
;
NDC(A,B) ;
;a is drug ien
;b is taxonomy ien
NEW N
S N=$P($G(^PSDRUG(A,2)),U,4)
I N]"",B,$D(^ATXAX(B,21,"B",N)) Q 1
Q 0
LEUK(A,B,C) ;
;a drug ien
;b tax ien
;c tax ien for ndc
I $D(^ATXAX(B,21,"B",A)) Q 1
I $$NDC(A,C) Q 1
Q ""
ASTHTHER(P,BDATE,EDATE) ;EP
;get number of asthma medication events
NEW APCHEDS1,T,T3,X,G,M,E,Z,D
K APCHEDS1
D GETMEDS^APCHSMU1(P,BDATE,EDATE,,,,,.APCHEDS1)
I '$D(APCHEDS1) Q ""
S T=$O(^ATXAX("B","BGP HEDIS PRIMARY ASTHMA MEDS",0))
S T3=$O(^ATXAX("B","BGP HEDIS PRIMARY ASTHMA NDC",0))
S (X,G,M,E)=0,D="" F S X=$O(APCHEDS1(X)) Q:X'=+X!(D]"") S V=$P(APCHEDS1(X),U,5),Y=+$P(APCHEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.I $D(^ATXAX(T,21,"B",Z))!($$NDC(Z,T3)),$P(^AUPNVMED(Y,0),U,8)="" S D=1_U_$P(^PSDRUG(Z,0),U)_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),".")) Q
Q D
;
STROKE ;EP
NEW APCHOXV,APCHD,APCHN
K APCHOXV
I $$AGE^AUPNPAT(APCHSDFN,DT)<18 Q ;don't process this measure, pt under 18
S APCHD1=0 ;Number of STROKE visits
S APCHN1=0
D TIAFIB(APCHSDFN,$$FMADD^XLFDT(DT,-365),DT,.APCHOXV)
;now evaluate result
D S^APCHPWH1("Stroke/Anitcoagulation Therapy",1)
;
I 'APCHOXV("DENOM")!($$AGE^AUPNPAT(APCHSDFN,DT)<18) D Q
.D S^APCHPWH1("This section only reports on people who had a blood clot in the brain (also")
.D S^APCHPWH1("called a stroke) and an abnormal heart beat. You do not have these")
.D S^APCHPWH1("problems, so you are not included in this report.")
.Q
S X=0 F S X=$O(APCHOXV(X)) Q:X'=+X D
.S Y="",M="" I $P(APCHOXV(X),U,2)]"" S Y=$$FMTE^XLFDT($P(APCHOXV(X),U,3)),M=$P(APCHOXV(X),U,2)
I Y="" D Q
.D S^APCHPWH1("This report looks to see if you were prescribed a medicine to prevent")
.D S^APCHPWH1("blood clots this year. You were not prescribed any medications to ")
.D S^APCHPWH1("prevent a blood clot this year.")
D S^APCHPWH1("This report looks to see if you were prescribed a medicine to prevent")
D S^APCHPWH1("blood clots this year. You were prescribed "_M)
D S^APCHPWH1("on "_Y_".")
Q
;
TIAFIB(P,BDATE,EDATE,APCHR) ;EP
NEW A,X,V,APCHG,G,C,T,B,E,APCHX,APCHV,APCHD
K APCHR,APCHG,APCHX
S APCHR="",APCHR(0)=""
S X=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"APCHG(")
I '$D(APCHG(1)) S APCHR("DENOM")=0 Q
;now go through and get rid of H and CHS
S T=$O(^ATXAX("B","BGP TIA DXS",0))
S A=0 F S A=$O(APCHG(A)) Q:A'=+A D
.S V=$P(APCHG(A),U,5)
.I '$D(^AUPNVSIT(V,0)) K APCHG(A) Q
.I $P(^AUPNVSIT(V,0),U,3)="C" K APCHG(A) Q
.I $P(^AUPNVSIT(V,0),U,7)'="H" K APCHG(A) Q
.S X=0,G=0,E=0,B=0 F S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X D
..S C=$P($G(^AUPNVPOV(X,0)),U)
..Q:C=""
..I $$ICD^ATXAPI(C,T,9) S G=1,$P(APCHG(A),U,15)=$$VAL^XBDIQ1(9000010.07,X,.01)
..I $$VAL^XBDIQ1(9000010.07,X,.01)="427.31" S E=1
.I G,E S B=1 ;have both
.I 'B K APCHG(A) ;no tia diagnosis
I '$D(APCHG) S APCHR("DENOM")=0 Q
;reorder the diagnoses by visit date
S A=0 F S A=$O(APCHG(A)) Q:A'=+A S V=$P(APCHG(A),U,5),D=$P($P($G(^AUPNVSIT(V,0)),U),"."),APCHX(D,V)=APCHG(A)
;now get the first one
S APCHD=0,APCHC=0 F S APCHD=$O(APCHX(APCHD)) Q:APCHD'=+APCHD D
.S APCHV=0 F S APCHV=$O(APCHX(APCHD,APCHV)) Q:APCHV'=+APCHV D
..S APCHC=APCHC+1,APCHR(APCHC)=APCHD ;set denominator
..S G=$$ANTICOAG(P,$$FMADD^XLFDT(APCHD,-365),$$DSCHDATE^APCLV(APCHV),APCHD) ; any ANTICOAG?
..S $P(APCHR(APCHC),U,2)=$P(G,U,2),$P(APCHR(APCHC),U,3)=$P(G,U,1) ;set numerator column
..;S $P(APCHR(0),U,$P(G,U,2))=$P(APCHR(0),U,$P(G,U,2))+1
S APCHR("DENOM")=APCHC
Q
;
ANTICOAG(P,BDATE,EDATE,APCHAD) ;EP - was there ANTICOAG
NEW APCHD,X,N,E,Y,T,D,C,APCHLT,L,J,APCHG,S,APCHD
K APCHG S Y="APCHG(",X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S X=0,G="" F S X=$O(APCHG(X)) Q:X'=+X!(G]"") D
.S N=+$P(APCHG(X),U,4) ;ien of v med
.S C=$$ANTIDRUG(N) ;not one of the drugs
.Q:'$P(C,U)
.;c=1^category of drug
.I $P(^AUPNVMED(N,0),U,8)]"",$P(^AUPNVMED(N,0),U,8)'>EDATE Q ;discontinued before discharge date
.S S=$P(^AUPNVMED(N,0),U,7)
.I $P($P(^AUPNVSIT($P(^AUPNVMED(N,0),U,3),0),U),".")=EDATE S G=$$FMTE^XLFDT(EDATE)_"^"_$P(C,U,2)_"^1" ;PRESCRIBED ON DISCHARGE DATE
.S V=$P(^AUPNVMED(N,0),U,3)
.S V=$P($P(^AUPNVSIT(V,0),U),".")
.I $$FMADD^XLFDT(V,S)<EDATE Q ;not valid through discharge date
.S G=V_"^"_$P(C,U,2)
I G]"" Q G
;now check for cpts
S G=$$CPTI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4073F"),,,"1P;2P;8P")
I G Q $$FMTE^XLFDT($P(G,U,2))_"^ANTI-PLT CPT [4073F]^1"
S G=$$CPTI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4075F"),,,"1P;2P;8P")
I G Q $$FMTE^XLFDT($P(G,U,2))_"^ANTI-PLT CPT [4075F]^1"
S G=$$CPTI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("G8006"))
I G Q $$FMTE^XLFDT($P(G,U,2))_"^ANTI-PLT CPT [G8006]^1"
S G=$$TRANI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4073F"))
I G Q $$FMTE^XLFDT($P(G,U,2))_"^ANTI-PLT CPT/TRAN [4073F]^1"
S G=$$TRANI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4075F"))
I G Q $$FMTE^XLFDT($P(G,U,2))_"^ANTI-PLT CPT/TRAN [4075F]^1"
S G=$$TRANI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("G8006"))
I G Q $$FMTE^XLFDT($P(G,U,2))_"^ANTI-PLT CPT/TRAN [G8006]^1"
Q ""
;now go get refusals of any of the above
;
;refusal of MEDS
;S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
;S G=$$REFTAX^APCHSMU1(P,50,T,EDATE,EDATE)
;I G Q $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED WARF^2"
;S T=$O(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
;S G=$$REFTAX^APCHSMU1(P,50,T,EDATE,EDATE)
;I G Q $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ANTI-PLT^2"
;S T=$O(^ATXAX("B","D AUDIT ASPIRIN DRUGS",0))
;S G=$$REFTAX^APCHSMU1(P,50,T,EDATE,EDATE)
;I G Q $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ASA^2"
;CHECK BL700 CLASS REFUSALS
S G=""
S I=0 F S I=$O(^AUPNPREF("AA",P,50,I)) Q:I=""!($P(G,U)) D
.S (X,G)=0 F S X=$O(^AUPNPREF("AA",P,50,I,X)) Q:X'=+X!($P(G,U)) S Y=0 F S Y=$O(^AUPNPREF("AA",P,50,I,X,Y)) Q:Y'=+Y S D=$P(^AUPNPREF(Y,0),U,3) I D=EDATE D
.Q:$P($G(^PSDRUG(I,0)),U,2)'="BL700"
.S G=$$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ANTI-PLT^2"
I G]"" Q G
S G=$$REFUSAL^APCHSMU(P,81,+$$CODEN^ICPTCOD("4073F"),EDATE,EDATE)
I G Q $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ANTI-PLT [4073F]^2"
S G=$$REFUSAL^APCHSMU(P,81,+$$CODEN^ICPTCOD("4075F"),EDATE,EDATE)
I G Q $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ANTI-PLT [4075F]^2"
S G=$$REFUSAL^APCHSMU(P,81,+$$CODEN^ICPTCOD("G8006"),EDATE,EDATE)
I G Q $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ANTI-PLT [G8006]^2"
Q $$FMTE^XLFDT(EDATE)_" ZZZZZ: NO THERAPY^3"
;
ANTIDRUG(N) ;
NEW G,T,I
S I=$P($G(^AUPNVMED(N,0)),U)
I 'I Q 0
S G=0
S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
I T,$D(^ATXAX(T,21,"B",I)) Q "1^"_$P(^PSDRUG(I,0),U,1)
S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
I T,$D(^ATXAX(T,21,"B",I)) Q "1^"_$P(^PSDRUG(I,0),U,1)
S T=$O(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
I T,$D(^ATXAX(T,21,"B",I)) Q "1^"_$P(^PSDRUG(I,0),U,1)
S G=$P(^PSDRUG(I,0),U,2)
I G="BL700" Q "1^"_$P(^PSDRUG(I,0),U,1)
I $P(^PSDRUG(I,0),U)["WARFARIN" Q "1^"_$P(^PSDRUG(I,0),U,1)
Q ""
APCHPWH7 ; IHS/CMI/LAB - PCC HEALTH SUMMARY - MAIN DRIVER PART 2 ;
+1 ;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58
+2 ;
+3 ;EO MEASURES IN PWH
ASTHMA ;EP
+1 NEW APCHX,APCHSTH1,APCHSTH2
+2 IF $$AGE^AUPNPAT(APCHSDFN)<5
QUIT
+3 IF $$AGE^AUPNPAT(APCHSDFN)>56
QUIT
+4 ;.D S^APCHPWH1("Asthma Medication Status",1)
+5 ;.;D S^APCHPWH1("This section only reports on people ages 5-56 who have asthma.")
+6 ;.;D S^APCHPWH1("You are over 56 years of age.")
+7 ;has dx of emphysema
IF $$EMP(DFN,$$DOB^AUPNPAT(DFN),DT)
QUIT
+8 ;has copd
IF $$COPD(DFN,$$DOB^AUPNPAT(DFN),DT)
QUIT
+9 DO S^APCHPWH1("Asthma Medication Status",1)
+10 SET APCHSTH1=$$HMR5ST^APCHSMAS(APCHSDFN)
+11 ;not asthma in both time periods
IF 'APCHSTH1
Begin DoDot:1
+12 KILL ^TMP($JOB,"A")
+13 DO S^APCHPWH1("This section only reports on people who have asthma. You do not have")
+14 DO S^APCHPWH1("asthma, so you are not included in this report. If you think you have")
+15 DO S^APCHPWH1("asthma, talk to your doctor.")
End DoDot:1
QUIT
+16 KILL ^TMP($JOB,"A")
+17 SET APCHX=$$ASTHTHER(DFN,$$FMADD^XLFDT(DT,-365),DT)
+18 IF $PIECE(APCHX,U)=1
Begin DoDot:1
+19 DO S^APCHPWH1("This reports looks to see if you were prescribed a medicine for your asthma.")
+20 DO S^APCHPWH1("You were prescribed at least one medication for your asthma.")
End DoDot:1
QUIT
+21 DO S^APCHPWH1("This reports looks to see if you were prescribed a medicine for your asthma.")
+22 DO S^APCHPWH1("You were not prescribed any asthma medications this year. Talk to your doctor")
+23 DO S^APCHPWH1("about what asthma treatment, if any, is best for you.")
+24 QUIT
EMP(P,BDATE,EDATE) ;
+1 NEW APCHG,X,Y,E
+2 KILL APCHG
+3 SET Y="APCHG("
+4 SET X=P_"^LAST DX [BGP EMPHYSEMA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+5 ;has a dx
IF $DATA(APCHG(1))
QUIT 1
+6 QUIT 0
COPD(P,BDATE,EDATE) ;
+1 NEW APCHG,X,Y,E
+2 KILL APCHG
+3 SET Y="APCHG("
+4 SET X=P_"^LAST DX [BGP COPD DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+5 ;has a dx
IF $DATA(APCHG(1))
QUIT 1
+6 QUIT 0
PERASTH(P,BDATE,EDATE) ;EP
+1 ;I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
+2 ;item 1 - one visit to er w/493 OR hospitalization
+3 NEW A,B,E,T,X,G,V,K,Y,APCHT,S,J,M
+4 KILL ^TMP($JOB,"A")
+5 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+6 ;not asthma or hosp or meds
IF '$DATA(^TMP($JOB,"A",1))
QUIT 0
+7 SET T=$ORDER(^ATXAX("B","BGP ASTHMA DXS",0))
+8 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G)
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 SET K=0
+13 IF $PIECE(^AUPNVSIT(V,0),U,7)="H"
SET K=1
+14 IF $$CLINIC^APCLV(V,"C")=30
SET K=1
+15 IF 'K
QUIT
+16 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+17 SET Y=$$PRIMPOV^APCLV(V,"I")
+18 IF '$$ICD^ATXAPI(Y,T,9)
QUIT
+19 ;got one
SET G=1_U_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
End DoDot:1
+20 ;
+21 ;had prim dx on 30 or H so meets denom
IF G
QUIT 1_U_"DX ON HOSP/OR ER ON "_$PIECE(G,U,2)
PER3 ;
+1 ;now check for meds
+2 SET APCHT=$ORDER(^ATXAX("B","BGP ASTHMA DXS",0))
+3 SET T=$ORDER(^ATXAX("B","BGP HEDIS ASTHMA MEDS",0))
+4 SET T3=$ORDER(^ATXAX("B","BGP HEDIS ASTHMA NDC",0))
+5 SET T1=$ORDER(^ATXAX("B","BGP HEDIS ASTHMA INHALED MEDS",0))
+6 SET T4=$ORDER(^ATXAX("B","BGP HEDIS ASTHMA INHALED NDC",0))
+7 SET T2=$ORDER(^ATXAX("B","BGP HEDIS ASTHMA LEUK MEDS",0))
+8 SET T5=$ORDER(^ATXAX("B","BGP HEDIS ASTHMA LEUK NDC",0))
+9 SET (X,G,M,D,E)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+10 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+11 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+12 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+13 IF "AOS"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+14 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^ATXAPI(%,APCHT,9)
SET D=1
+15 ;got one visit
IF D
SET G=G+1
+16 SET Y=0
FOR
SET Y=$ORDER(^AUPNVMED("AD",V,Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+17 SET S=0
+18 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+19 ;it is an inhaled steroid that wasn't d/c'ed so 1 dispensing event
IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
IF $PIECE(^AUPNVMED(Y,0),U,8)=""
SET M=M+1
QUIT
+20 IF $DATA(^ATXAX(T,21,"B",Z))!($$NDC(Z,T3))
Begin DoDot:3
+21 ;don't count if it is a leukotriene
IF $$LEUK(Z,T2,T5)
QUIT
+22 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+23 IF J]""
SET S=$$FMADD^XLFDT(J,$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
+24 IF J=""
SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+25 SET K=S/30
SET M=M+K
End DoDot:3
+26 IF $DATA(^ATXAX(T2,21,"B",Z))!($$NDC(Z,T5))
Begin DoDot:3
+27 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+28 IF J]""
SET S=$$FMADD^XLFDT(J,$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
+29 IF J=""
SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+30 SET K=S/30
SET M=M+K
SET E=E+K
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+31 ;had 4 povs and 2 dispensing events
IF G>3
IF M>1
QUIT 1_U_"4 POVS AND 2 MEDS"
+32 ;had 4 meds, not all were leuko
IF M>3
IF E<M
QUIT 1_U_"4 meds"
+33 ;had all leuk and 1 dx
IF M>3
IF E=M
IF G>0
QUIT 1_U_"LEUKOTRIENE AND 1 DX"
+34 QUIT ""
+35 ;
NDC(A,B) ;
+1 ;a is drug ien
+2 ;b is taxonomy ien
+3 NEW N
+4 SET N=$PIECE($GET(^PSDRUG(A,2)),U,4)
+5 IF N]""
IF B
IF $DATA(^ATXAX(B,21,"B",N))
QUIT 1
+6 QUIT 0
LEUK(A,B,C) ;
+1 ;a drug ien
+2 ;b tax ien
+3 ;c tax ien for ndc
+4 IF $DATA(^ATXAX(B,21,"B",A))
QUIT 1
+5 IF $$NDC(A,C)
QUIT 1
+6 QUIT ""
ASTHTHER(P,BDATE,EDATE) ;EP
+1 ;get number of asthma medication events
+2 NEW APCHEDS1,T,T3,X,G,M,E,Z,D
+3 KILL APCHEDS1
+4 DO GETMEDS^APCHSMU1(P,BDATE,EDATE,,,,,.APCHEDS1)
+5 IF '$DATA(APCHEDS1)
QUIT ""
+6 SET T=$ORDER(^ATXAX("B","BGP HEDIS PRIMARY ASTHMA MEDS",0))
+7 SET T3=$ORDER(^ATXAX("B","BGP HEDIS PRIMARY ASTHMA NDC",0))
+8 SET (X,G,M,E)=0
SET D=""
FOR
SET X=$ORDER(APCHEDS1(X))
IF X'=+X!(D]"")
QUIT
SET V=$PIECE(APCHEDS1(X),U,5)
SET Y=+$PIECE(APCHEDS1(X),U,4)
Begin DoDot:1
+9 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+10 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+11 IF $DATA(^ATXAX(T,21,"B",Z))!($$NDC(Z,T3))
IF $PIECE(^AUPNVMED(Y,0),U,8)=""
SET D=1_U_$PIECE(^PSDRUG(Z,0),U)_U_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
QUIT
End DoDot:1
+12 QUIT D
+13 ;
STROKE ;EP
+1 NEW APCHOXV,APCHD,APCHN
+2 KILL APCHOXV
+3 ;don't process this measure, pt under 18
IF $$AGE^AUPNPAT(APCHSDFN,DT)<18
QUIT
+4 ;Number of STROKE visits
SET APCHD1=0
+5 SET APCHN1=0
+6 DO TIAFIB(APCHSDFN,$$FMADD^XLFDT(DT,-365),DT,.APCHOXV)
+7 ;now evaluate result
+8 DO S^APCHPWH1("Stroke/Anitcoagulation Therapy",1)
+9 ;
+10 IF 'APCHOXV("DENOM")!($$AGE^AUPNPAT(APCHSDFN,DT)<18)
Begin DoDot:1
+11 DO S^APCHPWH1("This section only reports on people who had a blood clot in the brain (also")
+12 DO S^APCHPWH1("called a stroke) and an abnormal heart beat. You do not have these")
+13 DO S^APCHPWH1("problems, so you are not included in this report.")
+14 QUIT
End DoDot:1
QUIT
+15 SET X=0
FOR
SET X=$ORDER(APCHOXV(X))
IF X'=+X
QUIT
Begin DoDot:1
+16 SET Y=""
SET M=""
IF $PIECE(APCHOXV(X),U,2)]""
SET Y=$$FMTE^XLFDT($PIECE(APCHOXV(X),U,3))
SET M=$PIECE(APCHOXV(X),U,2)
End DoDot:1
+17 IF Y=""
Begin DoDot:1
+18 DO S^APCHPWH1("This report looks to see if you were prescribed a medicine to prevent")
+19 DO S^APCHPWH1("blood clots this year. You were not prescribed any medications to ")
+20 DO S^APCHPWH1("prevent a blood clot this year.")
End DoDot:1
QUIT
+21 DO S^APCHPWH1("This report looks to see if you were prescribed a medicine to prevent")
+22 DO S^APCHPWH1("blood clots this year. You were prescribed "_M)
+23 DO S^APCHPWH1("on "_Y_".")
+24 QUIT
+25 ;
TIAFIB(P,BDATE,EDATE,APCHR) ;EP
+1 NEW A,X,V,APCHG,G,C,T,B,E,APCHX,APCHV,APCHD
+2 KILL APCHR,APCHG,APCHX
+3 SET APCHR=""
SET APCHR(0)=""
+4 SET X=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"APCHG(")
+5 IF '$DATA(APCHG(1))
SET APCHR("DENOM")=0
QUIT
+6 ;now go through and get rid of H and CHS
+7 SET T=$ORDER(^ATXAX("B","BGP TIA DXS",0))
+8 SET A=0
FOR
SET A=$ORDER(APCHG(A))
IF A'=+A
QUIT
Begin DoDot:1
+9 SET V=$PIECE(APCHG(A),U,5)
+10 IF '$DATA(^AUPNVSIT(V,0))
KILL APCHG(A)
QUIT
+11 IF $PIECE(^AUPNVSIT(V,0),U,3)="C"
KILL APCHG(A)
QUIT
+12 IF $PIECE(^AUPNVSIT(V,0),U,7)'="H"
KILL APCHG(A)
QUIT
+13 SET X=0
SET G=0
SET E=0
SET B=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",V,X))
IF X'=+X
QUIT
Begin DoDot:2
+14 SET C=$PIECE($GET(^AUPNVPOV(X,0)),U)
+15 IF C=""
QUIT
+16 IF $$ICD^ATXAPI(C,T,9)
SET G=1
SET $PIECE(APCHG(A),U,15)=$$VAL^XBDIQ1(9000010.07,X,.01)
+17 IF $$VAL^XBDIQ1(9000010.07,X,.01)="427.31"
SET E=1
End DoDot:2
+18 ;have both
IF G
IF E
SET B=1
+19 ;no tia diagnosis
IF 'B
KILL APCHG(A)
End DoDot:1
+20 IF '$DATA(APCHG)
SET APCHR("DENOM")=0
QUIT
+21 ;reorder the diagnoses by visit date
+22 SET A=0
FOR
SET A=$ORDER(APCHG(A))
IF A'=+A
QUIT
SET V=$PIECE(APCHG(A),U,5)
SET D=$PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
SET APCHX(D,V)=APCHG(A)
+23 ;now get the first one
+24 SET APCHD=0
SET APCHC=0
FOR
SET APCHD=$ORDER(APCHX(APCHD))
IF APCHD'=+APCHD
QUIT
Begin DoDot:1
+25 SET APCHV=0
FOR
SET APCHV=$ORDER(APCHX(APCHD,APCHV))
IF APCHV'=+APCHV
QUIT
Begin DoDot:2
+26 ;set denominator
SET APCHC=APCHC+1
SET APCHR(APCHC)=APCHD
+27 ; any ANTICOAG?
SET G=$$ANTICOAG(P,$$FMADD^XLFDT(APCHD,-365),$$DSCHDATE^APCLV(APCHV),APCHD)
+28 ;set numerator column
SET $PIECE(APCHR(APCHC),U,2)=$PIECE(G,U,2)
SET $PIECE(APCHR(APCHC),U,3)=$PIECE(G,U,1)
+29 ;S $P(APCHR(0),U,$P(G,U,2))=$P(APCHR(0),U,$P(G,U,2))+1
End DoDot:2
End DoDot:1
+30 SET APCHR("DENOM")=APCHC
+31 QUIT
+32 ;
ANTICOAG(P,BDATE,EDATE,APCHAD) ;EP - was there ANTICOAG
+1 NEW APCHD,X,N,E,Y,T,D,C,APCHLT,L,J,APCHG,S,APCHD
+2 KILL APCHG
SET Y="APCHG("
SET X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+3 SET X=0
SET G=""
FOR
SET X=$ORDER(APCHG(X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+4 ;ien of v med
SET N=+$PIECE(APCHG(X),U,4)
+5 ;not one of the drugs
SET C=$$ANTIDRUG(N)
+6 IF '$PIECE(C,U)
QUIT
+7 ;c=1^category of drug
+8 ;discontinued before discharge date
IF $PIECE(^AUPNVMED(N,0),U,8)]""
IF $PIECE(^AUPNVMED(N,0),U,8)'>EDATE
QUIT
+9 SET S=$PIECE(^AUPNVMED(N,0),U,7)
+10 ;PRESCRIBED ON DISCHARGE DATE
IF $PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVMED(N,0),U,3),0),U),".")=EDATE
SET G=$$FMTE^XLFDT(EDATE)_"^"_$PIECE(C,U,2)_"^1"
+11 SET V=$PIECE(^AUPNVMED(N,0),U,3)
+12 SET V=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
+13 ;not valid through discharge date
IF $$FMADD^XLFDT(V,S)<EDATE
QUIT
+14 SET G=V_"^"_$PIECE(C,U,2)
End DoDot:1
+15 IF G]""
QUIT G
+16 ;now check for cpts
+17 SET G=$$CPTI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4073F"),,,"1P;2P;8P")
+18 IF G
QUIT $$FMTE^XLFDT($PIECE(G,U,2))_"^ANTI-PLT CPT [4073F]^1"
+19 SET G=$$CPTI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4075F"),,,"1P;2P;8P")
+20 IF G
QUIT $$FMTE^XLFDT($PIECE(G,U,2))_"^ANTI-PLT CPT [4075F]^1"
+21 SET G=$$CPTI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("G8006"))
+22 IF G
QUIT $$FMTE^XLFDT($PIECE(G,U,2))_"^ANTI-PLT CPT [G8006]^1"
+23 SET G=$$TRANI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4073F"))
+24 IF G
QUIT $$FMTE^XLFDT($PIECE(G,U,2))_"^ANTI-PLT CPT/TRAN [4073F]^1"
+25 SET G=$$TRANI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("4075F"))
+26 IF G
QUIT $$FMTE^XLFDT($PIECE(G,U,2))_"^ANTI-PLT CPT/TRAN [4075F]^1"
+27 SET G=$$TRANI^APCHSMU1(P,EDATE,EDATE,+$$CODEN^ICPTCOD("G8006"))
+28 IF G
QUIT $$FMTE^XLFDT($PIECE(G,U,2))_"^ANTI-PLT CPT/TRAN [G8006]^1"
+29 QUIT ""
+30 ;now go get refusals of any of the above
+31 ;
+32 ;refusal of MEDS
+33 ;S T=$O(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
+34 ;S G=$$REFTAX^APCHSMU1(P,50,T,EDATE,EDATE)
+35 ;I G Q $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED WARF^2"
+36 ;S T=$O(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
+37 ;S G=$$REFTAX^APCHSMU1(P,50,T,EDATE,EDATE)
+38 ;I G Q $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ANTI-PLT^2"
+39 ;S T=$O(^ATXAX("B","D AUDIT ASPIRIN DRUGS",0))
+40 ;S G=$$REFTAX^APCHSMU1(P,50,T,EDATE,EDATE)
+41 ;I G Q $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ASA^2"
+42 ;CHECK BL700 CLASS REFUSALS
+43 SET G=""
+44 SET I=0
FOR
SET I=$ORDER(^AUPNPREF("AA",P,50,I))
IF I=""!($PIECE(G,U))
QUIT
Begin DoDot:1
+45 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,I,X))
IF X'=+X!($PIECE(G,U))
QUIT
SET Y=0
FOR
SET Y=$ORDER(^AUPNPREF("AA",P,50,I,X,Y))
IF Y'=+Y
QUIT
SET D=$PIECE(^AUPNPREF(Y,0),U,3)
IF D=EDATE
Begin DoDot:2
End DoDot:2
+46 IF $PIECE($GET(^PSDRUG(I,0)),U,2)'="BL700"
QUIT
+47 SET G=$$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ANTI-PLT^2"
End DoDot:1
+48 IF G]""
QUIT G
+49 SET G=$$REFUSAL^APCHSMU(P,81,+$$CODEN^ICPTCOD("4073F"),EDATE,EDATE)
+50 IF G
QUIT $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ANTI-PLT [4073F]^2"
+51 SET G=$$REFUSAL^APCHSMU(P,81,+$$CODEN^ICPTCOD("4075F"),EDATE,EDATE)
+52 IF G
QUIT $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ANTI-PLT [4075F]^2"
+53 SET G=$$REFUSAL^APCHSMU(P,81,+$$CODEN^ICPTCOD("G8006"),EDATE,EDATE)
+54 IF G
QUIT $$FMTE^XLFDT(EDATE)_" ZZZZZ: DECLINED ANTI-PLT [G8006]^2"
+55 QUIT $$FMTE^XLFDT(EDATE)_" ZZZZZ: NO THERAPY^3"
+56 ;
ANTIDRUG(N) ;
+1 NEW G,T,I
+2 SET I=$PIECE($GET(^AUPNVMED(N,0)),U)
+3 IF 'I
QUIT 0
+4 SET G=0
+5 SET T=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
+6 IF T
IF $DATA(^ATXAX(T,21,"B",I))
QUIT "1^"_$PIECE(^PSDRUG(I,0),U,1)
+7 SET T=$ORDER(^ATXAX("B","BGP CMS WARFARIN MEDS",0))
+8 IF T
IF $DATA(^ATXAX(T,21,"B",I))
QUIT "1^"_$PIECE(^PSDRUG(I,0),U,1)
+9 SET T=$ORDER(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
+10 IF T
IF $DATA(^ATXAX(T,21,"B",I))
QUIT "1^"_$PIECE(^PSDRUG(I,0),U,1)
+11 SET G=$PIECE(^PSDRUG(I,0),U,2)
+12 IF G="BL700"
QUIT "1^"_$PIECE(^PSDRUG(I,0),U,1)
+13 IF $PIECE(^PSDRUG(I,0),U)["WARFARIN"
QUIT "1^"_$PIECE(^PSDRUG(I,0),U,1)
+14 QUIT ""
