- BGP5DSPO ; IHS/CMI/LAB - IHS summary page ; 17 May 2015 9:52 AM
- ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
- ;
- START ;
- I BGPRTYPE'=7 Q
- I $G(BGPNPL) Q ;not on gpra pat list
- I $G(BGPCPPL) Q ;not on comp list
- S BGPQUIT="",BGPGPG=0
- D HEADER
- S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY OTHER",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
- .D
- ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- ..S BGPC1=$O(^BGPSCAT("D",BGPC,0))
- ..D W^BGP5DP("",0,1,BGPPTYPE)
- ..D W^BGP5DP($P(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
- ..S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY OTHER",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
- ...S BGPPC=$O(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,0))
- ...I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
- ...I $P(^BGPINDKC(BGPPC,0),U,4)["014.A"!($P(^BGPINDKC(BGPPC,0),U,4)["023.")!($P(^BGPINDKC(BGPPC,0),U,4)="016.A.1")!($P(^BGPINDKC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDKC(BGPPC,19)),U,13)) D I 1
- ....D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,4),0,1,BGPPTYPE,,1)
- ....I $P(^BGPINDKC(BGPPC,19),U,7)]"" D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,7),0,1,BGPPTYPE,1,1)
- ....I $P(^BGPINDKC(BGPPC,19),U,12)]"" D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,12),0,1,BGPPTYPE,1,1)
- ....I BGPPTYPE="P" D
- .....D W^BGP5DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,2,26)
- .....D W^BGP5DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,3,34)
- .....D W^BGP5DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,4,41)
- .....D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,2),0,0,BGPPTYPE,5,57)
- .....D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
- ....I BGPPTYPE="D" D
- .....D W^BGP5DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U),0,0,BGPPTYPE,2,26)
- .....D W^BGP5DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,2),0,0,BGPPTYPE,3,34)
- .....D W^BGP5DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,3),0,0,BGPPTYPE,4,41)
- .....D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,2),0,0,BGPPTYPE,5,57)
- .....D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
- ...E D
- ....D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,4),0,1,BGPPTYPE,,1)
- ....I $P(^BGPINDKC(BGPPC,19),U,7)]"" D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,7),0,1,BGPPTYPE,1,1)
- ....I $P(^BGPINDKC(BGPPC,19),U,12)]"" D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,12),0,1,BGPPTYPE,1,1)
- ....I BGPPTYPE="P" D
- .....D W^BGP5DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,2,26)
- .....D W^BGP5DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,3,34)
- .....D W^BGP5DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,4,41)
- .....D W^BGP5DP($TR($P(^BGPINDKC(BGPPC,19),U,2),"$","^"),0,0,BGPPTYPE,5,57)
- .....D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
- ....I BGPPTYPE="D" D
- .....D W^BGP5DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U)_"%",0,0,BGPPTYPE,2,26)
- .....D W^BGP5DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,2)_"%",0,0,BGPPTYPE,3,34)
- .....D W^BGP5DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,3)_"%",0,0,BGPPTYPE,4,41)
- .....D W^BGP5DP($TR($P(^BGPINDKC(BGPPC,19),U,2),"$","^"),0,0,BGPPTYPE,5,57)
- .....D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
- ....I $P(^BGPINDKC(BGPPC,19),U,9)]""!($P(^BGPINDKC(BGPPC,19),U,10)]"")!($P(^BGPINDKC(BGPPC,19),U,11)]"") D
- .....D W^BGP5DP($TR($P(^BGPINDKC(BGPPC,19),U,10),"$","^"),0,0,BGPPTYPE,5,57)
- .....D W^BGP5DP($P(^BGPINDKC(BGPPC,19),U,11),0,0,BGPPTYPE,6,68)
- I BGPPTYPE="P",$Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
- D W^BGP5DP("",0,1,BGPPTYPE)
- Q
- ;
- D HEADER^BGP5DPH
- D H1
- Q
- H1 ;
- S X="SELECTED OTHER NATIONAL MEASURES CLINICAL PERFORMANCE SUMMARY" D W^BGP5DP(X,0,1,BGPPTYPE)
- I $G(BGPAREAA) D W^BGP5DP("Area",0,1,BGPPTYPE,2,27),W^BGP5DP("Area",0,0,BGPPTYPE,3,35),W^BGP5DP("Area",0,0,BGPPTYPE,4,44),W^BGP5DP("Nat'l",0,0,BGPPTYPE,5,57),W^BGP5DP("2020",0,0,BGPPTYPE,6,68)
- I '$G(BGPAREAA) D W^BGP5DP("Site",0,1,BGPPTYPE,2,27),W^BGP5DP("Site",0,0,BGPPTYPE,3,35),W^BGP5DP("Site",0,0,BGPPTYPE,4,44),W^BGP5DP("Nat'l",0,0,BGPPTYPE,5,57),W^BGP5DP("2020",0,0,BGPPTYPE,6,68)
- D W^BGP5DP("Current",0,1,BGPPTYPE,2,26),W^BGP5DP("Previous",0,0,BGPPTYPE,3,34),W^BGP5DP("Baseline",0,0,BGPPTYPE,4,43),W^BGP5DP("2014",0,0,BGPPTYPE,5,57),W^BGP5DP("Target",0,0,BGPPTYPE,6,68)
- D W^BGP5DP($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")
- ;----------
- BGP5DSPO ; IHS/CMI/LAB - IHS summary page ; 17 May 2015 9:52 AM
- +1 ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
- +2 ;
- START ;
- +1 IF BGPRTYPE'=7
- QUIT
- +2 ;not on gpra pat list
- IF $GET(BGPNPL)
- QUIT
- +3 ;not on comp list
- IF $GET(BGPCPPL)
- QUIT
- +4 SET BGPQUIT=""
- SET BGPGPG=0
- +5 DO HEADER
- +6 SET BGPC=0
- FOR
- SET BGPC=$ORDER(^TMP($JOB,"SUMMARY OTHER",BGPC))
- IF BGPC'=+BGPC!(BGPQUIT)
- QUIT
- Begin DoDot:1
- +7 Begin DoDot:2
- +8 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- +9 SET BGPC1=$ORDER(^BGPSCAT("D",BGPC,0))
- +10 DO W^BGP5DP("",0,1,BGPPTYPE)
- +11 DO W^BGP5DP($PIECE(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
- +12 SET BGPO=""
- FOR
- SET BGPO=$ORDER(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO))
- IF BGPO=""!(BGPQUIT)
- QUIT
- Begin DoDot:3
- +13 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,0))
- +14 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-4)
- DO HEADER
- IF BGPQUIT
- QUIT
- +15 IF $PIECE(^BGPINDKC(BGPPC,0),U,4)["014.A"!($PIECE(^BGPINDKC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDKC(BGPPC,0),U,4)="016.A.1")!($PIECE(^BGPINDKC(BGPPC,0),U,4)="016.A.5")!($PIECE($GET(^BGPINDKC(BGPPC,19)),U,13))
- Begin DoDot:4
- +16 DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,4),0,1,BGPPTYPE,,1)
- +17 IF $PIECE(^BGPINDKC(BGPPC,19),U,7)]""
- DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,7),0,1,BGPPTYPE,1,1)
- +18 IF $PIECE(^BGPINDKC(BGPPC,19),U,12)]""
- DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,12),0,1,BGPPTYPE,1,1)
- +19 IF BGPPTYPE="P"
- Begin DoDot:5
- +20 DO W^BGP5DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,2,26)
- +21 DO W^BGP5DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,3,34)
- +22 DO W^BGP5DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,4,41)
- +23 DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,2),0,0,BGPPTYPE,5,57)
- +24 DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
- End DoDot:5
- +25 IF BGPPTYPE="D"
- Begin DoDot:5
- +26 DO W^BGP5DP($PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U),0,0,BGPPTYPE,2,26)
- +27 DO W^BGP5DP($PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,2),0,0,BGPPTYPE,3,34)
- +28 DO W^BGP5DP($PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,3),0,0,BGPPTYPE,4,41)
- +29 DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,2),0,0,BGPPTYPE,5,57)
- +30 DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
- End DoDot:5
- End DoDot:4
- IF 1
- +31 IF '$TEST
- Begin DoDot:4
- +32 DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,4),0,1,BGPPTYPE,,1)
- +33 IF $PIECE(^BGPINDKC(BGPPC,19),U,7)]""
- DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,7),0,1,BGPPTYPE,1,1)
- +34 IF $PIECE(^BGPINDKC(BGPPC,19),U,12)]""
- DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,12),0,1,BGPPTYPE,1,1)
- +35 IF BGPPTYPE="P"
- Begin DoDot:5
- +36 DO W^BGP5DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,2,26)
- +37 DO W^BGP5DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,3,34)
- +38 DO W^BGP5DP($JUSTIFY($PIECE(^TMP($JOB,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,4,41)
- +39 DO W^BGP5DP($TRANSLATE($PIECE(^BGPINDKC(BGPPC,19),U,2),"$","^"),0,0,BGPPTYPE,5,57)
- +40 DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
- End DoDot:5
- +41 IF BGPPTYPE="D"
- Begin DoDot:5
- +42 DO W^BGP5DP($PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U)_"%",0,0,BGPPTYPE,2,26)
- +43 DO W^BGP5DP($PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,2)_"%",0,0,BGPPTYPE,3,34)
- +44 DO W^BGP5DP($PIECE(^TMP($JOB,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,3)_"%",0,0,BGPPTYPE,4,41)
- +45 DO W^BGP5DP($TRANSLATE($PIECE(^BGPINDKC(BGPPC,19),U,2),"$","^"),0,0,BGPPTYPE,5,57)
- +46 DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
- End DoDot:5
- +47 IF $PIECE(^BGPINDKC(BGPPC,19),U,9)]""!($PIECE(^BGPINDKC(BGPPC,19),U,10)]"")!($PIECE(^BGPINDKC(BGPPC,19),U,11)]"")
- Begin DoDot:5
- +48 DO W^BGP5DP($TRANSLATE($PIECE(^BGPINDKC(BGPPC,19),U,10),"$","^"),0,0,BGPPTYPE,5,57)
- +49 DO W^BGP5DP($PIECE(^BGPINDKC(BGPPC,19),U,11),0,0,BGPPTYPE,6,68)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +50 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-2)
- DO HEADER
- IF BGPQUIT
- QUIT
- +51 DO W^BGP5DP("",0,1,BGPPTYPE)
- +52 QUIT
- +53 ;
- +1 DO HEADER^BGP5DPH
- +2 DO H1
- +3 QUIT
- H1 ;
- +1 SET X="SELECTED OTHER NATIONAL MEASURES CLINICAL PERFORMANCE SUMMARY"
- DO W^BGP5DP(X,0,1,BGPPTYPE)
- +2 IF $GET(BGPAREAA)
- DO W^BGP5DP("Area",0,1,BGPPTYPE,2,27)
- DO W^BGP5DP("Area",0,0,BGPPTYPE,3,35)
- DO W^BGP5DP("Area",0,0,BGPPTYPE,4,44)
- DO W^BGP5DP("Nat'l",0,0,BGPPTYPE,5,57)
- DO W^BGP5DP("2020",0,0,BGPPTYPE,6,68)
- +3 IF '$GET(BGPAREAA)
- DO W^BGP5DP("Site",0,1,BGPPTYPE,2,27)
- DO W^BGP5DP("Site",0,0,BGPPTYPE,3,35)
- DO W^BGP5DP("Site",0,0,BGPPTYPE,4,44)
- DO W^BGP5DP("Nat'l",0,0,BGPPTYPE,5,57)
- DO W^BGP5DP("2020",0,0,BGPPTYPE,6,68)
- +4 DO W^BGP5DP("Current",0,1,BGPPTYPE,2,26)
- DO W^BGP5DP("Previous",0,0,BGPPTYPE,3,34)
- DO W^BGP5DP("Baseline",0,0,BGPPTYPE,4,43)
- DO W^BGP5DP("2014",0,0,BGPPTYPE,5,57)
- DO W^BGP5DP("Target",0,0,BGPPTYPE,6,68)
- +5 DO W^BGP5DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
- +6 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 ;----------
