Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP3DSPO

BGP3DSPO.m

Go to the documentation of this file.
  1. BGP3DSPO ; IHS/CMI/LAB - IHS summary page ; 17 May 2013 9:52 AM
  1. ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
  1. ;
  1. START ;
  1. I BGPRTYPE'=7 Q
  1. I $G(BGPNPL) Q ;not on gpra pat list
  1. I $G(BGPCPPL) Q ;not on comp list
  1. S BGPQUIT="",BGPGPG=0
  1. D HEADER
  1. S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY OTHER",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
  1. .D
  1. ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1. ..S BGPC1=$O(^BGPSCAT("D",BGPC,0))
  1. ..D W^BGP3DP("",0,1,BGPPTYPE)
  1. ..D W^BGP3DP($P(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
  1. ..S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY OTHER",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
  1. ...S BGPPC=$O(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,0))
  1. ...I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
  1. ...I $P(^BGPINDHC(BGPPC,0),U,4)["014.A"!($P(^BGPINDHC(BGPPC,0),U,4)["023.")!($P(^BGPINDHC(BGPPC,0),U,4)="016.A.1")!($P(^BGPINDHC(BGPPC,0),U,4)="016.A.5")!($P($G(^BGPINDHC(BGPPC,19)),U,13)) D I 1
  1. ....D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,4),0,1,BGPPTYPE,,1)
  1. ....I $P(^BGPINDHC(BGPPC,19),U,7)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,7),0,1,BGPPTYPE,1,1)
  1. ....I $P(^BGPINDHC(BGPPC,19),U,12)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,12),0,1,BGPPTYPE,1,1)
  1. ....I BGPPTYPE="P" D
  1. .....D W^BGP3DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,2,26)
  1. .....D W^BGP3DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,3,34)
  1. .....D W^BGP3DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,4,41)
  1. .....D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,2),0,0,BGPPTYPE,5,57)
  1. .....D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
  1. ....I BGPPTYPE="D" D
  1. .....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U),0,0,BGPPTYPE,2,26)
  1. .....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,2),0,0,BGPPTYPE,3,34)
  1. .....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,3),0,0,BGPPTYPE,4,41)
  1. .....D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,2),0,0,BGPPTYPE,5,57)
  1. .....D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
  1. ...E D
  1. ....D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,4),0,1,BGPPTYPE,,1)
  1. ....I $P(^BGPINDHC(BGPPC,19),U,7)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,7),0,1,BGPPTYPE,1,1)
  1. ....I $P(^BGPINDHC(BGPPC,19),U,12)]"" D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,12),0,1,BGPPTYPE,1,1)
  1. ....I BGPPTYPE="P" D
  1. .....D W^BGP3DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,2,26)
  1. .....D W^BGP3DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,3,34)
  1. .....D W^BGP3DP($J($P(^TMP($J,"SUMMARY OTHER",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,4,41)
  1. .....D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,19),U,2),"$","^"),0,0,BGPPTYPE,5,57)
  1. .....D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
  1. ....I BGPPTYPE="D" D
  1. .....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U)_"%",0,0,BGPPTYPE,2,26)
  1. .....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,2)_"%",0,0,BGPPTYPE,3,34)
  1. .....D W^BGP3DP($P(^TMP($J,"SUMMARYDEL OTHER",BGPC,BGPO,BGPPC),U,3)_"%",0,0,BGPPTYPE,4,41)
  1. .....D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,19),U,2),"$","^"),0,0,BGPPTYPE,5,57)
  1. .....D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,3),0,0,BGPPTYPE,6,68)
  1. ....I $P(^BGPINDHC(BGPPC,19),U,9)]""!($P(^BGPINDHC(BGPPC,19),U,10)]"")!($P(^BGPINDHC(BGPPC,19),U,11)]"") D
  1. .....D W^BGP3DP($TR($P(^BGPINDHC(BGPPC,19),U,10),"$","^"),0,0,BGPPTYPE,5,57)
  1. .....D W^BGP3DP($P(^BGPINDHC(BGPPC,19),U,11),0,0,BGPPTYPE,6,68)
  1. I BGPPTYPE="P",$Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
  1. D W^BGP3DP("",0,1,BGPPTYPE)
  1. Q
  1. ;
  1. D HEADER^BGP3DPH
  1. D H1
  1. Q
  1. H1 ;
  1. S X="SELECTED OTHER NATIONAL MEASURES CLINICAL PERFORMANCE SUMMARY" D W^BGP3DP(X,0,1,BGPPTYPE)
  1. I $G(BGPAREAA) D W^BGP3DP("Area",0,1,BGPPTYPE,2,27),W^BGP3DP("Area",0,0,BGPPTYPE,3,35),W^BGP3DP("Area",0,0,BGPPTYPE,4,44),W^BGP3DP("Nat'l",0,0,BGPPTYPE,5,57),W^BGP3DP("2020",0,0,BGPPTYPE,6,68)
  1. I '$G(BGPAREAA) D W^BGP3DP("Site",0,1,BGPPTYPE,2,27),W^BGP3DP("Site",0,0,BGPPTYPE,3,35),W^BGP3DP("Site",0,0,BGPPTYPE,4,44),W^BGP3DP("Nat'l",0,0,BGPPTYPE,5,57),W^BGP3DP("2020",0,0,BGPPTYPE,6,68)
  1. D W^BGP3DP("Current",0,1,BGPPTYPE,2,26),W^BGP3DP("Previous",0,0,BGPPTYPE,3,34),W^BGP3DP("Baseline",0,0,BGPPTYPE,4,43),W^BGP3DP("2012",0,0,BGPPTYPE,5,57),W^BGP3DP("Target",0,0,BGPPTYPE,6,68)
  1. D W^BGP3DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
  1. Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1. Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1. ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1. Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1. ;----------