BGP2PDLO ; IHS/CMI/LAB - IHS gpra print ;
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;
S(Y,F,P) ;EP set up array
I '$G(F) S F=0
S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
S $P(^TMP($J,"BGPDEL",%),U,P)=Y
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q X
OTHSUM ;EP
I BGPRTYPE'=7 Q ;national gpra only
Q:$G(BGPCPPL)
I $G(BGPNPL) Q ;not on lists
S BGPQUIT="",BGPGPG=0
S BGPSUMP=1
D HEADER^BGP2PDL
D:'$G(BGPSUMON) H1
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL OTHER",BGPC)) Q:BGPC'=+BGPC D
.S X=" " D S(X,1,1)
.S BGPC1=$O(^BGPSCAT("D",BGPC,0))
.S X=$P(^BGPSCAT(BGPC1,0),U,1) D S(X,1,1)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,0))
..S X=""
..I $P(^BGPINDWC(BGPPC,0),U,4)["014.A"!($P(^BGPINDWC(BGPPC,0),U,4)["023.")!($P(^BGPINDWC(BGPPC,0),U,4)["016")!($P($G(^BGPINDWC(BGPPC,19)),U,13)) D I 1
...S X=" "_$P(^BGPINDWC(BGPPC,19),U,4)
...I $P(^BGPINDWC(BGPPC,19),U,7)]"" D S(X,1,1) S X=" "_$P(^BGPINDWC(BGPPC,19),U,7)
...S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U)
...S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,2)
...S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,3)
...S $P(X,U,5)=$P(^BGPINDWC(BGPPC,19),U,2),$P(X,U,6)=$P(^BGPINDWC(BGPPC,19),U,3)
...D S(X,1,1)
..E D
...S X=" "_$P(^BGPINDWC(BGPPC,19),U,4)
...I $P(^BGPINDWC(BGPPC,19),U,7)]"" D S(X,1,1) S X=" "_$P(^BGPINDWC(BGPPC,19),U,7)
...S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U)_"%"
...S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,2)_"%"
...S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,3)_"%"
...S $P(X,U,5)=$TR($P(^BGPINDWC(BGPPC,19),U,2),"$","^"),$P(X,U,6)=$P(^BGPINDWC(BGPPC,19),U,3)
...D S(X,1,1)
...S X="" I $P(^BGPINDWC(BGPPC,19),U,9)]""!($P(^BGPINDWC(BGPPC,19),U,10)]"")!($P(^BGPINDWC(BGPPC,19),U,11)]"") S $P(X,U,5)=$TR($P(^BGPINDWC(BGPPC,19),U,10),"$","^") D
....S $P(X,U,6)=$P(^BGPINDWC(BGPPC,19),U,11)
...I X]"" D S(X,1,1)
D SDP
Q
;
H1 ;
S X=" " D S(X,2,1)
S X="SELECTED OTHER NATIONAL MEASURES CLINICAL PERFORMANCE SUMMARY" D S(X,3,1)
I $G(BGPAREAA) S X="",$P(X,U,2)=" Area",$P(X,U,3)=" Area",$P(X,U,4)=" Area",$P(X,U,5)="Nat'l",$P(X,U,6)="2012" D S(X,1,1)
I '$G(BGPAREAA) S X="",$P(X,U,2)=" Site",$P(X,U,3)=" Site",$P(X,U,4)=" Site",$P(X,U,5)="Nat'l",$P(X,U,6)="2012" D S(X,1,1)
S X="",$P(X,U,2)="Current",$P(X,U,3)="Previous",$P(X,U,4)="Baseline",$P(X,U,5)="2011",$P(X,U,6)="Target" D S(X,1,1)
S X=$TR($J("",80)," ","-") D S(X,1,1)
Q
H2 ;
S X=" " D S(X,2,1)
S X="SELECTED OTHER NATIONAL MEASURES CLINICAL PERFORMANCE DETAIL" D S(X,2,1)
S X="",$P(X,U,2)=" Site",$P(X,U,3)=" Site",$P(X,U,4)=" Site",$P(X,U,5)="Area",$P(X,U,6)="National",$P(X,U,7)="2012" D S(X,1,1)
S X="",$P(X,U,2)="Current",$P(X,U,3)="Previous",$P(X,U,4)="Baseline",$P(X,U,5)="Current",$P(X,U,6)="2011",$P(X,U,7)="Target" D S(X,1,1)
S X=$TR($J("",80)," ","-") D S(X,1,1)
Q
SDPX ;
I BGPRTYPE'=7 Q ;national gpra only
I '$G(BGPAREAA) Q
S BGPQUIT="",BGPGPG=0
S BGPSUMP=1
S X=" " D S(X,2,1)
D HEADER^BGP2PDL
D H2
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC)) Q:BGPC'=+BGPC D
.S X=" " D S(X,1,1)
.S BGPC1=$O(^BGPSCAT("D",BGPC,0))
.S X=$P(^BGPSCAT(BGPC1,0),U,1) D S(X,1,1)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,0))
..S X=" " D S(X,1,1)
..S XX=" "_$P(^BGPINDWC(BGPPC,19),U,4)
..I $P(^BGPINDWC(BGPPC,19),U,7)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDWC(BGPPC,19),U,7)
..I $P(^BGPINDWC(BGPPC,19),U,12)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDWC(BGPPC,19),U,12)
..S F=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,0))
..S F=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,F),U,4)
..S $P(XX,U,5)=$P(^BGPINDWC(BGPPC,19),U,2),$P(XX,U,6)=$P(^BGPINDWC(BGPPC,19),U,3)
..S BGPSN=0,BGPCNT=0 F S BGPSN=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN S BGPCNT=BGPCNT+1 D
...S BGPSASU=$P(^BGPGPDCW(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCW(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
...I $P(^BGPINDWC(BGPPC,0),U,4)["014.A"!($P(^BGPINDWC(BGPPC,0),U,4)["023.")!($P(^BGPINDWC(BGPPC,0),U,4)["016")!($P($G(^BGPINDWC(BGPPC,19)),U,13)) D I 1
....S X="",$P(X,U,1)=BGPSASU_" "_BGPSNAM
....S $P(X,U,2)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U)
....S $P(X,U,3)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,2)
....S $P(X,U,4)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,3)
...E D
....S $P(X,U,1)=BGPSASU_" "_BGPSNAM
....S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
...I BGPCNT=1 D S(XX,1,1) D
....S Y="" I $P(^BGPINDWC(BGPPC,19),U,9)]""!($P(^BGPINDWC(BGPPC,19),U,10)]"")!($P(^BGPINDWC(BGPPC,19),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDWC(BGPPC,19),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDWC(BGPPC,19),U,10),"$","^") D
.....S $P(Y,U,8)=$P(^BGPINDWC(BGPPC,19),U,11)
....I Y]"" D S(Y,1,1)
...D S(X,1,1)
Q
SDP ;
I BGPRTYPE'=7 Q
I '$G(BGPAREAA) Q ;area only
S BGPQUIT="",BGPGPG=0
S BGPSUMP=1
S X=" " D S(X,2,1)
D HEADER^BGP2PDL
D H2
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC)) Q:BGPC'=+BGPC D
.S X=" " D S(X,1,1)
.S BGPC1=$O(^BGPSCAT("D",BGPC,0))
.S X=$P(^BGPSCAT(BGPC1,0),U,1) D S(X,1,1)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,0))
..S X=" " D S(X,1,1)
..S XX=" "_$P(^BGPINDWC(BGPPC,19),U,4)
..I $P(^BGPINDWC(BGPPC,19),U,7)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDWC(BGPPC,19),U,7)
..I $P(^BGPINDWC(BGPPC,19),U,12)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDWC(BGPPC,19),U,12)
..S F=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,0))
..S F=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,F),U,4)
..S $P(XX,U,5)=F_$S($P(^BGPINDWC(BGPPC,0),U,4)["014.A"!($P(^BGPINDWC(BGPPC,0),U,4)["023.")!($P(^BGPINDWC(BGPPC,0),U,4)="016.A.1")!($P($G(^BGPINDWC(BGPPC,19)),U,13)):"",1:"%")
..S $P(XX,U,6)=$P(^BGPINDWC(BGPPC,19),U,2),$P(XX,U,7)=$P(^BGPINDWC(BGPPC,19),U,3)
..S BGPSN=0,BGPCNT=0 F S BGPSN=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN S BGPCNT=BGPCNT+1 D
...S BGPSASU=$P(^BGPGPDCW(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCW(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
...I $P(^BGPINDWC(BGPPC,0),U,4)["014.A"!($P(^BGPINDWC(BGPPC,0),U,4)["023.")!($P(^BGPINDWC(BGPPC,0),U,4)["016")!($P($G(^BGPINDWC(BGPPC,19)),U,13)) D I 1
....S X="",$P(X,U,1)=BGPSASU_" "_BGPSNAM
....S $P(X,U,2)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U)
....S $P(X,U,3)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,2)
....S $P(X,U,4)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,3)
....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,4)
...E D
....S $P(X,U,1)=BGPSASU_" "_BGPSNAM
....S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
....;S $P(X,U,5)=$P(^BGPINDWC(BGPPC,19),U,2),$P(X,U,6)=$P(^BGPINDWC(BGPPC,19),U,3)
...I BGPCNT=1 D S(XX,1,1) D
....;S Y="" I $P(^BGPINDWC(BGPPC,19),U,9)]""!($P(^BGPINDWC(BGPPC,19),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDWC(BGPPC,19),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDWC(BGPPC,19),U,10),"$","^")
....S Y="" I $P(^BGPINDWC(BGPPC,19),U,9)]""!($P(^BGPINDWC(BGPPC,19),U,10)]"")!($P(^BGPINDWC(BGPPC,19),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDWC(BGPPC,19),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDWC(BGPPC,19),U,10),"$","^") D
.....S $P(Y,U,8)=$P(^BGPINDWC(BGPPC,19),U,11)
....I Y]"" D S(Y,1,1)
...D S(X,1,1)
Q
BGP2PDLO ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;
S(Y,F,P) ;EP set up array
+1 IF '$GET(F)
SET F=0
+2 SET %=$PIECE(^TMP($JOB,"BGPDEL",0),U)+F
SET $PIECE(^TMP($JOB,"BGPDEL",0),U)=%
+3 IF '$DATA(^TMP($JOB,"BGPDEL",%))
SET ^TMP($JOB,"BGPDEL",%)=""
+4 SET $PIECE(^TMP($JOB,"BGPDEL",%),U,P)=Y
+5 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
OTHSUM ;EP
+1 ;national gpra only
IF BGPRTYPE'=7
QUIT
+2 IF $GET(BGPCPPL)
QUIT
+3 ;not on lists
IF $GET(BGPNPL)
QUIT
+4 SET BGPQUIT=""
SET BGPGPG=0
+5 SET BGPSUMP=1
+6 DO HEADER^BGP2PDL
+7 IF '$GET(BGPSUMON)
DO H1
+8 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL OTHER",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+9 SET X=" "
DO S(X,1,1)
+10 SET BGPC1=$ORDER(^BGPSCAT("D",BGPC,0))
+11 SET X=$PIECE(^BGPSCAT(BGPC1,0),U,1)
DO S(X,1,1)
+12 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+13 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,0))
+14 SET X=""
+15 IF $PIECE(^BGPINDWC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDWC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDWC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDWC(BGPPC,19)),U,13))
Begin DoDot:3
+16 SET X=" "_$PIECE(^BGPINDWC(BGPPC,19),U,4)
+17 IF $PIECE(^BGPINDWC(BGPPC,19),U,7)]""
DO S(X,1,1)
SET X=" "_$PIECE(^BGPINDWC(BGPPC,19),U,7)
+18 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U)
+19 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,2)
+20 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,3)
+21 SET $PIECE(X,U,5)=$PIECE(^BGPINDWC(BGPPC,19),U,2)
SET $PIECE(X,U,6)=$PIECE(^BGPINDWC(BGPPC,19),U,3)
+22 DO S(X,1,1)
End DoDot:3
IF 1
+23 IF '$TEST
Begin DoDot:3
+24 SET X=" "_$PIECE(^BGPINDWC(BGPPC,19),U,4)
+25 IF $PIECE(^BGPINDWC(BGPPC,19),U,7)]""
DO S(X,1,1)
SET X=" "_$PIECE(^BGPINDWC(BGPPC,19),U,7)
+26 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U)_"%"
+27 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,2)_"%"
+28 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,3)_"%"
+29 SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDWC(BGPPC,19),U,2),"$","^")
SET $PIECE(X,U,6)=$PIECE(^BGPINDWC(BGPPC,19),U,3)
+30 DO S(X,1,1)
+31 SET X=""
IF $PIECE(^BGPINDWC(BGPPC,19),U,9)]""!($PIECE(^BGPINDWC(BGPPC,19),U,10)]"")!($PIECE(^BGPINDWC(BGPPC,19),U,11)]"")
SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDWC(BGPPC,19),U,10),"$","^")
Begin DoDot:4
+32 SET $PIECE(X,U,6)=$PIECE(^BGPINDWC(BGPPC,19),U,11)
End DoDot:4
+33 IF X]""
DO S(X,1,1)
End DoDot:3
End DoDot:2
End DoDot:1
+34 DO SDP
+35 QUIT
+36 ;
H1 ;
+1 SET X=" "
DO S(X,2,1)
+2 SET X="SELECTED OTHER NATIONAL MEASURES CLINICAL PERFORMANCE SUMMARY"
DO S(X,3,1)
+3 IF $GET(BGPAREAA)
SET X=""
SET $PIECE(X,U,2)=" Area"
SET $PIECE(X,U,3)=" Area"
SET $PIECE(X,U,4)=" Area"
SET $PIECE(X,U,5)="Nat'l"
SET $PIECE(X,U,6)="2012"
DO S(X,1,1)
+4 IF '$GET(BGPAREAA)
SET X=""
SET $PIECE(X,U,2)=" Site"
SET $PIECE(X,U,3)=" Site"
SET $PIECE(X,U,4)=" Site"
SET $PIECE(X,U,5)="Nat'l"
SET $PIECE(X,U,6)="2012"
DO S(X,1,1)
+5 SET X=""
SET $PIECE(X,U,2)="Current"
SET $PIECE(X,U,3)="Previous"
SET $PIECE(X,U,4)="Baseline"
SET $PIECE(X,U,5)="2011"
SET $PIECE(X,U,6)="Target"
DO S(X,1,1)
+6 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO S(X,1,1)
+7 QUIT
H2 ;
+1 SET X=" "
DO S(X,2,1)
+2 SET X="SELECTED OTHER NATIONAL MEASURES CLINICAL PERFORMANCE DETAIL"
DO S(X,2,1)
+3 SET X=""
SET $PIECE(X,U,2)=" Site"
SET $PIECE(X,U,3)=" Site"
SET $PIECE(X,U,4)=" Site"
SET $PIECE(X,U,5)="Area"
SET $PIECE(X,U,6)="National"
SET $PIECE(X,U,7)="2012"
DO S(X,1,1)
+4 SET X=""
SET $PIECE(X,U,2)="Current"
SET $PIECE(X,U,3)="Previous"
SET $PIECE(X,U,4)="Baseline"
SET $PIECE(X,U,5)="Current"
SET $PIECE(X,U,6)="2011"
SET $PIECE(X,U,7)="Target"
DO S(X,1,1)
+5 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO S(X,1,1)
+6 QUIT
SDPX ;
+1 ;national gpra only
IF BGPRTYPE'=7
QUIT
+2 IF '$GET(BGPAREAA)
QUIT
+3 SET BGPQUIT=""
SET BGPGPG=0
+4 SET BGPSUMP=1
+5 SET X=" "
DO S(X,2,1)
+6 DO HEADER^BGP2PDL
+7 DO H2
+8 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+9 SET X=" "
DO S(X,1,1)
+10 SET BGPC1=$ORDER(^BGPSCAT("D",BGPC,0))
+11 SET X=$PIECE(^BGPSCAT(BGPC1,0),U,1)
DO S(X,1,1)
+12 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+13 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,0))
+14 SET X=" "
DO S(X,1,1)
+15 SET XX=" "_$PIECE(^BGPINDWC(BGPPC,19),U,4)
+16 IF $PIECE(^BGPINDWC(BGPPC,19),U,7)]""
DO S(XX,1,1)
SET XX=" "_$PIECE(^BGPINDWC(BGPPC,19),U,7)
+17 IF $PIECE(^BGPINDWC(BGPPC,19),U,12)]""
DO S(XX,1,1)
SET XX=" "_$PIECE(^BGPINDWC(BGPPC,19),U,12)
+18 SET F=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,0))
+19 SET F=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,F),U,4)
+20 SET $PIECE(XX,U,5)=$PIECE(^BGPINDWC(BGPPC,19),U,2)
SET $PIECE(XX,U,6)=$PIECE(^BGPINDWC(BGPPC,19),U,3)
+21 SET BGPSN=0
SET BGPCNT=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN
QUIT
SET BGPCNT=BGPCNT+1
Begin DoDot:3
+22 SET BGPSASU=$PIECE(^BGPGPDCW(BGPSN,0),U,9)
SET X=$ORDER(^AUTTLOC("C",BGPSASU,0))
SET BGPSNAM=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
SET BGPSNAM=$SELECT($PIECE(^BGPGPDCW(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+23 IF $PIECE(^BGPINDWC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDWC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDWC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDWC(BGPPC,19)),U,13))
Begin DoDot:4
+24 SET X=""
SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+25 SET $PIECE(X,U,2)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U)
+26 SET $PIECE(X,U,3)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,2)
+27 SET $PIECE(X,U,4)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,3)
End DoDot:4
IF 1
+28 IF '$TEST
Begin DoDot:4
+29 SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+30 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
+31 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
+32 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
End DoDot:4
+33 IF BGPCNT=1
DO S(XX,1,1)
Begin DoDot:4
+34 SET Y=""
IF $PIECE(^BGPINDWC(BGPPC,19),U,9)]""!($PIECE(^BGPINDWC(BGPPC,19),U,10)]"")!($PIECE(^BGPINDWC(BGPPC,19),U,11)]"")
SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPINDWC(BGPPC,19),U,9),"$","^")
SET $PIECE(Y,U,7)=$TRANSLATE($PIECE(^BGPINDWC(BGPPC,19),U,10),"$","^")
Begin DoDot:5
+35 SET $PIECE(Y,U,8)=$PIECE(^BGPINDWC(BGPPC,19),U,11)
End DoDot:5
+36 IF Y]""
DO S(Y,1,1)
End DoDot:4
+37 DO S(X,1,1)
End DoDot:3
End DoDot:2
End DoDot:1
+38 QUIT
SDP ;
+1 IF BGPRTYPE'=7
QUIT
+2 ;area only
IF '$GET(BGPAREAA)
QUIT
+3 SET BGPQUIT=""
SET BGPGPG=0
+4 SET BGPSUMP=1
+5 SET X=" "
DO S(X,2,1)
+6 DO HEADER^BGP2PDL
+7 DO H2
+8 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+9 SET X=" "
DO S(X,1,1)
+10 SET BGPC1=$ORDER(^BGPSCAT("D",BGPC,0))
+11 SET X=$PIECE(^BGPSCAT(BGPC1,0),U,1)
DO S(X,1,1)
+12 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+13 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,0))
+14 SET X=" "
DO S(X,1,1)
+15 SET XX=" "_$PIECE(^BGPINDWC(BGPPC,19),U,4)
+16 IF $PIECE(^BGPINDWC(BGPPC,19),U,7)]""
DO S(XX,1,1)
SET XX=" "_$PIECE(^BGPINDWC(BGPPC,19),U,7)
+17 IF $PIECE(^BGPINDWC(BGPPC,19),U,12)]""
DO S(XX,1,1)
SET XX=" "_$PIECE(^BGPINDWC(BGPPC,19),U,12)
+18 SET F=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,0))
+19 SET F=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,F),U,4)
+20 SET $PIECE(XX,U,5)=F_$SELECT($PIECE(^BGPINDWC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDWC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDWC(BGPPC,0),U,4)="016.A.1")!($PIECE($GET(^BGPINDWC(BGPPC,19)),U,13)):"",1:"%")
+21 SET $PIECE(XX,U,6)=$PIECE(^BGPINDWC(BGPPC,19),U,2)
SET $PIECE(XX,U,7)=$PIECE(^BGPINDWC(BGPPC,19),U,3)
+22 SET BGPSN=0
SET BGPCNT=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN
QUIT
SET BGPCNT=BGPCNT+1
Begin DoDot:3
+23 SET BGPSASU=$PIECE(^BGPGPDCW(BGPSN,0),U,9)
SET X=$ORDER(^AUTTLOC("C",BGPSASU,0))
SET BGPSNAM=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
SET BGPSNAM=$SELECT($PIECE(^BGPGPDCW(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+24 IF $PIECE(^BGPINDWC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDWC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDWC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDWC(BGPPC,19)),U,13))
Begin DoDot:4
+25 SET X=""
SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+26 SET $PIECE(X,U,2)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U)
+27 SET $PIECE(X,U,3)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,2)
+28 SET $PIECE(X,U,4)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,3)
+29 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,4)
End DoDot:4
IF 1
+30 IF '$TEST
Begin DoDot:4
+31 SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+32 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
+33 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
+34 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
+35 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE OTHER",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
+36 ;S $P(X,U,5)=$P(^BGPINDWC(BGPPC,19),U,2),$P(X,U,6)=$P(^BGPINDWC(BGPPC,19),U,3)
End DoDot:4
+37 IF BGPCNT=1
DO S(XX,1,1)
Begin DoDot:4
+38 ;S Y="" I $P(^BGPINDWC(BGPPC,19),U,9)]""!($P(^BGPINDWC(BGPPC,19),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDWC(BGPPC,19),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDWC(BGPPC,19),U,10),"$","^")
+39 SET Y=""
IF $PIECE(^BGPINDWC(BGPPC,19),U,9)]""!($PIECE(^BGPINDWC(BGPPC,19),U,10)]"")!($PIECE(^BGPINDWC(BGPPC,19),U,11)]"")
SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPINDWC(BGPPC,19),U,9),"$","^")
SET $PIECE(Y,U,7)=$TRANSLATE($PIECE(^BGPINDWC(BGPPC,19),U,10),"$","^")
Begin DoDot:5
+40 SET $PIECE(Y,U,8)=$PIECE(^BGPINDWC(BGPPC,19),U,11)
End DoDot:5
+41 IF Y]""
DO S(Y,1,1)
End DoDot:4
+42 DO S(X,1,1)
End DoDot:3
End DoDot:2
End DoDot:1
+43 QUIT
