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

BGP9D41.m

Go to the documentation of this file.
  1. BGP9D41 ; IHS/CMI/LAB - measure 3 ;
  1. ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
  1. ;
  1. ;IHS/CMI/LAB - patch 1 7-7-03 added HDL and Triglyceride check to 30-1
  1. ; - fixed IMM refusal check for null reason
  1. I0302A ;EP
  1. S BGPHTN="",BGPIHD=""
  1. I BGPAGEB<22 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q ;must be active clinical
  1. S BGPIHD=$$IHD^BGP9D721(DFN,BGPBDATE,BGPEDATE)
  1. I 'BGPIHD S BGPSTOP=1 Q ;no IHD
  1. I0302ASC ;EP
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPD1,BGPD2,BGPD3,BGPD4)=0
  1. S BGPD1=1
  1. I BGPDMD2 S BGPD3=1
  1. I 'BGPDMD2 S BGPD2=1
  1. S BGPBPC=""
  1. S BGPBP=$$MEANBP(DFN,$$FMADD^XLFDT(BGPEDATE,-(2*365)),BGPEDATE)
  1. I BGPBP["unknown" S BGPBPC=$$BPCPT^BGP9D22(DFN,$$FMADD^XLFDT(BGPEDATE,-(2*365)),BGPEDATE) I BGPBPC]"" S BGPBP=$P(BGPBPC,U,2)_"^1"
  1. S BGPN1=$S($P(BGPBP,U,2):1,1:0)
  1. S BGPLDL=$$LDL^BGP9D2(DFN,$$FMADD^XLFDT(BGPEDATE,-(5*365)),BGPEDATE,1) ;date^value
  1. I $P(BGPLDL,U) S BGPN2=1 ;had ldl done
  1. S BGPTOB=$$TOBACCO(DFN,BGP365,BGPEDATE)
  1. I $P(BGPTOB,U) S BGPN3=1
  1. S BGPBMI=$$BMI^BGP9D6(DFN,BGPEDATE,BGPAGEE),BGPN4=$S(BGPBMI]"":1,1:0)
  1. S BGPBMIR="" I 'BGPN4 S BGPBMIR=$$REF^BGP9D6(DFN,BGPBDATE,BGPEDATE,BGPAGEE) I $P(BGPBMIR,U) S BGPN4=1,BGPN8=1,BGPBMIR=1_U_"BMI: ref: ht "_$$DATE^BGP9UTL($P(BGPBMIR,U,3))_" wt "_$$DATE^BGP9UTL($P(BGPBMIR,U,6))
  1. S BGPLIFE=$$LIFE(DFN,BGP365,BGPEDATE),BGPN5=$S($P(BGPLIFE,U):1,1:0)
  1. S BGPDEP=$$DEP(DFN,BGP365,BGPEDATE),BGPN6=$S($P(BGPDEP,U):1,1:0)
  1. I BGPN1,BGPN2,BGPN3,BGPN4,BGPN5 S BGPN7=1
  1. I BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,'BGPN8 S BGPN9=1
  1. I BGPN4,'BGPN8 S BGPN10=1
  1. S BGPALL=0 I BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6 S BGPALL=1
  1. S BGPDV=$S(BGPD1:"IHD",1:"")_$S(BGPD3:";AD",1:"")
  1. S BGPVALUE=BGPDV_"|||"_$S(BGPN7:"GPRA ",1:"")_$S(BGPALL:"ALL ",1:"")_$S(BGPN1:"BP: "_$P($P(BGPBP,U)," ",1,3),1:"")
  1. S %=$S($P(BGPLDL,U,2):"LDL: "_$$DATE^BGP9UTL($P(BGPLDL,U,2)),1:"")
  1. I %]"" S BGPVALUE=BGPVALUE_" "_%
  1. S %="" I $P(BGPTOB,U) S %="TOB: "_$S($P(BGPTOB,U,3)["/":$P(BGPTOB,U,3),1:$$DATE^BGP9UTL($P(BGPTOB,U,3)))_": "_$P(BGPTOB,U,2)
  1. I %]"" S BGPVALUE=BGPVALUE_" "_%
  1. S %=$S($P(BGPBMI,U)]"":"BMI: "_$J(BGPBMI,5,1),1:$P(BGPBMIR,U,2))
  1. I %]"" S BGPVALUE=BGPVALUE_" "_%
  1. S %=$S($P(BGPLIFE,U):"LIFE: "_$$DATE^BGP9UTL($P(BGPLIFE,U,2))_":"_$P(BGPLIFE,U,3),1:"")
  1. I %]"" S BGPVALUE=BGPVALUE_" "_%
  1. S %=$S($P(BGPDEP,U):"DEP: "_$P(BGPDEP,U,2),1:"")
  1. I %]"" S BGPVALUE=BGPVALUE_" "_%
  1. I $G(BGPIISO) Q
  1. K BGPBP,BGPLDL,BGPTOB,BGPBMI,BGPLIFE,BGPDEP,BGPDV
  1. Q
  1. I0302 ;EP
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
  1. ;I BGPAGEB<20 S BGPSTOP=1 Q ;no need to process
  1. I BGPACTUP,BGPAGEB>19 S BGPD1=1
  1. I BGPACTCL,BGPAGEB>19 S BGPD2=1
  1. I BGPACTCL,$$IHD^BGP9D721(DFN,BGP365,BGPEDATE) S BGPIHD=1,BGPD3=1
  1. I '(BGPD1+BGPD2+BGPD3) S BGPSTOP=1 Q ;not in any denominator
  1. BPCV ;EP - called from elder care routine
  1. S BGPVALUE=$$MEANBP(DFN,$$FMADD^XLFDT(BGPEDATE,-(2*365)),BGPEDATE)
  1. I BGPVALUE["unknown" S BGPVALUE=$$BPCPT^BGP9D22(DFN,$$FMADD^XLFDT(BGPEDATE,-(2*365)),BGPEDATE) I BGPVALUE]"" S BGPN1=1,BGPVALUE=$P(BGPVALUE,U,2) G V ;CPTS COUNT IN NUMERATOR 1 ONLY
  1. S BGPXPNV=$P(BGPVALUE,U,1),BGPXPNV=$P(BGPXPNV," ")
  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. V S BGPVALUE=$S(BGPD1:"UP;",1:"")_$S(BGPD2:"AC;",1:"")_$S(BGPD3:"IHD",1:"")_"|||"_$P(BGPVALUE,U)
  1. Q
  1. DEP(P,BDATE,EDATE) ;EP
  1. S X=$$DEP^BGP9D25(P,BDATE,EDATE) I $P(X,U) Q X
  1. S X=$$DEPSCR^BGP9D25(P,BDATE,EDATE) I $P(X,U) Q X
  1. Q ""
  1. LIFE(P,BDATE,EDATE) ;EP
  1. S X=$$MEDNUTR^BGP9D711(P,BDATE,EDATE) I X]"" Q 1_U_X
  1. S X=$$SPECNUTR^BGP9D711(P,BDATE,EDATE) I X]"" Q 1_U_X
  1. S X=$$SPECEX^BGP9D711(P,BDATE,EDATE) I X]"" Q 1_U_X
  1. S X=$$OTHREL^BGP9D711(P,BDATE,EDATE) I X]"" Q 1_U_X
  1. Q ""
  1. TOBACCO(P,BDATE,EDATE) ;EP
  1. S X=$$TOBACCO^BGP9D7(P,BDATE,EDATE) I X]"" Q 1_U_X
  1. S X=$$TOBDX(P,BDATE,EDATE) I X]"" Q 1_U_X
  1. S X=$$PED^BGP9D7(P,BDATE,EDATE) I X]"" Q 1_U_X
  1. S X=$$DENT^BGP9D7(P,BDATE,EDATE) I X]"" Q 1_U_X
  1. S X=$$CPTSM^BGP9D7(P,BDATE,EDATE) I X]"" Q 1_U_X
  1. Q ""
  1. MEANBP(P,BDATE,EDATE) ;EP
  1. S X=$$BPS(P,BDATE,EDATE,"I")
  1. S S=$$SYSMEAN(X) I S="" Q "unknown^^"
  1. S DS=$$DIAMEAN(X) I DS="" Q "unknown^^"
  1. I S>159!(DS>99) Q S_"/"_DS_" STG 2 HTN"_U_6
  1. I S>139&(S<160)!(DS>89&(DS<100)) Q S_"/"_DS_" STG 1 HTN"_U_5
  1. I S>129&(S<140)!(DS>79&(DS<90)) Q S_"/"_DS_" PRE STG II"_U_4
  1. I S>119&(S<130)!(DS=80) Q S_"/"_DS_" PRE STG 1"_U_3
  1. I S<120&(DS<80) Q S_"/"_DS_" NORMAL"_U_2
  1. Q ""
  1. ;
  1. SYSMEAN(X) ;EP
  1. I X="" Q ""
  1. S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
  1. I C<2 Q ""
  1. S T=0 F Y=1:1:3 S T=$P($P(X,";",Y),"/")+T
  1. Q T\C
  1. ;Q $$STRIP^XLFSTR($J((T/C),5,1)," ")
  1. ;
  1. DIAMEAN(X) ;EP
  1. I X="" Q ""
  1. S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
  1. I C<2 Q ""
  1. S T=0 F Y=1:1:3 S T=$P($P(X,";",Y),"/",2)+T
  1. Q T\C
  1. ;Q $$STRIP^XLFSTR($J((T/C),5,1)," ")
  1. ;
  1. BPS(P,BDATE,EDATE,F) ;EP ;
  1. I $G(F)="" S F="E"
  1. S BGPGLL=0,BGPGV=""
  1. K BGPG
  1. K ^TMP($J,"BPV")
  1. S A="^TMP($J,""BPV"",",B=P_"^LAST 365 VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1. I '$D(^TMP($J,"BPV",1)) Q ""
  1. ;S X=P_"^LAST 50 MEAS BP;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
  1. ;S BGPGL=0 F S BGPGL=$O(BGPG(BGPGL)) Q:BGPGL'=+BGPGL!(BGPGLL=3) S BGPGBP=$P($G(BGPG(BGPGL)),U,2) D
  1. S Y=0 F S Y=$O(^TMP($J,"BPV",Y)) Q:Y'=+Y!(BGPGLL=3) D
  1. .S V=$P(^TMP($J,"BPV",Y),U,5)
  1. .Q:$$CLINIC^APCLV(V,"C")=30 ;NO ER CLINIC VISITS COUNTED
  1. .Q:'$D(^AUPNVMSR("AD",V)) ;no measurements to look at
  1. .;NOW GET ALL BPS ON THIS VISIT
  1. .S BGPBP=""
  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" ;not a BP measurement type
  1. ..S Z=$P(^AUPNVMSR(X,0),U,4) ;blood pressure value
  1. ..I BGPBP="" S BGPBP=Z Q
  1. ..I $P(Z,"/")'>$P(BGPBP,"/") S BGPBP=Z
  1. .Q:BGPBP=""
  1. .S BGPGLL=BGPGLL+1
  1. .I F="E" S $P(BGPGV,";",BGPGLL)=BGPBP_" "_$$FMTE^XLFDT($P(^TMP($J,"BPV",V),U))
  1. .I F="I" S $P(BGPGV,";",BGPGLL)=$P(BGPBP," ")
  1. K ^TMP($J,"BPV")
  1. Q BGPGV
  1. TOBDX(P,BDATE,EDATE) ;EP
  1. K BGPG
  1. S X=P_"^LAST DX [BGP GPRA SMOKING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
  1. I $D(BGPG(1)) Q $P(BGPG(1),U,2)_U_$P(BGPG(1),U)
  1. ;S X=P_"^LAST DX V15.82;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
  1. ;I $D(BGPG(1)) Q $P(BGPG(1),U,2)_U_$P(BGPG(1),U)
  1. S X=0,G="" F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G]"") D
  1. .Q:$P(^AUPNPROB(X,0),U,12)'="A"
  1. .Q:$P(^AUPNPROB(X,0),U,3)>EDATE
  1. .Q:$P(^AUPNPROB(X,0),U,3)<BDATE
  1. .S Y=$P(^AUPNPROB(X,0),U)
  1. .I $E($P($$ICDDX^ICDCODE(Y),U,2),1,5)'="305.1",$P($$ICDDX^ICDCODE(Y),U,2)'="V15.82" Q
  1. .S G=$P($$ICDDX^ICDCODE(Y),U,2)_" PL"
  1. .Q
  1. Q G