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

BGP7D9.m

Go to the documentation of this file.
  1. BGP7D9 ; IHS/CMI/LAB - measure J ;
  1. ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
  1. ;
  1. ;
  1. I0303 ;EP
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN9,BGPN10,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPHOSP,BGPHTN)=0
  1. S (BGPVALUE,BGPVALUD)=""
  1. I BGPAGEB<18 S BGPSTOP=1 Q
  1. I BGPAGEB>85 S BGPSTOP=1 Q
  1. I BGPRTYPE=4 I $$ESRD^BGP7D211(DFN,$P(^DPT(DFN,0),U,3),BGPEDATE) S BGPSTOP=1 Q ;esrd anytime before end date
  1. I $$V1HTN(DFN,BGP365,BGPEDATE),$$FIRSTHTN(DFN,BGPEDATE),BGPACTCL S BGPHTN=1,BGPD1=1
  1. I 'BGPD1 S BGPSTOP=1 Q ;not in denominator
  1. I BGPAGEB>17,BGPAGEB<46 S BGPD2=1
  1. I BGPAGEB>45,BGPAGEB<86 S BGPD3=1
  1. I BGPAGEB<60 S BGPD7=1
  1. I BGPAGEB>59 S BGPD8=1
  1. S BGPVALUE=$$MEANBP^BGP7D41(DFN,BGPBDATE,BGPEDATE,1)
  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
  1. S BGPN1=$S($P(BGPVALUE,U,2):1,1:0) ;any value 2-6
  1. S BGPN2=$S($P(BGPVALUE,U,2)=2:1,1:0)
  1. S BGPN3=$S($P(BGPVALUE,U,2)=3:1,1:0)
  1. S BGPN4=$S($P(BGPVALUE,U,2)=4:1,1:0)
  1. S BGPN5=$S($P(BGPVALUE,U,2)=5:1,1:0)
  1. S BGPN6=$S($P(BGPVALUE,U,2)=6:1,1:0)
  1. S BGPN9="" I BGPN1,$P(BGPVALUE,U)'["CPT",$P(BGPVALUE,"/")<140,+$P(BGPVALUE,"/",2)<90 S BGPN9=1
  1. V S X=$$MEANBPD^BGP7D2(DFN,BGPBDATE,BGPEDATE,1,BGPAGEB)
  1. ;I X="" S X=$$BPCPT^BGP7D22(DFN,BGPBDATE,BGPEDATE,1) I X]"" D G V1
  1. ;.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")
  1. I $P(X,U,2)=4 S BGPN10=1
  1. V1 S BGPVALUE=$S(BGPD1:"HTN PT",1:"")_"|||"_$S($P(BGPVALUE,U,2)="":"",1:$P(BGPVALUE,U))
  1. I BGPRTYPE=3 S BGPVALUE=BGPVALUE_$S(BGPN9:" - CONTROLLED BP",1:"")
  1. S BGPVALUD="HTN PT|||"_$S($P(X,U,2)="":"",1:$P(X,U)) ;S BGPVALUD=BGPVALUD_$S(BGPN10:"CON",1:"UNC")
  1. K ^TMP($J,"A")
  1. Q
  1. IC2 ;EP
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
  1. I '$$MED(DFN,BGP365,BGPEDATE) S BGPSTOP=1 Q ;no meds for this patient
  1. I BGPACTUP S BGPD1=1
  1. I BGPACTCL,BGPACTUP S BGPD2=1
  1. I '(BGPD1+BGPD2) Q
  1. S BGPVALUE=$$MEDPED(DFN,BGPBDATE,BGPEDATE)
  1. I $P(BGPVALUE,U,1) S BGPN1=1
  1. ;I 'BGPN1 S BGPVALUE=$$MEDPEDRF(DFN,BGPBDATE,BGPEDATE) I $P(BGPVALUE,U,1)]"" S BGPN2=1
  1. S V=$S(BGPD1:"UP")_$S(BGPD2:",AC",1:"")
  1. S V=V_"|||"_$$DATE^BGP7UTL($P(BGPVALUE,U,1))_" "_$P(BGPVALUE,U,2)
  1. S BGPVALUE=V
  1. K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
  1. K ^TMP($J,"A")
  1. Q
  1. IMTM ;EP
  1. S (BGPN1,BGPD1)=""
  1. Q:BGPAGEB<18
  1. I '$$MED(DFN,BGP365,BGPEDATE) S BGPSTOP=1 Q ;no meds for this patient
  1. I BGPACTCL S BGPD1=1
  1. I 'BGPD1 Q
  1. S BGPVALUE=$$MTM(DFN,BGPBDATE,BGPEDATE)
  1. I $P(BGPVALUE,U,1) S BGPN1=1
  1. S V="AC"
  1. S V=V_"|||"_$P(BGPVALUE,U,2)
  1. S BGPVALUE=V
  1. K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
  1. K ^TMP($J,"A")
  1. Q
  1. MTM(P,BDATE,EDATE) ;
  1. NEW %
  1. S %=""
  1. S %=$$CPT^BGP7DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP CPT MTM",0)),5)
  1. I %]"" Q 1_U_$$DATE^BGP1UTL($P(%,U,1))_" CPT "_$P(%,U,2)
  1. ;now check clinic visits
  1. NEW G,B,C,D,V,E
  1. S G=""
  1. S B=9999999-BDATE,C=0,E=9999999-EDATE ;get inverse date and begin at edate-1 and end when greater than begin date
  1. S D=E-1,D=D_".9999" F S D=$O(^AUPNVSIT("AA",P,D)) Q:D=""!($P(D,".")>B)!(G]"") D
  1. .S V=0 F S V=$O(^AUPNVSIT("AA",P,D,V)) Q:V'=+V D
  1. ..S C=$$CLINIC^APCLV(V,"C")
  1. ..I C'="D1",C'="D2",C'="D5" Q
  1. ..S G=1_U_$$DATE^BGP7UTL($$VD^APCLV(V))_" Cl "_C
  1. I G]"" Q G
  1. Q ""
  1. ISMT ;
  1. S (BGPD1,BGPN1)=0
  1. I 'BGPACTCL Q ;only active clinical in this measure
  1. S BGPVALUE=$$LASTHF^BGP7D7(DFN,"CONFIDENCE IN MANAGING HEALTH PROBLEMS",BGPBDATE,BGPEDATE)
  1. I BGPVALUE="" Q ;not assessed
  1. S BGPD1=1
  1. I $P(BGPVALUE,U,1)="VERY SURE" S BGPN1=1
  1. S BGPVALUE="AC"_"|||"_$S(BGPN1:$P(BGPVALUE,U,2),1:"")
  1. Q
  1. ;
  1. MEDPED(P,BDATE,EDATE) ;
  1. K BGPG
  1. S Y="BGPG("
  1. S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. I '$D(BGPG(1)) Q ""
  1. S (X,P,D,E)=0,%="",T="" F S X=$O(BGPG(X)) Q:X'=+X!(E) D
  1. .Q:$P($G(^AUPNVPED(+$P(BGPG(X),U,4),0)),U,6)=5
  1. .S T=$P(^AUPNVPED(+$P(BGPG(X),U,4),0),U)
  1. .Q:'T
  1. .Q:'$D(^AUTTEDT(T,0))
  1. .S T=$P(^AUTTEDT(T,0),U,2)
  1. .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
  1. Q %
  1. ;
  1. MED(P,BDATE,EDATE) ;
  1. K ^TMP($J,"A")
  1. S Y="^TMP($J,""A"","
  1. S X=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. I '$D(^TMP($J,"A",1)) Q ""
  1. S (X,Y,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G) D
  1. .S V=$P(^TMP($J,"A",X),U,5)
  1. .Q:'$O(^AUPNVMED("AD",V,0))
  1. .Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2)
  1. .Q:$P(^AUPNVSIT(V,0),U,7)="E"
  1. .Q:$P(^AUPNVSIT(V,0),U,3)="C"
  1. .S G=1
  1. Q G
  1. ESRD(P,EDATE) ;
  1. K BGPG
  1. S Y="BGPG("
  1. S X=P_"^LAST DX [BGP ESRD DXS;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE S E=$$START1^APCLDF(X,Y)
  1. I $D(BGPG(1)) Q 1
  1. S E=+$$CODEN^ICPTCOD(90921),X=$$CPTI^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
  1. I $P(X,U) Q 1
  1. S E=+$$CODEN^ICPTCOD(90925),X=$$CPTI^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
  1. I $P(X,U) Q 1
  1. S E=+$$CODEN^ICPTCOD(90921),X=$$TRANI^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
  1. I $P(X,U) Q 1
  1. S E=+$$CODEN^ICPTCOD(90925),X=$$TRANI^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,E)
  1. I $P(X,U) Q 1
  1. Q ""
  1. FIRSTHTN(P,EDATE) ;EP
  1. S X=$$FIRSTPV(P,EDATE) I X Q 1
  1. ;now check problem list
  1. S BDATE=$$FMADD^XLFDT(EDATE,-365)
  1. S T=$O(^ATXAX("B","BGP HYPERTENSION DXS",0))
  1. S (X,G)=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G) D
  1. .Q:$P(^AUPNPROB(X,0),U,8)>BDATE ;if added to pl after beginning of time period, no go
  1. .I $P(^AUPNPROB(X,0),U,13)]"",$P(^AUPNPROB(X,0),U,13)>EDATE Q ;doo
  1. .S Y=$P(^AUPNPROB(X,0),U)
  1. .Q:$P(^AUPNPROB(X,0),U,12)="I"
  1. .Q:$P(^AUPNPROB(X,0),U,12)="D"
  1. .Q:'$$ICD^BGP7UTL2(Y,T,9)
  1. .S G=1
  1. .Q
  1. Q G
  1. FIRSTPV(P,EDATE) ;EP
  1. I $G(P)="" Q ""
  1. K BGPG
  1. S Y="BGPG("
  1. S X=P_"^FIRST DX [BGP HYPERTENSION DXS" S E=$$START1^APCLDF(X,Y)
  1. I '$D(BGPG(1)) Q ""
  1. S X=$$FMDIFF^XLFDT(EDATE,$P(BGPG(1),U))
  1. Q $S(X>365:1,1:"")
  1. ;
  1. V1HTN(P,BDATE,EDATE) ;EP
  1. I '$G(P) Q ""
  1. I '$D(^AUPNVSIT("AC",P)) Q ""
  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 ""
  1. S T=$O(^ATXAX("B","BGP HYPERTENSION DXS",0))
  1. I 'T Q ""
  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. .Q:"SAHO"'[$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^BGP7UTL2(%,T,9) S D=1
  1. .Q:'D
  1. .S G=G+1
  1. .Q
  1. Q G
  1. ;
  1. MH ;EP
  1. S (BGPN1,BGPN2,BGPD1,BGPD2,BGPD3)=0
  1. I 'BGPACTUP S BGPSTOP=1 Q
  1. I BGPAGEE<18 S BGPSTOP=1 Q
  1. I BGPAGEE>85 S BGPSTOP=1 Q
  1. I $$ESRD^BGP7D211(DFN,$P(^DPT(DFN,0),U,3),BGPEDATE) S BGPSTOP=1 Q ;esrd anytime before end date
  1. 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
  1. I '$$MHHTN(DFN,BGPBDATE,BGPEDATE) S BGPSTOP=1 Q ;no htn per definition
  1. S BGPD1=1
  1. I BGPAGEE>17,BGPAGEE<60 S BGPD2=1
  1. I BGPAGEE>59,BGPAGEE<86 S BGPD3=1
  1. S BGPBP=$$LASTBP(DFN,BGPBDATE,BGPEDATE)
  1. I BGPBP]"" D
  1. .S X=BGPBP
  1. .I $P(X,"/",1)<140,$P(X,"/",2)<90 S BGPN1=1
  1. .I BGPD3,$P(X,"/",1)<150,$P(X,"/",2)<90 S BGPN2=1
  1. VMH S BGPVALUE="HTN PT|||"_$S(BGPN1!(BGPN2):BGPBP,1:"") I BGPD3 S BGPVALUE=BGPVALUE_$S(BGPN2&('BGPN1):" (<150/90)",1:"")
  1. Q
  1. MHHTN(P,BDATE,EDATE) ;EP
  1. I '$G(P) Q ""
  1. I '$D(^DPT(P,0)) Q ""
  1. NEW S,X,B,N,D,E
  1. S B=$$DOB^AUPNPAT(P)
  1. S S=$$FMADD^XLFDT(BDATE,182) ;6 months
  1. S X=$$LASTDX^BGP7UTL1(P,"BGP HYPERTENSION DXS",B,S)
  1. S G=0
  1. I 'X D I 'G Q "" ;no dx/PROBLEM through 1st 6 months of time period
  1. .S T=$O(^ATXAX("B","BGP HYPERTENSION DXS",0))
  1. .S (X,G)=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G) D
  1. ..;Q:$P(^AUPNPROB(X,0),U,8)>S ;if added to pl after 6 MONTHS of time period, no go
  1. ..S D=$P(^AUPNPROB(X,0),U,13) I D]"",D>S Q ;doo after report period
  1. ..I $P(^AUPNPROB(X,0),U,13)="" Q:$P(^AUPNPROB(X,0),U,8)>S
  1. ..S Y=$P(^AUPNPROB(X,0),U)
  1. ..Q:$P(^AUPNPROB(X,0),U,12)="I"
  1. ..Q:$P(^AUPNPROB(X,0),U,12)="D"
  1. ..I $$ICD^BGP7UTL2(Y,T,9) D
  1. ...I D]"",D'<BDATE,D'>S S G=1 Q ;during 1st 6 months, no pov needed
  1. ...S E=$P(^AUPNPROB(X,0),U,8)
  1. ...I E'<BDATE,E'>S S G=1 Q
  1. ...S G=2 ;NEEDS POV DURING REPORT PERIOD
  1. ..S N=$$VAL^XBDIQ1(9000011,X,80001) I N]"",$D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM ESSENTIAL HYPERTENSION",N)) D
  1. ...I D]"",D'<BDATE,D'>S S G=1 Q ;during 1st 6 months, no pov needed
  1. ...S E=$P(^AUPNPROB(X,0),U,8)
  1. ...I E'<BDATE,E'>S S G=1 Q
  1. ...S G=2 ;NEEDS POV DURING REPORT PERIOD
  1. ..Q
  1. ;now did they have 1 pov in time period?
  1. I G=1 Q 1 ;no need for pov in rpt period
  1. S X=$$LASTDX^BGP7UTL1(P,"BGP HYPERTENSION DXS",BDATE,EDATE)
  1. I X Q 1
  1. Q 0
  1. LASTBP(P,BDATE,EDATE) ;EP
  1. ;TABLE ALL BPs in date order
  1. I $G(F)="" S F="E"
  1. NEW BGPGLL,BGPGV,BGPG,A,B,E,Y,V,BGPBP,X,Z,BGPD
  1. S BGPGLL=0,BGPGV=""
  1. K ^TMP($J,"BPV")
  1. K BGPBP
  1. S BGPD=""
  1. S A="^TMP($J,""BPV"",",B=P_"^LAST 365 MEAS BP;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1. I '$D(^TMP($J,"BPV",1)) Q ""
  1. ;SET UP ARRAY BY DATE
  1. S BGPBP=""
  1. K BGPG
  1. S Y=0 F S Y=$O(^TMP($J,"BPV",Y)) Q:Y'=+Y D
  1. .S V=$P(^TMP($J,"BPV",Y),U,5)
  1. .I $$CLINIC^APCLV(V,"C")=30 Q
  1. .Q:$$GDEV^BGP7D2(V)
  1. .Q:'$D(^AUPNVMSR("AD",V))
  1. .;NOW GET ALL BPS ON THIS VISIT
  1. .S X=0 F S X=$O(^AUPNVMSR("AD",V,X)) Q:X'=+X D
  1. ..Q:'$D(^AUPNVMSR(X,0)) ;BAD AD XREF
  1. ..S T=$P($G(^AUPNVMSR(X,0)),U)
  1. ..Q:T="" ;BAD AD XREF
  1. ..Q:$P($G(^AUTTMSR(T,0)),U)'="BP"
  1. ..Q:$P($G(^AUPNVMSR(X,2)),U,1)
  1. ..S BGPD=(9999999-$$VD^APCLV(V)) ;use this date
  1. ..S BGPG(BGPD,X)=$P(^AUPNVMSR(X,0),U,4)
  1. K ^TMP($J,"BPV")
  1. I '$O(BGPG(0)) Q "" ;no BPS
  1. S BGPD=$O(BGPG(0)) ;use this date and check all
  1. S Y=0 F S Y=$O(BGPG(BGPD,Y)) Q:Y'=+Y!(BGPBP]"") D
  1. .S Z=$P(BGPG(BGPD,Y),U,1) ;blood pressure value
  1. .I $P(Z,"/")<140,$P(Z,"/",2)<90 S BGPBP=Z Q
  1. I BGPBP]"" Q BGPBP
  1. S Y=0 F S Y=$O(BGPG(BGPD,Y)) Q:Y'=+Y!(BGPBP]"") D
  1. .S Z=$P(BGPG(BGPD,Y),U,1) ;blood pressure value
  1. .I $P(Z,"/")<150,$P(Z,"/",2)<90 S BGPBP=Z Q
  1. I BGPBP]"" Q BGPBP
  1. S Y=0 F S Y=$O(BGPG(BGPD,Y)) Q:Y'=+Y D
  1. .S Z=$P(BGPG(BGPD,Y),U,1) ;blood pressure value
  1. .S BGPBP=Z
  1. K ^TMP($J,"BPV")
  1. Q BGPBP