BGP4GRA.m

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