- BGP7D9 ; IHS/CMI/LAB - measure J ;
- ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- ;
- ;
- 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^BGP7D211(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^BGP7D41(DFN,BGPBDATE,BGPEDATE,1)
- I BGPVALUE["unknown" S BGPVALUE=$$BPCPT^BGP7D22(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^BGP7D2(DFN,BGPBDATE,BGPEDATE,1,BGPAGEB)
- ;I X="" S X=$$BPCPT^BGP7D22(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^BGP7UTL($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^BGP7DU(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^BGP7UTL($$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^BGP7D7(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^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
- I $P(X,U) Q 1
- S E=+$$CODEN^ICPTCOD(90925),X=$$CPTI^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
- I $P(X,U) Q 1
- S E=+$$CODEN^ICPTCOD(90921),X=$$TRANI^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
- I $P(X,U) Q 1
- S E=+$$CODEN^ICPTCOD(90925),X=$$TRANI^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
- I $P(X,U) Q 1
- Q ""
- 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
- .I $P(^AUPNPROB(X,0),U,13)]"",$P(^AUPNPROB(X,0),U,13)>EDATE Q ;doo
- .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^BGP7UTL2(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^BGP7UTL2(%,T,9) S D=1
- .Q:'D
- .S G=G+1
- .Q
- Q G
- ;
- MH ;EP
- S (BGPN1,BGPN2,BGPD1,BGPD2,BGPD3)=0
- I 'BGPACTUP S BGPSTOP=1 Q
- I BGPAGEE<18 S BGPSTOP=1 Q
- I BGPAGEE>85 S BGPSTOP=1 Q
- I $$ESRD^BGP7D211(DFN,$P(^DPT(DFN,0),U,3),BGPEDATE) S BGPSTOP=1 Q ;esrd anytime before end date
- S X=$$PREG^BGP7D7(DFN,BGPBDATE,BGPEDATE,1,1,,BGPBDATE,BGPEDATE) I X S BGPSTOP=1 Q ;V17.1 CMI/LAB ADDED DATES FOR CURRENTLY PREGNANT
- I '$$MHHTN(DFN,BGPBDATE,BGPEDATE) S BGPSTOP=1 Q ;no htn per definition
- S BGPD1=1
- I BGPAGEE>17,BGPAGEE<60 S BGPD2=1
- I BGPAGEE>59,BGPAGEE<86 S BGPD3=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
- .I BGPD3,$P(X,"/",1)<150,$P(X,"/",2)<90 S BGPN2=1
- VMH S BGPVALUE="HTN PT|||"_$S(BGPN1!(BGPN2):BGPBP,1:"") I BGPD3 S BGPVALUE=BGPVALUE_$S(BGPN2&('BGPN1):" (<150/90)",1:"")
- Q
- MHHTN(P,BDATE,EDATE) ;EP
- I '$G(P) Q ""
- I '$D(^DPT(P,0)) Q ""
- NEW S,X,B,N,D,E
- S B=$$DOB^AUPNPAT(P)
- S S=$$FMADD^XLFDT(BDATE,182) ;6 months
- S X=$$LASTDX^BGP7UTL1(P,"BGP HYPERTENSION DXS",B,S)
- S G=0
- 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 D=$P(^AUPNPROB(X,0),U,13) I D]"",D>S Q ;doo after report period
- ..I $P(^AUPNPROB(X,0),U,13)="" Q:$P(^AUPNPROB(X,0),U,8)>S
- ..S Y=$P(^AUPNPROB(X,0),U)
- ..Q:$P(^AUPNPROB(X,0),U,12)="I"
- ..Q:$P(^AUPNPROB(X,0),U,12)="D"
- ..I $$ICD^BGP7UTL2(Y,T,9) D
- ...I D]"",D'<BDATE,D'>S S G=1 Q ;during 1st 6 months, no pov needed
- ...S E=$P(^AUPNPROB(X,0),U,8)
- ...I E'<BDATE,E'>S S G=1 Q
- ...S G=2 ;NEEDS POV DURING REPORT PERIOD
- ..S N=$$VAL^XBDIQ1(9000011,X,80001) I N]"",$D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM ESSENTIAL HYPERTENSION",N)) D
- ...I D]"",D'<BDATE,D'>S S G=1 Q ;during 1st 6 months, no pov needed
- ...S E=$P(^AUPNPROB(X,0),U,8)
- ...I E'<BDATE,E'>S S G=1 Q
- ...S G=2 ;NEEDS POV DURING REPORT PERIOD
- ..Q
- ;now did they have 1 pov in time period?
- I G=1 Q 1 ;no need for pov in rpt period
- S X=$$LASTDX^BGP7UTL1(P,"BGP HYPERTENSION DXS",BDATE,EDATE)
- I X Q 1
- Q 0
- LASTBP(P,BDATE,EDATE) ;EP
- ;TABLE ALL BPs in date order
- I $G(F)="" S F="E"
- NEW BGPGLL,BGPGV,BGPG,A,B,E,Y,V,BGPBP,X,Z,BGPD
- S BGPGLL=0,BGPGV=""
- K ^TMP($J,"BPV")
- K BGPBP
- S BGPD=""
- S A="^TMP($J,""BPV"",",B=P_"^LAST 365 MEAS BP;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
- I '$D(^TMP($J,"BPV",1)) Q ""
- ;SET UP ARRAY BY DATE
- S BGPBP=""
- K BGPG
- S Y=0 F S Y=$O(^TMP($J,"BPV",Y)) Q:Y'=+Y D
- .S V=$P(^TMP($J,"BPV",Y),U,5)
- .I $$CLINIC^APCLV(V,"C")=30 Q
- .Q:$$GDEV^BGP7D2(V)
- .Q:'$D(^AUPNVMSR("AD",V))
- .;NOW GET ALL BPS ON THIS VISIT
- .S X=0 F S X=$O(^AUPNVMSR("AD",V,X)) Q:X'=+X D
- ..Q:'$D(^AUPNVMSR(X,0)) ;BAD AD XREF
- ..S T=$P($G(^AUPNVMSR(X,0)),U)
- ..Q:T="" ;BAD AD XREF
- ..Q:$P($G(^AUTTMSR(T,0)),U)'="BP"
- ..Q:$P($G(^AUPNVMSR(X,2)),U,1)
- ..S BGPD=(9999999-$$VD^APCLV(V)) ;use this date
- ..S BGPG(BGPD,X)=$P(^AUPNVMSR(X,0),U,4)
- K ^TMP($J,"BPV")
- I '$O(BGPG(0)) Q "" ;no BPS
- S BGPD=$O(BGPG(0)) ;use this date and check all
- S Y=0 F S Y=$O(BGPG(BGPD,Y)) Q:Y'=+Y!(BGPBP]"") D
- .S Z=$P(BGPG(BGPD,Y),U,1) ;blood pressure value
- .I $P(Z,"/")<140,$P(Z,"/",2)<90 S BGPBP=Z Q
- I BGPBP]"" Q BGPBP
- S Y=0 F S Y=$O(BGPG(BGPD,Y)) Q:Y'=+Y!(BGPBP]"") D
- .S Z=$P(BGPG(BGPD,Y),U,1) ;blood pressure value
- .I $P(Z,"/")<150,$P(Z,"/",2)<90 S BGPBP=Z Q
- I BGPBP]"" Q BGPBP
- S Y=0 F S Y=$O(BGPG(BGPD,Y)) Q:Y'=+Y D
- .S Z=$P(BGPG(BGPD,Y),U,1) ;blood pressure value
- .S BGPBP=Z
- K ^TMP($J,"BPV")
- Q BGPBP
- BGP7D9 ; IHS/CMI/LAB - measure J ;
- +1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- +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^BGP7D211(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^BGP7D41(DFN,BGPBDATE,BGPEDATE,1)
- +13 IF BGPVALUE["unknown"
- SET BGPVALUE=$$BPCPT^BGP7D22(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^BGP7D2(DFN,BGPBDATE,BGPEDATE,1,BGPAGEB)
- +1 ;I X="" S X=$$BPCPT^BGP7D22(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^BGP7UTL($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^BGP7DU(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^BGP7UTL($$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^BGP7D7(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^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
- +6 IF $PIECE(X,U)
- QUIT 1
- +7 SET E=+$$CODEN^ICPTCOD(90925)
- SET X=$$CPTI^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
- +8 IF $PIECE(X,U)
- QUIT 1
- +9 SET E=+$$CODEN^ICPTCOD(90921)
- SET X=$$TRANI^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
- +10 IF $PIECE(X,U)
- QUIT 1
- +11 SET E=+$$CODEN^ICPTCOD(90925)
- SET X=$$TRANI^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
- +12 IF $PIECE(X,U)
- QUIT 1
- +13 QUIT ""
- 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 ;doo
- IF $PIECE(^AUPNPROB(X,0),U,13)]""
- IF $PIECE(^AUPNPROB(X,0),U,13)>EDATE
- QUIT
- +8 SET Y=$PIECE(^AUPNPROB(X,0),U)
- +9 IF $PIECE(^AUPNPROB(X,0),U,12)="I"
- QUIT
- +10 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
- QUIT
- +11 IF '$$ICD^BGP7UTL2(Y,T,9)
- QUIT
- +12 SET G=1
- +13 QUIT
- End DoDot:1
- +14 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^BGP7UTL2(%,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,BGPN2,BGPD1,BGPD2,BGPD3)=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^BGP7D211(DFN,$PIECE(^DPT(DFN,0),U,3),BGPEDATE)
- SET BGPSTOP=1
- QUIT
- +6 ;V17.1 CMI/LAB ADDED DATES FOR CURRENTLY PREGNANT
- SET X=$$PREG^BGP7D7(DFN,BGPBDATE,BGPEDATE,1,1,,BGPBDATE,BGPEDATE)
- 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 IF BGPAGEE>17
- IF BGPAGEE<60
- SET BGPD2=1
- +10 IF BGPAGEE>59
- IF BGPAGEE<86
- SET BGPD3=1
- +11 SET BGPBP=$$LASTBP(DFN,BGPBDATE,BGPEDATE)
- +12 IF BGPBP]""
- Begin DoDot:1
- +13 SET X=BGPBP
- +14 IF $PIECE(X,"/",1)<140
- IF $PIECE(X,"/",2)<90
- SET BGPN1=1
- +15 IF BGPD3
- IF $PIECE(X,"/",1)<150
- IF $PIECE(X,"/",2)<90
- SET BGPN2=1
- End DoDot:1
- VMH SET BGPVALUE="HTN PT|||"_$SELECT(BGPN1!(BGPN2):BGPBP,1:"")
- IF BGPD3
- SET BGPVALUE=BGPVALUE_$SELECT(BGPN2&('BGPN1):" (<150/90)",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,N,D,E
- +4 SET B=$$DOB^AUPNPAT(P)
- +5 ;6 months
- SET S=$$FMADD^XLFDT(BDATE,182)
- +6 SET X=$$LASTDX^BGP7UTL1(P,"BGP HYPERTENSION DXS",B,S)
- +7 SET G=0
- +8 ;no dx/PROBLEM through 1st 6 months of time period
- IF 'X
- Begin DoDot:1
- +9 SET T=$ORDER(^ATXAX("B","BGP HYPERTENSION DXS",0))
- +10 SET (X,G)=0
- FOR
- SET X=$ORDER(^AUPNPROB("AC",P,X))
- IF X'=+X!(G)
- QUIT
- Begin DoDot:2
- +11 ;Q:$P(^AUPNPROB(X,0),U,8)>S ;if added to pl after 6 MONTHS of time period, no go
- +12 ;doo after report period
- SET D=$PIECE(^AUPNPROB(X,0),U,13)
- IF D]""
- IF D>S
- QUIT
- +13 IF $PIECE(^AUPNPROB(X,0),U,13)=""
- IF $PIECE(^AUPNPROB(X,0),U,8)>S
- QUIT
- +14 SET Y=$PIECE(^AUPNPROB(X,0),U)
- +15 IF $PIECE(^AUPNPROB(X,0),U,12)="I"
- QUIT
- +16 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
- QUIT
- +17 IF $$ICD^BGP7UTL2(Y,T,9)
- Begin DoDot:3
- +18 ;during 1st 6 months, no pov needed
- IF D]""
- IF D'<BDATE
- IF D'>S
- SET G=1
- QUIT
- +19 SET E=$PIECE(^AUPNPROB(X,0),U,8)
- +20 IF E'<BDATE
- IF E'>S
- SET G=1
- QUIT
- +21 ;NEEDS POV DURING REPORT PERIOD
- SET G=2
- End DoDot:3
- +22 SET N=$$VAL^XBDIQ1(9000011,X,80001)
- IF N]""
- IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,"PXRM ESSENTIAL HYPERTENSION",N))
- Begin DoDot:3
- +23 ;during 1st 6 months, no pov needed
- IF D]""
- IF D'<BDATE
- IF D'>S
- SET G=1
- QUIT
- +24 SET E=$PIECE(^AUPNPROB(X,0),U,8)
- +25 IF E'<BDATE
- IF E'>S
- SET G=1
- QUIT
- +26 ;NEEDS POV DURING REPORT PERIOD
- SET G=2
- End DoDot:3
- +27 QUIT
- End DoDot:2
- End DoDot:1
- IF 'G
- QUIT ""
- +28 ;now did they have 1 pov in time period?
- +29 ;no need for pov in rpt period
- IF G=1
- QUIT 1
- +30 SET X=$$LASTDX^BGP7UTL1(P,"BGP HYPERTENSION DXS",BDATE,EDATE)
- +31 IF X
- QUIT 1
- +32 QUIT 0
- LASTBP(P,BDATE,EDATE) ;EP
- +1 ;TABLE ALL BPs in date order
- +2 IF $GET(F)=""
- SET F="E"
- +3 NEW BGPGLL,BGPGV,BGPG,A,B,E,Y,V,BGPBP,X,Z,BGPD
- +4 SET BGPGLL=0
- SET BGPGV=""
- +5 KILL ^TMP($JOB,"BPV")
- +6 KILL BGPBP
- +7 SET BGPD=""
- +8 SET A="^TMP($J,""BPV"","
- SET B=P_"^LAST 365 MEAS BP;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(B,A)
- +9 IF '$DATA(^TMP($JOB,"BPV",1))
- QUIT ""
- +10 ;SET UP ARRAY BY DATE
- +11 SET BGPBP=""
- +12 KILL BGPG
- +13 SET Y=0
- FOR
- SET Y=$ORDER(^TMP($JOB,"BPV",Y))
- IF Y'=+Y
- QUIT
- Begin DoDot:1
- +14 SET V=$PIECE(^TMP($JOB,"BPV",Y),U,5)
- +15 IF $$CLINIC^APCLV(V,"C")=30
- QUIT
- +16 IF $$GDEV^BGP7D2(V)
- QUIT
- +17 IF '$DATA(^AUPNVMSR("AD",V))
- QUIT
- +18 ;NOW GET ALL BPS ON THIS VISIT
- +19 SET X=0
- FOR
- SET X=$ORDER(^AUPNVMSR("AD",V,X))
- IF X'=+X
- QUIT
- Begin DoDot:2
- +20 ;BAD AD XREF
- IF '$DATA(^AUPNVMSR(X,0))
- QUIT
- +21 SET T=$PIECE($GET(^AUPNVMSR(X,0)),U)
- +22 ;BAD AD XREF
- IF T=""
- QUIT
- +23 IF $PIECE($GET(^AUTTMSR(T,0)),U)'="BP"
- QUIT
- +24 IF $PIECE($GET(^AUPNVMSR(X,2)),U,1)
- QUIT
- +25 ;use this date
- SET BGPD=(9999999-$$VD^APCLV(V))
- +26 SET BGPG(BGPD,X)=$PIECE(^AUPNVMSR(X,0),U,4)
- End DoDot:2
- End DoDot:1
- +27 KILL ^TMP($JOB,"BPV")
- +28 ;no BPS
- IF '$ORDER(BGPG(0))
- QUIT ""
- +29 ;use this date and check all
- SET BGPD=$ORDER(BGPG(0))
- +30 SET Y=0
- FOR
- SET Y=$ORDER(BGPG(BGPD,Y))
- IF Y'=+Y!(BGPBP]"")
- QUIT
- Begin DoDot:1
- +31 ;blood pressure value
- SET Z=$PIECE(BGPG(BGPD,Y),U,1)
- +32 IF $PIECE(Z,"/")<140
- IF $PIECE(Z,"/",2)<90
- SET BGPBP=Z
- QUIT
- End DoDot:1
- +33 IF BGPBP]""
- QUIT BGPBP
- +34 SET Y=0
- FOR
- SET Y=$ORDER(BGPG(BGPD,Y))
- IF Y'=+Y!(BGPBP]"")
- QUIT
- Begin DoDot:1
- +35 ;blood pressure value
- SET Z=$PIECE(BGPG(BGPD,Y),U,1)
- +36 IF $PIECE(Z,"/")<150
- IF $PIECE(Z,"/",2)<90
- SET BGPBP=Z
- QUIT
- End DoDot:1
- +37 IF BGPBP]""
- QUIT BGPBP
- +38 SET Y=0
- FOR
- SET Y=$ORDER(BGPG(BGPD,Y))
- IF Y'=+Y
- QUIT
- Begin DoDot:1
- +39 ;blood pressure value
- SET Z=$PIECE(BGPG(BGPD,Y),U,1)
- +40 SET BGPBP=Z
- End DoDot:1
- +41 KILL ^TMP($JOB,"BPV")
- +42 QUIT BGPBP