- BGP7SDPN ; IHS/CMI/LAB - IHS summary page ;
- ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- ;
- START ;
- I '$G(BGPAREAA) Q
- I BGPRTYPE'=1 Q
- S BGPQUIT="",BGPGPG=0
- D HEADER
- S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
- .I BGPPTYPE-"P" I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .S BGPC1=$O(^BGPSCAT("D",BGPC,0))
- .D W^BGP7DP("",0,1,BGPPTYPE)
- .D W^BGP7DP($P(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
- .S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
- ..S BGPPC=$O(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,0))
- ..I BGPPTYPE="P" D
- ...I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ...D W^BGP7DP($P(^BGPINDGC(BGPPC,15),U,4),0,2,BGPPTYPE)
- ...I $P(^BGPINDGC(BGPPC,15),U,7)]"" D W^BGP7DP($P(^BGPINDGC(BGPPC,15),U,7),0,1,BGPPTYPE)
- ...I $P(^BGPINDGC(BGPPC,15),U,12)]"" D W^BGP7DP($P(^BGPINDGC(BGPPC,15),U,12),0,1,BGPPTYPE)
- ...S F=$O(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,0))
- ...S F=$P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,F),U,4)
- ...D W^BGP7DP(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(^BGPINDGC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDGC(BGPPC,19)),U,13)):"",1:"%"),0,0,BGPPTYPE,,46)
- ...D W^BGP7DP($P(^BGPINDGC(BGPPC,15),U,2),0,0,BGPPTYPE,,55)
- ...;D W^BGP7DP($P(^BGPINDGC(BGPPC,15),U,3),0,0,BGPPTYPE,,65)
- ...I $P(^BGPINDGC(BGPPC,15),U,9)]""!($P(^BGPINDGC(BGPPC,15),U,10)]"")!($P(^BGPINDGC(BGPPC,15),U,11)]"") D
- ....D W^BGP7DP($TR($P(^BGPINDGC(BGPPC,15),U,10),"$","^"),0,0,BGPPTYPE,,55) ;,W^BGP7DP($P(^BGPINDGC(BGPPC,15),U,11),0,0,BGPPTYPE,,65)
- ...S BGPSN=0 F S BGPSN=$O(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN!(BGPQUIT) D
- ....S BGPSASU=$P(^BGPGPDCG(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)) S 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.A.1")!($P(^BGPINDGC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDGC(BGPPC,19)),U,13)) D I 1
- .....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .....D W^BGP7DP(BGPSASU,0,1,BGPPTYPE,,2),W^BGP7DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
- .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U),7,0),0,0,BGPPTYPE,,20)
- .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0),0,0,BGPPTYPE,,29)
- .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0),0,0,BGPPTYPE,,38)
- ....E D
- .....I $Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- .....D W^BGP7DP(BGPSASU,0,1,BGPPTYPE,,2),W^BGP7DP($E(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
- .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U),7,1)_"%",0,0,BGPPTYPE,,20)
- .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1)_"%",0,0,BGPPTYPE,,29)
- .....D W^BGP7DP($J($P(^TMP($J,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1)_"%",0,0,BGPPTYPE,,38)
- ..I BGPPTYPE="D" D
- ...D W^BGP7DP("",0,1,BGPPTYPE)
- ...S XX=" "_$P(^BGPINDGC(BGPPC,15),U,4)
- ...I $P(^BGPINDGC(BGPPC,15),U,7)]"" D W^BGP7DP(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPINDGC(BGPPC,15),U,7)
- ...I $P(^BGPINDGC(BGPPC,15),U,12)]"" D W^BGP7DP(XX,0,1,BGPPTYPE) S XX=" "_$P(^BGPINDGC(BGPPC,15),U,12)
- ...S F=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,0))
- ...S F=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",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,15),U,2) ;,$P(XX,U,7)=$P(^BGPINDGC(BGPPC,15),U,3)
- ...S BGPSN=0,BGPCNT=0 F S BGPSN=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",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.A.1")!($P(^BGPINDGC(BGPPC,0),U,4)="016.A.5")!($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 NON",BGPC,BGPO,BGPPC,BGPSN),U)
- .....S $P(X,U,3)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2)
- .....S $P(X,U,4)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3)
- .....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",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 NON",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
- .....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
- .....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
- .....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
- .....;S $P(X,U,5)=$P(^BGPINDGC(BGPPC,15),U,2),$P(X,U,6)=$P(^BGPINDGC(BGPPC,15),U,3)
- .....;I BGPCNT=1 D S(XX,1,1) D
- ....I BGPCNT=1 D W^BGP7DP(XX,0,1,BGPPTYPE,1)
- ....;S Y="" I $P(^BGPINDGC(BGPPC,15),U,9)]""!($P(^BGPINDGC(BGPPC,15),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDGC(BGPPC,15),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDGC(BGPPC,15),U,10),"$","^")
- ....S Y="" I $P(^BGPINDGC(BGPPC,15),U,9)]""!($P(^BGPINDGC(BGPPC,15),U,10)]"")!($P(^BGPINDGC(BGPPC,15),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDGC(BGPPC,15),U,9),"$","^") D
- .....S $P(Y,U,8)=$P(^BGPINDGC(BGPPC,15),U,11)
- ....I Y]"" D W^BGP7DP(Y,0,1,BGPPTYPE,1) ;D S(Y,1,1)
- ....D W^BGP7DP(X,0,1,BGPPTYPE,1) ;D S(X,1,1)
- ..;D W^BGP7DP(" ",0,1,BGPPTYPE) ;S X=" " D S(X,1,1)
- I BGPPTYPE="P",$Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
- D W^BGP7DP(" *Non-GPRA measure included in the IHS GPRA report submitted to OMB to",0,2,BGPPTYPE)
- D W^BGP7DP("provide context to other GPRA measures.",0,1,BGPPTYPE)
- D W^BGP7DP("",0,1,BGPPTYPE)
- Q
- ;
- D HEADER^BGP7DPH
- D H1
- Q
- H1 ;
- I BGPRTYPE=1 S X="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE DETAIL" D W^BGP7DP(X,1,1,BGPPTYPE)
- D W^BGP7DP("Site",0,1,BGPPTYPE,2,21),W^BGP7DP("Site",0,0,BGPPTYPE,3,32),W^BGP7DP("Site",0,0,BGPPTYPE,4,40),W^BGP7DP("Area",0,0,BGPPTYPE,5,46),W^BGP7DP("Nat'l",0,0,BGPPTYPE,6,55) ;,W^BGP7DP("2016",0,0,BGPPTYPE,7,66)
- D W^BGP7DP("Current",0,1,BGPPTYPE,2,21),W^BGP7DP("Prev",0,0,BGPPTYPE,3,32),W^BGP7DP("Base",0,0,BGPPTYPE,4,40),W^BGP7DP("Current",0,0,BGPPTYPE,5,46),W^BGP7DP("2016",0,0,BGPPTYPE,6,55) ;,W^BGP7DP("Target",0,0,BGPPTYPE,7,66)
- D W^BGP7DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
- Q
- CTR(X,Y) ;EP - Center X in a field Y wide.
- Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
- ;----------
- USR() ;EP - Return name of current user from ^VA(200.
- Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- ;----------
- BGP7SDPN ; IHS/CMI/LAB - IHS summary page ;
- +1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- +2 ;
- START ;
- +1 IF '$GET(BGPAREAA)
- QUIT
- +2 IF BGPRTYPE'=1
- QUIT
- +3 SET BGPQUIT=""
- SET BGPGPG=0
- +4 DO HEADER
- +5 SET BGPC=0
- FOR
- SET BGPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC))
- IF BGPC'=+BGPC!(BGPQUIT)
- QUIT
- Begin DoDot:1
- +6 IF BGPPTYPE-"P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +7 SET BGPC1=$ORDER(^BGPSCAT("D",BGPC,0))
- +8 DO W^BGP7DP("",0,1,BGPPTYPE)
- +9 DO W^BGP7DP($PIECE(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
- +10 SET BGPO=""
- FOR
- SET BGPO=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO))
- IF BGPO=""!(BGPQUIT)
- QUIT
- Begin DoDot:2
- +11 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,0))
- +12 IF BGPPTYPE="P"
- Begin DoDot:3
- +13 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +14 DO W^BGP7DP($PIECE(^BGPINDGC(BGPPC,15),U,4),0,2,BGPPTYPE)
- +15 IF $PIECE(^BGPINDGC(BGPPC,15),U,7)]""
- DO W^BGP7DP($PIECE(^BGPINDGC(BGPPC,15),U,7),0,1,BGPPTYPE)
- +16 IF $PIECE(^BGPINDGC(BGPPC,15),U,12)]""
- DO W^BGP7DP($PIECE(^BGPINDGC(BGPPC,15),U,12),0,1,BGPPTYPE)
- +17 SET F=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,0))
- +18 SET F=$PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,F),U,4)
- +19 DO W^BGP7DP(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(^BGPINDGC(BGPPC,0),U,4)="016.A.5")!(...
- ... $PIECE($GET(^BGPINDGC(BGPPC,19)),U,13)):"",1:"%"),0,0,BGPPTYPE,,46)
- +20 DO W^BGP7DP($PIECE(^BGPINDGC(BGPPC,15),U,2),0,0,BGPPTYPE,,55)
- +21 ;D W^BGP7DP($P(^BGPINDGC(BGPPC,15),U,3),0,0,BGPPTYPE,,65)
- +22 IF $PIECE(^BGPINDGC(BGPPC,15),U,9)]""!($PIECE(^BGPINDGC(BGPPC,15),U,10)]"")!($PIECE(^BGPINDGC(BGPPC,15),U,11)]"")
- Begin DoDot:4
- +23 ;,W^BGP7DP($P(^BGPINDGC(BGPPC,15),U,11),0,0,BGPPTYPE,,65)
- DO W^BGP7DP($TRANSLATE($PIECE(^BGPINDGC(BGPPC,15),U,10),"$","^"),0,0,BGPPTYPE,,55)
- End DoDot:4
- +24 SET BGPSN=0
- FOR
- SET BGPSN=$ORDER(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN))
- IF BGPSN'=+BGPSN!(BGPQUIT)
- QUIT
- Begin DoDot:4
- +25 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)
- +26 IF $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(^BGPINDGC(BGPPC,0),U,4)="016.A.5")!($PIECE($GET(^BGPINDGC(BGPPC,19)),U,13))
- Begin DoDot:5
- +27 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +28 DO W^BGP7DP(BGPSASU,0,1,BGPPTYPE,,2)
- DO W^BGP7DP($EXTRACT(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
- +29 DO W^BGP7DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U),7,0),0,0,BGPPTYPE,,20)
- +30 DO W^BGP7DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2),7,0),0,0,BGPPTYPE,,29)
- +31 DO W^BGP7DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3),7,0),0,0,BGPPTYPE,,38)
- End DoDot:5
- IF 1
- +32 IF '$TEST
- Begin DoDot:5
- +33 IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +34 DO W^BGP7DP(BGPSASU,0,1,BGPPTYPE,,2)
- DO W^BGP7DP($EXTRACT(BGPSNAM,1,12),0,0,BGPPTYPE,,8)
- +35 DO W^BGP7DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U),7,1)_"%",0,0,BGPPTYPE,,20)
- +36 DO W^BGP7DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2),7,1)_"%",0,0,BGPPTYPE,,29)
- +37 DO W^BGP7DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3),7,1)_"%",0,0,BGPPTYPE,,38)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- +38 IF BGPPTYPE="D"
- Begin DoDot:3
- +39 DO W^BGP7DP("",0,1,BGPPTYPE)
- +40 SET XX=" "_$PIECE(^BGPINDGC(BGPPC,15),U,4)
- +41 IF $PIECE(^BGPINDGC(BGPPC,15),U,7)]""
- DO W^BGP7DP(XX,0,1,BGPPTYPE)
- SET XX=" "_$PIECE(^BGPINDGC(BGPPC,15),U,7)
- +42 IF $PIECE(^BGPINDGC(BGPPC,15),U,12)]""
- DO W^BGP7DP(XX,0,1,BGPPTYPE)
- SET XX=" "_$PIECE(^BGPINDGC(BGPPC,15),U,12)
- +43 SET F=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,0))
- +44 SET F=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,F),U,4)
- +45 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:"%")
- +46 ;,$P(XX,U,7)=$P(^BGPINDGC(BGPPC,15),U,3)
- SET $PIECE(XX,U,6)=$PIECE(^BGPINDGC(BGPPC,15),U,2)
- +47 SET BGPSN=0
- SET BGPCNT=0
- FOR
- SET BGPSN=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN))
- IF BGPSN'=+BGPSN
- QUIT
- SET BGPCNT=BGPCNT+1
- Begin DoDot:4
- +48 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)
- +49 IF $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(^BGPINDGC(BGPPC,0),U,4)="016.A.5")!($PIECE($GET(^BGPINDGC(BGPPC,19)),U,13))
- Begin DoDot:5
- +50 SET X=""
- SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
- +51 SET $PIECE(X,U,2)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U)
- +52 SET $PIECE(X,U,3)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2)
- +53 SET $PIECE(X,U,4)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3)
- +54 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,4)
- End DoDot:5
- IF 1
- +55 IF '$TEST
- Begin DoDot:5
- +56 SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
- +57 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
- +58 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
- +59 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
- +60 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE NON",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
- +61 ;S $P(X,U,5)=$P(^BGPINDGC(BGPPC,15),U,2),$P(X,U,6)=$P(^BGPINDGC(BGPPC,15),U,3)
- +62 ;I BGPCNT=1 D S(XX,1,1) D
- End DoDot:5
- +63 IF BGPCNT=1
- DO W^BGP7DP(XX,0,1,BGPPTYPE,1)
- +64 ;S Y="" I $P(^BGPINDGC(BGPPC,15),U,9)]""!($P(^BGPINDGC(BGPPC,15),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDGC(BGPPC,15),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDGC(BGPPC,15),U,10),"$","^")
- +65 SET Y=""
- IF $PIECE(^BGPINDGC(BGPPC,15),U,9)]""!($PIECE(^BGPINDGC(BGPPC,15),U,10)]"")!($PIECE(^BGPINDGC(BGPPC,15),U,11)]"")
- SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPINDGC(BGPPC,15),U,9),"$","^")
- Begin DoDot:5
- +66 SET $PIECE(Y,U,8)=$PIECE(^BGPINDGC(BGPPC,15),U,11)
- End DoDot:5
- +67 ;D S(Y,1,1)
- IF Y]""
- DO W^BGP7DP(Y,0,1,BGPPTYPE,1)
- +68 ;D S(X,1,1)
- DO W^BGP7DP(X,0,1,BGPPTYPE,1)
- End DoDot:4
- End DoDot:3
- +69 ;D W^BGP7DP(" ",0,1,BGPPTYPE) ;S X=" " D S(X,1,1)
- End DoDot:2
- End DoDot:1
- +70 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-2)
- DO HEADER
- IF BGPQUIT
- QUIT
- +71 DO W^BGP7DP(" *Non-GPRA measure included in the IHS GPRA report submitted to OMB to",0,2,BGPPTYPE)
- +72 DO W^BGP7DP("provide context to other GPRA measures.",0,1,BGPPTYPE)
- +73 DO W^BGP7DP("",0,1,BGPPTYPE)
- +74 QUIT
- +75 ;
- +1 DO HEADER^BGP7DPH
- +2 DO H1
- +3 QUIT
- H1 ;
- +1 IF BGPRTYPE=1
- SET X="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE DETAIL"
- DO W^BGP7DP(X,1,1,BGPPTYPE)
- +2 ;,W^BGP7DP("2016",0,0,BGPPTYPE,7,66)
- DO W^BGP7DP("Site",0,1,BGPPTYPE,2,21)
- DO W^BGP7DP("Site",0,0,BGPPTYPE,3,32)
- DO W^BGP7DP("Site",0,0,BGPPTYPE,4,40)
- DO W^BGP7DP("Area",0,0,BGPPTYPE,5,46)
- DO W^BGP7DP("Nat'l",0,0,BGPPTYPE,6,55)
- +3 ;,W^BGP7DP("Target",0,0,BGPPTYPE,7,66)
- DO W^BGP7DP("Current",0,1,BGPPTYPE,2,21)
- DO W^BGP7DP("Prev",0,0,BGPPTYPE,3,32)
- DO W^BGP7DP("Base",0,0,BGPPTYPE,4,40)
- DO W^BGP7DP("Current",0,0,BGPPTYPE,5,46)
- DO W^BGP7DP("2016",0,0,BGPPTYPE,6,55)
- +4 DO W^BGP7DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
- +5 QUIT
- CTR(X,Y) ;EP - Center X in a field Y wide.
- +1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
- +2 ;----------
- USR() ;EP - Return name of current user from ^VA(200.
- +1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- +2 ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- +1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- +2 ;----------
