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

BGP1D9.m

Go to the documentation of this file.
BGP1D9 ; IHS/CMI/LAB - measure J ;
 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
 ;
 ;
I0303 ;EP
 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN9,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPHOSP,BGPHTN)=0
 I BGPAGEB<18 S BGPSTOP=1 Q
 I BGPAGEB>85 S BGPSTOP=1 Q
 I $$ESRD^BGP1D211(DFN,$P(^DPT(DFN,0),U,3),BGPEDATE) S BGPSTOP=1 Q  ;esrd anytime before end date
 I $$V1HTN(DFN,BGP365,BGPEDATE),$$FIRSTHTN(DFN,BGPEDATE),BGPACTCL S BGPHTN=1,BGPD1=1
 I 'BGPD1 S BGPSTOP=1 Q  ;not in denominator
 I BGPAGEB>17,BGPAGEB<46 S BGPD2=1
 I BGPAGEB>45,BGPAGEB<86 S BGPD3=1
 S BGPVALUE=$$MEANBP^BGP1D41(DFN,BGPBDATE,BGPEDATE)
 I BGPVALUE["unknown" S BGPVALUE=$$BPCPT^BGP1D22(DFN,BGPBDATE,BGPEDATE) I BGPVALUE]"" S BGPN1=1,BGPVALUE=$P(BGPVALUE,U,2)_U_0 G V
 S BGPN1=$S($P(BGPVALUE,U,2):1,1:0)  ;any value 2-6
 S BGPN2=$S($P(BGPVALUE,U,2)=2:1,1:0)
 S BGPN3=$S($P(BGPVALUE,U,2)=3:1,1:0)
 S BGPN4=$S($P(BGPVALUE,U,2)=4:1,1:0)
 S BGPN5=$S($P(BGPVALUE,U,2)=5:1,1:0)
 S BGPN6=$S($P(BGPVALUE,U,2)=6:1,1:0)
 S BGPN9="" I BGPN1,$P(BGPVALUE,U)'["CPT",$P(BGPVALUE,"/")<140,+$P(BGPVALUE,"/",2)<90 S BGPN9=1
V S BGPVALUE=$S(BGPD1:"HTN PT",1:"")_"|||"_$S($P(BGPVALUE,U,2)="":"",1:$P(BGPVALUE,U))
 I BGPRTYPE=3 S BGPVALUE=BGPVALUE_$S(BGPN9:" - CONTROLLED BP",1:"")
 K ^TMP($J,"A")
 Q
IC2 ;EP
 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
 I '$$MED(DFN,BGP365,BGPEDATE) S BGPSTOP=1 Q  ;no meds for this patient
 I BGPACTUP S BGPD1=1
 I BGPACTCL,BGPACTUP S BGPD2=1
 I '(BGPD1+BGPD2) Q
 S BGPVALUE=$$MEDPED(DFN,BGPBDATE,BGPEDATE)
 I $P(BGPVALUE,U,1)]"" S BGPN1=1,BGPN2=0
 I 'BGPN1 S BGPVALUE=$$MEDPEDRF(DFN,BGPBDATE,BGPEDATE) I $P(BGPVALUE,U,1)]"" S BGPN2=1
 S V=$S(BGPD1:"UP")_$S(BGPD2:",AC",1:"")
 S V=V_"|||"_$$DATE^BGP1UTL($P(BGPVALUE,U,1))_" "_$P(BGPVALUE,U,2)
 S BGPVALUE=V
 K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
 K ^TMP($J,"A")
 Q
MEDPED(P,BDATE,EDATE) ;
 K BGPG
 S Y="BGPG("
 S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
 I '$D(BGPG(1)) Q ""
 S (X,P,D,E)=0,%="",T="" F  S X=$O(BGPG(X)) Q:X'=+X!(E)  D
 .Q:$P($G(^AUPNVPED(+$P(BGPG(X),U,4),0)),U,6)=5
 .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 $P(T,"-",2)="M"!($P(T,"-",1)="M")!(T="DMC-IN")!(T="FP-DPO")!(T="FP-OC")!(T="ASM-NEB")!(T="ASM-MDI")!(T="PL-NEB")!(T="PL-MDI")!(T="FP-TD") S E=1,$P(%,U,1)=$P(BGPG(X),U),$P(%,U,2)=T Q
 .;I $P(T,"-",1)="V68.1"!($P(T,"-",1)="V65.49") S E=1,$P(%,U,1)=$P(BGPG(X),U),$P(%,U,2)=T Q
 Q %
 ;
