- 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
