BGP4D52 ; IHS/CMI/LAB - measure 31 ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
WASS ;
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
NEW BGPBMI,BGPNUTR,BGPPHY
I 'BGPACTCL S BGPSTOP=1 Q ;must be active clinical
I BGPAGEE<3 Q ;age at end must be 3 or older
S BGPD1=1
I BGPAGEE>2,BGPAGEE<12 S BGPD2=1
I BGPAGEE>11,BGPAGEE<18 S BGPD3=1
I BGPAGEE>17 S BGPD4=1
I BGPAGEE>2,BGPAGEE<18 S BGPD5=1
S BGPBMI=$$BMI^BGP4D6(DFN,BGPEDATE,BGPAGEE)
I BGPBMI="" S BGPBMI=$$LASTDX^BGP4UTL1(DFN,"BGP BMI DXS",BGPBDATE,BGPEDATE) I BGPBMI S BGPBMI=$P(BGPBMI,U,2)
S BGPN2=$S(BGPBMI]"":1,1:0)
S BGPNUTR=$$NUTR(DFN,BGPBDATE,BGPEDATE),BGPN3=$S(BGPNUTR]"":1,1:0)
S BGPPHY=$$PHY(DFN,BGPBDATE,BGPEDATE),BGPN4=$S(BGPPHY]"":1,1:0)
I BGPN2,BGPN3,BGPN4 S BGPN1=1
S BGPVALUE="AC|||"
S N=""
I BGPN1 S N="COMP ASSESS"
I BGPN2 D
.I N]"" S N=N_"; "
.S N=N_"BMI: "_$S('$E(BGPBMI):BGPBMI,1:$J(BGPBMI,5,2))
I BGPN3 D
.I N]"" S N=N_"; "
.S N=N_"NUTR: "_$$DATE^BGP4UTL($P(BGPNUTR,U))_" "_$P(BGPNUTR,U,2)
I BGPN4 D
.I N]"" S N=N_"; "
.S N=N_"PHY: "_$$DATE^BGP4UTL($P(BGPPHY,U))_" "_$P(BGPPHY,U,2)
S BGPVALUE=BGPVALUE_N
S BGPVALUD=BGPVALUE
Q
;
NUTR(P,BDATE,EDATE) ;EP
NEW BGPG,X,BGPALLED,Y,E,D,T,%,S
S X=P_"^LAST DX [BGP DIETARY SURVEILLANCE DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
I $D(BGPG(1)) Q $P(BGPG(1),U)_U_"DX "_$P(BGPG(1),U,2)
S BGPG=$$CPT^BGP4DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP CPT NUTRITION COUNSELING",0)),5)
I BGPG Q $P(BGPG,U,1)_U_"CPT "_$P(BGPG,U,2) ;BGPG
S Y="BGPALLED("
S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S (X,D)=0,%="",T="" F S X=$O(BGPALLED(X)) Q:X'=+X!(%]"") D
.S T=$P(^AUPNVPED(+$P(BGPALLED(X),U,4),0),U)
.Q:'T
.Q:'$D(^AUTTEDT(T,0))
.S T=$P(^AUTTEDT(T,0),U,2)
.I $P(T,"-",2)="N"!($P(T,"-",2)="DT")!($P(T,"-",2)="MNT") S %=$P(BGPALLED(X),U)_U_"EDUC: "_T Q
.S S=$P(T,"-",1)
.S S=$$ICDDX^BGP4UTL2(S)
.I $P(S,U,1)'="-1",$$ICD^BGP4UTL2($P(S,U,1),$O(^ATXAX("B","BGP DIETARY SURVEILLANCE DXS",0)),9) S %=$P(BGPALLED(X),U)_U_"EDUC: "_T Q
.S S=$P(T,"-",1),S=$$CPT^ICPTCOD(S)
.I $P(S,U,1)'="-1",$$ICD^BGP4UTL2($P(S,U,1),$O(^ATXAX("B","BGP CPT NUTRITION COUNSELING",0)),1) S %=$P(BGPALLED(X),U)_U_"EDUC: "_T Q
I %]"" Q %
Q ""
PHY(P,BDATE,EDATE) ;EP
NEW BGPG,X,E,BGPALLED,T,%,D
S X=P_"^LAST DX [BGP EXERCISE COUNSELING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
I $D(BGPG(1)) Q $P(BGPG(1),U)_U_"DX "_$P(BGPG(1),U,2)
S BGPG=$$CPT^BGP4DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP CPT PHYSICAL ACTIVITY",0)),5)
I BGPG Q $P(BGPG,U,1)_U_"CPT "_$P(BGPG,U,2) ;BGPG
S Y="BGPALLED("
S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S (X,D)=0,%="",T="" F S X=$O(BGPALLED(X)) Q:X'=+X!(%]"") D
.S T=$P(^AUPNVPED(+$P(BGPALLED(X),U,4),0),U)
.Q:'T
.Q:'$D(^AUTTEDT(T,0))
.S T=$P(^AUTTEDT(T,0),U,2)
.I $P(T,"-",2)="EX" S %=$P(BGPALLED(X),U)_U_T Q
.S S=$P(T,"-",1)
.S S=$$ICDDX^BGP4UTL2(S)
.I $P(S,U,1)'="-1",$$ICD^BGP4UTL2($P(S,U,1),$O(^ATXAX("B","BGP EXERCISE COUNSELING DXS",0)),9) S %=$P(BGPALLED(X),U)_U_T Q
.S S=$P(T,"-",1),S=$$CPT^ICPTCOD(S)
.I $P(S,U,1)'="-1",$$ICD^BGP4UTL2($P(S,U,1),$O(^ATXAX("B","BGP CPT PHYSICAL ACTIVITY",0)),1) S %=$P(BGPALLED(X),U)_U_"EDUC: "_T Q
I %]"" Q %
Q ""
EAPT(P,BDATE,EDATE,BGPDAYS,BGPGAP,BGPDAYS1) ;EP
;get all ANTIDEPRESSANTS
K ^TMP($J,"MEDS")
K BGPZ,M
S (G,N,Y,X,T,T1,T2,M,K,S,C,R,A)=""
S K=0
S Y="^TMP($J,""MEDS"",",X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S T=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT MEDS",0))
S T2=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT VA CLASS",0))
S X=0 F S X=$O(^TMP($J,"MEDS",X)) Q:X'=+X S Y=+$P(^TMP($J,"MEDS",X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'$D(^AUPNVSIT(V,0))
.S G=0
.S D=$P(^AUPNVMED(Y,0),U)
.I T,$D(^ATXAX(T,21,"B",D)) S G=1 G EAPT1
.S C=$P($G(^PSDRUG(D,0)),U,2)
.I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S G=1 G EAPT1
.Q:'G
EAPT1 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S S=$$DAYS^BGP4D82(Y,V,EDATE)
.S K=S+K ;TOTAL DAYS SUPPLY
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP4UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
.S F=$P($P(^AUPNVSIT(V,0),U),".")
.S A=$$FMADD^XLFDT(F,$P(^AUPNVMED(Y,0),U,7))
.I J]"",J<A S A=J
.S M(F)=A ;$S(J:J,1:$$FMADD^XLFDT(F,$P(^AUPNVMED(Y,0),U,7)))
;I K>83 S BGPREG=1_U_Q 1_U_" total days beta blocker: "_K
GAP ;now FIGURE OUT GAP DAYS
S G=0 ;gap days
S B=0 F S B=$O(M(B)) Q:B'=+B S E=M(B) D
.S Y=$O(M(B)) ;NEXT BEGINNING
.;I Y="" S Y=$$FMADD^XLFDT(BDATE,BGPDAYS1)
.I Y="" Q
.I Y>EDATE Q
.S Z=$$FMDIFF^XLFDT(Y,E)
.I Z>0 S G=Z+G
.Q
I G>BGPGAP!(K<BGPDAYS) Q 0_U_R_U_"DAYS="_K_", GAP="_G
Q 1_U_R_U_"DAYS="_K_", GAP="_G
BGP4D52 ; IHS/CMI/LAB - measure 31 ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+2 ;
WASS ;
+1 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
+2 NEW BGPBMI,BGPNUTR,BGPPHY
+3 ;must be active clinical
IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+4 ;age at end must be 3 or older
IF BGPAGEE<3
QUIT
+5 SET BGPD1=1
+6 IF BGPAGEE>2
IF BGPAGEE<12
SET BGPD2=1
+7 IF BGPAGEE>11
IF BGPAGEE<18
SET BGPD3=1
+8 IF BGPAGEE>17
SET BGPD4=1
+9 IF BGPAGEE>2
IF BGPAGEE<18
SET BGPD5=1
+10 SET BGPBMI=$$BMI^BGP4D6(DFN,BGPEDATE,BGPAGEE)
+11 IF BGPBMI=""
SET BGPBMI=$$LASTDX^BGP4UTL1(DFN,"BGP BMI DXS",BGPBDATE,BGPEDATE)
IF BGPBMI
SET BGPBMI=$PIECE(BGPBMI,U,2)
+12 SET BGPN2=$SELECT(BGPBMI]"":1,1:0)
+13 SET BGPNUTR=$$NUTR(DFN,BGPBDATE,BGPEDATE)
SET BGPN3=$SELECT(BGPNUTR]"":1,1:0)
+14 SET BGPPHY=$$PHY(DFN,BGPBDATE,BGPEDATE)
SET BGPN4=$SELECT(BGPPHY]"":1,1:0)
+15 IF BGPN2
IF BGPN3
IF BGPN4
SET BGPN1=1
+16 SET BGPVALUE="AC|||"
+17 SET N=""
+18 IF BGPN1
SET N="COMP ASSESS"
+19 IF BGPN2
Begin DoDot:1
+20 IF N]""
SET N=N_"; "
+21 SET N=N_"BMI: "_$SELECT('$EXTRACT(BGPBMI):BGPBMI,1:$JUSTIFY(BGPBMI,5,2))
End DoDot:1
+22 IF BGPN3
Begin DoDot:1
+23 IF N]""
SET N=N_"; "
+24 SET N=N_"NUTR: "_$$DATE^BGP4UTL($PIECE(BGPNUTR,U))_" "_$PIECE(BGPNUTR,U,2)
End DoDot:1
+25 IF BGPN4
Begin DoDot:1
+26 IF N]""
SET N=N_"; "
+27 SET N=N_"PHY: "_$$DATE^BGP4UTL($PIECE(BGPPHY,U))_" "_$PIECE(BGPPHY,U,2)
End DoDot:1
+28 SET BGPVALUE=BGPVALUE_N
+29 SET BGPVALUD=BGPVALUE
+30 QUIT
+31 ;
NUTR(P,BDATE,EDATE) ;EP
+1 NEW BGPG,X,BGPALLED,Y,E,D,T,%,S
+2 SET X=P_"^LAST DX [BGP DIETARY SURVEILLANCE DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BGPG(")
+3 IF $DATA(BGPG(1))
QUIT $PIECE(BGPG(1),U)_U_"DX "_$PIECE(BGPG(1),U,2)
+4 SET BGPG=$$CPT^BGP4DU(P,BDATE,EDATE,$ORDER(^ATXAX("B","BGP CPT NUTRITION COUNSELING",0)),5)
+5 ;BGPG
IF BGPG
QUIT $PIECE(BGPG,U,1)_U_"CPT "_$PIECE(BGPG,U,2)
+6 SET Y="BGPALLED("
+7 SET X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+8 SET (X,D)=0
SET %=""
SET T=""
FOR
SET X=$ORDER(BGPALLED(X))
IF X'=+X!(%]"")
QUIT
Begin DoDot:1
+9 SET T=$PIECE(^AUPNVPED(+$PIECE(BGPALLED(X),U,4),0),U)
+10 IF 'T
QUIT
+11 IF '$DATA(^AUTTEDT(T,0))
QUIT
+12 SET T=$PIECE(^AUTTEDT(T,0),U,2)
+13 IF $PIECE(T,"-",2)="N"!($PIECE(T,"-",2)="DT")!($PIECE(T,"-",2)="MNT")
SET %=$PIECE(BGPALLED(X),U)_U_"EDUC: "_T
QUIT
+14 SET S=$PIECE(T,"-",1)
+15 SET S=$$ICDDX^BGP4UTL2(S)
+16 IF $PIECE(S,U,1)'="-1"
IF $$ICD^BGP4UTL2($PIECE(S,U,1),$ORDER(^ATXAX("B","BGP DIETARY SURVEILLANCE DXS",0)),9)
SET %=$PIECE(BGPALLED(X),U)_U_"EDUC: "_T
QUIT
+17 SET S=$PIECE(T,"-",1)
SET S=$$CPT^ICPTCOD(S)
+18 IF $PIECE(S,U,1)'="-1"
IF $$ICD^BGP4UTL2($PIECE(S,U,1),$ORDER(^ATXAX("B","BGP CPT NUTRITION COUNSELING",0)),1)
SET %=$PIECE(BGPALLED(X),U)_U_"EDUC: "_T
QUIT
End DoDot:1
+19 IF %]""
QUIT %
+20 QUIT ""
PHY(P,BDATE,EDATE) ;EP
+1 NEW BGPG,X,E,BGPALLED,T,%,D
+2 SET X=P_"^LAST DX [BGP EXERCISE COUNSELING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BGPG(")
+3 IF $DATA(BGPG(1))
QUIT $PIECE(BGPG(1),U)_U_"DX "_$PIECE(BGPG(1),U,2)
+4 SET BGPG=$$CPT^BGP4DU(P,BDATE,EDATE,$ORDER(^ATXAX("B","BGP CPT PHYSICAL ACTIVITY",0)),5)
+5 ;BGPG
IF BGPG
QUIT $PIECE(BGPG,U,1)_U_"CPT "_$PIECE(BGPG,U,2)
+6 SET Y="BGPALLED("
+7 SET X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+8 SET (X,D)=0
SET %=""
SET T=""
FOR
SET X=$ORDER(BGPALLED(X))
IF X'=+X!(%]"")
QUIT
Begin DoDot:1
+9 SET T=$PIECE(^AUPNVPED(+$PIECE(BGPALLED(X),U,4),0),U)
+10 IF 'T
QUIT
+11 IF '$DATA(^AUTTEDT(T,0))
QUIT
+12 SET T=$PIECE(^AUTTEDT(T,0),U,2)
+13 IF $PIECE(T,"-",2)="EX"
SET %=$PIECE(BGPALLED(X),U)_U_T
QUIT
+14 SET S=$PIECE(T,"-",1)
+15 SET S=$$ICDDX^BGP4UTL2(S)
+16 IF $PIECE(S,U,1)'="-1"
IF $$ICD^BGP4UTL2($PIECE(S,U,1),$ORDER(^ATXAX("B","BGP EXERCISE COUNSELING DXS",0)),9)
SET %=$PIECE(BGPALLED(X),U)_U_T
QUIT
+17 SET S=$PIECE(T,"-",1)
SET S=$$CPT^ICPTCOD(S)
+18 IF $PIECE(S,U,1)'="-1"
IF $$ICD^BGP4UTL2($PIECE(S,U,1),$ORDER(^ATXAX("B","BGP CPT PHYSICAL ACTIVITY",0)),1)
SET %=$PIECE(BGPALLED(X),U)_U_"EDUC: "_T
QUIT
End DoDot:1
+19 IF %]""
QUIT %
+20 QUIT ""
EAPT(P,BDATE,EDATE,BGPDAYS,BGPGAP,BGPDAYS1) ;EP
+1 ;get all ANTIDEPRESSANTS
+2 KILL ^TMP($JOB,"MEDS")
+3 KILL BGPZ,M
+4 SET (G,N,Y,X,T,T1,T2,M,K,S,C,R,A)=""
+5 SET K=0
+6 SET Y="^TMP($J,""MEDS"","
SET X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+7 SET T=$ORDER(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT MEDS",0))
+8 SET T2=$ORDER(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT VA CLASS",0))
+9 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"MEDS",X))
IF X'=+X
QUIT
SET Y=+$PIECE(^TMP($JOB,"MEDS",X),U,4)
Begin DoDot:1
+10 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+11 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
+12 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+13 SET G=0
+14 SET D=$PIECE(^AUPNVMED(Y,0),U)
+15 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO EAPT1
+16 SET C=$PIECE($GET(^PSDRUG(D,0)),U,2)
+17 IF C]""
IF T2
IF $DATA(^ATXAX(T2,21,"B",C))
SET G=1
GOTO EAPT1
+18 IF 'G
QUIT
EAPT1 ;
+1 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+2 SET S=$$DAYS^BGP4D82(Y,V,EDATE)
+3 ;TOTAL DAYS SUPPLY
SET K=S+K
+4 IF R]""
SET R=R_";"
+5 SET R=R_$$DATE^BGP4UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
+6 SET F=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
+7 SET A=$$FMADD^XLFDT(F,$PIECE(^AUPNVMED(Y,0),U,7))
+8 IF J]""
IF J<A
SET A=J
+9 ;$S(J:J,1:$$FMADD^XLFDT(F,$P(^AUPNVMED(Y,0),U,7)))
SET M(F)=A
End DoDot:1
+10 ;I K>83 S BGPREG=1_U_Q 1_U_" total days beta blocker: "_K
GAP ;now FIGURE OUT GAP DAYS
+1 ;gap days
SET G=0
+2 SET B=0
FOR
SET B=$ORDER(M(B))
IF B'=+B
QUIT
SET E=M(B)
Begin DoDot:1
+3 ;NEXT BEGINNING
SET Y=$ORDER(M(B))
+4 ;I Y="" S Y=$$FMADD^XLFDT(BDATE,BGPDAYS1)
+5 IF Y=""
QUIT
+6 IF Y>EDATE
QUIT
+7 SET Z=$$FMDIFF^XLFDT(Y,E)
+8 IF Z>0
SET G=Z+G
+9 QUIT
End DoDot:1
+10 IF G>BGPGAP!(K<BGPDAYS)
QUIT 0_U_R_U_"DAYS="_K_", GAP="_G
+11 QUIT 1_U_R_U_"DAYS="_K_", GAP="_G
