BGP2GR1 ; IHS/CMI/LAB - BGPG Visual CRS Reports 12/30/2004 12:29:35 PM ;
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;
DEBUG(RETVAL,BGPSTR) ;run the debugger
D DEBUG^%Serenji("NTLSUM^BGP2GR1(.RETVAL,.BGPSTR)")
Q
;
ELD ;EP
S X="MERR^BGP2GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND
S P="|",R="~",A="*"
I $G(BGPSTR)="" D CATSTR^BGP2GR(.BGPSTR,.BGPSTR)
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 BGPTP=$P(BGPSTR,P,2)
S BGPQTR=$P(BGPSTR,P,3)
S BGPRDT=$P(BGPSTR,P,4)
S BGPRE=$P(BGPSTR,P,5)
S BGPOPT="CRS 12 ELDER CARE REPORT"
S BGPBAS=$P(BGPSTR,P,6)
S BGPPATT=$P(BGPSTR,P,7)
S BGPLIST=$P(BGPSTR,P,8)
S BGPPRV=$P($P(BGPSTR,P,9),R)
S BGPPROV=$P($P(BGPSTR,P,9),R,2)
S BGPEXP=$P(BGPSTR,P,10)
S BGPOT=$P(BGPSTR,P,11)
S BGPINDI=$P(BGPSTR,P,13)
S BGPLSTI=$P(BGPSTR,P,12)
S BGPMFITI=$P(BGPSTR,P,14)
S BGPFN=$P(BGPSTR,P,15)
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)=""
N J
F J=2:1 D Q:$P(BGPINDI,A,J)=""
. Q:$P(BGPINDI,A,J)=""
. N BGPL
. S BGPL=$P($P(BGPINDI,A,J),R)
. S BGPIND(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP2GELD(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,BGPMFITI,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
;
EO(RETVAL,BGPSTR) ;EP
S X="MERR^BGP2GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND,BGPHC
S P="|",R="~",A="*"
I $G(BGPSTR)="" D CATSTR^BGP2GR(.BGPSTR,.BGPSTR)
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 BGPTP=$P(BGPSTR,P,2)
S BGPQTR=$P(BGPSTR,P,3)
S BGPRDT=$P(BGPSTR,P,4)
S BGPRE=$P(BGPSTR,P,5)
S BGPOPT="CRS 12 EO REPORT"
S BGPBAS=$P(BGPSTR,P,6)
S BGPPATT=$P(BGPSTR,P,7)
S BGPLIST=$P(BGPSTR,P,8)
S BGPPRV=$P($P(BGPSTR,P,9),R)
S BGPPROV=$P($P(BGPSTR,P,9),R,2)
S BGPEXP=$P(BGPSTR,P,10)
S BGPOT=$P(BGPSTR,P,11)
S BGPINDI=$P(BGPSTR,P,13)
S BGPLSTI=$P(BGPSTR,P,12)
S BGPMFITI=$P(BGPSTR,P,14)
S BGPHC=$P(BGPSTR,P,15)
S BGPFN=$P(BGPSTR,P,16)
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)=""
N J
F J=2:1 D Q:$P(BGPINDI,A,J)=""
. Q:$P(BGPINDI,A,J)=""
. N BGPL
. S BGPL=$P($P(BGPINDI,A,J),R)
. S BGPIND(BGPL)=""
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP2GEO(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,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
;
NTL9(RETVAL,BGPSTR) ;-- queue National GPRA Report
S X="MERR^BGP2GU",@^%ZOSF("TRAP") ;m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,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 BGPYN=$P(BGPSTR,P,2)
S BGPOT=$P(BGPSTR,P,3)
S BGPOPT=$P(BGPSTR,P,4)
S BGPOPT="CRS 12 NATIONAL GPRA RPT FOR 2013" ;8.0 p2
S BGPRT=$P(BGPSTR,P,5)
S BGPMFITI=$P(BGPSTR,P,6)
S BGPYWCHW=$P(BGPSTR,P,7)
S BGPOM=$P(BGPSTR,P,8)
S BGPFN=$P(BGPSTR,P,9)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP2GNT9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,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
NTLSUM(RETVAL,BGPSTR) ;-- queue National GPRA Report PERFORMANCE SUMMARIES
S X="MERR^BGP2GU",@^%ZOSF("TRAP") ;m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPSUMON,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 BGPYN=$P(BGPSTR,P,2)
S BGPOT=$P(BGPSTR,P,3)
S BGPOPT=$P(BGPSTR,P,4)
S BGPOPT="CRS 12 NATIONAL GPRA PERF SUMM" ;8.0 p2
S BGPRT=$P(BGPSTR,P,5)
S BGPMFITI=$P(BGPSTR,P,6)
S BGPYWCHW=$P(BGPSTR,P,7)
S BGPOM=$P(BGPSTR,P,8)
S BGPFN=$P(BGPSTR,P,9)
S BGPSUMON=1
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EPSUM^BGP2GNTS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,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
;
DPRV(RETVAL,BGPSTR) ;-- queue National GPRA Report - BY PROVIDER
S X="MERR^BGP2GU",@^%ZOSF("TRAP") ;m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPDPRV,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 BGPYN=0
S BGPOT=$P(BGPSTR,P,3)
S BGPOPT=$P(BGPSTR,P,4)
S BGPOPT="CRS 12 NATIONAL GPRA RPT DESG P" ;8.0 p2
S BGPRT=$P(BGPSTR,P,5)
S BGPMFITI=$P(BGPSTR,P,6)
S BGPYWCHW=0
S BGPOM=$P(BGPSTR,P,8)
S BGPDPRV=$P(BGPSTR,P,9) ;ien of designated provider selected by the user
S BGPFN=$P(BGPSTR,P,10)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP2GNTP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPDPRV,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
;
NTL10(RETVAL,BGPSTR) ;-- queue National GPRA Report
S X="MERR^BGP2GU",@^%ZOSF("TRAP") ;m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,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 BGPYN=$P(BGPSTR,P,2)
S BGPOT=$P(BGPSTR,P,3)
S BGPOPT=$P(BGPSTR,P,4)
S BGPOPT="CRS 12 NATIONAL GPRA RPT FOR 2013" ;10.0p1
S BGPRT=$P(BGPSTR,P,5)
S BGPMFITI=$P(BGPSTR,P,6)
S BGPYWCHW=$P(BGPSTR,P,7)
S BGPOM=$P(BGPSTR,P,8)
S BGPFN=$P(BGPSTR,P,9)
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP2GNT9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,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
BGP2GR1 ; IHS/CMI/LAB - BGPG Visual CRS Reports 12/30/2004 12:29:35 PM ;
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;
DEBUG(RETVAL,BGPSTR) ;run the debugger
+1 DO DEBUG^%Serenji("NTLSUM^BGP2GR1(.RETVAL,.BGPSTR)")
+2 QUIT
+3 ;
ELD ;EP
+1 ; m error trap
SET X="MERR^BGP2GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
+3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND
+4 SET P="|"
SET R="~"
SET A="*"
+5 IF $GET(BGPSTR)=""
DO CATSTR^BGP2GR(.BGPSTR,.BGPSTR)
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+9 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+10 SET BGPTP=$PIECE(BGPSTR,P,2)
+11 SET BGPQTR=$PIECE(BGPSTR,P,3)
+12 SET BGPRDT=$PIECE(BGPSTR,P,4)
+13 SET BGPRE=$PIECE(BGPSTR,P,5)
+14 SET BGPOPT="CRS 12 ELDER CARE REPORT"
+15 SET BGPBAS=$PIECE(BGPSTR,P,6)
+16 SET BGPPATT=$PIECE(BGPSTR,P,7)
+17 SET BGPLIST=$PIECE(BGPSTR,P,8)
+18 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)
+19 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)
+20 SET BGPEXP=$PIECE(BGPSTR,P,10)
+21 SET BGPOT=$PIECE(BGPSTR,P,11)
+22 SET BGPINDI=$PIECE(BGPSTR,P,13)
+23 SET BGPLSTI=$PIECE(BGPSTR,P,12)
+24 SET BGPMFITI=$PIECE(BGPSTR,P,14)
+25 SET BGPFN=$PIECE(BGPSTR,P,15)
+26 NEW I
+27 FOR I=2:1
Begin DoDot:1
+28 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+29 NEW BGPL
+30 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+31 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+32 NEW J
+33 FOR J=2:1
Begin DoDot:1
+34 IF $PIECE(BGPINDI,A,J)=""
QUIT
+35 NEW BGPL
+36 SET BGPL=$PIECE($PIECE(BGPINDI,A,J),R)
+37 SET BGPIND(BGPL)=""
End DoDot:1
IF $PIECE(BGPINDI,A,J)=""
QUIT
+38 KILL ^BGPTMP($JOB)
+39 SET RETVAL="^BGPTMP("_$JOB_")"
+40 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+41 DO EP^BGP2GELD(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,BGPMFITI,BGPFN)
+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
+47 ;
EO(RETVAL,BGPSTR) ;EP
+1 ; m error trap
SET X="MERR^BGP2GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
+3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND,BGPHC
+4 SET P="|"
SET R="~"
SET A="*"
+5 IF $GET(BGPSTR)=""
DO CATSTR^BGP2GR(.BGPSTR,.BGPSTR)
+6 SET BGPI=0
+7 SET BGPERR=""
+8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+9 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+10 SET BGPTP=$PIECE(BGPSTR,P,2)
+11 SET BGPQTR=$PIECE(BGPSTR,P,3)
+12 SET BGPRDT=$PIECE(BGPSTR,P,4)
+13 SET BGPRE=$PIECE(BGPSTR,P,5)
+14 SET BGPOPT="CRS 12 EO REPORT"
+15 SET BGPBAS=$PIECE(BGPSTR,P,6)
+16 SET BGPPATT=$PIECE(BGPSTR,P,7)
+17 SET BGPLIST=$PIECE(BGPSTR,P,8)
+18 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)
+19 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)
+20 SET BGPEXP=$PIECE(BGPSTR,P,10)
+21 SET BGPOT=$PIECE(BGPSTR,P,11)
+22 SET BGPINDI=$PIECE(BGPSTR,P,13)
+23 SET BGPLSTI=$PIECE(BGPSTR,P,12)
+24 SET BGPMFITI=$PIECE(BGPSTR,P,14)
+25 SET BGPHC=$PIECE(BGPSTR,P,15)
+26 SET BGPFN=$PIECE(BGPSTR,P,16)
+27 NEW I
+28 FOR I=2:1
Begin DoDot:1
+29 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+30 NEW BGPL
+31 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+32 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+33 NEW J
+34 FOR J=2:1
Begin DoDot:1
+35 IF $PIECE(BGPINDI,A,J)=""
QUIT
+36 NEW BGPL
+37 SET BGPL=$PIECE($PIECE(BGPINDI,A,J),R)
+38 SET BGPIND(BGPL)=""
End DoDot:1
IF $PIECE(BGPINDI,A,J)=""
QUIT
+39 KILL ^BGPTMP($JOB)
+40 SET RETVAL="^BGPTMP("_$JOB_")"
+41 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+42 DO EP^BGP2GEO(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,BGPMFITI,BGPHC,BGPFN)
+43 SET BGPI=BGPI+1
+44 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+45 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+46 DO EN^XBVK("BGP")
+47 QUIT
+48 ;
NTL9(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ;m error trap
SET X="MERR^BGP2GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPFN
+3 SET P="|"
SET R="~"
+4 SET BGPI=0
+5 SET BGPERR=""
+6 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+7 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+8 SET BGPYN=$PIECE(BGPSTR,P,2)
+9 SET BGPOT=$PIECE(BGPSTR,P,3)
+10 SET BGPOPT=$PIECE(BGPSTR,P,4)
+11 ;8.0 p2
SET BGPOPT="CRS 12 NATIONAL GPRA RPT FOR 2013"
+12 SET BGPRT=$PIECE(BGPSTR,P,5)
+13 SET BGPMFITI=$PIECE(BGPSTR,P,6)
+14 SET BGPYWCHW=$PIECE(BGPSTR,P,7)
+15 SET BGPOM=$PIECE(BGPSTR,P,8)
+16 SET BGPFN=$PIECE(BGPSTR,P,9)
+17 KILL ^BGPTMP($JOB)
+18 SET RETVAL="^BGPTMP("_$JOB_")"
+19 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+20 DO EP^BGP2GNT9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPFN)
+21 SET BGPI=BGPI+1
+22 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+23 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+24 DO EN^XBVK("BGP")
+25 QUIT
NTLSUM(RETVAL,BGPSTR) ;-- queue National GPRA Report PERFORMANCE SUMMARIES
+1 ;m error trap
SET X="MERR^BGP2GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPSUMON,BGPFN
+3 SET P="|"
SET R="~"
+4 SET BGPI=0
+5 SET BGPERR=""
+6 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+7 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+8 SET BGPYN=$PIECE(BGPSTR,P,2)
+9 SET BGPOT=$PIECE(BGPSTR,P,3)
+10 SET BGPOPT=$PIECE(BGPSTR,P,4)
+11 ;8.0 p2
SET BGPOPT="CRS 12 NATIONAL GPRA PERF SUMM"
+12 SET BGPRT=$PIECE(BGPSTR,P,5)
+13 SET BGPMFITI=$PIECE(BGPSTR,P,6)
+14 SET BGPYWCHW=$PIECE(BGPSTR,P,7)
+15 SET BGPOM=$PIECE(BGPSTR,P,8)
+16 SET BGPFN=$PIECE(BGPSTR,P,9)
+17 SET BGPSUMON=1
+18 KILL ^BGPTMP($JOB)
+19 SET RETVAL="^BGPTMP("_$JOB_")"
+20 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+21 DO EPSUM^BGP2GNTS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPSUMON,BGPFN)
+22 SET BGPI=BGPI+1
+23 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+24 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+25 DO EN^XBVK("BGP")
+26 QUIT
+27 ;
DPRV(RETVAL,BGPSTR) ;-- queue National GPRA Report - BY PROVIDER
+1 ;m error trap
SET X="MERR^BGP2GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPDPRV,BGPFN
+3 SET P="|"
SET R="~"
+4 SET BGPI=0
+5 SET BGPERR=""
+6 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+7 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+8 SET BGPYN=0
+9 SET BGPOT=$PIECE(BGPSTR,P,3)
+10 SET BGPOPT=$PIECE(BGPSTR,P,4)
+11 ;8.0 p2
SET BGPOPT="CRS 12 NATIONAL GPRA RPT DESG P"
+12 SET BGPRT=$PIECE(BGPSTR,P,5)
+13 SET BGPMFITI=$PIECE(BGPSTR,P,6)
+14 SET BGPYWCHW=0
+15 SET BGPOM=$PIECE(BGPSTR,P,8)
+16 ;ien of designated provider selected by the user
SET BGPDPRV=$PIECE(BGPSTR,P,9)
+17 SET BGPFN=$PIECE(BGPSTR,P,10)
+18 KILL ^BGPTMP($JOB)
+19 SET RETVAL="^BGPTMP("_$JOB_")"
+20 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+21 DO EP^BGP2GNTP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPDPRV,BGPFN)
+22 SET BGPI=BGPI+1
+23 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+24 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+25 DO EN^XBVK("BGP")
+26 QUIT
+27 ;
NTL10(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ;m error trap
SET X="MERR^BGP2GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPFN
+3 SET P="|"
SET R="~"
+4 SET BGPI=0
+5 SET BGPERR=""
+6 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
+7 IF $PIECE(BGPCT,R)'?.N
SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
+8 SET BGPYN=$PIECE(BGPSTR,P,2)
+9 SET BGPOT=$PIECE(BGPSTR,P,3)
+10 SET BGPOPT=$PIECE(BGPSTR,P,4)
+11 ;10.0p1
SET BGPOPT="CRS 12 NATIONAL GPRA RPT FOR 2013"
+12 SET BGPRT=$PIECE(BGPSTR,P,5)
+13 SET BGPMFITI=$PIECE(BGPSTR,P,6)
+14 SET BGPYWCHW=$PIECE(BGPSTR,P,7)
+15 SET BGPOM=$PIECE(BGPSTR,P,8)
+16 SET BGPFN=$PIECE(BGPSTR,P,9)
+17 KILL ^BGPTMP($JOB)
+18 SET RETVAL="^BGPTMP("_$JOB_")"
+19 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+20 DO EP^BGP2GNT9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPFN)
+21 SET BGPI=BGPI+1
+22 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
+23 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+24 DO EN^XBVK("BGP")
+25 QUIT
