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

BGP2DSPN.m

Go to the documentation of this file.
BGP2DSPN ; IHS/CMI/LAB - IHS summary page ;
 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
 ;
START ;
 I BGPRTYPE'=1 Q
 I $G(BGPNPL) Q  ;not on gpra pat list
 I $G(BGPCPPL) Q  ;not on comp list
 S BGPQUIT=""
 D HEADER
 S BGPC=0 F  S BGPC=$O(^TMP($J,"SUMMARY NON",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT)  D
 .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
 .S BGPC1=$O(^BGPSCAT("C",BGPC,0))
 .D W^BGP2DP("",0,1,BGPPTYPE)
 .D W^BGP2DP($P(^BGPSCAT(BGPC1,0),U),0,1,BGPPTYPE)
 .S BGPO="" F  S BGPO=$O(^TMP($J,"SUMMARY NON",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT)  D
 ..S BGPPC=$O(^TMP($J,"SUMMARY NON",BGPC,BGPO,0))
 ..I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER Q:BGPQUIT
 ..I $P(^BGPINDWC(BGPPC,0),U,4)["014.A"!($P(^BGPINDWC(BGPPC,0),U,4)["023.")!($P(^BGPINDWC(BGPPC,0),U,4)["016.A.5")!($P($G(^BGPINDWC(BGPPC,19)),U,13)) D  I 1
 ...D W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,4),0,1,BGPPTYPE,1,1)
 ...I $P(^BGPINDWC(BGPPC,15),U,7)]"" D W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,7),0,1,BGPPTYPE,1,1)  ;W !?1,$P(^BGPINDWC(BGPPC,15),U,7)
 ...I BGPPTYPE="P" D
 ....D W^BGP2DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U),7,0),0,0,BGPPTYPE,1,26)
 ....D W^BGP2DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U,2),7,0),0,0,BGPPTYPE,1,34)
 ....D W^BGP2DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U,3),7,0),0,0,BGPPTYPE,1,41)
 ....D W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,2),0,0,BGPPTYPE,1,57)
 ....D W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,3),0,0,BGPPTYPE,1,68)
 ...I BGPPTYPE="D" D
 ....D W^BGP2DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U),0,0,BGPPTYPE,2)
 ....D W^BGP2DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,2),0,0,BGPPTYPE,3)
 ....D W^BGP2DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,3),0,0,BGPPTYPE,4)
 ....D W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,2),0,0,BGPPTYPE,5)
 ....D W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,3),0,0,BGPPTYPE,6)
 ....;D S(X,1,1)
 ..E  D
 ...D W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,4),0,1,BGPPTYPE,1,1)
 ...I $P(^BGPINDWC(BGPPC,15),U,7)]"" D W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,7),0,1,BGPPTYPE,1,1)  ;W !?1,$P(^BGPINDWC(BGPPC,15),U,7)
 ...I BGPPTYPE="P" D
 ....D W^BGP2DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U),7,1)_"%",0,0,BGPPTYPE,1,26)
 ....D W^BGP2DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U,2),7,1)_"%",0,0,BGPPTYPE,1,34)
 ....D W^BGP2DP($J($P(^TMP($J,"SUMMARY NON",BGPC,BGPO,BGPPC),U,3),7,1)_"%",0,0,BGPPTYPE,1,41)
 ....D W^BGP2DP($TR($P(^BGPINDWC(BGPPC,15),U,2),"$","^"),0,0,BGPPTYPE,1,57)
 ....D W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,3),0,0,BGPPTYPE,1,68)
 ...I BGPPTYPE="D" D
 ....D W^BGP2DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U)_"%",0,0,BGPPTYPE,2,26)
 ....D W^BGP2DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,2)_"%",0,0,BGPPTYPE,3,34)
 ....D W^BGP2DP($P(^TMP($J,"SUMMARYDEL NON",BGPC,BGPO,BGPPC),U,3)_"%",0,0,BGPPTYPE,4,41)
 ....D W^BGP2DP($TR($P(^BGPINDWC(BGPPC,15),U,2),"$","^"),0,0,BGPPTYPE,5,57)
 ....D W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,3),0,0,BGPPTYPE,6,68)
 ...I $P(^BGPINDWC(BGPPC,15),U,9)]""!($P(^BGPINDWC(BGPPC,15),U,10)]"")!($P(^BGPINDWC(BGPPC,15),U,11)]"") D
 ....D W^BGP2DP($TR($P(^BGPINDWC(BGPPC,15),U,10),"$","^"),0,0,BGPPTYPE,5,57),W^BGP2DP($P(^BGPINDWC(BGPPC,15),U,11),0,0,BGPPTYPE,6,68)
 ....D W^BGP2DP("",0,0,BGPPTYPE)
 I BGPPTYPE="P",$Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
 D W^BGP2DP(" *Non-GPRA measure included in the IHS GPRA report submitted to OMB to",0,2,BGPPTYPE)
 D W^BGP2DP("provide context to other GPRA measures.",0,1,BGPPTYPE)
 D W^BGP2DP("",0,1,BGPPTYPE)
 Q
 ;
 D HEADER^BGP2DPH
 D H1
 Q
 ;
H1 ;
 S X="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY" D W^BGP2DP(X,1,1,BGPPTYPE)
 I $G(BGPAREAA) D W^BGP2DP("Area",0,1,BGPPTYPE,2,27),W^BGP2DP("Area",0,0,BGPPTYPE,3,35),W^BGP2DP("Area",0,0,BGPPTYPE,4,44),W^BGP2DP("Nat'l",0,0,BGPPTYPE,5,57),W^BGP2DP("2020",0,0,BGPPTYPE,6,68)
 I '$G(BGPAREAA) D W^BGP2DP("Site",0,1,BGPPTYPE,2,27),W^BGP2DP("Site",0,0,BGPPTYPE,3,35),W^BGP2DP("Site",0,0,BGPPTYPE,4,44),W^BGP2DP("Nat'l",0,0,BGPPTYPE,5,57),W^BGP2DP("2020",0,0,BGPPTYPE,6,68)
 D W^BGP2DP("Current",0,1,BGPPTYPE,2,26),W^BGP2DP("Previous",0,0,BGPPTYPE,3,34),W^BGP2DP("Baseline",0,0,BGPPTYPE,4,43),W^BGP2DP("2011",0,0,BGPPTYPE,5,57),W^BGP2DP("Target",0,0,BGPPTYPE,6,68)
 D W^BGP2DP($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")
 ;----------