BGP8GRA ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
;
;
;area GPRA reports
Q
;
DEBUG(RETVAL,BGPSTR) ;run the debugger
D DEBUG^%Serenji("AONM^BGP8GRA(.RETVAL,.BGPSTR)")
Q
;
AGP(RETVAL,BGPSTR) ;-- queue National GPRA Report
S X="MERR^BGP8GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN,A,R,BGPLOG
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 18 AREA NATIONAL GPRA REPORT"
S BGPRT=$P(BGPSTR,P,4)
S BGPLSTI=$P(BGPSTR,P,5)
S BGPFN=$P(BGPSTR,P,7)
S BGPLOG=$P(BGPSTR,P,8)
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^BGP8GAGP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPFN,BGPRT,BGPFN,BGPLOG)
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^BGP8GU",@^%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,BGPLOG
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,11)
S BGPLOG=$P(BGPSTR,P,12)
S BGPOPT="CRS 18 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^BGP8GAEL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN,BGPLOG)
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^BGP8GU",@^%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,11)
S BGPOPT="CRS 18 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^BGP8GAHE(.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^BGP8GU",@^%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,BGPLOG
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,11)
S BGPLOG=$P(BGPSTR,P,12)
S BGPOPT="CRS 18 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^BGP8GAPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN,BGPLOG)
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^BGP8GU",@^%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 18 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^BGP8GACW(.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^BGP8GU",@^%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,BGPBG,BGPLOG
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 BGPBG=$P(BGPSTR,P,10)
S BGPFN=$P(BGPSTR,P,11)
S BGPLOG=$P(BGPSTR,P,12)
S BGPOPT="CRS 18 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^BGP8GAPE(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN,BGPBG,BGPLOG)
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^BGP8GU",@^%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,BGPLOG
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,11)
S BGPLOG=$P(BGPSTR,P,12)
S BGPOPT="CRS 18 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^BGP8GAON(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPHC,BGPFN,BGPLOG)
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^BGP8GU",@^%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,BGPLOG
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 BGPLOG=$P(BGPSTR,P,12)
S BGPOPT="CRS 18 OTHER NATIONAL MEASURES REPORT"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP8GDON(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPHC,BGPFN,BGPLOG)
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^BGP8GU",@^%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,BGPLOG
S P="|",R="~"
S BGPI=0
S BGPERR=""
I $G(BGPSTR)="" D CATSTR^BGP8GR(.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 18 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)
S BGPLOG=$P(BGPSTR,P,12)
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($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($P(BGPNSTR,R,J),"*")
.. S BGPINDL(BGPINDI,BGPSIND)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP8GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN,BGPLOG)
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^BGP8GU",@^%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 18 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^BGP8GAG9(.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
;
AGP10(RETVAL,BGPSTR) ;-- queue National GPRA Report
S X="MERR^BGP8GU",@^%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 18 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^BGP8GAG9(.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^BGP8GU",@^%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 18 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^BGP8GAGS(.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
;
BGP8GRA ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
+3 ;
+4 ;
+5 ;area GPRA reports
+6 QUIT
+7 ;
DEBUG(RETVAL,BGPSTR) ;run the debugger
+1 DO DEBUG^%Serenji("AONM^BGP8GRA(.RETVAL,.BGPSTR)")
+2 QUIT
+3 ;
AGP(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ; m error trap
SET X="MERR^BGP8GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN,A,R,BGPLOG
+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 18 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 SET BGPLOG=$PIECE(BGPSTR,P,8)
+15 NEW I
+16 FOR I=2:1
Begin DoDot:1
+17 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+18 NEW BGPL
+19 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+20 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+21 KILL ^BGPTMP($JOB)
+22 SET RETVAL="^BGPTMP("_$JOB_")"
+23 SET ^BGPTMP($JOB,BGPI)="T02500DATA"_$CHAR(30)
+24 DO EP^BGP8GAGP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPFN,BGPRT,BGPFN,BGPLOG)
+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 ;
AELD(RETVAL,BGPSTR) ;-- area elder care report
+1 ; m error trap
SET X="MERR^BGP8GU"
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,BGPLOG
+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,11)
+17 SET BGPLOG=$PIECE(BGPSTR,P,12)
+18 SET BGPOPT="CRS 18 AREA ELDER CARE 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^BGP8GAEL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN,BGPLOG)
+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 ;
AHED(RETVAL,BGPSTR) ;-- area hedis report
+1 ; m error trap
SET X="MERR^BGP8GU"
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,11)
+17 SET BGPOPT="CRS 18 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^BGP8GAHE(.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^BGP8GU"
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,BGPLOG
+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,11)
+17 SET BGPLOG=$PIECE(BGPSTR,P,12)
+18 SET BGPOPT="CRS 18 AREA GPRA PERFORMANCE 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^BGP8GAPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN,BGPLOG)
+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 ;
CHW(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ; m error trap
SET X="MERR^BGP8GU"
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 18 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^BGP8GACW(.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^BGP8GU"
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,BGPBG,BGPLOG
+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 BGPBG=$PIECE(BGPSTR,P,10)
+17 SET BGPFN=$PIECE(BGPSTR,P,11)
+18 SET BGPLOG=$PIECE(BGPSTR,P,12)
+19 SET BGPOPT="CRS 18 AREA PATIENT EDUCATION REPORT"
+20 NEW I
+21 FOR I=2:1
Begin DoDot:1
+22 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+23 NEW BGPL
+24 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+25 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+26 KILL ^BGPTMP($JOB)
+27 SET RETVAL="^BGPTMP("_$JOB_")"
+28 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+29 DO EP^BGP8GAPE(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPFN,BGPBG,BGPLOG)
+30 SET BGPI=BGPI+1
+31 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+32 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+33 DO EN^XBVK("BGP")
+34 QUIT
+35 ;
AONM(RETVAL,BGPSTR) ;-- area other national measures
+1 ; m error trap
SET X="MERR^BGP8GU"
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,BGPLOG
+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,11)
+18 SET BGPLOG=$PIECE(BGPSTR,P,12)
+19 SET BGPOPT="CRS 18 AREA OTHER NATIONAL MEASURES REPORT"
+20 NEW I
+21 FOR I=2:1
Begin DoDot:1
+22 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+23 NEW BGPL
+24 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+25 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+26 KILL ^BGPTMP($JOB)
+27 SET RETVAL="^BGPTMP("_$JOB_")"
+28 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+29 DO EP^BGP8GAON(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPHC,BGPFN,BGPLOG)
+30 SET BGPI=BGPI+1
+31 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+32 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+33 DO EN^XBVK("BGP")
+34 QUIT
+35 ;
ONM(RETVAL,BGPSTR) ;-- queue Other National Measures Report
+1 ; m error trap
SET X="MERR^BGP8GU"
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,BGPLOG
+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 BGPLOG=$PIECE(BGPSTR,P,12)
+21 SET BGPOPT="CRS 18 OTHER NATIONAL MEASURES REPORT"
+22 KILL ^BGPTMP($JOB)
+23 SET RETVAL="^BGPTMP("_$JOB_")"
+24 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+25 DO EP^BGP8GDON(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPHC,BGPFN,BGPLOG)
+26 SET BGPI=BGPI+1
+27 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+28 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+29 DO EN^XBVK("BGP")
+30 QUIT
+31 ;
ONML(RETVAL,BGPSTR) ;-- queue other national measures patient lists
+1 ; m error trap
SET X="MERR^BGP8GU"
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,BGPLOG
+4 SET P="|"
SET R="~"
+5 SET BGPI=0
+6 SET BGPERR=""
+7 IF $GET(BGPSTR)=""
DO CATSTR^BGP8GR(.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 18 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 SET BGPLOG=$PIECE(BGPSTR,P,12)
+24 NEW I
+25 ;F I=11:1 D Q:$P(BGPSTR,P,I)=""
+26 FOR I=13:1
Begin DoDot:1
+27 IF $PIECE(BGPSTR,P,I)=""
QUIT
+28 NEW BGPNSTR
+29 SET BGPNSTR=$PIECE(BGPSTR,P,I)
+30 SET BGPINDI=$PIECE($PIECE(BGPNSTR,R),"*")
+31 SET BGPIND(BGPINDI)=""
+32 NEW J
+33 FOR J=2:1
Begin DoDot:2
+34 IF $PIECE(BGPNSTR,R,J)=""
QUIT
+35 NEW BGPSIND
+36 SET BGPSIND=$PIECE($PIECE(BGPNSTR,R,J),"*")
+37 SET BGPINDL(BGPINDI,BGPSIND)=""
End DoDot:2
IF $PIECE(BGPNSTR,R,J)=""
QUIT
End DoDot:1
IF $PIECE(BGPSTR,P,I)=""
QUIT
+38 KILL ^BGPTMP($JOB)
+39 SET RETVAL="^BGPTMP("_$JOB_")"
+40 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+41 DO EP^BGP8GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN,BGPLOG)
+42 SET BGPI=BGPI+1
+43 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+44 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+45 DO EN^XBVK("BGP")
+46 QUIT
AGP9(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ; m error trap
SET X="MERR^BGP8GU"
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 18 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^BGP8GAG9(.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 ;
AGP10(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ; m error trap
SET X="MERR^BGP8GU"
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 18 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^BGP8GAG9(.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^BGP8GU"
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 18 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^BGP8GAGS(.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 ;
