- BGP4GRA ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
- ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
- ;
- ;
- ;
- ;area GPRA reports
- Q
- ;
- DEBUG(RETVAL,BGPSTR) ;run the debugger
- D DEBUG^%Serenji("AONM^BGP4GRA(.RETVAL,.BGPSTR)")
- Q
- ;
- AGP(RETVAL,BGPSTR) ;-- queue National GPRA Report
- S X="MERR^BGP4GU",@^%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 14 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^BGP4GAGP(.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^BGP4GU",@^%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 14 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^BGP4GAEL(.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^BGP4GU",@^%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 14 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^BGP4GAHE(.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^BGP4GU",@^%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 14 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^BGP4GAPU(.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^BGP4GU",@^%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 14 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^BGP4GACW(.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^BGP4GU",@^%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 14 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^BGP4GAPE(.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^BGP4GU",@^%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 14 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^BGP4GAON(.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^BGP4GU",@^%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 14 OTHER NATIONAL MEASURES REPORT"
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP4GDON(.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^BGP4GU",@^%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^BGP4GR(.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 14 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^BGP4GNPL(.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^BGP4GU",@^%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 14 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^BGP4GAG9(.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^BGP4GU",@^%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 14 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^BGP4GAG9(.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^BGP4GU",@^%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 14 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^BGP4GAGS(.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
- ;
- BGP4GRA ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
- +1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
- +2 ;
- +3 ;
- +4 ;
- +5 ;area GPRA reports
- +6 QUIT
- +7 ;
- DEBUG(RETVAL,BGPSTR) ;run the debugger
- +1 DO DEBUG^%Serenji("AONM^BGP4GRA(.RETVAL,.BGPSTR)")
- +2 QUIT
- +3 ;
- AGP(RETVAL,BGPSTR) ;-- queue National GPRA Report
- +1 ; m error trap
- SET X="MERR^BGP4GU"
- 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 14 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^BGP4GAGP(.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^BGP4GU"
- 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 14 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^BGP4GAEL(.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^BGP4GU"
- 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 14 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^BGP4GAHE(.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^BGP4GU"
- 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 14 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^BGP4GAPU(.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^BGP4GU"
- 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 14 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^BGP4GACW(.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^BGP4GU"
- 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 14 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^BGP4GAPE(.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^BGP4GU"
- 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 14 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^BGP4GAON(.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^BGP4GU"
- 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 14 OTHER NATIONAL MEASURES REPORT"
- +22 KILL ^BGPTMP($JOB)
- +23 SET RETVAL="^BGPTMP("_$JOB_")"
- +24 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +25 DO EP^BGP4GDON(.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^BGP4GU"
- 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^BGP4GR(.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 14 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^BGP4GNPL(.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^BGP4GU"
- 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 14 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^BGP4GAG9(.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^BGP4GU"
- 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 14 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^BGP4GAG9(.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^BGP4GU"
- 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 14 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^BGP4GAGS(.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 ;