BGP9PDL.m

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

HEADER ;EP

 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