BGP4DPEF ; IHS/CMI/LAB - IHS gpra print ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
;
7 ;EP
S X=""
D S^BGP4DPED(" ",1,1) D S^BGP4DPED(" ",1,1) ;S X=$P(^BGPPEIJ(BGPIC,0),U,2) D S^BGP4DPED(X,1,1)
D H1^BGP4PDL1
D S^BGP4DPED(" ",1,1)
S BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,29)
S BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,29)
S BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,29)
I $G(BGPSEAT) S X=$P(^DIBT(BGPSEAT,0),U,1)_" Population w/ Pat Ed" D S^BGP4DPED(X,1,1)
I '$G(BGPSEAT) S X="# User Pop" D S^BGP4DPED(X,1,1)
S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S^BGP4DPED(Y,,2)
D S^BGP4DPED(" ",1,1)
S X="Goal Setting" D S^BGP4DPED(X,1,1)
S N=11,P=24 D SETN^BGP4DPED
S X="# w/goal set" D S^BGP4DPED(X,1,1)
D H2^BGP4PDL1
D S^BGP4DPED(" ",1,1)
K BGPPROVS
S N=16 D SETNM^BGP4DPEQ
K BGPX
S BGPCNT=0
S X="",C=0 F S X=$O(BGPPROVS(X)) Q:X="" S Y="" F S Y=$O(BGPPROVS(X,Y)) Q:Y="" S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
S BGP1=0 F S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPCNT>15) D
.S BGPCNT=BGPCNT+1 S BGP2=0 F S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2 D
..S X=BGPCNT_". "_$P(BGPX(BGP1,BGP2),U,2) D S^BGP4DPED(X,1,1)
..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
..D H2^BGP4PDL1
NOTSET ;
D S^BGP4DPED(" ",1,1)
S BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,29)
S BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,29)
S BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,29)
D S^BGP4DPED(" ",1,1)
S N=11,P=25 D SETN^BGP4DPED
S X="# w/goal not set" D S^BGP4DPED(X,1,1)
D H2^BGP4PDL1
D S^BGP4DPED(" ",1,1)
K BGPPROVS
S N=17 D SETNM^BGP4DPEQ
K BGPX
S BGPCNT=0
S X="",C=0 F S X=$O(BGPPROVS(X)) Q:X="" S Y="" F S Y=$O(BGPPROVS(X,Y)) Q:Y="" S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
S BGP1=0 F S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPCNT>15) D
.S BGPCNT=BGPCNT+1 S BGP2=0 F S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2 D
..S X=BGPCNT_". "_$P(BGPX(BGP1,BGP2),U,2) D S^BGP4DPED(X,1,1)
..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
..D H2^BGP4PDL1
MET ;
D S^BGP4DPED(" ",1,1)
S BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,29)
S BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,29)
S BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,29)
D S^BGP4DPED(" ",1,1)
S N=11,P=26 D SETN^BGP4DPED
S X="# w/goal met" D S^BGP4DPED(X,1,1)
D H2^BGP4PDL1
D S^BGP4DPED(" ",1,1)
K BGPPROVS
S N=18 D SETNM^BGP4DPEQ
K BGPX
S BGPCNT=0
S X="",C=0 F S X=$O(BGPPROVS(X)) Q:X="" S Y="" F S Y=$O(BGPPROVS(X,Y)) Q:Y="" S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
S BGP1=0 F S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPCNT>15) D
.S BGPCNT=BGPCNT+1 S BGP2=0 F S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2 D
..S X=BGPCNT_". "_$P(BGPX(BGP1,BGP2),U,2) D S^BGP4DPED(X,1,1)
..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
..D H2^BGP4PDL1
MAIN ;
D S^BGP4DPED(" ",1,1)
S BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,29)
S BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,29)
S BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,29)
D S^BGP4DPED(" ",1,1)
S N=11,P=27 D SETN^BGP4DPED
S X="# w/goal maintained" D S^BGP4DPED(X,1,1)
D H2^BGP4PDL1
D S^BGP4DPED(" ",1,1)
K BGPPROVS
S N=19 D SETNM^BGP4DPEQ
K BGPX
S BGPCNT=0
S X="",C=0 F S X=$O(BGPPROVS(X)) Q:X="" S Y="" F S Y=$O(BGPPROVS(X,Y)) Q:Y="" S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
S BGP1=0 F S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPCNT>15) D
.S BGPCNT=BGPCNT+1 S BGP2=0 F S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2 D
..S X=BGPCNT_". "_$P(BGPX(BGP1,BGP2),U,2) D S^BGP4DPED(X,1,1)
..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
..D H2^BGP4PDL1
NOTMET ;
D S^BGP4DPED(" ",1,1)
S BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,29)
S BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,29)
S BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,29)
D S^BGP4DPED(" ",1,1)
S N=11,P=28 D SETN^BGP4DPED
S X="# w/goal not met" D S^BGP4DPED(X,1,1)
D H2^BGP4PDL1
D S^BGP4DPED(" ",1,1)
K BGPPROVS
S N=21 D SETNM^BGP4DPEQ
K BGPX
S BGPCNT=0
S X="",C=0 F S X=$O(BGPPROVS(X)) Q:X="" S Y="" F S Y=$O(BGPPROVS(X,Y)) Q:Y="" S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
S BGP1=0 F S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPCNT>15) D
.S BGPCNT=BGPCNT+1 S BGP2=0 F S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2 D
..S X=BGPCNT_". "_$P(BGPX(BGP1,BGP2),U,2) D S^BGP4DPED(X,1,1)
..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
..D H2^BGP4PDL1
;UPPED
S X=""
D S^BGP4DPED(" ",1,1) D S^BGP4DPED(" ",1,1) ;S X=$P(^BGPPEIJ(BGPIC,0),U,2) D S^BGP4DPED(X,1,1)
D H1^BGP4PDL1
D S^BGP4DPED(" ",1,1)
S BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,19)
S BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,19)
S BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,19)
I $G(BGPSEAT) S X=$P(^DIBT(BGPSEAT,0),U,1)_" Population w/ Pat Ed" D S^BGP4DPED(X,1,1)
I '$G(BGPSEAT) S X="# User Pop w/ Pat Ed" D S^BGP4DPED(X,1,1)
S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S^BGP4DPED(Y,,2)
D S^BGP4DPED(" ",1,1)
S X="Goal Setting" D S^BGP4DPED(X,1,1)
S N=11,P=20 D SETN^BGP4DPED
S X="# w/goal set" D S^BGP4DPED(X,1,1)
D H2^BGP4PDL1
S N=11,P=21 D SETN^BGP4DPED
S X="# w/goal not set" D S^BGP4DPED(X,1,1)
D H2^BGP4PDL1
S N=11,P=22 D SETN^BGP4DPED
S X="# w/goal met" D S^BGP4DPED(X,1,1)
D H2^BGP4PDL1
S N=11,P=23 D SETN^BGP4DPED
S X="# w/goal not met" D S^BGP4DPED(X,1,1)
D H2^BGP4PDL1
Q
BGP4DPEF ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+2 ;
+3 ;
7 ;EP
+1 SET X=""
+2 ;S X=$P(^BGPPEIJ(BGPIC,0),U,2) D S^BGP4DPED(X,1,1)
DO S^BGP4DPED(" ",1,1)
DO S^BGP4DPED(" ",1,1)
+3 DO H1^BGP4PDL1
+4 DO S^BGP4DPED(" ",1,1)
+5 SET BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,29)
+6 SET BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,29)
+7 SET BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,29)
+8 IF $GET(BGPSEAT)
SET X=$PIECE(^DIBT(BGPSEAT,0),U,1)_" Population w/ Pat Ed"
DO S^BGP4DPED(X,1,1)
+9 IF '$GET(BGPSEAT)
SET X="# User Pop"
DO S^BGP4DPED(X,1,1)
+10 SET Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD
DO S^BGP4DPED(Y,,2)
+11 DO S^BGP4DPED(" ",1,1)
+12 SET X="Goal Setting"
DO S^BGP4DPED(X,1,1)
+13 SET N=11
SET P=24
DO SETN^BGP4DPED
+14 SET X="# w/goal set"
DO S^BGP4DPED(X,1,1)
+15 DO H2^BGP4PDL1
+16 DO S^BGP4DPED(" ",1,1)
+17 KILL BGPPROVS
+18 SET N=16
DO SETNM^BGP4DPEQ
+19 KILL BGPX
+20 SET BGPCNT=0
+21 SET X=""
SET C=0
FOR
SET X=$ORDER(BGPPROVS(X))
IF X=""
QUIT
SET Y=""
FOR
SET Y=$ORDER(BGPPROVS(X,Y))
IF Y=""
QUIT
SET C=C+1
SET BGPX((9999999-$PIECE(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
+22 SET BGP1=0
FOR
SET BGP1=$ORDER(BGPX(BGP1))
IF BGP1'=+BGP1!(BGPCNT>15)
QUIT
Begin DoDot:1
+23 SET BGPCNT=BGPCNT+1
SET BGP2=0
FOR
SET BGP2=$ORDER(BGPX(BGP1,BGP2))
IF BGP2'=+BGP2
QUIT
Begin DoDot:2
+24 SET X=BGPCNT_". "_$PIECE(BGPX(BGP1,BGP2),U,2)
DO S^BGP4DPED(X,1,1)
+25 SET BGPCYN=$PIECE(BGPX(BGP1,BGP2),U,3)
+26 SET BGPPRN=$PIECE(BGPX(BGP1,BGP2),U,4)
+27 SET BGPBLN=$PIECE(BGPX(BGP1,BGP2),U,5)
+28 SET BGPCYP=$PIECE(BGPX(BGP1,BGP2),U,6)
+29 SET BGPPRP=$PIECE(BGPX(BGP1,BGP2),U,7)
+30 SET BGPBLP=$PIECE(BGPX(BGP1,BGP2),U,8)
+31 DO H2^BGP4PDL1
End DoDot:2
End DoDot:1
NOTSET ;
+1 DO S^BGP4DPED(" ",1,1)
+2 SET BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,29)
+3 SET BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,29)
+4 SET BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,29)
+5 DO S^BGP4DPED(" ",1,1)
+6 SET N=11
SET P=25
DO SETN^BGP4DPED
+7 SET X="# w/goal not set"
DO S^BGP4DPED(X,1,1)
+8 DO H2^BGP4PDL1
+9 DO S^BGP4DPED(" ",1,1)
+10 KILL BGPPROVS
+11 SET N=17
DO SETNM^BGP4DPEQ
+12 KILL BGPX
+13 SET BGPCNT=0
+14 SET X=""
SET C=0
FOR
SET X=$ORDER(BGPPROVS(X))
IF X=""
QUIT
SET Y=""
FOR
SET Y=$ORDER(BGPPROVS(X,Y))
IF Y=""
QUIT
SET C=C+1
SET BGPX((9999999-$PIECE(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
+15 SET BGP1=0
FOR
SET BGP1=$ORDER(BGPX(BGP1))
IF BGP1'=+BGP1!(BGPCNT>15)
QUIT
Begin DoDot:1
+16 SET BGPCNT=BGPCNT+1
SET BGP2=0
FOR
SET BGP2=$ORDER(BGPX(BGP1,BGP2))
IF BGP2'=+BGP2
QUIT
Begin DoDot:2
+17 SET X=BGPCNT_". "_$PIECE(BGPX(BGP1,BGP2),U,2)
DO S^BGP4DPED(X,1,1)
+18 SET BGPCYN=$PIECE(BGPX(BGP1,BGP2),U,3)
+19 SET BGPPRN=$PIECE(BGPX(BGP1,BGP2),U,4)
+20 SET BGPBLN=$PIECE(BGPX(BGP1,BGP2),U,5)
+21 SET BGPCYP=$PIECE(BGPX(BGP1,BGP2),U,6)
+22 SET BGPPRP=$PIECE(BGPX(BGP1,BGP2),U,7)
+23 SET BGPBLP=$PIECE(BGPX(BGP1,BGP2),U,8)
+24 DO H2^BGP4PDL1
End DoDot:2
End DoDot:1
MET ;
+1 DO S^BGP4DPED(" ",1,1)
+2 SET BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,29)
+3 SET BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,29)
+4 SET BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,29)
+5 DO S^BGP4DPED(" ",1,1)
+6 SET N=11
SET P=26
DO SETN^BGP4DPED
+7 SET X="# w/goal met"
DO S^BGP4DPED(X,1,1)
+8 DO H2^BGP4PDL1
+9 DO S^BGP4DPED(" ",1,1)
+10 KILL BGPPROVS
+11 SET N=18
DO SETNM^BGP4DPEQ
+12 KILL BGPX
+13 SET BGPCNT=0
+14 SET X=""
SET C=0
FOR
SET X=$ORDER(BGPPROVS(X))
IF X=""
QUIT
SET Y=""
FOR
SET Y=$ORDER(BGPPROVS(X,Y))
IF Y=""
QUIT
SET C=C+1
SET BGPX((9999999-$PIECE(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
+15 SET BGP1=0
FOR
SET BGP1=$ORDER(BGPX(BGP1))
IF BGP1'=+BGP1!(BGPCNT>15)
QUIT
Begin DoDot:1
+16 SET BGPCNT=BGPCNT+1
SET BGP2=0
FOR
SET BGP2=$ORDER(BGPX(BGP1,BGP2))
IF BGP2'=+BGP2
QUIT
Begin DoDot:2
+17 SET X=BGPCNT_". "_$PIECE(BGPX(BGP1,BGP2),U,2)
DO S^BGP4DPED(X,1,1)
+18 SET BGPCYN=$PIECE(BGPX(BGP1,BGP2),U,3)
+19 SET BGPPRN=$PIECE(BGPX(BGP1,BGP2),U,4)
+20 SET BGPBLN=$PIECE(BGPX(BGP1,BGP2),U,5)
+21 SET BGPCYP=$PIECE(BGPX(BGP1,BGP2),U,6)
+22 SET BGPPRP=$PIECE(BGPX(BGP1,BGP2),U,7)
+23 SET BGPBLP=$PIECE(BGPX(BGP1,BGP2),U,8)
+24 DO H2^BGP4PDL1
End DoDot:2
End DoDot:1
MAIN ;
+1 DO S^BGP4DPED(" ",1,1)
+2 SET BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,29)
+3 SET BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,29)
+4 SET BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,29)
+5 DO S^BGP4DPED(" ",1,1)
+6 SET N=11
SET P=27
DO SETN^BGP4DPED
+7 SET X="# w/goal maintained"
DO S^BGP4DPED(X,1,1)
+8 DO H2^BGP4PDL1
+9 DO S^BGP4DPED(" ",1,1)
+10 KILL BGPPROVS
+11 SET N=19
DO SETNM^BGP4DPEQ
+12 KILL BGPX
+13 SET BGPCNT=0
+14 SET X=""
SET C=0
FOR
SET X=$ORDER(BGPPROVS(X))
IF X=""
QUIT
SET Y=""
FOR
SET Y=$ORDER(BGPPROVS(X,Y))
IF Y=""
QUIT
SET C=C+1
SET BGPX((9999999-$PIECE(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
+15 SET BGP1=0
FOR
SET BGP1=$ORDER(BGPX(BGP1))
IF BGP1'=+BGP1!(BGPCNT>15)
QUIT
Begin DoDot:1
+16 SET BGPCNT=BGPCNT+1
SET BGP2=0
FOR
SET BGP2=$ORDER(BGPX(BGP1,BGP2))
IF BGP2'=+BGP2
QUIT
Begin DoDot:2
+17 SET X=BGPCNT_". "_$PIECE(BGPX(BGP1,BGP2),U,2)
DO S^BGP4DPED(X,1,1)
+18 SET BGPCYN=$PIECE(BGPX(BGP1,BGP2),U,3)
+19 SET BGPPRN=$PIECE(BGPX(BGP1,BGP2),U,4)
+20 SET BGPBLN=$PIECE(BGPX(BGP1,BGP2),U,5)
+21 SET BGPCYP=$PIECE(BGPX(BGP1,BGP2),U,6)
+22 SET BGPPRP=$PIECE(BGPX(BGP1,BGP2),U,7)
+23 SET BGPBLP=$PIECE(BGPX(BGP1,BGP2),U,8)
+24 DO H2^BGP4PDL1
End DoDot:2
End DoDot:1
NOTMET ;
+1 DO S^BGP4DPED(" ",1,1)
+2 SET BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,29)
+3 SET BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,29)
+4 SET BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,29)
+5 DO S^BGP4DPED(" ",1,1)
+6 SET N=11
SET P=28
DO SETN^BGP4DPED
+7 SET X="# w/goal not met"
DO S^BGP4DPED(X,1,1)
+8 DO H2^BGP4PDL1
+9 DO S^BGP4DPED(" ",1,1)
+10 KILL BGPPROVS
+11 SET N=21
DO SETNM^BGP4DPEQ
+12 KILL BGPX
+13 SET BGPCNT=0
+14 SET X=""
SET C=0
FOR
SET X=$ORDER(BGPPROVS(X))
IF X=""
QUIT
SET Y=""
FOR
SET Y=$ORDER(BGPPROVS(X,Y))
IF Y=""
QUIT
SET C=C+1
SET BGPX((9999999-$PIECE(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
+15 SET BGP1=0
FOR
SET BGP1=$ORDER(BGPX(BGP1))
IF BGP1'=+BGP1!(BGPCNT>15)
QUIT
Begin DoDot:1
+16 SET BGPCNT=BGPCNT+1
SET BGP2=0
FOR
SET BGP2=$ORDER(BGPX(BGP1,BGP2))
IF BGP2'=+BGP2
QUIT
Begin DoDot:2
+17 SET X=BGPCNT_". "_$PIECE(BGPX(BGP1,BGP2),U,2)
DO S^BGP4DPED(X,1,1)
+18 SET BGPCYN=$PIECE(BGPX(BGP1,BGP2),U,3)
+19 SET BGPPRN=$PIECE(BGPX(BGP1,BGP2),U,4)
+20 SET BGPBLN=$PIECE(BGPX(BGP1,BGP2),U,5)
+21 SET BGPCYP=$PIECE(BGPX(BGP1,BGP2),U,6)
+22 SET BGPPRP=$PIECE(BGPX(BGP1,BGP2),U,7)
+23 SET BGPBLP=$PIECE(BGPX(BGP1,BGP2),U,8)
+24 DO H2^BGP4PDL1
End DoDot:2
End DoDot:1
+25 ;UPPED
+26 SET X=""
+27 ;S X=$P(^BGPPEIJ(BGPIC,0),U,2) D S^BGP4DPED(X,1,1)
DO S^BGP4DPED(" ",1,1)
DO S^BGP4DPED(" ",1,1)
+28 DO H1^BGP4PDL1
+29 DO S^BGP4DPED(" ",1,1)
+30 SET BGPCYD=$$V^BGP4DPED(1,BGPRPT,11,19)
+31 SET BGPPRD=$$V^BGP4DPED(2,BGPRPT,11,19)
+32 SET BGPBLD=$$V^BGP4DPED(3,BGPRPT,11,19)
+33 IF $GET(BGPSEAT)
SET X=$PIECE(^DIBT(BGPSEAT,0),U,1)_" Population w/ Pat Ed"
DO S^BGP4DPED(X,1,1)
+34 IF '$GET(BGPSEAT)
SET X="# User Pop w/ Pat Ed"
DO S^BGP4DPED(X,1,1)
+35 SET Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD
DO S^BGP4DPED(Y,,2)
+36 DO S^BGP4DPED(" ",1,1)
+37 SET X="Goal Setting"
DO S^BGP4DPED(X,1,1)
+38 SET N=11
SET P=20
DO SETN^BGP4DPED
+39 SET X="# w/goal set"
DO S^BGP4DPED(X,1,1)
+40 DO H2^BGP4PDL1
+41 SET N=11
SET P=21
DO SETN^BGP4DPED
+42 SET X="# w/goal not set"
DO S^BGP4DPED(X,1,1)
+43 DO H2^BGP4PDL1
+44 SET N=11
SET P=22
DO SETN^BGP4DPED
+45 SET X="# w/goal met"
DO S^BGP4DPED(X,1,1)
+46 DO H2^BGP4PDL1
+47 SET N=11
SET P=23
DO SETN^BGP4DPED
+48 SET X="# w/goal not met"
DO S^BGP4DPED(X,1,1)
+49 DO H2^BGP4PDL1
+50 QUIT
