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

APCHPWH7.m

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