BGPGRA ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
;
;
;area GPRA reports
Q
;
DEBUG(RETVAL,BGPSTR) ;run the debugger
;D DEBUG^%Serenji("AGP^BGPGRA(.RETVAL,.BGPSTR)")
Q
;
AGP(RETVAL,BGPSTR) ;-- queue National GPRA Report
S X="MERR^BGPGU",@^%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="BGP 05 AREA GPRA"
S BGPRT=$P(BGPSTR,P,4)
S BGPLSTI=$P(BGPSTR,P,5)
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^BGP5GAGP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPFN,BGPRT)
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^BGPGU",@^%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
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 BGPOPT="BGP 05 AREA ELDER 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^BGP5GAEL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE)
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^BGPGU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC
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 BGPOPT="BGP 05 AREA HEDIS"
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^BGP5GAHE(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE)
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^BGPGU",@^%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
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 BGPOPT="BGP 05 AREA GPU"
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^BGP5GAPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
BGPGRA ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
+3 ;
+4 ;
+5 ;area GPRA reports
+6 QUIT
+7 ;
DEBUG(RETVAL,BGPSTR) ;run the debugger
+1 ;D DEBUG^%Serenji("AGP^BGPGRA(.RETVAL,.BGPSTR)")
+2 QUIT
+3 ;
AGP(RETVAL,BGPSTR) ;-- queue National GPRA Report
+1 ; m error trap
SET X="MERR^BGPGU"
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="BGP 05 AREA GPRA"
+11 SET BGPRT=$PIECE(BGPSTR,P,4)
+12 SET BGPLSTI=$PIECE(BGPSTR,P,5)
+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^BGP5GAGP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPFN,BGPRT)
+23 SET BGPI=BGPI+1
+24 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+25 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+26 DO EN^XBVK("BGP")
+27 QUIT
+28 ;
AELD(RETVAL,BGPSTR) ;-- area elder care report
+1 ; m error trap
SET X="MERR^BGPGU"
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
+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 BGPOPT="BGP 05 AREA ELDER REPORT"
+17 NEW I
+18 FOR I=2:1
Begin DoDot:1
+19 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+20 NEW BGPL
+21 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+22 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+23 KILL ^BGPTMP($JOB)
+24 SET RETVAL="^BGPTMP("_$JOB_")"
+25 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+26 DO EP^BGP5GAEL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE)
+27 SET BGPI=BGPI+1
+28 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+29 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+30 DO EN^XBVK("BGP")
+31 QUIT
+32 ;
AHED(RETVAL,BGPSTR) ;-- area hedis report
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT
+3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC
+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 BGPOPT="BGP 05 AREA HEDIS"
+17 NEW I
+18 FOR I=2:1
Begin DoDot:1
+19 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+20 NEW BGPL
+21 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+22 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+23 KILL ^BGPTMP($JOB)
+24 SET RETVAL="^BGPTMP("_$JOB_")"
+25 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+26 DO EP^BGP5GAHE(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE)
+27 SET BGPI=BGPI+1
+28 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+29 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+30 DO EN^XBVK("BGP")
+31 QUIT
+32 ;
APER(RETVAL,BGPSTR) ;-- area performance report
+1 ; m error trap
SET X="MERR^BGPGU"
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
+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 BGPOPT="BGP 05 AREA GPU"
+17 NEW I
+18 FOR I=2:1
Begin DoDot:1
+19 IF $PIECE(BGPLSTI,A,I)=""
QUIT
+20 NEW BGPL
+21 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
+22 SET BGPLIST(BGPL)=""
End DoDot:1
IF $PIECE(BGPLSTI,A,I)=""
QUIT
+23 KILL ^BGPTMP($JOB)
+24 SET RETVAL="^BGPTMP("_$JOB_")"
+25 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+26 DO EP^BGP5GAPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE)
+27 SET BGPI=BGPI+1
+28 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+29 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+30 DO EN^XBVK("BGP")
+31 QUIT
+32 ;
