BGP1GRB ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
;
;area GPRA reports
Q
;
DEBUG(RETVAL,BGPSTR) ;run the debugger
D DEBUG^%Serenji("FOR^BGP1GRB(.RETVAL,.BGPSTR)")
Q
;
FOR(RETVAL,BGPSTR) ;-- gpra patient forcast report
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN,BGPANY,BGPAO,BGPAOD,BGPSTM
S P="|",R="~"
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPOPT="CRS 11 PATIENT FORECAST REPORT"
I $G(BGPSTR)="" D CATSTR^BGP1GU(.BGPSTR,.BGPSTR)
S BGPLST=$P(BGPSTR,P)
S BGPDIV=$P(BGPSTR,P,2)
I BGPDIV]"" S BGPDIV=$O(^DG(40.8,"B",BGPDIV,0))
S BGPBADT=$P(BGPSTR,P,3)
S BGPEADT=$P(BGPSTR,P,4)
S BGPCLNL=$P(BGPSTR,P,5)
S BGPPATL=$P(BGPSTR,P,6)
S BGPPATI=$P(BGPSTR,P,7)
I BGPPATI]"" S BGPPATL(BGPPATI)="",BGPPAT(BGPPATI)=""
S BGPRT=$P(BGPSTR,P,8)
S BGPST=$P(BGPSTR,P,9)
S BGPFN=$P(BGPSTR,P,10)
S BGPANY=$P(BGPSTR,P,11)
S BGPAO=$P(BGPSTR,P,12)
S BGPAOD=$P(BGPSTR,P,13)
S BGPSTM=$P(BGPSTR,P,14)
I $G(BGPSTM)]"",BGPSTM'?.N S BGPSTM=$O(^DIBT("B",BGPSTM,0))
;I BGPST]"" S BGPSTI=$O(^DIBT("B",BGPST,0))
I BGPCLNL]"",BGPCLNL'="A" D
. N I
. F I=1:1 D Q:$P(BGPCLNL,R,I)=""
.. Q:$P(BGPCLNL,R,I)=""
.. S BGPCLN($P(BGPCLNL,R,I))=$P(BGPCLNL,R,I)
I BGPPATL]"" D
. N J
. F J=1:1 D Q:$P(BGPPATL,R,J)=""
.. Q:$P(BGPPATL,R,J)=""
.. S BGPPAT($P(BGPPATL,R,J))=$P(BGPPATL,R,J)
I $G(BGPST) D
. N BGPDA
. S BGPCNT=0
. S BGPDA=0 F S BGPDA=$O(^DIBT(BGPST,1,BGPDA)) Q:'BGPDA D
.. S BGPCNT=BGPCNT+1
.. S BGPPAT(BGPCNT)=BGPDA
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP1GFOR(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,BGPFN,BGPANY,BGPAO,BGPAOD,BGPSTM)
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
;
FORD(RETVAL,BGPSTR) ;-- return the patient forecast denominator
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N P,BGPRDT,BGPFN
S P="|"
S BGPRDT=$P(BGPSTR,P)
S BGPFN=$P(BGPSTR,P,2)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPGUI=1
S BGPOPT="CRS 11 PATIENT FORECAST DENOMINATOR DEFINITIONS"
D ^XBFMK
D GUILOG(BGPOPT,BGPRDT,BGPFN)
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
K ZTSAVE S ZTSAVE("*")=""
S ZTIO="",ZTDTH=$S(BGPRDT]"":BGPRDT,1:$$NOW^XLFDT),ZTRTN="GUIECP^BGP1DPA",ZTDESC="GUI Denominator Definitions" D ^%ZTLOAD
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
D EN^XBVK("BGP")
Q
AEO(RETVAL,BGPSTR) ;-- area EO report
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPHC
N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R,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 BGPHC=$P(BGPSTR,P,9)
S BGPFN=$P(BGPSTR,P,11)
S BGPOPT="CRS 11 AREA EO 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^BGP1GAEO(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,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
;
GUILOG(BGPOPT,RDT,FN) ;-- log in the GUI REPORT FILE
D NOW^%DTC
S BGPNOW=$G(%)
K DD,D0,DIC
S X=DUZ_$$NOW^XLFDT
S X=FN
S BGPGFNM=X
S DIC="^BGPGUIB(",DIC(0)="L",DIADD=1,DLAYGO=90546.08,DIC("DR")=".02////"_DUZ_";.03////"_$S(RDT]"":RDT,1:$$NOW^XLFDT)_";.05///"_BGPOPT_";.06///R;.07///P"
K DD,D0,DO D FILE^DICN K DLAYGO,DIADD,DD,D0,DO
I Y=-1 S BGPIEN=-1 Q
S BGPIEN=+Y
Q
;
FOR9(RETVAL,BGPSTR) ;-- gpra patient forcast report
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN
S P="|",R="~"
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPOPT="CRS 11 PATIENT FORECAST REPORT 11"
I $G(BGPSTR)="" D CATSTR^BGP1GU(.BGPSTR,.BGPSTR)
S BGPLST=$P(BGPSTR,P)
S BGPDIV=$P(BGPSTR,P,2)
I BGPDIV]"" S BGPDIV=$O(^DG(40.8,"B",BGPDIV,0))
S BGPBADT=$P(BGPSTR,P,3)
S BGPEADT=$P(BGPSTR,P,4)
S BGPCLNL=$P(BGPSTR,P,5)
S BGPPATL=$P(BGPSTR,P,6)
S BGPPATI=$P(BGPSTR,P,7)
I BGPPATI]"" S BGPPATL(BGPPATI)="",BGPPAT(BGPPATI)=""
S BGPRT=$P(BGPSTR,P,8)
S BGPST=$P(BGPSTR,P,9)
S BGPFN=$P(BGPSTR,P,10)
I BGPST]"" S BGPSTI=$O(^DIBT("B",BGPST,0))
I BGPCLNL]"",BGPCLNL'="A" D
. N I
. F I=1:1 D Q:$P(BGPCLNL,R,I)=""
.. Q:$P(BGPCLNL,R,I)=""
.. S BGPCLN($P(BGPCLNL,R,I))=$P(BGPCLNL,R,I)
I BGPPATL]"" D
. N J
. F J=1:1 D Q:$P(BGPPATL,R,J)=""
.. Q:$P(BGPPATL,R,J)=""
.. S BGPPAT($P(BGPPATL,R,J))=$P(BGPPATL,R,J)
I $G(BGPSTI) D
. N BGPDA
. S BGPCNT=0
. S BGPDA=0 F S BGPDA=$O(^DIBT(BGPSTI,1,BGPDA)) Q:'BGPDA D
.. S BGPCNT=BGPCNT+1
.. S BGPPAT(BGPCNT)=BGPDA
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP1GFO9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,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
;
FOR10(RETVAL,BGPSTR) ;-- gpra patient forcast report
S X="MERR^BGP1GU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN
S P="|",R="~"
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPOPT="CRS 11 PATIENT FORECAST REPORT 11"
I $G(BGPSTR)="" D CATSTR^BGP1GU(.BGPSTR,.BGPSTR)
S BGPLST=$P(BGPSTR,P)
S BGPDIV=$P(BGPSTR,P,2)
I BGPDIV]"" S BGPDIV=$O(^DG(40.8,"B",BGPDIV,0))
S BGPBADT=$P(BGPSTR,P,3)
S BGPEADT=$P(BGPSTR,P,4)
S BGPCLNL=$P(BGPSTR,P,5)
S BGPPATL=$P(BGPSTR,P,6)
S BGPPATI=$P(BGPSTR,P,7)
I BGPPATI]"" S BGPPATL(BGPPATI)="",BGPPAT(BGPPATI)=""
S BGPRT=$P(BGPSTR,P,8)
S BGPST=$P(BGPSTR,P,9)
S BGPFN=$P(BGPSTR,P,10)
I BGPST]"" S BGPSTI=$O(^DIBT("B",BGPST,0))
I BGPCLNL]"",BGPCLNL'="A" D
. N I
. F I=1:1 D Q:$P(BGPCLNL,R,I)=""
.. Q:$P(BGPCLNL,R,I)=""
.. S BGPCLN($P(BGPCLNL,R,I))=$P(BGPCLNL,R,I)
I BGPPATL]"" D
. N J
. F J=1:1 D Q:$P(BGPPATL,R,J)=""
.. Q:$P(BGPPATL,R,J)=""
.. S BGPPAT($P(BGPPATL,R,J))=$P(BGPPATL,R,J)
I $G(BGPSTI) D
. N BGPDA
. S BGPCNT=0
. S BGPDA=0 F S BGPDA=$O(^DIBT(BGPSTI,1,BGPDA)) Q:'BGPDA D
.. S BGPCNT=BGPCNT+1
.. S BGPPAT(BGPCNT)=BGPDA
S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
D EP^BGP1GFO9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,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
;
ADASH(RETVAL,BGPSTR) ;-- area dashboard
S X="MERR^BGP1GU",@^%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="CRS 11 AREA NATIONAL GPRA DASHBOARD REPORT"
S BGPRT=$P(BGPSTR,P,4)
S BGPLSTI=$P(BGPSTR,P,5)
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)="T02500DATA"_$C(30)
D EP^BGP1GADB(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPRT,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
;
BGP1GRB ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ;
+4 ;
+5 ;area GPRA reports
+6 QUIT
+7 ;
DEBUG(RETVAL,BGPSTR) ;run the debugger
+1 DO DEBUG^%Serenji("FOR^BGP1GRB(.RETVAL,.BGPSTR)")
+2 QUIT
+3 ;
FOR(RETVAL,BGPSTR) ;-- gpra patient forcast report
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN,BGPANY,BGPAO,BGPAOD,BGPSTM
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^BGPTMP("_$JOB_")"
+5 SET BGPI=0
+6 SET BGPOPT="CRS 11 PATIENT FORECAST REPORT"
+7 IF $GET(BGPSTR)=""
DO CATSTR^BGP1GU(.BGPSTR,.BGPSTR)
+8 SET BGPLST=$PIECE(BGPSTR,P)
+9 SET BGPDIV=$PIECE(BGPSTR,P,2)
+10 IF BGPDIV]""
SET BGPDIV=$ORDER(^DG(40.8,"B",BGPDIV,0))
+11 SET BGPBADT=$PIECE(BGPSTR,P,3)
+12 SET BGPEADT=$PIECE(BGPSTR,P,4)
+13 SET BGPCLNL=$PIECE(BGPSTR,P,5)
+14 SET BGPPATL=$PIECE(BGPSTR,P,6)
+15 SET BGPPATI=$PIECE(BGPSTR,P,7)
+16 IF BGPPATI]""
SET BGPPATL(BGPPATI)=""
SET BGPPAT(BGPPATI)=""
+17 SET BGPRT=$PIECE(BGPSTR,P,8)
+18 SET BGPST=$PIECE(BGPSTR,P,9)
+19 SET BGPFN=$PIECE(BGPSTR,P,10)
+20 SET BGPANY=$PIECE(BGPSTR,P,11)
+21 SET BGPAO=$PIECE(BGPSTR,P,12)
+22 SET BGPAOD=$PIECE(BGPSTR,P,13)
+23 SET BGPSTM=$PIECE(BGPSTR,P,14)
+24 IF $GET(BGPSTM)]""
IF BGPSTM'?.N
SET BGPSTM=$ORDER(^DIBT("B",BGPSTM,0))
+25 ;I BGPST]"" S BGPSTI=$O(^DIBT("B",BGPST,0))
+26 IF BGPCLNL]""
IF BGPCLNL'="A"
Begin DoDot:1
+27 NEW I
+28 FOR I=1:1
Begin DoDot:2
+29 IF $PIECE(BGPCLNL,R,I)=""
QUIT
+30 SET BGPCLN($PIECE(BGPCLNL,R,I))=$PIECE(BGPCLNL,R,I)
End DoDot:2
IF $PIECE(BGPCLNL,R,I)=""
QUIT
End DoDot:1
+31 IF BGPPATL]""
Begin DoDot:1
+32 NEW J
+33 FOR J=1:1
Begin DoDot:2
+34 IF $PIECE(BGPPATL,R,J)=""
QUIT
+35 SET BGPPAT($PIECE(BGPPATL,R,J))=$PIECE(BGPPATL,R,J)
End DoDot:2
IF $PIECE(BGPPATL,R,J)=""
QUIT
End DoDot:1
+36 IF $GET(BGPST)
Begin DoDot:1
+37 NEW BGPDA
+38 SET BGPCNT=0
+39 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^DIBT(BGPST,1,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:2
+40 SET BGPCNT=BGPCNT+1
+41 SET BGPPAT(BGPCNT)=BGPDA
End DoDot:2
End DoDot:1
+42 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+43 DO EP^BGP1GFOR(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,BGPFN,BGPANY,BGPAO,BGPAOD,BGPSTM)
+44 SET BGPI=BGPI+1
+45 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+46 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+47 DO EN^XBVK("BGP")
+48 QUIT
+49 ;
FORD(RETVAL,BGPSTR) ;-- return the patient forecast denominator
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW P,BGPRDT,BGPFN
+3 SET P="|"
+4 SET BGPRDT=$PIECE(BGPSTR,P)
+5 SET BGPFN=$PIECE(BGPSTR,P,2)
+6 SET RETVAL="^BGPTMP("_$JOB_")"
+7 SET BGPI=0
+8 SET BGPGUI=1
+9 SET BGPOPT="CRS 11 PATIENT FORECAST DENOMINATOR DEFINITIONS"
+10 DO ^XBFMK
+11 DO GUILOG(BGPOPT,BGPRDT,BGPFN)
+12 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+13 KILL ZTSAVE
SET ZTSAVE("*")=""
+14 SET ZTIO=""
SET ZTDTH=$SELECT(BGPRDT]"":BGPRDT,1:$$NOW^XLFDT)
SET ZTRTN="GUIECP^BGP1DPA"
SET ZTDESC="GUI Denominator Definitions"
DO ^%ZTLOAD
+15 SET BGPI=BGPI+1
+16 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+17 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+18 DO EN^XBVK("BGP")
+19 QUIT
AEO(RETVAL,BGPSTR) ;-- area EO report
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPHC
+3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPFAC,A,R,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 BGPHC=$PIECE(BGPSTR,P,9)
+17 SET BGPFN=$PIECE(BGPSTR,P,11)
+18 SET BGPOPT="CRS 11 AREA EO 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^BGP1GAEO(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPRT,.BGPLIST,BGPQTR,BGPPER,BGPBAS,BGPBEN,BGPOT,BGPRE,BGPHC,BGPFN)
+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 ;
GUILOG(BGPOPT,RDT,FN) ;-- log in the GUI REPORT FILE
+1 DO NOW^%DTC
+2 SET BGPNOW=$GET(%)
+3 KILL DD,D0,DIC
+4 SET X=DUZ_$$NOW^XLFDT
+5 SET X=FN
+6 SET BGPGFNM=X
+7 SET DIC="^BGPGUIB("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=90546.08
SET DIC("DR")=".02////"_DUZ_";.03////"_$SELECT(RDT]"":RDT,1:$$NOW^XLFDT)_";.05///"_BGPOPT_";.06///R;.07///P"
+8 KILL DD,D0,DO
DO FILE^DICN
KILL DLAYGO,DIADD,DD,D0,DO
+9 IF Y=-1
SET BGPIEN=-1
QUIT
+10 SET BGPIEN=+Y
+11 QUIT
+12 ;
FOR9(RETVAL,BGPSTR) ;-- gpra patient forcast report
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^BGPTMP("_$JOB_")"
+5 SET BGPI=0
+6 SET BGPOPT="CRS 11 PATIENT FORECAST REPORT 11"
+7 IF $GET(BGPSTR)=""
DO CATSTR^BGP1GU(.BGPSTR,.BGPSTR)
+8 SET BGPLST=$PIECE(BGPSTR,P)
+9 SET BGPDIV=$PIECE(BGPSTR,P,2)
+10 IF BGPDIV]""
SET BGPDIV=$ORDER(^DG(40.8,"B",BGPDIV,0))
+11 SET BGPBADT=$PIECE(BGPSTR,P,3)
+12 SET BGPEADT=$PIECE(BGPSTR,P,4)
+13 SET BGPCLNL=$PIECE(BGPSTR,P,5)
+14 SET BGPPATL=$PIECE(BGPSTR,P,6)
+15 SET BGPPATI=$PIECE(BGPSTR,P,7)
+16 IF BGPPATI]""
SET BGPPATL(BGPPATI)=""
SET BGPPAT(BGPPATI)=""
+17 SET BGPRT=$PIECE(BGPSTR,P,8)
+18 SET BGPST=$PIECE(BGPSTR,P,9)
+19 SET BGPFN=$PIECE(BGPSTR,P,10)
+20 IF BGPST]""
SET BGPSTI=$ORDER(^DIBT("B",BGPST,0))
+21 IF BGPCLNL]""
IF BGPCLNL'="A"
Begin DoDot:1
+22 NEW I
+23 FOR I=1:1
Begin DoDot:2
+24 IF $PIECE(BGPCLNL,R,I)=""
QUIT
+25 SET BGPCLN($PIECE(BGPCLNL,R,I))=$PIECE(BGPCLNL,R,I)
End DoDot:2
IF $PIECE(BGPCLNL,R,I)=""
QUIT
End DoDot:1
+26 IF BGPPATL]""
Begin DoDot:1
+27 NEW J
+28 FOR J=1:1
Begin DoDot:2
+29 IF $PIECE(BGPPATL,R,J)=""
QUIT
+30 SET BGPPAT($PIECE(BGPPATL,R,J))=$PIECE(BGPPATL,R,J)
End DoDot:2
IF $PIECE(BGPPATL,R,J)=""
QUIT
End DoDot:1
+31 IF $GET(BGPSTI)
Begin DoDot:1
+32 NEW BGPDA
+33 SET BGPCNT=0
+34 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^DIBT(BGPSTI,1,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:2
+35 SET BGPCNT=BGPCNT+1
+36 SET BGPPAT(BGPCNT)=BGPDA
End DoDot:2
End DoDot:1
+37 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+38 DO EP^BGP1GFO9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,BGPFN)
+39 SET BGPI=BGPI+1
+40 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+41 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+42 DO EN^XBVK("BGP")
+43 QUIT
+44 ;
FOR10(RETVAL,BGPSTR) ;-- gpra patient forcast report
+1 ; m error trap
SET X="MERR^BGP1GU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPGDA,P,R,BGPLST,BGPDIV,BGPBADT,BGPEADT,BGPCLN,BGPPATL,BGPPATI,BGPPAT,BGPCLNL,BGPST,BGPSTI,BGPCNT,BGPFN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^BGPTMP("_$JOB_")"
+5 SET BGPI=0
+6 SET BGPOPT="CRS 11 PATIENT FORECAST REPORT 11"
+7 IF $GET(BGPSTR)=""
DO CATSTR^BGP1GU(.BGPSTR,.BGPSTR)
+8 SET BGPLST=$PIECE(BGPSTR,P)
+9 SET BGPDIV=$PIECE(BGPSTR,P,2)
+10 IF BGPDIV]""
SET BGPDIV=$ORDER(^DG(40.8,"B",BGPDIV,0))
+11 SET BGPBADT=$PIECE(BGPSTR,P,3)
+12 SET BGPEADT=$PIECE(BGPSTR,P,4)
+13 SET BGPCLNL=$PIECE(BGPSTR,P,5)
+14 SET BGPPATL=$PIECE(BGPSTR,P,6)
+15 SET BGPPATI=$PIECE(BGPSTR,P,7)
+16 IF BGPPATI]""
SET BGPPATL(BGPPATI)=""
SET BGPPAT(BGPPATI)=""
+17 SET BGPRT=$PIECE(BGPSTR,P,8)
+18 SET BGPST=$PIECE(BGPSTR,P,9)
+19 SET BGPFN=$PIECE(BGPSTR,P,10)
+20 IF BGPST]""
SET BGPSTI=$ORDER(^DIBT("B",BGPST,0))
+21 IF BGPCLNL]""
IF BGPCLNL'="A"
Begin DoDot:1
+22 NEW I
+23 FOR I=1:1
Begin DoDot:2
+24 IF $PIECE(BGPCLNL,R,I)=""
QUIT
+25 SET BGPCLN($PIECE(BGPCLNL,R,I))=$PIECE(BGPCLNL,R,I)
End DoDot:2
IF $PIECE(BGPCLNL,R,I)=""
QUIT
End DoDot:1
+26 IF BGPPATL]""
Begin DoDot:1
+27 NEW J
+28 FOR J=1:1
Begin DoDot:2
+29 IF $PIECE(BGPPATL,R,J)=""
QUIT
+30 SET BGPPAT($PIECE(BGPPATL,R,J))=$PIECE(BGPPATL,R,J)
End DoDot:2
IF $PIECE(BGPPATL,R,J)=""
QUIT
End DoDot:1
+31 IF $GET(BGPSTI)
Begin DoDot:1
+32 NEW BGPDA
+33 SET BGPCNT=0
+34 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^DIBT(BGPSTI,1,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:2
+35 SET BGPCNT=BGPCNT+1
+36 SET BGPPAT(BGPCNT)=BGPDA
End DoDot:2
End DoDot:1
+37 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
+38 DO EP^BGP1GFO9(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,BGPFN)
+39 SET BGPI=BGPI+1
+40 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
+41 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+42 DO EN^XBVK("BGP")
+43 QUIT
+44 ;
ADASH(RETVAL,BGPSTR) ;-- area dashboard
+1 ; m error trap
SET X="MERR^BGP1GU"
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="CRS 11 AREA NATIONAL GPRA DASHBOARD REPORT"
+11 SET BGPRT=$PIECE(BGPSTR,P,4)
+12 SET BGPLSTI=$PIECE(BGPSTR,P,5)
+13 SET BGPFN=$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^BGP1GADB(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPRT,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 ;