MED(P,BDATE,EDATE) ;
 K ^TMP($J,"A")
 S Y="^TMP($J,""A"","
 S X=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
 I '$D(^TMP($J,"A",1)) Q ""
 S (X,Y,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G)  D
 .S V=$P(^TMP($J,"A",X),U,5)
 .Q:'$O(^AUPNVMED("AD",V,0))
 .Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2)
 .Q:$P(^AUPNVSIT(V,0),U,7)="E"
 .Q:$P(^AUPNVSIT(V,0),U,3)="C"
 .S G=1
 Q G
ESRD(P,EDATE) ;
 K BGPG
 S Y="BGPG("
 S X=P_"^LAST DX [BGP ESRD DXS;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE S E=$$START1^APCLDF(X,Y)
 I $D(BGPG(1)) Q 1
 S E=+$$CODEN^ICPTCOD(90921),X=$$CPTI^BGP1DU(P,$$DOB^AUPNPAT(P),EDATE,E)
 I $P(X,U) Q 1
 S E=+$$CODEN^ICPTCOD(90925),X=$$CPTI^BGP1DU(P,$$DOB^AUPNPAT(P),EDATE,E)
 I $P(X,U) Q 1
 S E=+$$CODEN^ICPTCOD(90921),X=$$TRANI^BGP1DU(P,$$DOB^AUPNPAT(P),EDATE,E)
 I $P(X,U) Q 1
 S E=+$$CODEN^ICPTCOD(90925),X=$$TRANI^BGP1DU(P,$$DOB^AUPNPAT(P),EDATE,E)
 I $P(X,U) Q 1
 Q ""
FIRSTIHD(P,EDATE) ;EP
 I $G(P)="" Q ""
 K BGPG
 S Y="BGPG("
 S X=P_"^FIRST DX [BGP ISCHEMIC HEART 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 ISCHEMIC HEART 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)
 .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
 Q $S(G<2:"",1:1)
FIRSTHTN(P,EDATE) ;EP
 S X=$$FIRSTPV(P,EDATE) I X Q 1
 ;now check problem list
 S BDATE=$$FMADD^XLFDT(EDATE,-365)
 S T=$O(^ATXAX("B","BGP HYPERTENSION DXS",0))
 S (X,G)=0 F  S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G)  D
 .Q:$P(^AUPNPROB(X,0),U,8)>BDATE  ;if added to pl after beginning of time period, no go
 .S Y=$P(^AUPNPROB(X,0),U)
 .Q:$P(^AUPNPROB(X,0),U,12)'="A"
 .Q:'$$ICD^ATXCHK(Y,T,9)
 .S G=1
 .Q
 Q G
FIRSTPV(P,EDATE) ;EP
 I $G(P)="" Q ""
 K BGPG
 S Y="BGPG("
 S X=P_"^FIRST DX [BGP HYPERTENSION 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:"")
 ;
V1HTN(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 HYPERTENSION DXS",0))
 I 'T Q ""
 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)
 .Q:"SAHO"'[$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^ATXCHK(%,T,9) S D=1
 .Q:'D
 .S G=G+1
 .Q
 Q G
MEDPEDRF(P,BDATE,EDATE) ;
 NEW G,X,H,Z,T,D,BGPG,Y
 S G=""
 S X=0 F  S X=$O(^AUPNPREF("AA",P,9999999.09,X)) Q:X'=+X!(G)  D
 .S H=""
 .Q:'$D(^AUTTEDT(X,0))
 .S T=$P(^AUTTEDT(X,0),U,2)
 .I $P(T,"-",2)="M"!($P(T,"-",1)="M")!(T="DMC-IN")!(T="FP-DPO")!(T="FP-OC")!(T="ASM-NEB")!(T="ASM-MDI")!(T="PL-NEB")!(T="PL-MDI")!(T="FP-TD") S H=1
 .Q:H'=1
 .S D=0 F  S D=$O(^AUPNPREF("AA",P,9999999.09,X,D)) Q:D'=+D  D
 ..S Z=9999999-D
 ..Q:Z<BDATE
 ..Q:Z>EDATE
 ..S G=Z_"^Refused "_$P(^AUTTEDT(X,0),U,2)
 I G Q G
 ;CHECK V PAT ED FOR REFUSAL
 K BGPG
 S Y="BGPG("
 S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
 I '$D(BGPG(1)) Q ""
 S (X,P,D,E)=0,%="",T="" F  S X=$O(BGPG(X)) Q:X'=+X!(E)  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 $P(T,"-",2)="M"!($P(T,"-",1)="M")!(T="DMC-IN")!(T="FP-DPO")!(T="FP-OC")!(T="ASM-NEB")!(T="ASM-MDI")!(T="PL-NEB")!(T="PL-MDI")!(T="FP-TD") S E=1
 .I 'E Q
 .Q:$P(^AUPNVPED(+$P(BGPG(X),U,4),0),U,6)'=5
 .S $P(%,U,1)=$P(BGPG(X),U),$P(%,U,2)="Refused "_T
 Q %
 ;