BGP4D9 ; IHS/CMI/LAB - measure J ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
;
I0303 ;EP
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN9,BGPN10,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPHOSP,BGPHTN)=0
S (BGPVALUE,BGPVALUD)=""
I BGPAGEB<18 S BGPSTOP=1 Q
I BGPAGEB>85 S BGPSTOP=1 Q
I BGPRTYPE=4 I $$ESRD^BGP4D211(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
I BGPAGEB<60 S BGPD7=1
I BGPAGEB>59 S BGPD8=1
S BGPVALUE=$$MEANBP^BGP4D41(DFN,BGPBDATE,BGPEDATE,1)
I BGPVALUE["unknown" S BGPVALUE=$$BPCPT^BGP4D22(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 X=$$MEANBPD^BGP4D2(DFN,BGPBDATE,BGPEDATE,1,BGPAGEB)
;I X="" S X=$$BPCPT^BGP4D22(DFN,BGPBDATE,BGPEDATE,1) I X]"" D G V1
;.S BGPN10=$S($P(X,U)=1:1,1:0),X=$P(X,U,2)_"^"_$P(X,U,1) ;,BGPVALUD=$P(BGPBP,U,2) ;_" "_$S(BGPN5:"CON",1:"UNC")
I $P(X,U,2)=4 S BGPN10=1
V1 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:"")
S BGPVALUD="HTN PT|||"_$S($P(X,U,2)="":"",1:$P(X,U)) ;S BGPVALUD=BGPVALUD_$S(BGPN10:"CON",1:"UNC")
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
;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^BGP4UTL($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
IMTM ;EP
S (BGPN1,BGPD1)=""
Q:BGPAGEB<18
I '$$MED(DFN,BGP365,BGPEDATE) S BGPSTOP=1 Q ;no meds for this patient
I BGPACTCL S BGPD1=1
I 'BGPD1 Q
S BGPVALUE=$$MTM(DFN,BGPBDATE,BGPEDATE)
I $P(BGPVALUE,U,1) S BGPN1=1
S V="AC"
S V=V_"|||"_$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
MTM(P,BDATE,EDATE) ;
NEW %
S %=""
S %=$$CPT^BGP4DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP CPT MTM",0)),5)
I %]"" Q 1_U_$$DATE^BGP1UTL($P(%,U,1))_" CPT "_$P(%,U,2)
;now check clinic visits
NEW G,B,C,D,V,E
S G=""
S B=9999999-BDATE,C=0,E=9999999-EDATE ;get inverse date and begin at edate-1 and end when greater than begin date
S D=E-1,D=D_".9999" F S D=$O(^AUPNVSIT("AA",P,D)) Q:D=""!($P(D,".")>B)!(G]"") D
.S V=0 F S V=$O(^AUPNVSIT("AA",P,D,V)) Q:V'=+V D
..S C=$$CLINIC^APCLV(V,"C")
..I C'="D1",C'="D2",C'="D5" Q
..S G=1_U_$$DATE^BGP4UTL($$VD^APCLV(V))_" Cl "_C
I G]"" Q G
Q ""
ISMT ;
S (BGPD1,BGPN1)=0
I 'BGPACTCL Q ;only active clinical in this measure
S BGPVALUE=$$LASTHF^BGP4D7(DFN,"CONFIDENCE IN MANAGING HEALTH PROBLEMS",BGPBDATE,BGPEDATE)
I BGPVALUE="" Q ;not assessed
S BGPD1=1
I $P(BGPVALUE,U,1)="VERY SURE" S BGPN1=1
S BGPVALUE="AC"_"|||"_$S(BGPN1:$P(BGPVALUE,U,2),1:"")
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")!($P(T,"-",2)="NEB")!($P(T,"-",2)="MDI")!(T="FP-TD") 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^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,E)
I $P(X,U) Q 1
S E=+$$CODEN^ICPTCOD(90925),X=$$CPTI^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,E)
I $P(X,U) Q 1
S E=+$$CODEN^ICPTCOD(90921),X=$$TRANI^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,E)
I $P(X,U) Q 1
S E=+$$CODEN^ICPTCOD(90925),X=$$TRANI^BGP4DU(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^BGP4UTL2(%,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)="I"
.Q:$P(^AUPNPROB(X,0),U,12)="D"
.Q:'$$ICD^BGP4UTL2(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^BGP4UTL2(%,T,9) S D=1
.Q:'D
.S G=G+1
.Q
Q G
;
MH ;EP
S (BGPN1,BGPD1)=0
I 'BGPACTUP S BGPSTOP=1 Q
I BGPAGEE<18 S BGPSTOP=1 Q
I BGPAGEE>85 S BGPSTOP=1 Q
I $$ESRD^BGP4D211(DFN,$P(^DPT(DFN,0),U,3),BGPEDATE) S BGPSTOP=1 Q ;esrd anytime before end date
S X=$$PREG^BGP4D7(DFN,BGPBDATE,BGPEDATE,1,1) I X S BGPSTOP=1 Q
I '$$MHHTN(DFN,BGPBDATE,BGPEDATE) S BGPSTOP=1 Q ;no htn per definition
S BGPD1=1
S BGPBP=$$LASTBP(DFN,BGPBDATE,BGPEDATE)
I BGPBP]"" D
.S X=BGPBP
.I $P(X,"/",1)<140,$P(X,"/",2)<90 S BGPN1=1
VMH S BGPVALUE="HTN PT|||"_$S(BGPN1:BGPBP,1:"")
Q
MHHTN(P,BDATE,EDATE) ;EP
I '$G(P) Q ""
I '$D(^DPT(P,0)) Q ""
NEW S,X,B
S B=$$DOB^AUPNPAT(P)
S S=$$FMADD^XLFDT(BDATE,182) ;6 months
S X=$$LASTDX^BGP4UTL1(P,"BGP HYPERTENSION DXS",B,S)
I 'X D I 'G Q "" ;no dx/PROBLEM through 1st 6 months of time period
.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)>S ;if added to pl after 6 MONTHS of time period, no go
..S Y=$P(^AUPNPROB(X,0),U)
..Q:$P(^AUPNPROB(X,0),U,12)="I"
..Q:$P(^AUPNPROB(X,0),U,12)="D"
..Q:'$$ICD^BGP4UTL2(Y,T,9)
..S G=1
..Q
;now did they have 1 pov in time period?
S X=$$LASTDX^BGP4UTL1(P,"BGP HYPERTENSION DXS",BDATE,EDATE)
I X Q 1
Q 0
LASTBP(P,BDATE,EDATE) ;EP
NEW X
S X=$$BPS^BGP4D2(P,BDATE,EDATE,"I",1)
I X="" Q ""
Q $P(X,";",1)
BGP4D9 ; IHS/CMI/LAB - measure J ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+2 ;
+3 ;
I0303 ;EP
+1 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN9,BGPN10,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPHOSP,BGPHTN)=0
+2 SET (BGPVALUE,BGPVALUD)=""
+3 IF BGPAGEB<18
SET BGPSTOP=1
QUIT
+4 IF BGPAGEB>85
SET BGPSTOP=1
QUIT
+5 ;esrd anytime before end date
IF BGPRTYPE=4
IF $$ESRD^BGP4D211(DFN,$PIECE(^DPT(DFN,0),U,3),BGPEDATE)
SET BGPSTOP=1
QUIT
+6 IF $$V1HTN(DFN,BGP365,BGPEDATE)
IF $$FIRSTHTN(DFN,BGPEDATE)
IF BGPACTCL
SET BGPHTN=1
SET BGPD1=1
+7 ;not in denominator
IF 'BGPD1
SET BGPSTOP=1
QUIT
+8 IF BGPAGEB>17
IF BGPAGEB<46
SET BGPD2=1
+9 IF BGPAGEB>45
IF BGPAGEB<86
SET BGPD3=1
+10 IF BGPAGEB<60
SET BGPD7=1
+11 IF BGPAGEB>59
SET BGPD8=1
+12 SET BGPVALUE=$$MEANBP^BGP4D41(DFN,BGPBDATE,BGPEDATE,1)
+13 IF BGPVALUE["unknown"
SET BGPVALUE=$$BPCPT^BGP4D22(DFN,BGPBDATE,BGPEDATE)
IF BGPVALUE]""
SET BGPN1=1
SET BGPVALUE=$PIECE(BGPVALUE,U,2)_U_0
GOTO V
+14 ;any value 2-6
SET BGPN1=$SELECT($PIECE(BGPVALUE,U,2):1,1:0)
+15 SET BGPN2=$SELECT($PIECE(BGPVALUE,U,2)=2:1,1:0)
+16 SET BGPN3=$SELECT($PIECE(BGPVALUE,U,2)=3:1,1:0)
+17 SET BGPN4=$SELECT($PIECE(BGPVALUE,U,2)=4:1,1:0)
+18 SET BGPN5=$SELECT($PIECE(BGPVALUE,U,2)=5:1,1:0)
+19 SET BGPN6=$SELECT($PIECE(BGPVALUE,U,2)=6:1,1:0)
+20 SET BGPN9=""
IF BGPN1
IF $PIECE(BGPVALUE,U)'["CPT"
IF $PIECE(BGPVALUE,"/")<140
IF +$PIECE(BGPVALUE,"/",2)<90
SET BGPN9=1
V SET X=$$MEANBPD^BGP4D2(DFN,BGPBDATE,BGPEDATE,1,BGPAGEB)
+1 ;I X="" S X=$$BPCPT^BGP4D22(DFN,BGPBDATE,BGPEDATE,1) I X]"" D G V1
+2 ;.S BGPN10=$S($P(X,U)=1:1,1:0),X=$P(X,U,2)_"^"_$P(X,U,1) ;,BGPVALUD=$P(BGPBP,U,2) ;_" "_$S(BGPN5:"CON",1:"UNC")
+3 IF $PIECE(X,U,2)=4
SET BGPN10=1
V1 SET BGPVALUE=$SELECT(BGPD1:"HTN PT",1:"")_"|||"_$SELECT($PIECE(BGPVALUE,U,2)="":"",1:$PIECE(BGPVALUE,U))
+1 IF BGPRTYPE=3
SET BGPVALUE=BGPVALUE_$SELECT(BGPN9:" - CONTROLLED BP",1:"")
+2 ;S BGPVALUD=BGPVALUD_$S(BGPN10:"CON",1:"UNC")
SET BGPVALUD="HTN PT|||"_$SELECT($PIECE(X,U,2)="":"",1:$PIECE(X,U))
+3 KILL ^TMP($JOB,"A")
+4 QUIT
IC2 ;EP
+1 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
+2 ;no meds for this patient
IF '$$MED(DFN,BGP365,BGPEDATE)
SET BGPSTOP=1
QUIT
+3 IF BGPACTUP
SET BGPD1=1
+4 IF BGPACTCL
IF BGPACTUP
SET BGPD2=1
+5 IF '(BGPD1+BGPD2)
QUIT
+6 SET BGPVALUE=$$MEDPED(DFN,BGPBDATE,BGPEDATE)
+7 IF $PIECE(BGPVALUE,U,1)
SET BGPN1=1
+8 ;I 'BGPN1 S BGPVALUE=$$MEDPEDRF(DFN,BGPBDATE,BGPEDATE) I $P(BGPVALUE,U,1)]"" S BGPN2=1
+9 SET V=$SELECT(BGPD1:"UP")_$SELECT(BGPD2:",AC",1:"")
+10 SET V=V_"|||"_$$DATE^BGP4UTL($PIECE(BGPVALUE,U,1))_" "_$PIECE(BGPVALUE,U,2)
+11 SET BGPVALUE=V
+12 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
+13 KILL ^TMP($JOB,"A")
+14 QUIT
IMTM ;EP
+1 SET (BGPN1,BGPD1)=""
+2 IF BGPAGEB<18
QUIT
+3 ;no meds for this patient
IF '$$MED(DFN,BGP365,BGPEDATE)
SET BGPSTOP=1
QUIT
+4 IF BGPACTCL
SET BGPD1=1
+5 IF 'BGPD1
QUIT
+6 SET BGPVALUE=$$MTM(DFN,BGPBDATE,BGPEDATE)
+7 IF $PIECE(BGPVALUE,U,1)
SET BGPN1=1
+8 SET V="AC"
+9 SET V=V_"|||"_$PIECE(BGPVALUE,U,2)
+10 SET BGPVALUE=V
+11 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
+12 KILL ^TMP($JOB,"A")
+13 QUIT
MTM(P,BDATE,EDATE) ;
+1 NEW %
+2 SET %=""
+3 SET %=$$CPT^BGP4DU(P,BDATE,EDATE,$ORDER(^ATXAX("B","BGP CPT MTM",0)),5)
+4 IF %]""
QUIT 1_U_$$DATE^BGP1UTL($PIECE(%,U,1))_" CPT "_$PIECE(%,U,2)
+5 ;now check clinic visits
+6 NEW G,B,C,D,V,E
+7 SET G=""
+8 ;get inverse date and begin at edate-1 and end when greater than begin date
SET B=9999999-BDATE
SET C=0
SET E=9999999-EDATE
+9 SET D=E-1
SET D=D_".9999"
FOR
SET D=$ORDER(^AUPNVSIT("AA",P,D))
IF D=""!($PIECE(D,".")>B)!(G]"")
QUIT
Begin DoDot:1
+10 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",P,D,V))
IF V'=+V
QUIT
Begin DoDot:2
+11 SET C=$$CLINIC^APCLV(V,"C")
+12 IF C'="D1"
IF C'="D2"
IF C'="D5"
QUIT
+13 SET G=1_U_$$DATE^BGP4UTL($$VD^APCLV(V))_" Cl "_C
End DoDot:2
End DoDot:1
+14 IF G]""
QUIT G
+15 QUIT ""
ISMT ;
+1 SET (BGPD1,BGPN1)=0
+2 ;only active clinical in this measure
IF 'BGPACTCL
QUIT
+3 SET BGPVALUE=$$LASTHF^BGP4D7(DFN,"CONFIDENCE IN MANAGING HEALTH PROBLEMS",BGPBDATE,BGPEDATE)
+4 ;not assessed
IF BGPVALUE=""
QUIT
+5 SET BGPD1=1
+6 IF $PIECE(BGPVALUE,U,1)="VERY SURE"
SET BGPN1=1
+7 SET BGPVALUE="AC"_"|||"_$SELECT(BGPN1:$PIECE(BGPVALUE,U,2),1:"")
+8 QUIT
+9 ;
MEDPED(P,BDATE,EDATE) ;
+1 KILL BGPG
+2 SET Y="BGPG("
+3 SET X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+4 IF '$DATA(BGPG(1))
QUIT ""
+5 SET (X,P,D,E)=0
SET %=""
SET T=""
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X!(E)
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVPED(+$PIECE(BGPG(X),U,4),0)),U,6)=5
QUIT
+7 SET T=$PIECE(^AUPNVPED(+$PIECE(BGPG(X),U,4),0),U)
+8 IF 'T
QUIT
+9 IF '$DATA(^AUTTEDT(T,0))
QUIT
+10 SET T=$PIECE(^AUTTEDT(T,0),U,2)
+11 IF $PIECE(T,"-",2)="M"!($PIECE(T,"-",1)="M")!(T="DMC-IN")!(T="FP-DPO")!(T="FP-OC")!($PIECE(T,"-",2)="NEB")!($PIECE(T,"-",2)="MDI")!(T="FP-TD")
SET E=1
SET $PIECE(%,U,1)=$PIECE(BGPG(X),U)
SET $PIECE(%,U,2)=T
QUIT
End DoDot:1
+12 QUIT %
+13 ;
MED(P,BDATE,EDATE) ;
+1 KILL ^TMP($JOB,"A")
+2 SET Y="^TMP($J,""A"","
+3 SET X=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+4 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+5 SET (X,Y,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+6 SET V=$PIECE(^TMP($JOB,"A",X),U,5)
+7 IF '$ORDER(^AUPNVMED("AD",V,0))
QUIT
+8 IF $PIECE(^AUPNVSIT(V,0),U,6)'=DUZ(2)
QUIT
+9 IF $PIECE(^AUPNVSIT(V,0),U,7)="E"
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,3)="C"
QUIT
+11 SET G=1
End DoDot:1
+12 QUIT G
ESRD(P,EDATE) ;
+1 KILL BGPG
+2 SET Y="BGPG("
+3 SET X=P_"^LAST DX [BGP ESRD DXS;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE
SET E=$$START1^APCLDF(X,Y)
+4 IF $DATA(BGPG(1))
QUIT 1
+5 SET E=+$$CODEN^ICPTCOD(90921)
SET X=$$CPTI^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,E)
+6 IF $PIECE(X,U)
QUIT 1
+7 SET E=+$$CODEN^ICPTCOD(90925)
SET X=$$CPTI^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,E)
+8 IF $PIECE(X,U)
QUIT 1
+9 SET E=+$$CODEN^ICPTCOD(90921)
SET X=$$TRANI^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,E)
+10 IF $PIECE(X,U)
QUIT 1
+11 SET E=+$$CODEN^ICPTCOD(90925)
SET X=$$TRANI^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,E)
+12 IF $PIECE(X,U)
QUIT 1
+13 QUIT ""
FIRSTIHD(P,EDATE) ;EP
+1 IF $GET(P)=""
QUIT ""
+2 KILL BGPG
+3 SET Y="BGPG("
+4 SET X=P_"^FIRST DX [BGP ISCHEMIC HEART DXS"
SET E=$$START1^APCLDF(X,Y)
+5 IF '$DATA(BGPG(1))
QUIT ""
+6 SET X=$$FMDIFF^XLFDT(EDATE,$PIECE(BGPG(1),U))
+7 QUIT $SELECT(X>365:1,1:"")
+8 ;
V2IHD(P,BDATE,EDATE) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+3 KILL ^TMP($JOB,"A")
+4 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+5 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+6 SET T=$ORDER(^ATXAX("B","BGP ISCHEMIC HEART DXS",0))
+7 IF 'T
QUIT ""
+8 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G>2)
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 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+13 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^BGP4UTL2(%,T,9)
SET D=1
+14 IF 'D
QUIT
+15 SET G=G+1
+16 QUIT
End DoDot:1
+17 QUIT $SELECT(G<2:"",1:1)
FIRSTHTN(P,EDATE) ;EP
+1 SET X=$$FIRSTPV(P,EDATE)
IF X
QUIT 1
+2 ;now check problem list
+3 SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+4 SET T=$ORDER(^ATXAX("B","BGP HYPERTENSION DXS",0))
+5 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+6 ;if added to pl after beginning of time period, no go
IF $PIECE(^AUPNPROB(X,0),U,8)>BDATE
QUIT
+7 SET Y=$PIECE(^AUPNPROB(X,0),U)
+8 IF $PIECE(^AUPNPROB(X,0),U,12)="I"
QUIT
+9 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+10 IF '$$ICD^BGP4UTL2(Y,T,9)
QUIT
+11 SET G=1
+12 QUIT
End DoDot:1
+13 QUIT G
FIRSTPV(P,EDATE) ;EP
+1 IF $GET(P)=""
QUIT ""
+2 KILL BGPG
+3 SET Y="BGPG("
+4 SET X=P_"^FIRST DX [BGP HYPERTENSION DXS"
SET E=$$START1^APCLDF(X,Y)
+5 IF '$DATA(BGPG(1))
QUIT ""
+6 SET X=$$FMDIFF^XLFDT(EDATE,$PIECE(BGPG(1),U))
+7 QUIT $SELECT(X>365:1,1:"")
+8 ;
V1HTN(P,BDATE,EDATE) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+3 KILL ^TMP($JOB,"A")
+4 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+5 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+6 SET T=$ORDER(^ATXAX("B","BGP HYPERTENSION DXS",0))
+7 IF 'T
QUIT ""
+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 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+13 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^BGP4UTL2(%,T,9)
SET D=1
+14 IF 'D
QUIT
+15 SET G=G+1
+16 QUIT
End DoDot:1
+17 QUIT G
+18 ;
MH ;EP
+1 SET (BGPN1,BGPD1)=0
+2 IF 'BGPACTUP
SET BGPSTOP=1
QUIT
+3 IF BGPAGEE<18
SET BGPSTOP=1
QUIT
+4 IF BGPAGEE>85
SET BGPSTOP=1
QUIT
+5 ;esrd anytime before end date
IF $$ESRD^BGP4D211(DFN,$PIECE(^DPT(DFN,0),U,3),BGPEDATE)
SET BGPSTOP=1
QUIT
+6 SET X=$$PREG^BGP4D7(DFN,BGPBDATE,BGPEDATE,1,1)
IF X
SET BGPSTOP=1
QUIT
+7 ;no htn per definition
IF '$$MHHTN(DFN,BGPBDATE,BGPEDATE)
SET BGPSTOP=1
QUIT
+8 SET BGPD1=1
+9 SET BGPBP=$$LASTBP(DFN,BGPBDATE,BGPEDATE)
+10 IF BGPBP]""
Begin DoDot:1
+11 SET X=BGPBP
+12 IF $PIECE(X,"/",1)<140
IF $PIECE(X,"/",2)<90
SET BGPN1=1
End DoDot:1
VMH SET BGPVALUE="HTN PT|||"_$SELECT(BGPN1:BGPBP,1:"")
+1 QUIT
MHHTN(P,BDATE,EDATE) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^DPT(P,0))
QUIT ""
+3 NEW S,X,B
+4 SET B=$$DOB^AUPNPAT(P)
+5 ;6 months
SET S=$$FMADD^XLFDT(BDATE,182)
+6 SET X=$$LASTDX^BGP4UTL1(P,"BGP HYPERTENSION DXS",B,S)
+7 ;no dx/PROBLEM through 1st 6 months of time period
IF 'X
Begin DoDot:1
+8 SET T=$ORDER(^ATXAX("B","BGP HYPERTENSION DXS",0))
+9 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(G)
QUIT
Begin DoDot:2
+10 ;if added to pl after 6 MONTHS of time period, no go
IF $PIECE(^AUPNPROB(X,0),U,8)>S
QUIT
+11 SET Y=$PIECE(^AUPNPROB(X,0),U)
+12 IF $PIECE(^AUPNPROB(X,0),U,12)="I"
QUIT
+13 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+14 IF '$$ICD^BGP4UTL2(Y,T,9)
QUIT
+15 SET G=1
+16 QUIT
End DoDot:2
End DoDot:1
IF 'G
QUIT ""
+17 ;now did they have 1 pov in time period?
+18 SET X=$$LASTDX^BGP4UTL1(P,"BGP HYPERTENSION DXS",BDATE,EDATE)
+19 IF X
QUIT 1
+20 QUIT 0
LASTBP(P,BDATE,EDATE) ;EP
+1 NEW X
+2 SET X=$$BPS^BGP4D2(P,BDATE,EDATE,"I",1)
+3 IF X=""
QUIT ""
+4 QUIT $PIECE(X,";",1)
