- BGP7PDLO ; IHS/CMI/LAB - IHS gpra print ;
- ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- ;
- 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^BGP7PDL
- 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(^BGPINDGC(BGPPC,0),U,4)["014.A"!($P(^BGPINDGC(BGPPC,0),U,4)["023.")!($P(^BGPINDGC(BGPPC,0),U,4)["016")!($P($G(^BGPINDGC(BGPPC,19)),U,13)) D I 1
- ...S X=" "_$P(^BGPINDGC(BGPPC,19),U,4)
- ...I $P(^BGPINDGC(BGPPC,19),U,7)]"" D S(X,1,1) S X=" "_$P(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,2),$P(X,U,6)=$P(^BGPINDGC(BGPPC,19),U,3)
- ...D S(X,1,1)
- ..E D
- ...S X=" "_$P(^BGPINDGC(BGPPC,19),U,4)
- ...I $P(^BGPINDGC(BGPPC,19),U,7)]"" D S(X,1,1) S X=" "_$P(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,2),"$","^"),$P(X,U,6)=$P(^BGPINDGC(BGPPC,19),U,3)
- ...D S(X,1,1)
- ...S X="" I $P(^BGPINDGC(BGPPC,19),U,9)]""!($P(^BGPINDGC(BGPPC,19),U,10)]"")!($P(^BGPINDGC(BGPPC,19),U,11)]"") S $P(X,U,5)=$TR($P(^BGPINDGC(BGPPC,19),U,10),"$","^") D
- ....S $P(X,U,6)=$P(^BGPINDGC(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)="2016" 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)="2016" 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)="2016",$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)="2016" 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)="2016",$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^BGP7PDL
- 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(^BGPINDGC(BGPPC,19),U,4)
- ..I $P(^BGPINDGC(BGPPC,19),U,7)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDGC(BGPPC,19),U,7)
- ..I $P(^BGPINDGC(BGPPC,19),U,12)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,2),$P(XX,U,6)=$P(^BGPINDGC(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(^BGPGPDCG(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCG(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
- ...I $P(^BGPINDGC(BGPPC,0),U,4)["014.A"!($P(^BGPINDGC(BGPPC,0),U,4)["023.")!($P(^BGPINDGC(BGPPC,0),U,4)["016")!($P($G(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,9)]""!($P(^BGPINDGC(BGPPC,19),U,10)]"")!($P(^BGPINDGC(BGPPC,19),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDGC(BGPPC,19),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDGC(BGPPC,19),U,10),"$","^") D
- .....S $P(Y,U,8)=$P(^BGPINDGC(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^BGP7PDL
- 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(^BGPINDGC(BGPPC,19),U,4)
- ..I $P(^BGPINDGC(BGPPC,19),U,7)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDGC(BGPPC,19),U,7)
- ..I $P(^BGPINDGC(BGPPC,19),U,12)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDGC(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(^BGPINDGC(BGPPC,0),U,4)["014.A"!($P(^BGPINDGC(BGPPC,0),U,4)["023.")!($P(^BGPINDGC(BGPPC,0),U,4)="016.A.1")!($P($G(^BGPINDGC(BGPPC,19)),U,13)):"",1:"%")
- ..S $P(XX,U,6)=$P(^BGPINDGC(BGPPC,19),U,2),$P(XX,U,7)=$P(^BGPINDGC(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(^BGPGPDCG(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCG(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
- ...I $P(^BGPINDGC(BGPPC,0),U,4)["014.A"!($P(^BGPINDGC(BGPPC,0),U,4)["023.")!($P(^BGPINDGC(BGPPC,0),U,4)["016")!($P($G(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,2),$P(X,U,6)=$P(^BGPINDGC(BGPPC,19),U,3)
- ...I BGPCNT=1 D S(XX,1,1) D
- ....;S Y="" I $P(^BGPINDGC(BGPPC,19),U,9)]""!($P(^BGPINDGC(BGPPC,19),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDGC(BGPPC,19),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDGC(BGPPC,19),U,10),"$","^")
- ....S Y="" I $P(^BGPINDGC(BGPPC,19),U,9)]""!($P(^BGPINDGC(BGPPC,19),U,10)]"")!($P(^BGPINDGC(BGPPC,19),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDGC(BGPPC,19),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDGC(BGPPC,19),U,10),"$","^") D
- .....S $P(Y,U,8)=$P(^BGPINDGC(BGPPC,19),U,11)
- ....I Y]"" D S(Y,1,1)
- ...D S(X,1,1)
- Q
- BGP7PDLO ; IHS/CMI/LAB - IHS gpra print ;
- +1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- +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^BGP7PDL
- +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(^BGPINDGC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDGC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDGC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDGC(BGPPC,19)),U,13))
- Begin DoDot:3
- +16 SET X=" "_$PIECE(^BGPINDGC(BGPPC,19),U,4)
- +17 IF $PIECE(^BGPINDGC(BGPPC,19),U,7)]""
- DO S(X,1,1)
- SET X=" "_$PIECE(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,2)
- SET $PIECE(X,U,6)=$PIECE(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,4)
- +25 IF $PIECE(^BGPINDGC(BGPPC,19),U,7)]""
- DO S(X,1,1)
- SET X=" "_$PIECE(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,2),"$","^")
- SET $PIECE(X,U,6)=$PIECE(^BGPINDGC(BGPPC,19),U,3)
- +30 DO S(X,1,1)
- +31 SET X=""
- IF $PIECE(^BGPINDGC(BGPPC,19),U,9)]""!($PIECE(^BGPINDGC(BGPPC,19),U,10)]"")!($PIECE(^BGPINDGC(BGPPC,19),U,11)]"")
- SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDGC(BGPPC,19),U,10),"$","^")
- Begin DoDot:4
- +32 SET $PIECE(X,U,6)=$PIECE(^BGPINDGC(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)="2016"
- 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)="2016"
- 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)="2016"
- 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)="2016"
- 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)="2016"
- 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^BGP7PDL
- +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(^BGPINDGC(BGPPC,19),U,4)
- +16 IF $PIECE(^BGPINDGC(BGPPC,19),U,7)]""
- DO S(XX,1,1)
- SET XX=" "_$PIECE(^BGPINDGC(BGPPC,19),U,7)
- +17 IF $PIECE(^BGPINDGC(BGPPC,19),U,12)]""
- DO S(XX,1,1)
- SET XX=" "_$PIECE(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,2)
- SET $PIECE(XX,U,6)=$PIECE(^BGPINDGC(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(^BGPGPDCG(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(^BGPGPDCG(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
- +23 IF $PIECE(^BGPINDGC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDGC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDGC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,9)]""!($PIECE(^BGPINDGC(BGPPC,19),U,10)]"")!($PIECE(^BGPINDGC(BGPPC,19),U,11)]"")
- SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPINDGC(BGPPC,19),U,9),"$","^")
- SET $PIECE(Y,U,7)=$TRANSLATE($PIECE(^BGPINDGC(BGPPC,19),U,10),"$","^")
- Begin DoDot:5
- +35 SET $PIECE(Y,U,8)=$PIECE(^BGPINDGC(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^BGP7PDL
- +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(^BGPINDGC(BGPPC,19),U,4)
- +16 IF $PIECE(^BGPINDGC(BGPPC,19),U,7)]""
- DO S(XX,1,1)
- SET XX=" "_$PIECE(^BGPINDGC(BGPPC,19),U,7)
- +17 IF $PIECE(^BGPINDGC(BGPPC,19),U,12)]""
- DO S(XX,1,1)
- SET XX=" "_$PIECE(^BGPINDGC(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(^BGPINDGC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDGC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDGC(BGPPC,0),U,4)="016.A.1")!($PIECE($GET(^BGPINDGC(BGPPC,19)),U,13)):"",1:"%")
- +21 SET $PIECE(XX,U,6)=$PIECE(^BGPINDGC(BGPPC,19),U,2)
- SET $PIECE(XX,U,7)=$PIECE(^BGPINDGC(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(^BGPGPDCG(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(^BGPGPDCG(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
- +24 IF $PIECE(^BGPINDGC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDGC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDGC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDGC(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(^BGPINDGC(BGPPC,19),U,2),$P(X,U,6)=$P(^BGPINDGC(BGPPC,19),U,3)
- End DoDot:4
- +37 IF BGPCNT=1
- DO S(XX,1,1)
- Begin DoDot:4
- +38 ;S Y="" I $P(^BGPINDGC(BGPPC,19),U,9)]""!($P(^BGPINDGC(BGPPC,19),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDGC(BGPPC,19),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDGC(BGPPC,19),U,10),"$","^")
- +39 SET Y=""
- IF $PIECE(^BGPINDGC(BGPPC,19),U,9)]""!($PIECE(^BGPINDGC(BGPPC,19),U,10)]"")!($PIECE(^BGPINDGC(BGPPC,19),U,11)]"")
- SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPINDGC(BGPPC,19),U,9),"$","^")
- SET $PIECE(Y,U,7)=$TRANSLATE($PIECE(^BGPINDGC(BGPPC,19),U,10),"$","^")
- Begin DoDot:5
- +40 SET $PIECE(Y,U,8)=$PIECE(^BGPINDGC(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