BGP9GRA ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
;
;
;
;area GPRA reports
Q
;
DEBUG(RETVAL,BGPSTR) ;run the debugger
D DEBUG^%Serenji("AONM^BGP9GRA(.RETVAL,.BGPSTR)")
Q
;
AGP(RETVAL,BGPSTR) ;-- queue National GPRA Report
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN,A,R
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S P="|",A="*",R="~"
S BGPI=0
S BGPERR=""
S BGPAF=$P(BGPSTR,P)
S BGPOT=$P(BGPSTR,P,2)
S BGPFN=$P(BGPSTR,P,3)
S BGPOPT="CRS 09 AREA NATIONAL GPRA REPORT"
S BGPRT=$P(BGPSTR,P,4)
S BGPLSTI=$P(BGPSTR,P,5)
S BGPFN=$P(BGPSTR,P,7)
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T02500DATA"_$C(30)
D EP^BGP9GAGP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPFN,BGPRT,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
AELD(RETVAL,BGPSTR) ;-- area elder care report
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R,BGPFN
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S P="|",A="*",R="~"
S BGPI=0
S BGPERR=""
S BGPQTR=$P(BGPSTR,P)
S BGPRT=$P(BGPSTR,P,2)
S BGPRE=$P(BGPSTR,P,3)
S BGPPER=$P(BGPSTR,P,4)
S BGPBAS=$P(BGPSTR,P,5)
S BGPBEN=$P(BGPSTR,P,6)
S BGPOT=$P(BGPSTR,P,7)
S BGPLSTI=$P(BGPSTR,P,8)
S BGPFN=$P(BGPSTR,P,10)
S BGPOPT="CRS 09 AREA ELDER CARE REPORT"
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GAEL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
AHED(RETVAL,BGPSTR) ;-- area hedis report
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,BGPFN
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S P="|",A="*",R="~"
S BGPI=0
S BGPERR=""
S BGPQTR=$P(BGPSTR,P)
S BGPRT=$P(BGPSTR,P,2)
S BGPRE=$P(BGPSTR,P,3)
S BGPPER=$P(BGPSTR,P,4)
S BGPBAS=$P(BGPSTR,P,5)
S BGPBEN=$P(BGPSTR,P,6)
S BGPOT=$P(BGPSTR,P,7)
S BGPLSTI=$P(BGPSTR,P,8)
S BGPFN=$P(BGPSTR,P,10)
S BGPOPT="CRS 09 AREA HEDIS REPORT"
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GAHE(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
APER(RETVAL,BGPSTR) ;-- area performance report
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R,BGPFN
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S P="|",A="*",R="~"
S BGPI=0
S BGPERR=""
S BGPQTR=$P(BGPSTR,P)
S BGPRT=$P(BGPSTR,P,2)
S BGPRE=$P(BGPSTR,P,3)
S BGPPER=$P(BGPSTR,P,4)
S BGPBAS=$P(BGPSTR,P,5)
S BGPBEN=$P(BGPSTR,P,6)
S BGPOT=$P(BGPSTR,P,7)
S BGPLSTI=$P(BGPSTR,P,8)
S BGPFN=$P(BGPSTR,P,10)
S BGPOPT="CRS 09 AREA GPRA PERFORMANCE REPORT"
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GAPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
CHW(RETVAL,BGPSTR) ;-- queue National GPRA Report
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPMSG,BGPOPT,BGPRT,BGPFN,A,R,BGPOM,BGPFN
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S P="|",A="*",R="~"
S BGPI=0
S BGPERR=""
S BGPAF=$P(BGPSTR,P)
S BGPOPT="CRS 09 AREA HEIGHT AND WEIGHT DATA FILE"
S BGPRT=$P(BGPSTR,P,4)
S BGPLSTI=$P(BGPSTR,P,5)
S BGPOM=$P(BGPSTR,P,6)
S BGPFN=$P(BGPSTR,P,7)
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GACW(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPRT,BGPOM,BGPFN)
S BGPMSG=$P(BGPERR,U,2)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
APED(RETVAL,BGPSTR) ;-- area elder care report
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN
N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S P="|",A="*",R="~"
S BGPI=0
S BGPERR=""
S BGPQTR=$P(BGPSTR,P)
S BGPRT=$P(BGPSTR,P,2)
S BGPRE=$P(BGPSTR,P,3)
S BGPPER=$P(BGPSTR,P,4)
S BGPBAS=$P(BGPSTR,P,5)
S BGPBEN=$P(BGPSTR,P,6)
S BGPOT=$P(BGPSTR,P,7)
S BGPLSTI=$P(BGPSTR,P,8)
S BGPFN=$P(BGPSTR,P,10)
S BGPOPT="CRS 09 AREA PATIENT EDUCATION REPORT"
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GAPE(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
AONM(RETVAL,BGPSTR) ;-- area other national measures
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN
N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R,BGPHC
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S P="|",A="*",R="~"
S BGPI=0
S BGPERR=""
S BGPQTR=$P(BGPSTR,P)
S BGPRT=$P(BGPSTR,P,2)
S BGPRE=$P(BGPSTR,P,3)
S BGPPER=$P(BGPSTR,P,4)
S BGPBAS=$P(BGPSTR,P,5)
S BGPBEN=$P(BGPSTR,P,6)
S BGPOT=$P(BGPSTR,P,7)
S BGPLSTI=$P(BGPSTR,P,8)
S BGPHC=$P(BGPSTR,P,9)
S BGPFN=$P(BGPSTR,P,10)
S BGPOPT="CRS 09 AREA OTHER NATIONAL MEASURES REPORT"
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GAON(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPHC,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
ONM(RETVAL,BGPSTR) ;-- queue Other National Measures Report
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPIND,BGPLIST
N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPINDI,R,BGPHC,BGPFN
S P="|",R="~"
S BGPI=0
S BGPERR=""
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
;S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPYN=$P(BGPSTR,P,2)
S BGPQTR=$P(BGPSTR,P,3)
S BGPRT=$P(BGPSTR,P,4)
S BGPRE=$P(BGPSTR,P,5)
S BGPBAS=$P(BGPSTR,P,6)
S BGPBEN=$P(BGPSTR,P,7)
S BGPOT=$P(BGPSTR,P,8)
S BGPMFITI=$P(BGPSTR,P,9)
S BGPHC=$P(BGPSTR,P,10)
S BGPFN=$P(BGPSTR,P,11)
S BGPOPT="CRS 09 OTHER NATIONAL MEASURES REPORT"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GDON(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPHC,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
ONML(RETVAL,BGPSTR) ;-- queue other national measures patient lists
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL
N BGPBLDT,BGPBEN,BGPFN
S P="|",R="~"
S BGPI=0
S BGPERR=""
I $G(BGPSTR)="" D CATSTR^BGP9GR(.BGPSTR,.BGPSTR)
S BGPCT=$P($P(BGPSTR,P),R)
I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
;S BGPCT=$O(^ATXAX("B",BGPCT,0))
S BGPDT=$P(BGPSTR,P,2)
S BGPPIEN=$P($P(BGPSTR,P,3),R)
S BGPPRV=$P($P(BGPSTR,P,3),R,2)
S BGPOPT="CRS 09 OTHER NATIONAL MEASURES PAT LISTS"
S BGPOT=$P(BGPSTR,P,4)
S BGPRT=$P(BGPSTR,P,5)
S BGPQTR=$P(BGPSTR,P,6)
S BGPLST=$P(BGPSTR,P,7)
S BGPMFITI=$P(BGPSTR,P,8)
S BGPBLDT=$P(BGPSTR,P,9)
S BGPBEN=$P(BGPSTR,P,10)
S BGPFN=$P(BGPSTR,P,11)
N I
;F I=11:1 D Q:$P(BGPSTR,P,I)=""
F I=13:1 D Q:$P(BGPSTR,P,I)=""
. Q:$P(BGPSTR,P,I)=""
. N BGPNSTR
. S BGPNSTR=$P(BGPSTR,P,I)
. S BGPINDI=$P(BGPNSTR,R)
. S BGPIND(BGPINDI)=""
. N J
. F J=2:1 D Q:$P(BGPNSTR,R,J)=""
.. Q:$P(BGPNSTR,R,J)=""
.. N BGPSIND
.. S BGPSIND=$P(BGPNSTR,R,J)
.. S BGPINDL(BGPINDI,BGPSIND)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
AGP9(RETVAL,BGPSTR) ;-- queue National GPRA Report
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN,A,R,BGPFLN
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S P="|",A="*",R="~"
S BGPI=0
S BGPERR=""
S BGPAF=$P(BGPSTR,P)
S BGPOT=$P(BGPSTR,P,2)
S BGPFN=$P(BGPSTR,P,3)
S BGPOPT="CRS 09 AREA GPRA REPORT FOR 10"
S BGPRT=$P(BGPSTR,P,4)
S BGPLSTI=$P(BGPSTR,P,5)
S BGPFLN=$P(BGPSTR,P,7)
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T02500DATA"_$C(30)
D EP^BGP9GAG9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPFN,BGPRT,BGPFLN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
AGPSUM(RETVAL,BGPSTR) ;-- queue National GPRA Report
S X="MERR^BGP9GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN,A,R,BGPSUMON
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S P="|",A="*",R="~"
S BGPI=0
S BGPERR=""
S BGPAF=$P(BGPSTR,P)
S BGPOT=$P(BGPSTR,P,2)
S BGPOPT="CRS 09 AREA NTL GPRA SUM"
S BGPRT=$P(BGPSTR,P,4)
S BGPLSTI=$P(BGPSTR,P,5)
S BGPFN=$P(BGPSTR,P,7)
S BGPSUMON=1
N I
F I=2:1 D Q:$P(BGPLSTI,A,I)=""
. Q:$P(BGPLSTI,A,I)=""
. N BGPL
. S BGPL=$P($P(BGPLSTI,A,I),R)
. S BGPLIST(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP9GAGS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPRT,BGPSUMON,BGPFN)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
BGP9GRA ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
+1 ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
+2 ;
+3 ;
+4 ;
+5 ;area GPRA reports
+6 QUIT
+7 ;
DEBUG(RETVAL,BGPSTR) ;run the debugger
+1 DO DEBUG^%Serenji("AONM^BGP9GRA(.RETVAL,.BGPSTR)")
+2 QUIT
+3 ;
AGP(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN,A,R
+3 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+4 SET P="|"
SET A="*"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 SET BGPAF=$PIECE(BGPSTR,P)
+8 SET BGPOT=$PIECE(BGPSTR,P,2)
+9 SET BGPFN=$PIECE(BGPSTR,P,3)
+10 SET BGPOPT="CRS 09 AREA NATIONAL GPRA REPORT"
+11 SET BGPRT=$PIECE(BGPSTR,P,4)
+12 SET BGPLSTI=$PIECE(BGPSTR,P,5)
+13 SET BGPFN=$PIECE(BGPSTR,P,7)
+14 NEW I
+15 FOR I=2:1
Begin DoDot:1
+16 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+17 NEW BGPL
+18 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+19 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+20 KILL ^BGPTMP($JOB)
+21 SET RETVAL="^BGPTMP("_$JOB_")"
+22 SET ^BGPTMP($JOB,BGPI)="T02500DATA"_$CHAR(30)
+23 DO EP^BGP9GAGP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPFN,BGPRT,BGPFN)
+24 SET BGPI=BGPI+1
+25 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+26 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+27 DO EN^XBVK("BGP")
+28 QUIT
+29 ;
AELD(RETVAL,BGPSTR) ;-- area elder care report
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
+3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R,BGPFN
+4 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+5 SET P="|"
SET A="*"
SET R="~"
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPQTR=$PIECE(BGPSTR,P)
+9 SET BGPRT=$PIECE(BGPSTR,P,2)
+10 SET BGPRE=$PIECE(BGPSTR,P,3)
+11 SET BGPPER=$PIECE(BGPSTR,P,4)
+12 SET BGPBAS=$PIECE(BGPSTR,P,5)
+13 SET BGPBEN=$PIECE(BGPSTR,P,6)
+14 SET BGPOT=$PIECE(BGPSTR,P,7)
+15 SET BGPLSTI=$PIECE(BGPSTR,P,8)
+16 SET BGPFN=$PIECE(BGPSTR,P,10)
+17 SET BGPOPT="CRS 09 AREA ELDER CARE REPORT"
+18 NEW I
+19 FOR I=2:1
Begin DoDot:1
+20 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+21 NEW BGPL
+22 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+23 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+24 KILL ^BGPTMP($JOB)
+25 SET RETVAL="^BGPTMP("_$JOB_")"
+26 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+27 DO EP^BGP9GAEL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN)
+28 SET BGPI=BGPI+1
+29 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+30 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+31 DO EN^XBVK("BGP")
+32 QUIT
+33 ;
AHED(RETVAL,BGPSTR) ;-- area hedis report
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
+3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,BGPFN
+4 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+5 SET P="|"
SET A="*"
SET R="~"
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPQTR=$PIECE(BGPSTR,P)
+9 SET BGPRT=$PIECE(BGPSTR,P,2)
+10 SET BGPRE=$PIECE(BGPSTR,P,3)
+11 SET BGPPER=$PIECE(BGPSTR,P,4)
+12 SET BGPBAS=$PIECE(BGPSTR,P,5)
+13 SET BGPBEN=$PIECE(BGPSTR,P,6)
+14 SET BGPOT=$PIECE(BGPSTR,P,7)
+15 SET BGPLSTI=$PIECE(BGPSTR,P,8)
+16 SET BGPFN=$PIECE(BGPSTR,P,10)
+17 SET BGPOPT="CRS 09 AREA HEDIS REPORT"
+18 NEW I
+19 FOR I=2:1
Begin DoDot:1
+20 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+21 NEW BGPL
+22 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+23 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+24 KILL ^BGPTMP($JOB)
+25 SET RETVAL="^BGPTMP("_$JOB_")"
+26 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+27 DO EP^BGP9GAHE(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN)
+28 SET BGPI=BGPI+1
+29 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+30 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+31 DO EN^XBVK("BGP")
+32 QUIT
+33 ;
APER(RETVAL,BGPSTR) ;-- area performance report
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
+3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R,BGPFN
+4 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+5 SET P="|"
SET A="*"
SET R="~"
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPQTR=$PIECE(BGPSTR,P)
+9 SET BGPRT=$PIECE(BGPSTR,P,2)
+10 SET BGPRE=$PIECE(BGPSTR,P,3)
+11 SET BGPPER=$PIECE(BGPSTR,P,4)
+12 SET BGPBAS=$PIECE(BGPSTR,P,5)
+13 SET BGPBEN=$PIECE(BGPSTR,P,6)
+14 SET BGPOT=$PIECE(BGPSTR,P,7)
+15 SET BGPLSTI=$PIECE(BGPSTR,P,8)
+16 SET BGPFN=$PIECE(BGPSTR,P,10)
+17 SET BGPOPT="CRS 09 AREA GPRA PERFORMANCE REPORT"
+18 NEW I
+19 FOR I=2:1
Begin DoDot:1
+20 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+21 NEW BGPL
+22 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+23 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+24 KILL ^BGPTMP($JOB)
+25 SET RETVAL="^BGPTMP("_$JOB_")"
+26 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+27 DO EP^BGP9GAPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN)
+28 SET BGPI=BGPI+1
+29 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+30 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+31 DO EN^XBVK("BGP")
+32 QUIT
+33 ;
CHW(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPMSG,BGPOPT,BGPRT,BGPFN,A,R,BGPOM,BGPFN
+3 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+4 SET P="|"
SET A="*"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 SET BGPAF=$PIECE(BGPSTR,P)
+8 SET BGPOPT="CRS 09 AREA HEIGHT AND WEIGHT DATA FILE"
+9 SET BGPRT=$PIECE(BGPSTR,P,4)
+10 SET BGPLSTI=$PIECE(BGPSTR,P,5)
+11 SET BGPOM=$PIECE(BGPSTR,P,6)
+12 SET BGPFN=$PIECE(BGPSTR,P,7)
+13 NEW I
+14 FOR I=2:1
Begin DoDot:1
+15 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+16 NEW BGPL
+17 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+18 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+19 KILL ^BGPTMP($JOB)
+20 SET RETVAL="^BGPTMP("_$JOB_")"
+21 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+22 DO EP^BGP9GACW(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPRT,BGPOM,BGPFN)
+23 SET BGPMSG=$PIECE(BGPERR,U,2)
+24 SET BGPI=BGPI+1
+25 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+26 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+27 DO EN^XBVK("BGP")
+28 QUIT
+29 ;
APED(RETVAL,BGPSTR) ;-- area elder care report
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN
+3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R
+4 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+5 SET P="|"
SET A="*"
SET R="~"
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPQTR=$PIECE(BGPSTR,P)
+9 SET BGPRT=$PIECE(BGPSTR,P,2)
+10 SET BGPRE=$PIECE(BGPSTR,P,3)
+11 SET BGPPER=$PIECE(BGPSTR,P,4)
+12 SET BGPBAS=$PIECE(BGPSTR,P,5)
+13 SET BGPBEN=$PIECE(BGPSTR,P,6)
+14 SET BGPOT=$PIECE(BGPSTR,P,7)
+15 SET BGPLSTI=$PIECE(BGPSTR,P,8)
+16 SET BGPFN=$PIECE(BGPSTR,P,10)
+17 SET BGPOPT="CRS 09 AREA PATIENT EDUCATION REPORT"
+18 NEW I
+19 FOR I=2:1
Begin DoDot:1
+20 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+21 NEW BGPL
+22 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+23 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+24 KILL ^BGPTMP($JOB)
+25 SET RETVAL="^BGPTMP("_$JOB_")"
+26 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+27 DO EP^BGP9GAPE(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN)
+28 SET BGPI=BGPI+1
+29 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+30 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+31 DO EN^XBVK("BGP")
+32 QUIT
+33 ;
AONM(RETVAL,BGPSTR) ;-- area other national measures
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN
+3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R,BGPHC
+4 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+5 SET P="|"
SET A="*"
SET R="~"
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPQTR=$PIECE(BGPSTR,P)
+9 SET BGPRT=$PIECE(BGPSTR,P,2)
+10 SET BGPRE=$PIECE(BGPSTR,P,3)
+11 SET BGPPER=$PIECE(BGPSTR,P,4)
+12 SET BGPBAS=$PIECE(BGPSTR,P,5)
+13 SET BGPBEN=$PIECE(BGPSTR,P,6)
+14 SET BGPOT=$PIECE(BGPSTR,P,7)
+15 SET BGPLSTI=$PIECE(BGPSTR,P,8)
+16 SET BGPHC=$PIECE(BGPSTR,P,9)
+17 SET BGPFN=$PIECE(BGPSTR,P,10)
+18 SET BGPOPT="CRS 09 AREA OTHER NATIONAL MEASURES REPORT"
+19 NEW I
+20 FOR I=2:1
Begin DoDot:1
+21 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+22 NEW BGPL
+23 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+24 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+25 KILL ^BGPTMP($JOB)
+26 SET RETVAL="^BGPTMP("_$JOB_")"
+27 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+28 DO EP^BGP9GAON(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPHC,BGPFN)
+29 SET BGPI=BGPI+1
+30 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+31 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+32 DO EN^XBVK("BGP")
+33 QUIT
+34 ;
ONM(RETVAL,BGPSTR) ;-- queue Other National Measures Report
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPIND,BGPLIST
+3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPINDI,R,BGPHC,BGPFN
+4 SET P="|"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+8 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+9 ;S BGPCT=$O(^ATXAX("B",BGPCT,0))
+10 SET BGPYN=$PIECE(BGPSTR,P,2)
+11 SET BGPQTR=$PIECE(BGPSTR,P,3)
+12 SET BGPRT=$PIECE(BGPSTR,P,4)
+13 SET BGPRE=$PIECE(BGPSTR,P,5)
+14 SET BGPBAS=$PIECE(BGPSTR,P,6)
+15 SET BGPBEN=$PIECE(BGPSTR,P,7)
+16 SET BGPOT=$PIECE(BGPSTR,P,8)
+17 SET BGPMFITI=$PIECE(BGPSTR,P,9)
+18 SET BGPHC=$PIECE(BGPSTR,P,10)
+19 SET BGPFN=$PIECE(BGPSTR,P,11)
+20 SET BGPOPT="CRS 09 OTHER NATIONAL MEASURES REPORT"
+21 KILL ^BGPTMP($JOB)
+22 SET RETVAL="^BGPTMP("_$JOB_")"
+23 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+24 DO EP^BGP9GDON(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPHC,BGPFN)
+25 SET BGPI=BGPI+1
+26 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+27 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+28 DO EN^XBVK("BGP")
+29 QUIT
+30 ;
ONML(RETVAL,BGPSTR) ;-- queue other national measures patient lists
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL
+3 NEW BGPBLDT,BGPBEN,BGPFN
+4 SET P="|"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 IF $GET(BGPSTR)=""
DO CATSTR^BGP9GR(.BGPSTR,.BGPSTR)
+8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+9 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+10 ;S BGPCT=$O(^ATXAX("B",BGPCT,0))
+11 SET BGPDT=$PIECE(BGPSTR,P,2)
+12 SET BGPPIEN=$PIECE($PIECE(BGPSTR,P,3),R)
+13 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,3),R,2)
+14 SET BGPOPT="CRS 09 OTHER NATIONAL MEASURES PAT LISTS"
+15 SET BGPOT=$PIECE(BGPSTR,P,4)
+16 SET BGPRT=$PIECE(BGPSTR,P,5)
+17 SET BGPQTR=$PIECE(BGPSTR,P,6)
+18 SET BGPLST=$PIECE(BGPSTR,P,7)
+19 SET BGPMFITI=$PIECE(BGPSTR,P,8)
+20 SET BGPBLDT=$PIECE(BGPSTR,P,9)
+21 SET BGPBEN=$PIECE(BGPSTR,P,10)
+22 SET BGPFN=$PIECE(BGPSTR,P,11)
+23 NEW I
+24 ;F I=11:1 D Q:$P(BGPSTR,P,I)=""
+25 FOR I=13:1
Begin DoDot:1
+26 IF $PIECE(BGPSTR,P,I)=""
QUIT
+27 NEW BGPNSTR
+28 SET BGPNSTR=$PIECE(BGPSTR,P,I)
+29 SET BGPINDI=$PIECE(BGPNSTR,R)
+30 SET BGPIND(BGPINDI)=""
+31 NEW J
+32 FOR J=2:1
Begin DoDot:2
+33 IF $PIECE(BGPNSTR,R,J)=""
QUIT
+34 NEW BGPSIND
+35 SET BGPSIND=$PIECE(BGPNSTR,R,J)
+36 SET BGPINDL(BGPINDI,BGPSIND)=""
End DoDot:2
IF $PIECE(BGPNSTR,R,J)=""
QUIT
End DoDot:1
IF $PIECE(BGPSTR,P,I)=""
QUIT
+37 KILL ^BGPTMP($JOB)
+38 SET RETVAL="^BGPTMP("_$JOB_")"
+39 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+40 DO EP^BGP9GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN)
+41 SET BGPI=BGPI+1
+42 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+43 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+44 DO EN^XBVK("BGP")
+45 QUIT
AGP9(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN,A,R,BGPFLN
+3 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+4 SET P="|"
SET A="*"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 SET BGPAF=$PIECE(BGPSTR,P)
+8 SET BGPOT=$PIECE(BGPSTR,P,2)
+9 SET BGPFN=$PIECE(BGPSTR,P,3)
+10 SET BGPOPT="CRS 09 AREA GPRA REPORT FOR 10"
+11 SET BGPRT=$PIECE(BGPSTR,P,4)
+12 SET BGPLSTI=$PIECE(BGPSTR,P,5)
+13 SET BGPFLN=$PIECE(BGPSTR,P,7)
+14 NEW I
+15 FOR I=2:1
Begin DoDot:1
+16 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+17 NEW BGPL
+18 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+19 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+20 KILL ^BGPTMP($JOB)
+21 SET RETVAL="^BGPTMP("_$JOB_")"
+22 SET ^BGPTMP($JOB,BGPI)="T02500DATA"_$CHAR(30)
+23 DO EP^BGP9GAG9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPFN,BGPRT,BGPFLN)
+24 SET BGPI=BGPI+1
+25 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+26 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+27 DO EN^XBVK("BGP")
+28 QUIT
+29 ;
AGPSUM(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ; m error trap
SET X="MERR^BGP9GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN,A,R,BGPSUMON
+3 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+4 SET P="|"
SET A="*"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 SET BGPAF=$PIECE(BGPSTR,P)
+8 SET BGPOT=$PIECE(BGPSTR,P,2)
+9 SET BGPOPT="CRS 09 AREA NTL GPRA SUM"
+10 SET BGPRT=$PIECE(BGPSTR,P,4)
+11 SET BGPLSTI=$PIECE(BGPSTR,P,5)
+12 SET BGPFN=$PIECE(BGPSTR,P,7)
+13 SET BGPSUMON=1
+14 NEW I
+15 FOR I=2:1
Begin DoDot:1
+16 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+17 NEW BGPL
+18 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+19 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+20 KILL ^BGPTMP($JOB)
+21 SET RETVAL="^BGPTMP("_$JOB_")"
+22 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+23 DO EP^BGP9GAGS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPRT,BGPSUMON,BGPFN)
+24 SET BGPI=BGPI+1
+25 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+26 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+27 DO EN^XBVK("BGP")
+28 QUIT
+29 ;
