BGP9PDL ; IHS/CMI/LAB - IHS gpra print 01 Jul 2008 8:02 PM ;
;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
;
;
DEL ;
K ^TMP($J)
S ^TMP($J,"BGPDEL",0)=0
K BGPSUMP
D ^BGP9PDLH
D DEL1
I BGPRTYPE=1 D NONSUM^BGP9PDLN
I BGPRTYPE=1 D DEVSUM^BGP9PDLD
I BGPRTYPE=1 D SUMMARY
I BGPRTYPE=1 D SDP^BGP9PDLN
I BGPRTYPE=1 D SDP^BGP9PDLD
I BGPRTYPE=1 D SDP
I BGPRTYPE=7 D OTHSUM^BGP9PDLO
D ^BGP9PDLS ;print lists to delimited file
;if screen selected do screen
I $G(BGPSUMON) D SUMONLY Q ;NEW FOR 09, SUMMARY ONLY
I BGPDELT="S" D SCREEN,EXIT Q
;call xbgsave to create output file
S XBGL="BGPDATA"
L +^BGPDATA:300 E W:'$D(ZTQUEUED) "Unable to lock global" Q
K ^TMP($J,"SUMMARYDEL")
K ^BGPDATA ;global for saving
S X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X I ^TMP($J,"BGPDEL",X)'="ENDCOVERPAGE" S ^BGPDATA(X)=^TMP($J,"BGPDEL",X)
I '$D(BGPGUI) D
.S XBFLT=1,XBFN=BGPDELF_".txt",XBMED="F",XBTLE="GPRA 09 DELIMITED OUTPUT",XBQ="N",XBF=0
.D ^XBGSAVE
.K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
I $D(BGPGUI) D
.S (C,X)=0 F S X=$O(^BGPDATA(X)) Q:X'=+X S C=C+1,^BGPGUIN(BGPGIEN,12,C,0)=^BGPDATA(X)
.S ^BGPGUIN(BGPGIEN,12,0)="^90537.0812^"_C_"^"_C_"^"_DT
L -^BGPDATA
K ^BGPDATA ;export global
D EXIT
Q
SUMONLY ;
;if screen selected do screen
I BGPDELT="S" D SCREENSO,EXIT Q
;call xbgsave to create output file
S XBGL="BGPDATA"
L +^BGPDATA:300 E W:'$D(ZTQUEUED) "Unable to lock global" Q
K ^TMP($J,"SUMMARYDEL")
K ^BGPDATA ;global for saving
S X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(^TMP($J,"BGPDEL",X)="ENDCOVERPAGE") S ^BGPDATA(X)=^TMP($J,"BGPDEL",X),BGPLX=X
;GET STARTING POINT
S BGPSTP=0,X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X I ^TMP($J,"BGPDEL",X)="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY" S BGPSTP=X
S X=BGPSTP-1,BGPLX=BGPLX+1 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X S BGPLX=BGPLX+1 S ^BGPDATA(BGPLX)=^TMP($J,"BGPDEL",X)
I '$D(BGPGUI) D
.S XBFLT=1,XBFN=BGPDELF_".txt",XBMED="F",XBTLE="GPRA 09 DELIMITED OUTPUT",XBQ="N",XBF=0
.D ^XBGSAVE
.K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
I $D(BGPGUI) D
.S (C,X)=0 F S X=$O(^BGPDATA(X)) Q:X'=+X S C=C+1,^BGPGUIN(BGPGIEN,12,C,0)=^BGPDATA(X)
.S ^BGPGUIN(BGPGIEN,12,0)="^90537.0812^"_C_"^"_C_"^"_DT
L -^BGPDATA
K ^BGPDATA ;export global
D EXIT
Q
SCREENSO ;
S X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(^TMP($J,"BGPDEL",X)="ENDCOVERPAGE") W !,^TMP($J,"BGPDEL",X)
S BGPSTP=0,X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X I ^TMP($J,"BGPDEL",X)="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY" S BGPSTP=X
S X=BGPSTP-1 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X W !,^TMP($J,"BGPDEL",X)
Q
;
SCREEN ;
S X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X W:^TMP($J,"BGPDEL",X)'="ENDCOVERPAGE" !,^TMP($J,"BGPDEL",X)
Q
DEL1 ;EP
S BGPIC=0 F S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC="" D
.;now print individual measure
.S X=" " D S(X,1,1),S(X,1,1)
.S X=$P(^BGPINDN(BGPIC,0),U,3) D S(X,1,1)
.S X=" " D S(X,1,1)
.S X="Denominator(s):" D S(X,1,1)
.S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,61,"B",BGPX)) Q:BGPX'=+BGPX D
..S BGPY=0 F S BGPY=$O(^BGPINDN(BGPIC,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
...;I $P(^BGPINDN(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
...I '$D(^BGPINDN(BGPIC,61,BGPY,11,"B",BGPRTYPE)) Q
...I BGPRTYPE=4,'$D(^BGPINDN(BGPIC,61,BGPY,12,"B",BGPINDT)) Q
...S BGPZ=0 F S BGPZ=$O(^BGPINDN(BGPIC,61,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
....S Y=^BGPINDN(BGPIC,61,BGPY,1,BGPZ,0) D S(Y,1,1)
....Q
...Q
..Q
.S X=" " D S(X,1,1)
.S X="Numerator(s):" D S(X,1,1)
.S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,62,"B",BGPX)) Q:BGPX'=+BGPX D
..S BGPY=0 F S BGPY=$O(^BGPINDN(BGPIC,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
...;I $P(^BGPINDN(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
...;I BGPRTYPE=4,BGPINDT'="S",$P(^BGPINDN(BGPIC,62,BGPY,0),U,3)'[BGPINDT Q ;don't display
...I '$D(^BGPINDN(BGPIC,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
...I BGPRTYPE=4,'$D(^BGPINDN(BGPIC,62,BGPY,12,"B",BGPINDT)) Q
...S BGPZ=0 F S BGPZ=$O(^BGPINDN(BGPIC,62,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
....S X=^BGPINDN(BGPIC,62,BGPY,1,BGPZ,0) D S(X,1,1)
....Q
...Q
..Q
.S X=" " D S(X,1,1)
.S BGPNODE=11
.I BGPRTYPE=1,$O(^BGPINDN(BGPIC,54,0)) S BGPNODE=54
.I BGPRTYPE=7,$O(^BGPINDN(BGPIC,56,0)) S BGPNODE=56
.S X="Logic:" D S(X,1,1)
.S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
..S X=^BGPINDN(BGPIC,BGPNODE,BGPX,0) D S(X,1,1)
.S X=" " D S(X,1,1) S X="Performance Measure Description:" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,$S($G(BGPNGR09):57,1:51),BGPX)) Q:BGPX'=+BGPX D
..S X=^BGPINDN(BGPIC,$S($G(BGPNGR09):57,1:51),BGPX,0) D S(X,1,1)
.I $O(^BGPINDN(BGPIC,52,0)) S X=" " D S(X,1,1) S X="Past Performance and/or Target:" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,52,BGPX)) Q:BGPX'=+BGPX D
..S X=^BGPINDN(BGPIC,52,BGPX,0) D S(X,1,1)
.I $O(^BGPINDN(BGPIC,55,0)) S X=" " D S(X,1,1) S X="Source:" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDN(BGPIC,55,BGPX)) Q:BGPX'=+BGPX D
..S X=^BGPINDN(BGPIC,55,BGPX,0) D S(X,1,1)
.I '$O(^BGPINDN(BGPIC,55,0)) D S(" ",1,1)
.X ^BGPINDN(BGPIC,4)
.I $G(BGPNPL),$D(BGPINDL(BGPIC)),'$D(BGP9NPLT) S BGPINDN=BGPIC D NPL1^BGP9NPLD
.I $G(BGPNPL),$D(BGPINDL(BGPIC)),$D(BGP9NPLT) S BGPINDN=BGPIC S BGPDELIM=1 D CT^BGP9DSTM ; nat gpra SEARCH TEMPLATE
I $G(BGPCPPL) D CPPL1^BGP9DCLD
Q
S Y=$P(^VA(200,DUZ,0),U,2),$E(Y,35)=$$FMTE^XLFDT(DT) D S(Y,1,1)
I BGPRTYPE=7 S Y="*** IHS 2009 Other National Measures Report ***" D S(Y,1,1)
I BGPRTYPE=4 S Y="*** IHS 2009 Clinical Performance Report ***" D S(Y,1,1)
I BGPRTYPE=1,'$G(BGPNGR09) S Y="*** IHS 2009 National GPRA & PART Report ***" D S(Y,1,1)
I BGPRTYPE=1,$G(BGPNGR09) S Y="*** IHS 2010 National GPRA & PART Report, Run Using 2009 Logic ***" D S(Y,1,1)
I $G(BGPAREAA) S Y="AREA AGGREGATE" D S(Y,1,1)
I '$G(BGPAREAA) S Y=$P(^DIC(4,DUZ(2),0),U) D S(Y,1,1)
;S X=$$RPTVER^BGP9BAN D S(X,1,1)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D S(X,1,1)
S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D S(X,1,1)
S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D S(X,1,1)
S X=" " D S(X,1,1)
Q:$G(BGPSUMP)
I BGPRTYPE=1 S X="Measures: GPRA, GPRA Developmental, and PART Denominators and Numerators and Selected Other Clinical Denominators and Numerators" D S(X,1,1)
S X=" " D S(X,1,1)
I BGPRTYPE=1 S X="Population: AI/AN Only (Classification 01)" D S(X,1,1)
S X=" " D S(X,1,1)
S BGPI=$O(^BGPCTRL("B",2009,0))
S BGPX=0 F S BGPX=$O(^BGPCTRL(BGPI,14,BGPX)) Q:BGPX'=+BGPX D
.S X=^BGPCTRL(BGPI,14,BGPX,0) D S(X,1,1)
I $G(BGPEXPT) S X="A file will be created called BG09"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT_"." D S(X,1,1)
S X="It will reside in the public/export directory. This file should be sent to your Area Office." D S(X,1,1)
S X=" " D S(X,1,1)
I $G(BGPALLPT) S X="All Communities Included." D S(X,1,1)
I '$G(BGPALLPT),'$G(BGPSEAT) S X="Community Taxonomy Name: "_$P(^ATXAX(BGPTAXI,0),U) D S(X,1,1)
I '$G(BGPALLPT),'$G(BGPSEAT) S X="The following communities are included in this report:" D S(X,1,1) D
.S BGPZZ="",N=0,Y="" F S BGPZZ=$O(BGPTAX(BGPZZ)) Q:BGPZZ="" S N=N+1,Y=Y_$S(N=1:"",1:";")_BGPZZ
.S BGPZZ=0,C=0 F BGPZZ=1:3:N D
..S X=$E($P(Y,";",BGPZZ),1,20),$E(X,3)=$E($P(Y,";",(BGPZZ+1)),1,20),$E(X,60)=$E($P(Y,";",(BGPZZ+2)),1,20)
..Q
I $G(BGPMFITI) S X="MFI Location Taxonomy Name: "_$P(^ATXAX(BGPMFITI,0),U) D S(X,1,1)
I $G(BGPMFITI) S X="The following locations are used for patient visits in this report:" D S(X,1,1) D
.S BGPZZ="",N=0,Y="" F S BGPZZ=$O(^ATXAX(BGPMFITI,21,"B",BGPZZ)) Q:BGPZZ="" S N=N+1,Y=Y_$S(N=1:"",1:";")_$P($G(^DIC(4,BGPZZ,0)),U)
.S BGPZZ=0,C=0 F BGPZZ=1:3:N D
..S X=$E($P(Y,";",BGPZZ),1,20),$E(X,3)=$E($P(Y,";",(BGPZZ+1)),1,20),$E(X,60)=$E($P(Y,";",(BGPZZ+2)),1,20)
..Q
K BGPX,BGPQUIT
S X=$TR($J(""," ","-"),80) D S(X,1,1)
Q
EXIT ;
K ^TMP($J)
Q
CTR(X,Y) ;EP - Center
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return user
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
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
SUMMARY ;
I BGPRTYPE'=1 Q
Q:$G(BGPCPPL)
I $G(BGPNPL) Q
S BGPQUIT="",BGPGPG=0
S BGPSUMP=1,BGPNON=0
D H1
NEW P8,P4,P7,P12
S P8=$S('$G(BGPNGR09):8,1:13)
S P4=$S('$G(BGPNGR09):4,1:14)
S P7=$S('$G(BGPNGR09):7,1:15)
S P12=$S('$G(BGPNGR09):12,1:16)
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL",BGPC)) Q:BGPC'=+BGPC D
.S X=" " D S(X,1,1)
.S BGPC1=$O(^BGPSCAT("C",BGPC,0))
.S X=$P(^BGPSCAT(BGPC1,0),U,1) D S(X,1,1)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARYDEL",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL",BGPC,BGPO,0))
..S X=""
..I $P(^BGPINDNC(BGPPC,0),U,4)["014."!($P(^BGPINDNC(BGPPC,0),U,4)["023.")!($P(^BGPINDNC(BGPPC,0),U,4)["016")!($P($G(^BGPINDNC(BGPPC,19)),U,13)) D I 1
...S X=$P(^BGPINDNC(BGPPC,14),U,P4)
...I $P(^BGPINDNC(BGPPC,14),U,P7)]"" D S(X,1,1) S X=$P(^BGPINDNC(BGPPC,14),U,P7)
...I $P(^BGPINDNC(BGPPC,14),U,P12)]"" D S(X,1,1) S X=$P(^BGPINDNC(BGPPC,14),U,P12)
...S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)
...S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)
...S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)
...S $P(X,U,5)=$P(^BGPINDNC(BGPPC,14),U,P8)
...S $P(X,U,6)=$P(^BGPINDNC(BGPPC,14),U,2),$P(X,U,7)=$P(^BGPINDNC(BGPPC,14),U,3)
...D S(X,1,1)
..E D
...S X=$P(^BGPINDNC(BGPPC,14),U,P4)
...I $P(^BGPINDNC(BGPPC,14),U,P7)]"" D S(X,1,1) S X=$P(^BGPINDNC(BGPPC,14),U,P7)
...I $P(^BGPINDNC(BGPPC,14),U,P12)]"" D S(X,1,1) S X=$P(^BGPINDNC(BGPPC,14),U,P12)
...S $P(X,U,2)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)_"%"
...S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)_"%"
...S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)_"%"
...S $P(X,U,5)=$TR($P(^BGPINDNC(BGPPC,14),U,P8),"$","^")
...S $P(X,U,6)=$TR($P(^BGPINDNC(BGPPC,14),U,2),"$","^"),$P(X,U,7)=$P(^BGPINDNC(BGPPC,14),U,3)
...D S(X,1,1)
...S X="" I $P(^BGPINDNC(BGPPC,14),U,9)]""!($P(^BGPINDNC(BGPPC,14),U,10)]"")!($P(^BGPINDNC(BGPPC,14),U,11)]"") S $P(X,U,5)=$TR($P(^BGPINDNC(BGPPC,14),U,9),"$","^"),$P(X,U,6)=$TR($P(^BGPINDNC(BGPPC,14),U,10),"$","^") D
....S $P(X,U,7)=$P(^BGPINDNC(BGPPC,14),U,11)
...I X]"" D S(X,1,1)
S X=" " D S(X,1,1)
D FOOTER^BGP9PDH1
;D SDP
Q
;
H1 ;
S X=" " D S(X,2,1)
S X="OFFICIAL GPRA 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)=$S('$G(BGPNGR09):"GPRA09",1:"GPRA10"),$P(X,U,6)="Nat'l",$P(X,U,7)="2010" 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)=$S('$G(BGPNGR09):"GPRA09",1:"GPRA10"),$P(X,U,6)="Nat'l",$P(X,U,7)="2010" 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)="Target"_$S($G(BGPNGR09):"*",1:""),$P(X,U,6)="2008",$P(X,U,7)="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="OFFICIAL GPRA 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)=$S('$G(BGPNGR09):"GPRA09",1:"GPRA10"),$P(X,U,7)="National",$P(X,U,8)="2010" 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)="Target"_$S($G(BGPNGR09):"*",1:""),$P(X,U,7)="2008",$P(X,U,8)="Target" D S(X,1,1)
S X=$TR($J("",80)," ","-") D S(X,1,1)
Q
SDP ;
I BGPRTYPE'=1 Q ;national gpra only
I '$G(BGPAREAA) Q ;area only
S BGPQUIT="",BGPGPG=0
S BGPSUMP=1
S X=" " D S(X,2,1)
D HEADER
D H2
NEW P8,P4,P7,P12
S P8=$S('$G(BGPNGR09):8,1:13)
S P4=$S('$G(BGPNGR09):4,1:14)
S P7=$S('$G(BGPNGR09):7,1:15)
S P12=$S('$G(BGPNGR09):12,1:16)
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC)) Q:BGPC'=+BGPC D
.S X=" " D S(X,1,1)
.S BGPC1=$O(^BGPSCAT("C",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",BGPC,BGPO)) Q:BGPO="" D
..S BGPPC=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,0))
..S X=" " D S(X,1,1)
..S XX=" "_$P(^BGPINDNC(BGPPC,14),U,P4)
..I $P(^BGPINDNC(BGPPC,14),U,P7)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDNC(BGPPC,14),U,P7)
..I $P(^BGPINDNC(BGPPC,14),U,P12)]"" D S(XX,1,1) S XX=" "_$P(^BGPINDNC(BGPPC,14),U,P12)
..S F=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,0))
..S F=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
..S $P(XX,U,5)=F_$S($P(^BGPINDNC(BGPPC,0),U,4)["014."!($P(^BGPINDNC(BGPPC,0),U,4)["023.")!($P(^BGPINDNC(BGPPC,0),U,4)["016.")!($P($G(^BGPINDNC(BGPPC,19)),U,13)):"",1:"%")
..S $P(XX,U,6)=$P(^BGPINDNC(BGPPC,14),U,P8),$P(XX,U,7)=$P(^BGPINDNC(BGPPC,14),U,2),$P(XX,U,8)=$P(^BGPINDNC(BGPPC,14),U,3)
..S BGPSN=0,BGPCNT=0 F S BGPSN=$O(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN)) Q:BGPSN'=+BGPSN S BGPCNT=BGPCNT+1 D
...S BGPSASU=$P(^BGPGPDCN(BGPSN,0),U,9),X=$O(^AUTTLOC("C",BGPSASU,0)),BGPSNAM=$S(X:$P(^DIC(4,X,0),U),1:"?????"),BGPSNAM=$S($P(^BGPGPDCN(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
...I $P(^BGPINDNC(BGPPC,0),U,4)["014."!($P(^BGPINDNC(BGPPC,0),U,4)["023.")!($P(^BGPINDNC(BGPPC,0),U,4)["016")!($P($G(^BGPINDNC(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",BGPC,BGPO,BGPPC,BGPSN),U)
....S $P(X,U,3)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)
....S $P(X,U,4)=+$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)
....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",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",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
....S $P(X,U,3)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
....S $P(X,U,4)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
....;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
....;S $P(X,U,5)=$P(^BGPINDNC(BGPPC,14),U,2),$P(X,U,6)=$P(^BGPINDNC(BGPPC,14),U,3)
...I BGPCNT=1 D S(XX,1,1) D
....;S Y="" I $P(^BGPINDNC(BGPPC,14),U,9)]""!($P(^BGPINDNC(BGPPC,14),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDNC(BGPPC,14),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDNC(BGPPC,14),U,10),"$","^")
....S Y="" I $P(^BGPINDNC(BGPPC,14),U,9)]""!($P(^BGPINDNC(BGPPC,14),U,10)]"")!($P(^BGPINDNC(BGPPC,14),U,11)]"") S $P(Y,U,6)=$TR($P(^BGPINDNC(BGPPC,14),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDNC(BGPPC,14),U,10),"$","^") D
.....S $P(Y,U,8)=$P(^BGPINDNC(BGPPC,14),U,11)
....I Y]"" D S(Y,1,1)
...D S(X,1,1)
S X=" " D S(X,1,1)
D FOOTER^BGP9PDH1
Q
BGP9PDL ; IHS/CMI/LAB - IHS gpra print 01 Jul 2008 8:02 PM ;
+1 ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
+2 ;
+3 ;
DEL ;
+1 KILL ^TMP($JOB)
+2 SET ^TMP($JOB,"BGPDEL",0)=0
+3 KILL BGPSUMP
+4 DO ^BGP9PDLH
+5 DO DEL1
+6 IF BGPRTYPE=1
DO NONSUM^BGP9PDLN
+7 IF BGPRTYPE=1
DO DEVSUM^BGP9PDLD
+8 IF BGPRTYPE=1
DO SUMMARY
+9 IF BGPRTYPE=1
DO SDP^BGP9PDLN
+10 IF BGPRTYPE=1
DO SDP^BGP9PDLD
+11 IF BGPRTYPE=1
DO SDP
+12 IF BGPRTYPE=7
DO OTHSUM^BGP9PDLO
+13 ;print lists to delimited file
DO ^BGP9PDLS
+14 ;if screen selected do screen
+15 ;NEW FOR 09, SUMMARY ONLY
IF $GET(BGPSUMON)
DO SUMONLY
QUIT
+16 IF BGPDELT="S"
DO SCREEN
DO EXIT
QUIT
+17 ;call xbgsave to create output file
+18 SET XBGL="BGPDATA"
+19 LOCK +^BGPDATA:300
IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE "Unable to lock global"
QUIT
+20 KILL ^TMP($JOB,"SUMMARYDEL")
+21 ;global for saving
KILL ^BGPDATA
+22 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)'="ENDCOVERPAGE"
SET ^BGPDATA(X)=^TMP($JOB,"BGPDEL",X)
+23 IF '$DATA(BGPGUI)
Begin DoDot:1
+24 SET XBFLT=1
SET XBFN=BGPDELF_".txt"
SET XBMED="F"
SET XBTLE="GPRA 09 DELIMITED OUTPUT"
SET XBQ="N"
SET XBF=0
+25 DO ^XBGSAVE
+26 KILL XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
End DoDot:1
+27 IF $DATA(BGPGUI)
Begin DoDot:1
+28 SET (C,X)=0
FOR
SET X=$ORDER(^BGPDATA(X))
IF X'=+X
QUIT
SET C=C+1
SET ^BGPGUIN(BGPGIEN,12,C,0)=^BGPDATA(X)
+29 SET ^BGPGUIN(BGPGIEN,12,0)="^90537.0812^"_C_"^"_C_"^"_DT
End DoDot:1
+30 LOCK -^BGPDATA
+31 ;export global
KILL ^BGPDATA
+32 DO EXIT
+33 QUIT
SUMONLY ;
+1 ;if screen selected do screen
+2 IF BGPDELT="S"
DO SCREENSO
DO EXIT
QUIT
+3 ;call xbgsave to create output file
+4 SET XBGL="BGPDATA"
+5 LOCK +^BGPDATA:300
IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE "Unable to lock global"
QUIT
+6 KILL ^TMP($JOB,"SUMMARYDEL")
+7 ;global for saving
KILL ^BGPDATA
+8 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X!(^TMP($JOB,"BGPDEL",X)="ENDCOVERPAGE")
QUIT
SET ^BGPDATA(X)=^TMP($JOB,"BGPDEL",X)
SET BGPLX=X
+9 ;GET STARTING POINT
+10 SET BGPSTP=0
SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY"
SET BGPSTP=X
+11 SET X=BGPSTP-1
SET BGPLX=BGPLX+1
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
SET BGPLX=BGPLX+1
SET ^BGPDATA(BGPLX)=^TMP($JOB,"BGPDEL",X)
+12 IF '$DATA(BGPGUI)
Begin DoDot:1
+13 SET XBFLT=1
SET XBFN=BGPDELF_".txt"
SET XBMED="F"
SET XBTLE="GPRA 09 DELIMITED OUTPUT"
SET XBQ="N"
SET XBF=0
+14 DO ^XBGSAVE
+15 KILL XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
End DoDot:1
+16 IF $DATA(BGPGUI)
Begin DoDot:1
+17 SET (C,X)=0
FOR
SET X=$ORDER(^BGPDATA(X))
IF X'=+X
QUIT
SET C=C+1
SET ^BGPGUIN(BGPGIEN,12,C,0)=^BGPDATA(X)
+18 SET ^BGPGUIN(BGPGIEN,12,0)="^90537.0812^"_C_"^"_C_"^"_DT
End DoDot:1
+19 LOCK -^BGPDATA
+20 ;export global
KILL ^BGPDATA
+21 DO EXIT
+22 QUIT
SCREENSO ;
+1 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X!(^TMP($JOB,"BGPDEL",X)="ENDCOVERPAGE")
QUIT
WRITE !,^TMP($JOB,"BGPDEL",X)
+2 SET BGPSTP=0
SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY"
SET BGPSTP=X
+3 SET X=BGPSTP-1
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
WRITE !,^TMP($JOB,"BGPDEL",X)
+4 QUIT
+5 ;
SCREEN ;
+1 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)'="ENDCOVERPAGE"
WRITE !,^TMP($JOB,"BGPDEL",X)
+2 QUIT
DEL1 ;EP
+1 SET BGPIC=0
FOR
SET BGPIC=$ORDER(BGPIND(BGPIC))
IF BGPIC=""
QUIT
Begin DoDot:1
+2 ;now print individual measure
+3 SET X=" "
DO S(X,1,1)
DO S(X,1,1)
+4 SET X=$PIECE(^BGPINDN(BGPIC,0),U,3)
DO S(X,1,1)
+5 SET X=" "
DO S(X,1,1)
+6 SET X="Denominator(s):"
DO S(X,1,1)
+7 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,61,"B",BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+8 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDN(BGPIC,61,"B",BGPX,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:3
+9 ;I $P(^BGPINDN(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
+10 IF '$DATA(^BGPINDN(BGPIC,61,BGPY,11,"B",BGPRTYPE))
QUIT
+11 IF BGPRTYPE=4
IF '$DATA(^BGPINDN(BGPIC,61,BGPY,12,"B",BGPINDT))
QUIT
+12 SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPINDN(BGPIC,61,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ
QUIT
Begin DoDot:4
+13 SET Y=^BGPINDN(BGPIC,61,BGPY,1,BGPZ,0)
DO S(Y,1,1)
+14 QUIT
End DoDot:4
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 SET X=" "
DO S(X,1,1)
+18 SET X="Numerator(s):"
DO S(X,1,1)
+19 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,62,"B",BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+20 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDN(BGPIC,62,"B",BGPX,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:3
+21 ;I $P(^BGPINDN(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
+22 ;I BGPRTYPE=4,BGPINDT'="S",$P(^BGPINDN(BGPIC,62,BGPY,0),U,3)'[BGPINDT Q ;don't display
+23 ;not this report type
IF '$DATA(^BGPINDN(BGPIC,62,BGPY,11,"B",BGPRTYPE))
QUIT
+24 IF BGPRTYPE=4
IF '$DATA(^BGPINDN(BGPIC,62,BGPY,12,"B",BGPINDT))
QUIT
+25 SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPINDN(BGPIC,62,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ
QUIT
Begin DoDot:4
+26 SET X=^BGPINDN(BGPIC,62,BGPY,1,BGPZ,0)
DO S(X,1,1)
+27 QUIT
End DoDot:4
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 SET X=" "
DO S(X,1,1)
+31 SET BGPNODE=11
+32 IF BGPRTYPE=1
IF $ORDER(^BGPINDN(BGPIC,54,0))
SET BGPNODE=54
+33 IF BGPRTYPE=7
IF $ORDER(^BGPINDN(BGPIC,56,0))
SET BGPNODE=56
+34 SET X="Logic:"
DO S(X,1,1)
+35 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,BGPNODE,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+36 SET X=^BGPINDN(BGPIC,BGPNODE,BGPX,0)
DO S(X,1,1)
End DoDot:2
+37 SET X=" "
DO S(X,1,1)
SET X="Performance Measure Description:"
DO S(X,1,1)
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,$SELECT($GET(BGPNGR09):57,1:51),BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+38 SET X=^BGPINDN(BGPIC,$SELECT($GET(BGPNGR09):57,1:51),BGPX,0)
DO S(X,1,1)
End DoDot:2
+39 IF $ORDER(^BGPINDN(BGPIC,52,0))
SET X=" "
DO S(X,1,1)
SET X="Past Performance and/or Target:"
DO S(X,1,1)
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,52,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+40 SET X=^BGPINDN(BGPIC,52,BGPX,0)
DO S(X,1,1)
End DoDot:2
+41 IF $ORDER(^BGPINDN(BGPIC,55,0))
SET X=" "
DO S(X,1,1)
SET X="Source:"
DO S(X,1,1)
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDN(BGPIC,55,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+42 SET X=^BGPINDN(BGPIC,55,BGPX,0)
DO S(X,1,1)
End DoDot:2
+43 IF '$ORDER(^BGPINDN(BGPIC,55,0))
DO S(" ",1,1)
+44 XECUTE ^BGPINDN(BGPIC,4)
+45 IF $GET(BGPNPL)
IF $DATA(BGPINDL(BGPIC))
IF '$DATA(BGP9NPLT)
SET BGPINDN=BGPIC
DO NPL1^BGP9NPLD
+46 ; nat gpra SEARCH TEMPLATE
IF $GET(BGPNPL)
IF $DATA(BGPINDL(BGPIC))
IF $DATA(BGP9NPLT)
SET BGPINDN=BGPIC
SET BGPDELIM=1
DO CT^BGP9DSTM
End DoDot:1
+47 IF $GET(BGPCPPL)
DO CPPL1^BGP9DCLD
+48 QUIT
+1 SET Y=$PIECE(^VA(200,DUZ,0),U,2)
SET $EXTRACT(Y,35)=$$FMTE^XLFDT(DT)
DO S(Y,1,1)
+2 IF BGPRTYPE=7
SET Y="*** IHS 2009 Other National Measures Report ***"
DO S(Y,1,1)
+3 IF BGPRTYPE=4
SET Y="*** IHS 2009 Clinical Performance Report ***"
DO S(Y,1,1)
+4 IF BGPRTYPE=1
IF '$GET(BGPNGR09)
SET Y="*** IHS 2009 National GPRA & PART Report ***"
DO S(Y,1,1)
+5 IF BGPRTYPE=1
IF $GET(BGPNGR09)
SET Y="*** IHS 2010 National GPRA & PART Report, Run Using 2009 Logic ***"
DO S(Y,1,1)
+6 IF $GET(BGPAREAA)
SET Y="AREA AGGREGATE"
DO S(Y,1,1)
+7 IF '$GET(BGPAREAA)
SET Y=$PIECE(^DIC(4,DUZ(2),0),U)
DO S(Y,1,1)
+8 ;S X=$$RPTVER^BGP9BAN D S(X,1,1)
+9 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO S(X,1,1)
+10 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
DO S(X,1,1)
+11 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
DO S(X,1,1)
+12 SET X=" "
DO S(X,1,1)
+13 IF $GET(BGPSUMP)
QUIT
+14 IF BGPRTYPE=1
SET X="Measures: GPRA, GPRA Developmental, and PART Denominators and Numerators and Selected Other Clinical Denominators and Numerators"
DO S(X,1,1)
+15 SET X=" "
DO S(X,1,1)
+16 IF BGPRTYPE=1
SET X="Population: AI/AN Only (Classification 01)"
DO S(X,1,1)
+17 SET X=" "
DO S(X,1,1)
+18 SET BGPI=$ORDER(^BGPCTRL("B",2009,0))
+19 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPCTRL(BGPI,14,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:1
+20 SET X=^BGPCTRL(BGPI,14,BGPX,0)
DO S(X,1,1)
End DoDot:1
+21 IF $GET(BGPEXPT)
SET X="A file will be created called BG09"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT_"."
DO S(X,1,1)
+22 SET X="It will reside in the public/export directory. This file should be sent to your Area Office."
DO S(X,1,1)
+23 SET X=" "
DO S(X,1,1)
+24 IF $GET(BGPALLPT)
SET X="All Communities Included."
DO S(X,1,1)
+25 IF '$GET(BGPALLPT)
IF '$GET(BGPSEAT)
SET X="Community Taxonomy Name: "_$PIECE(^ATXAX(BGPTAXI,0),U)
DO S(X,1,1)
+26 IF '$GET(BGPALLPT)
IF '$GET(BGPSEAT)
SET X="The following communities are included in this report:"
DO S(X,1,1)
Begin DoDot:1
+27 SET BGPZZ=""
SET N=0
SET Y=""
FOR
SET BGPZZ=$ORDER(BGPTAX(BGPZZ))
IF BGPZZ=""
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_BGPZZ
+28 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:N
Begin DoDot:2
+29 SET X=$EXTRACT($PIECE(Y,";",BGPZZ),1,20)
SET $EXTRACT(X,3)=$EXTRACT($PIECE(Y,";",(BGPZZ+1)),1,20)
SET $EXTRACT(X,60)=$EXTRACT($PIECE(Y,";",(BGPZZ+2)),1,20)
+30 QUIT
End DoDot:2
End DoDot:1
+31 IF $GET(BGPMFITI)
SET X="MFI Location Taxonomy Name: "_$PIECE(^ATXAX(BGPMFITI,0),U)
DO S(X,1,1)
+32 IF $GET(BGPMFITI)
SET X="The following locations are used for patient visits in this report:"
DO S(X,1,1)
Begin DoDot:1
+33 SET BGPZZ=""
SET N=0
SET Y=""
FOR
SET BGPZZ=$ORDER(^ATXAX(BGPMFITI,21,"B",BGPZZ))
IF BGPZZ=""
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_$PIECE($GET(^DIC(4,BGPZZ,0)),U)
+34 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:N
Begin DoDot:2
+35 SET X=$EXTRACT($PIECE(Y,";",BGPZZ),1,20)
SET $EXTRACT(X,3)=$EXTRACT($PIECE(Y,";",(BGPZZ+1)),1,20)
SET $EXTRACT(X,60)=$EXTRACT($PIECE(Y,";",(BGPZZ+2)),1,20)
+36 QUIT
End DoDot:2
End DoDot:1
+37 KILL BGPX,BGPQUIT
+38 SET X=$TRANSLATE($JUSTIFY(""," ","-"),80)
DO S(X,1,1)
+39 QUIT
EXIT ;
+1 KILL ^TMP($JOB)
+2 QUIT
CTR(X,Y) ;EP - Center
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return user
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+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
SUMMARY ;
+1 IF BGPRTYPE'=1
QUIT
+2 IF $GET(BGPCPPL)
QUIT
+3 IF $GET(BGPNPL)
QUIT
+4 SET BGPQUIT=""
SET BGPGPG=0
+5 SET BGPSUMP=1
SET BGPNON=0
+6 DO H1
+7 NEW P8,P4,P7,P12
+8 SET P8=$SELECT('$GET(BGPNGR09):8,1:13)
+9 SET P4=$SELECT('$GET(BGPNGR09):4,1:14)
+10 SET P7=$SELECT('$GET(BGPNGR09):7,1:15)
+11 SET P12=$SELECT('$GET(BGPNGR09):12,1:16)
+12 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+13 SET X=" "
DO S(X,1,1)
+14 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+15 SET X=$PIECE(^BGPSCAT(BGPC1,0),U,1)
DO S(X,1,1)
+16 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+17 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,0))
+18 SET X=""
+19 IF $PIECE(^BGPINDNC(BGPPC,0),U,4)["014."!($PIECE(^BGPINDNC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDNC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDNC(BGPPC,19)),U,13))
Begin DoDot:3
+20 SET X=$PIECE(^BGPINDNC(BGPPC,14),U,P4)
+21 IF $PIECE(^BGPINDNC(BGPPC,14),U,P7)]""
DO S(X,1,1)
SET X=$PIECE(^BGPINDNC(BGPPC,14),U,P7)
+22 IF $PIECE(^BGPINDNC(BGPPC,14),U,P12)]""
DO S(X,1,1)
SET X=$PIECE(^BGPINDNC(BGPPC,14),U,P12)
+23 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)
+24 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)
+25 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)
+26 SET $PIECE(X,U,5)=$PIECE(^BGPINDNC(BGPPC,14),U,P8)
+27 SET $PIECE(X,U,6)=$PIECE(^BGPINDNC(BGPPC,14),U,2)
SET $PIECE(X,U,7)=$PIECE(^BGPINDNC(BGPPC,14),U,3)
+28 DO S(X,1,1)
End DoDot:3
IF 1
+29 IF '$TEST
Begin DoDot:3
+30 SET X=$PIECE(^BGPINDNC(BGPPC,14),U,P4)
+31 IF $PIECE(^BGPINDNC(BGPPC,14),U,P7)]""
DO S(X,1,1)
SET X=$PIECE(^BGPINDNC(BGPPC,14),U,P7)
+32 IF $PIECE(^BGPINDNC(BGPPC,14),U,P12)]""
DO S(X,1,1)
SET X=$PIECE(^BGPINDNC(BGPPC,14),U,P12)
+33 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U)_"%"
+34 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,2)_"%"
+35 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL",BGPC,BGPO,BGPPC),U,3)_"%"
+36 SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDNC(BGPPC,14),U,P8),"$","^")
+37 SET $PIECE(X,U,6)=$TRANSLATE($PIECE(^BGPINDNC(BGPPC,14),U,2),"$","^")
SET $PIECE(X,U,7)=$PIECE(^BGPINDNC(BGPPC,14),U,3)
+38 DO S(X,1,1)
+39 SET X=""
IF $PIECE(^BGPINDNC(BGPPC,14),U,9)]""!($PIECE(^BGPINDNC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDNC(BGPPC,14),U,11)]"")
SET $PIECE(X,U,5)=$TRANSLATE($PIECE(^BGPINDNC(BGPPC,14),U,9),"$","^")
SET $PIECE(X,U,6)=$TRANSLATE($PIECE(^BGPINDNC(BGPPC,14),U,10),"$","^")
Begin DoDot:4
+40 SET $PIECE(X,U,7)=$PIECE(^BGPINDNC(BGPPC,14),U,11)
End DoDot:4
+41 IF X]""
DO S(X,1,1)
End DoDot:3
End DoDot:2
End DoDot:1
+42 SET X=" "
DO S(X,1,1)
+43 DO FOOTER^BGP9PDH1
+44 ;D SDP
+45 QUIT
+46 ;
H1 ;
+1 SET X=" "
DO S(X,2,1)
+2 SET X="OFFICIAL GPRA 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)=$SELECT('$GET(BGPNGR09):"GPRA09",1:"GPRA10")
SET $PIECE(X,U,6)="Nat'l"
SET $PIECE(X,U,7)="2010"
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)=$SELECT('$GET(BGPNGR09):"GPRA09",1:"GPRA10")
SET $PIECE(X,U,6)="Nat'l"
SET $PIECE(X,U,7)="2010"
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)="Target"_$SELECT($GET(BGPNGR09):"*",1:"")
SET $PIECE(X,U,6)="2008"
SET $PIECE(X,U,7)="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="OFFICIAL GPRA 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)=$SELECT('$GET(BGPNGR09):"GPRA09",1:"GPRA10")
SET $PIECE(X,U,7)="National"
SET $PIECE(X,U,8)="2010"
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)="Target"_$SELECT($GET(BGPNGR09):"*",1:"")
SET $PIECE(X,U,7)="2008"
SET $PIECE(X,U,8)="Target"
DO S(X,1,1)
+5 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO S(X,1,1)
+6 QUIT
SDP ;
+1 ;national gpra only
IF BGPRTYPE'=1
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
+7 DO H2
+8 NEW P8,P4,P7,P12
+9 SET P8=$SELECT('$GET(BGPNGR09):8,1:13)
+10 SET P4=$SELECT('$GET(BGPNGR09):4,1:14)
+11 SET P7=$SELECT('$GET(BGPNGR09):7,1:15)
+12 SET P12=$SELECT('$GET(BGPNGR09):12,1:16)
+13 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC))
IF BGPC'=+BGPC
QUIT
Begin DoDot:1
+14 SET X=" "
DO S(X,1,1)
+15 SET BGPC1=$ORDER(^BGPSCAT("C",BGPC,0))
+16 SET X=$PIECE(^BGPSCAT(BGPC1,0),U,1)
DO S(X,1,1)
+17 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO))
IF BGPO=""
QUIT
Begin DoDot:2
+18 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,0))
+19 SET X=" "
DO S(X,1,1)
+20 SET XX=" "_$PIECE(^BGPINDNC(BGPPC,14),U,P4)
+21 IF $PIECE(^BGPINDNC(BGPPC,14),U,P7)]""
DO S(XX,1,1)
SET XX=" "_$PIECE(^BGPINDNC(BGPPC,14),U,P7)
+22 IF $PIECE(^BGPINDNC(BGPPC,14),U,P12)]""
DO S(XX,1,1)
SET XX=" "_$PIECE(^BGPINDNC(BGPPC,14),U,P12)
+23 SET F=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,0))
+24 SET F=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,F),U,4)
+25 SET $PIECE(XX,U,5)=F_$SELECT($PIECE(^BGPINDNC(BGPPC,0),U,4)["014."!($PIECE(^BGPINDNC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDNC(BGPPC,0),U,4)["016.")!($PIECE($GET(^BGPINDNC(BGPPC,19)),U,13)):"",1:"%")
+26 SET $PIECE(XX,U,6)=$PIECE(^BGPINDNC(BGPPC,14),U,P8)
SET $PIECE(XX,U,7)=$PIECE(^BGPINDNC(BGPPC,14),U,2)
SET $PIECE(XX,U,8)=$PIECE(^BGPINDNC(BGPPC,14),U,3)
+27 SET BGPSN=0
SET BGPCNT=0
FOR
SET BGPSN=$ORDER(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN))
IF BGPSN'=+BGPSN
QUIT
SET BGPCNT=BGPCNT+1
Begin DoDot:3
+28 SET BGPSASU=$PIECE(^BGPGPDCN(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(^BGPGPDCN(BGPSN,0),U,17):"+"_BGPSNAM,1:BGPSNAM)
+29 IF $PIECE(^BGPINDNC(BGPPC,0),U,4)["014."!($PIECE(^BGPINDNC(BGPPC,0),U,4)["023.")!($PIECE(^BGPINDNC(BGPPC,0),U,4)["016")!($PIECE($GET(^BGPINDNC(BGPPC,19)),U,13))
Begin DoDot:4
+30 SET X=""
SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+31 SET $PIECE(X,U,2)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U)
+32 SET $PIECE(X,U,3)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)
+33 SET $PIECE(X,U,4)=+$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)
+34 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,4)
End DoDot:4
IF 1
+35 IF '$TEST
Begin DoDot:4
+36 SET $PIECE(X,U,1)=BGPSASU_" "_BGPSNAM
+37 SET $PIECE(X,U,2)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U)_"%"
+38 SET $PIECE(X,U,3)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,2)_"%"
+39 SET $PIECE(X,U,4)=$PIECE(^TMP($JOB,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,3)_"%"
+40 ;S $P(X,U,5)=$P(^TMP($J,"SUMMARYDEL DETAIL PAGE",BGPC,BGPO,BGPPC,BGPSN),U,4)_"%"
+41 ;S $P(X,U,5)=$P(^BGPINDNC(BGPPC,14),U,2),$P(X,U,6)=$P(^BGPINDNC(BGPPC,14),U,3)
End DoDot:4
+42 IF BGPCNT=1
DO S(XX,1,1)
Begin DoDot:4
+43 ;S Y="" I $P(^BGPINDNC(BGPPC,14),U,9)]""!($P(^BGPINDNC(BGPPC,14),U,10)]"") S $P(Y,U,6)=$TR($P(^BGPINDNC(BGPPC,14),U,9),"$","^"),$P(Y,U,7)=$TR($P(^BGPINDNC(BGPPC,14),U,10),"$","^")
+44 SET Y=""
IF $PIECE(^BGPINDNC(BGPPC,14),U,9)]""!($PIECE(^BGPINDNC(BGPPC,14),U,10)]"")!($PIECE(^BGPINDNC(BGPPC,14),U,11)]"")
SET $PIECE(Y,U,6)=$TRANSLATE($PIECE(^BGPINDNC(BGPPC,14),U,9),"$","^")
SET $PIECE(Y,U,7)=$TRANSLATE($PIECE(^BGPINDNC(BGPPC,14),U,10),"$","^")
Begin DoDot:5
+45 SET $PIECE(Y,U,8)=$PIECE(^BGPINDNC(BGPPC,14),U,11)
End DoDot:5
+46 IF Y]""
DO S(Y,1,1)
End DoDot:4
+47 DO S(X,1,1)
End DoDot:3
End DoDot:2
End DoDot:1
+48 SET X=" "
DO S(X,1,1)
+49 DO FOOTER^BGP9PDH1
+50 QUIT
