BQIIPCBP ;GDIT/HS/ALA-IPC Blood Pressure ; 21 Oct 2014 12:00 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**5**;Apr 18, 2012;Build 17
;
PAT(DFN) ;EP
I '$$VTHR^BQIUL1(DFN) Q "NDA"
NEW HTN,CVD
S HTN=$$ATAG^BQITDUTL(DFN,"Hypertension")
S CVD=$$ATAG^BQITDUTL(DFN,"CVD Known")
I 'CVD D
. S CVD=$$ATAG^BQITDUTL(DFN,"CVD Highest Risk")
. ;I 'CVD S CVD=$$ATAG^BQITDUTL(DFN,"CVD Significant Risk")
I 'HTN,'CVD Q "N/A"
;
NEW BGPVALUE,BGPVALUD,BGPBP,BDT,EDT,BGPN1,BGPN2,BPGN3,BGPN4,BGPN5,AGE
S BGPVALUE="",BGPVALUD="",BGPBP="",BGPN5=0
S BDT=$$DATE^BQIUL1("T-12M"),EDT=DT
S AGE=$$AGE^BQIAGE(DFN,"")
;
I AGE<18 Q "N/A"
;
S BGPVALUE=$$MEANBP(DFN,BDT,EDT)
I BGPVALUE'="" D
. I CVD Q
. I 'HTN Q
. I AGE>59 S BGPN5=$S($P(BGPVALUE,U,2)=5:1,1:0)
I BGPVALUE="" S BGPBP=$$BPCPT(DFN,BDT,EDT) I BGPBP]"" S BGPN1=1 D G BPX
. S (BGPN2,BGPN4)=$S($P(BGPBP,U)=1:1,1:0),BGPN3=$S('$P(BGPBP,U):1,1:0)
S BGPN1=$S($P(BGPVALUE,U,2):1,1:0)
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)
I BGPN2 S BGPN4=1 ;IF <130/80 THEN ALSO IS <140/90
I BGPN5 S BGPN4=1 ;IF <150/90 and age then is equivalent to in control
BPX ;
I BGPN4 Q "YES"
Q "NO"
;
MEANBP(P,BDATE,EDATE,GDEV) ;EP
NEW X,S,DS
S GDEV=$G(GDEV)
S X=$$BPS(P,BDATE,EDATE,"I",GDEV)
S S=$$SYSMEAN(X) I S="" Q ""
S DS=$$DIAMEAN(X) I DS="" Q ""
I S<130&(DS<80) Q S_"/"_DS_U_2
I S<140&(DS<90) Q S_"/"_DS_U_4
I S<150&(DS<90) Q S_"/"_DS_U_5
Q S_"/"_DS_U_3
;
SYSMEAN(X) ;EP
NEW Y,C,T
I X="" Q ""
S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
I C<2 Q ""
S T=0 F Y=1:1:3 S T=$P($P(X,";",Y),"/")+T
Q T\C
;
DIAMEAN(X) ;EP
NEW C,Y,T
I X="" Q ""
S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
I C<2 Q ""
S T=0 F Y=1:1:3 S T=$P($P(X,";",Y),"/",2)+T
;Q $$STRIP^XLFSTR($J((T/C),5,1)," ")
Q T\C
;
GDEV(V) ;EP
I $P(^AUPNVSIT(V,0),U,7)="H" Q 1
I $P(^AUPNVSIT(V,0),U,7)="I" Q 1
I $P(^AUPNVSIT(V,0),U,7)="S" Q 1
I $P(^AUPNVSIT(V,0),U,7)="O" Q 1
NEW C
S C=$$CLINIC^APCLV(V,"C")
I C=30 Q 1
I C=23 Q 1
I C=44 Q 1
I C="C1" Q 1
I C="D4" Q 1
Q 0
;
BPS(P,BDATE,EDATE,F,GDEV) ;EP ;
I $G(F)="" S F="E"
NEW BGPGLL,BGPGV,BGPG,A,B,E,Y,V,BGPBP,X,Z
S BGPGLL=0,BGPGV=""
K BGPG
K ^TMP($J,"BPV")
S A="^TMP($J,""BPV"",",B=P_"^LAST 365 VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"BPV",1)) Q ""
S Y=0 F S Y=$O(^TMP($J,"BPV",Y)) Q:Y'=+Y!(BGPGLL=3) D
.S V=$P(^TMP($J,"BPV",Y),U,5)
.Q:$$CLINIC^APCLV(V,"C")=30
.Q:$$GDEV(V)
.Q:'$D(^AUPNVMSR("AD",V))
.;NOW GET ALL BPS ON THIS VISIT
.S BGPBP=""
.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) ;entered in error so skip it
..S Z=$P(^AUPNVMSR(X,0),U,4) ;blood pressure value
..I BGPBP="" S BGPBP=Z Q
..I $P(Z,"/")'>$P(BGPBP,"/") S BGPBP=Z
.Q:BGPBP=""
.S BGPGLL=BGPGLL+1
.I F="E" S $P(BGPGV,";",BGPGLL)=BGPBP_" "_$$FMTE^XLFDT($P(^TMP($J,"BPV",Y),U))
.I F="I" S $P(BGPGV,";",BGPGLL)=$P(BGPBP," ")
K ^TMP($J,"BPV")
Q BGPGV
;
BPCPT(P,BDATE,EDATE,GDEV) ;EP
NEW S,D,C,E,BGPG,X,Y,G,T,M,A,Z,L
K BGPG S Y="BGPG(",X=P_"^ALL VISIT;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,Y)
S X=0,G="" F S X=$O(BGPG(X)) Q:X'=+X D
.S V=$P(BGPG(X),U,5)
.Q:'$D(^AUPNVSIT(V,0))
.Q:$$CLINIC^APCLV(V,"C")=30
.Q:$$GDEV^BGP4D2(V)
.S E=0 F S E=$O(^AUPNVCPT("AD",V,E)) Q:E'=+E D
..S C=$P($G(^AUPNVCPT(E,0)),U)
..I 'C Q
..S D=$P($P(^AUPNVSIT(V,0),U),"."),D=(9999999-D)_"."_$P(D,".",2)
..I $$ICD^BGP4UTL2(C,$O(^ATXAX("B","BGP SYSTOLIC BP CPTS",0)),1) D
...S Y=$P($$CPT^ICPTCOD(C),U,2)
...S:'$D(S(D)) S(D)=Y,A(D)=Y_U_"S"
...I +S(D)>+Y S S(D)=Y
..I $$ICD^BGP4UTL2(C,$O(^ATXAX("B","BGP DIASTOLIC BP CPTS",0)),1) D
...S Y=$P($$CPT^ICPTCOD(C),U,2)
...S:'$D(T(D)) T(D)=Y,A(D)=Y_U_"T"
...I +T(D)>+Y S T(D)=Y
..I $$ICD^BGP4UTL2(C,$O(^ATXAX("B","BGP BP MEASURED CPT",0)),1) D
...S Y=$P($$CPT^ICPTCOD(C),U,2)
...S:'$D(M(D)) M(D)=Y,A(D)=Y_U_"M"
.S E=0 F S E=$O(^AUPNVPOV("AD",V,E)) Q:E'=+E D
..S Y=$$VAL^XBDIQ1(9000010.07,E,.01)
..I Y="" Q
..Q:'$$ICD^BGP4UTL2($$VALI^XBDIQ1(9000010.07,E,.01),$O(^ATXAX("B","BGP HYPERTENSION SCREEN DXS",0)),9)
..S D=$P($P(^AUPNVSIT(V,0),U),"."),D=(9999999-D)_"."_$P(D,".",2)
..S:'$D(M(D)) M(D)=Y,A(D)=Y_U_"M"
I '$D(S),'$D(T),'$D(M) Q "" ;
S L=$O(A(0)),Z=$P(A(L),U,2) I Z="M" Q 0_U_$P(A(L),U,1)
S S=$O(S(0)) I S S S=S(S)
S D=$O(T(0)) I D S D=T(D)
I S=""!(D="") Q 0_U_S_"/"_D
I S="3074F"!(S="3075F"),D="3078F"!(D="3079F") Q 1_U_S_"/"_D
Q 0_U_S_"/"_D
BQIIPCBP ;GDIT/HS/ALA-IPC Blood Pressure ; 21 Oct 2014 12:00 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**5**;Apr 18, 2012;Build 17
+2 ;
PAT(DFN) ;EP
+1 IF '$$VTHR^BQIUL1(DFN)
QUIT "NDA"
+2 NEW HTN,CVD
+3 SET HTN=$$ATAG^BQITDUTL(DFN,"Hypertension")
+4 SET CVD=$$ATAG^BQITDUTL(DFN,"CVD Known")
+5 IF 'CVD
Begin DoDot:1
+6 SET CVD=$$ATAG^BQITDUTL(DFN,"CVD Highest Risk")
+7 ;I 'CVD S CVD=$$ATAG^BQITDUTL(DFN,"CVD Significant Risk")
End DoDot:1
+8 IF 'HTN
IF 'CVD
QUIT "N/A"
+9 ;
+10 NEW BGPVALUE,BGPVALUD,BGPBP,BDT,EDT,BGPN1,BGPN2,BPGN3,BGPN4,BGPN5,AGE
+11 SET BGPVALUE=""
SET BGPVALUD=""
SET BGPBP=""
SET BGPN5=0
+12 SET BDT=$$DATE^BQIUL1("T-12M")
SET EDT=DT
+13 SET AGE=$$AGE^BQIAGE(DFN,"")
+14 ;
+15 IF AGE<18
QUIT "N/A"
+16 ;
+17 SET BGPVALUE=$$MEANBP(DFN,BDT,EDT)
+18 IF BGPVALUE'=""
Begin DoDot:1
+19 IF CVD
QUIT
+20 IF 'HTN
QUIT
+21 IF AGE>59
SET BGPN5=$SELECT($PIECE(BGPVALUE,U,2)=5:1,1:0)
End DoDot:1
+22 IF BGPVALUE=""
SET BGPBP=$$BPCPT(DFN,BDT,EDT)
IF BGPBP]""
SET BGPN1=1
Begin DoDot:1
+23 SET (BGPN2,BGPN4)=$SELECT($PIECE(BGPBP,U)=1:1,1:0)
SET BGPN3=$SELECT('$PIECE(BGPBP,U):1,1:0)
End DoDot:1
GOTO BPX
+24 SET BGPN1=$SELECT($PIECE(BGPVALUE,U,2):1,1:0)
+25 SET BGPN2=$SELECT($PIECE(BGPVALUE,U,2)=2:1,1:0)
+26 SET BGPN3=$SELECT($PIECE(BGPVALUE,U,2)=3:1,1:0)
+27 SET BGPN4=$SELECT($PIECE(BGPVALUE,U,2)=4:1,1:0)
+28 ;IF <130/80 THEN ALSO IS <140/90
IF BGPN2
SET BGPN4=1
+29 ;IF <150/90 and age then is equivalent to in control
IF BGPN5
SET BGPN4=1
BPX ;
+1 IF BGPN4
QUIT "YES"
+2 QUIT "NO"
+3 ;
MEANBP(P,BDATE,EDATE,GDEV) ;EP
+1 NEW X,S,DS
+2 SET GDEV=$GET(GDEV)
+3 SET X=$$BPS(P,BDATE,EDATE,"I",GDEV)
+4 SET S=$$SYSMEAN(X)
IF S=""
QUIT ""
+5 SET DS=$$DIAMEAN(X)
IF DS=""
QUIT ""
+6 IF S<130&(DS<80)
QUIT S_"/"_DS_U_2
+7 IF S<140&(DS<90)
QUIT S_"/"_DS_U_4
+8 IF S<150&(DS<90)
QUIT S_"/"_DS_U_5
+9 QUIT S_"/"_DS_U_3
+10 ;
SYSMEAN(X) ;EP
+1 NEW Y,C,T
+2 IF X=""
QUIT ""
+3 SET C=0
FOR Y=1:1:3
IF $PIECE(X,";",Y)]""
SET C=C+1
+4 IF C<2
QUIT ""
+5 SET T=0
FOR Y=1:1:3
SET T=$PIECE($PIECE(X,";",Y),"/")+T
+6 QUIT T\C
+7 ;
DIAMEAN(X) ;EP
+1 NEW C,Y,T
+2 IF X=""
QUIT ""
+3 SET C=0
FOR Y=1:1:3
IF $PIECE(X,";",Y)]""
SET C=C+1
+4 IF C<2
QUIT ""
+5 SET T=0
FOR Y=1:1:3
SET T=$PIECE($PIECE(X,";",Y),"/",2)+T
+6 ;Q $$STRIP^XLFSTR($J((T/C),5,1)," ")
+7 QUIT T\C
+8 ;
GDEV(V) ;EP
+1 IF $PIECE(^AUPNVSIT(V,0),U,7)="H"
QUIT 1
+2 IF $PIECE(^AUPNVSIT(V,0),U,7)="I"
QUIT 1
+3 IF $PIECE(^AUPNVSIT(V,0),U,7)="S"
QUIT 1
+4 IF $PIECE(^AUPNVSIT(V,0),U,7)="O"
QUIT 1
+5 NEW C
+6 SET C=$$CLINIC^APCLV(V,"C")
+7 IF C=30
QUIT 1
+8 IF C=23
QUIT 1
+9 IF C=44
QUIT 1
+10 IF C="C1"
QUIT 1
+11 IF C="D4"
QUIT 1
+12 QUIT 0
+13 ;
BPS(P,BDATE,EDATE,F,GDEV) ;EP ;
+1 IF $GET(F)=""
SET F="E"
+2 NEW BGPGLL,BGPGV,BGPG,A,B,E,Y,V,BGPBP,X,Z
+3 SET BGPGLL=0
SET BGPGV=""
+4 KILL BGPG
+5 KILL ^TMP($JOB,"BPV")
+6 SET A="^TMP($J,""BPV"","
SET B=P_"^LAST 365 VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+7 IF '$DATA(^TMP($JOB,"BPV",1))
QUIT ""
+8 SET Y=0
FOR
SET Y=$ORDER(^TMP($JOB,"BPV",Y))
IF Y'=+Y!(BGPGLL=3)
QUIT
Begin DoDot:1
+9 SET V=$PIECE(^TMP($JOB,"BPV",Y),U,5)
+10 IF $$CLINIC^APCLV(V,"C")=30
QUIT
+11 IF $$GDEV(V)
QUIT
+12 IF '$DATA(^AUPNVMSR("AD",V))
QUIT
+13 ;NOW GET ALL BPS ON THIS VISIT
+14 SET BGPBP=""
+15 SET X=0
FOR
SET X=$ORDER(^AUPNVMSR("AD",V,X))
IF X'=+X
QUIT
Begin DoDot:2
+16 ;BAD AD XREF
IF '$DATA(^AUPNVMSR(X,0))
QUIT
+17 SET T=$PIECE($GET(^AUPNVMSR(X,0)),U)
+18 ;BAD AD XREF
IF T=""
QUIT
+19 IF $PIECE($GET(^AUTTMSR(T,0)),U)'="BP"
QUIT
+20 ;entered in error so skip it
IF $PIECE($GET(^AUPNVMSR(X,2)),U,1)
QUIT
+21 ;blood pressure value
SET Z=$PIECE(^AUPNVMSR(X,0),U,4)
+22 IF BGPBP=""
SET BGPBP=Z
QUIT
+23 IF $PIECE(Z,"/")'>$PIECE(BGPBP,"/")
SET BGPBP=Z
End DoDot:2
+24 IF BGPBP=""
QUIT
+25 SET BGPGLL=BGPGLL+1
+26 IF F="E"
SET $PIECE(BGPGV,";",BGPGLL)=BGPBP_" "_$$FMTE^XLFDT($PIECE(^TMP($JOB,"BPV",Y),U))
+27 IF F="I"
SET $PIECE(BGPGV,";",BGPGLL)=$PIECE(BGPBP," ")
End DoDot:1
+28 KILL ^TMP($JOB,"BPV")
+29 QUIT BGPGV
+30 ;
BPCPT(P,BDATE,EDATE,GDEV) ;EP
+1 NEW S,D,C,E,BGPG,X,Y,G,T,M,A,Z,L
+2 KILL BGPG
SET Y="BGPG("
SET X=P_"^ALL VISIT;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,Y)
+3 SET X=0
SET G=""
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
Begin DoDot:1
+4 SET V=$PIECE(BGPG(X),U,5)
+5 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+6 IF $$CLINIC^APCLV(V,"C")=30
QUIT
+7 IF $$GDEV^BGP4D2(V)
QUIT
+8 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AD",V,E))
IF E'=+E
QUIT
Begin DoDot:2
+9 SET C=$PIECE($GET(^AUPNVCPT(E,0)),U)
+10 IF 'C
QUIT
+11 SET D=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
SET D=(9999999-D)_"."_$PIECE(D,".",2)
+12 IF $$ICD^BGP4UTL2(C,$ORDER(^ATXAX("B","BGP SYSTOLIC BP CPTS",0)),1)
Begin DoDot:3
+13 SET Y=$PIECE($$CPT^ICPTCOD(C),U,2)
+14 IF '$DATA(S(D))
SET S(D)=Y
SET A(D)=Y_U_"S"
+15 IF +S(D)>+Y
SET S(D)=Y
End DoDot:3
+16 IF $$ICD^BGP4UTL2(C,$ORDER(^ATXAX("B","BGP DIASTOLIC BP CPTS",0)),1)
Begin DoDot:3
+17 SET Y=$PIECE($$CPT^ICPTCOD(C),U,2)
+18 IF '$DATA(T(D))
SET T(D)=Y
SET A(D)=Y_U_"T"
+19 IF +T(D)>+Y
SET T(D)=Y
End DoDot:3
+20 IF $$ICD^BGP4UTL2(C,$ORDER(^ATXAX("B","BGP BP MEASURED CPT",0)),1)
Begin DoDot:3
+21 SET Y=$PIECE($$CPT^ICPTCOD(C),U,2)
+22 IF '$DATA(M(D))
SET M(D)=Y
SET A(D)=Y_U_"M"
End DoDot:3
End DoDot:2
+23 SET E=0
FOR
SET E=$ORDER(^AUPNVPOV("AD",V,E))
IF E'=+E
QUIT
Begin DoDot:2
+24 SET Y=$$VAL^XBDIQ1(9000010.07,E,.01)
+25 IF Y=""
QUIT
+26 IF '$$ICD^BGP4UTL2($$VALI^XBDIQ1(9000010.07,E,.01),$ORDER(^ATXAX("B","BGP HYPERTENSION SCREEN DXS",0)),9)
QUIT
+27 SET D=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
SET D=(9999999-D)_"."_$PIECE(D,".",2)
+28 IF '$DATA(M(D))
SET M(D)=Y
SET A(D)=Y_U_"M"
End DoDot:2
End DoDot:1
+29 ;
IF '$DATA(S)
IF '$DATA(T)
IF '$DATA(M)
QUIT ""
+30 SET L=$ORDER(A(0))
SET Z=$PIECE(A(L),U,2)
IF Z="M"
QUIT 0_U_$PIECE(A(L),U,1)
+31 SET S=$ORDER(S(0))
IF S
SET S=S(S)
+32 SET D=$ORDER(T(0))
IF D
SET D=T(D)
+33 IF S=""!(D="")
QUIT 0_U_S_"/"_D
+34 IF S="3074F"!(S="3075F")
IF D="3078F"!(D="3079F")
QUIT 1_U_S_"/"_D
+35 QUIT 0_U_S_"/"_D
