BGP8GRB.m

BGP8GRB ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;

 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 ;

 ;

 ;

 ;area GPRA reports

 Q

 ;

DEBUG(RETVAL,BGPSTR) ;run the debugger

 D DEBUG^%Serenji("FOR^BGP8GRB(.RETVAL,.BGPSTR)")

 Q

 ;

FOR(RETVAL,BGPSTR) ;-- gpra patient forcast report

 S X="MERR^BGP8GU",@^%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

 N BGPGY

 S P="|",R="~"

 S RETVAL="^BGPTMP("_$J_")"

 S BGPI=0

 S BGPOPT="CRS 18 PATIENT FORECAST REPORT"

 I $G(BGPSTR)="" D CATSTR^BGP8GU(.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)

 S BGPGY=$P(BGPSTR,P,15)

 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^BGP8GFOR(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,BGPFN,BGPANY,BGPAO,BGPAOD,BGPSTM,BGPGY)

 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^BGP8GU",@^%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 18 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^BGP8DPA",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^BGP8GU",@^%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 18 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^BGP8GAEO(.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="^BGPGUIR(",DIC(0)="L",DIADD=1,DLAYGO=90560.19,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^BGP8GU",@^%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 18 PATIENT FORECAST REPORT 11"

 I $G(BGPSTR)="" D CATSTR^BGP8GU(.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^BGP8GFO9(.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^BGP8GU",@^%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 18 PATIENT FORECAST REPORT 11"

 I $G(BGPSTR)="" D CATSTR^BGP8GU(.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^BGP8GFO9(.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^BGP8GU",@^%ZOSF("TRAP") ; m error trap

 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPAF,BGPYN,BGPOT,BGPOPT,BGPRT,BGPFN,A,R,BGPYR

 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 18 AREA NATIONAL GPRA DASHBOARD REPORT"

 S BGPRT=$P(BGPSTR,P,4)

 S BGPLSTI=$P(BGPSTR,P,5)

 S BGPFN=$P(BGPSTR,P,7)

 S BGPYR=$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^BGP8GADB(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPAF,.BGPLIST,BGPOT,BGPRT,BGPFN,BGPYR)

 S BGPI=BGPI+1

 S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)

 S ^BGPTMP($J,BGPI+1)=$C(31)

 D EN^XBVK("BGP")

 Q

 ;

MANE(RETVAL,BGPSTR) ;-- queue the manual extract

A S X="MERR^BGP8GU",@^%ZOSF("TRAP") ; m error trap

 N BGPI,BGPSITE,BGPTAXI,BGPRT,P,Q,BGPDTH

 S P="|"

 I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)

 S BGPSITE=$P(BGPSTR,P)

 S BGPTAXI=$P(BGPSTR,P,2)

 S BGPRT=$P(BGPSTR,P,3)

 S BGPDTH=$$FMTH^XLFDT(BGPRT)

 S BGPI=0

 K ^BGPTMP($J)

 S RETVAL="^BGPTMP("_$J_")"

 S ^BGPTMP($J,BGPI)="T00001DATA"_$C(30)

 S BGPT=$P(^BGPGP2PM(BGPSITE,0),U,2)

 S Q=0

 F F=.02,4.2,4.3,4.4,4.5 I $$VAL^XBDIQ1(90241.04,BGPSITE,F)="" S Q=1

 I Q D  Q

 . S BGPI=BGPI+1

 . S ^BGPTMP($J,BGPI)=0_$C(30)

 . S ^BGPTMP($J,BGPI+1)=$C(31)

 I BGPT="T" D

 .S BGPDT=$$FMADD^XLFDT(DT,-60)

 .S BGPY=$E(BGPDT,1,3)

 .S BGPM=+$E(BGPDT,4,5)

 .S BGPD=$P("31^28^31^30^31^30^31^31^30^31^30^31",U,BGPM)

 .I BGPM=2 S BGPD=BGPD+$$LEAP^XLFDT2(BGPY+1700)

 .S BGPD=$E("00",1,2-$L(BGPD))_BGPD

 .S BGPM=$E("00",1,2-$L(BGPM))_BGPM

 .S BGPEND=BGPY_BGPM_BGPD

 .S (BGPBD,BGPED,BGPTP)=""

 .S BGPBD=$$FMADD^XLFDT(BGPEND,-364),BGPED=BGPEND,BGPPER=$E(BGPED,1,3)_"0000"

 .S BGPVDT=3000000 ;***HARD CODED TO BASELINE YEAR 2000

 .S X=$E(BGPPER,1,3)-$E(BGPVDT,1,3)

 .S X=X_"0000"

 .S BGPBBD=BGPBD-X,BGPBBD=$E(BGPBBD,1,3)_$E(BGPBD,4,7)

 .S BGPBED=BGPED-X,BGPBED=$E(BGPBED,1,3)_$E(BGPED,4,7)

 .S BGPPBD=($E(BGPBD,1,3)-1)_$E(BGPBD,4,7)

 .S BGPPED=($E(BGPED,1,3)-1)_$E(BGPED,4,7)

 S X=$O(^BGPCTRL("B",2018,0))

 S Y=^BGPCTRL(X,0)

 S BGPBD=$S(+$E(DT,4,7)<701:$E(DT,1,3)-1_"0701",1:$E(DT,1,3)_"0701")

 S (BGPEND,BGPED)=$S(+$E(DT,4,7)<701:$E(DT,1,3)_"0630",1:$E(DT,1,3)+1_"0630")

 ;S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)

 S BGPPBD=$E(BGPBD,1,3)-1_"0701",BGPPED=$E(BGPED,1,3)-1_"0630"

 S BGPBBD=$P(Y,U,12),BGPBED=$P(Y,U,13)

 S BGPPER=$P(Y,U,14)

 S BGPQTR=3

 S BGPVDT=3000000 ;***HARD CODED TO BASELINE YEAR 2000

 S BGPAMEX=1,BGPERRM=""

 S BGPMAN=1

 D QUE^BGP8AUEX(BGPEND,BGPRT)

 I $G(ZTSK) D

 . S BGPI=BGPI+1

 . S ^BGPTMP($J,BGPI)=1_$C(30)

 S ^BGPTMP($J,BGPI+1)=$C(31)

 D EN^XBVK("BGP")

 Q

 ;

MANA ;-- queue the area auto extract

 Q

 ;

BGP8GRB   ; IHS/CMI/LAB - BGP Gui Area Reports 5/2/2005 8:38:59 PM ;

 +1       ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 +2       ;

 +3       ;

 +4       ;

 +5       ;area GPRA reports

 +6        QUIT 

 +7       ;

DEBUG(RETVAL,BGPSTR) ;run the debugger

 +1        DO DEBUG^%Serenji("FOR^BGP8GRB(.RETVAL,.BGPSTR)")

 +2        QUIT 

 +3       ;

FOR(RETVAL,BGPSTR) ;-- gpra patient forcast report

 +1       ; m error trap

           SET X="MERR^BGP8GU"

           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        NEW BGPGY

 +4        SET P="|"

           SET R="~"

 +5        SET RETVAL="^BGPTMP("_$JOB_")"

 +6        SET BGPI=0

 +7        SET BGPOPT="CRS 18 PATIENT FORECAST REPORT"

 +8        IF $GET(BGPSTR)=""

               DO CATSTR^BGP8GU(.BGPSTR,.BGPSTR)

 +9        SET BGPLST=$PIECE(BGPSTR,P)

 +10       SET BGPDIV=$PIECE(BGPSTR,P,2)

 +11       IF BGPDIV]""

               SET BGPDIV=$ORDER(^DG(40.8,"B",BGPDIV,0))

 +12       SET BGPBADT=$PIECE(BGPSTR,P,3)

 +13       SET BGPEADT=$PIECE(BGPSTR,P,4)

 +14       SET BGPCLNL=$PIECE(BGPSTR,P,5)

 +15       SET BGPPATL=$PIECE(BGPSTR,P,6)

 +16       SET BGPPATI=$PIECE(BGPSTR,P,7)

 +17       IF BGPPATI]""

               SET BGPPATL(BGPPATI)=""

               SET BGPPAT(BGPPATI)=""

 +18       SET BGPRT=$PIECE(BGPSTR,P,8)

 +19       SET BGPST=$PIECE(BGPSTR,P,9)

 +20       SET BGPFN=$PIECE(BGPSTR,P,10)

 +21       SET BGPANY=$PIECE(BGPSTR,P,11)

 +22       SET BGPAO=$PIECE(BGPSTR,P,12)

 +23       SET BGPAOD=$PIECE(BGPSTR,P,13)

 +24       SET BGPSTM=$PIECE(BGPSTR,P,14)

 +25       SET BGPGY=$PIECE(BGPSTR,P,15)

 +26       IF $GET(BGPSTM)]""

               IF BGPSTM'?.N

                   SET BGPSTM=$ORDER(^DIBT("B",BGPSTM,0))

 +27      ;I BGPST]"" S BGPSTI=$O(^DIBT("B",BGPST,0))

 +28       IF BGPCLNL]""

               IF BGPCLNL'="A"

                   Begin DoDot:1

 +29                   NEW I

 +30                   FOR I=1:1

                           Begin DoDot:2

 +31                           IF $PIECE(BGPCLNL,R,I)=""

                                   QUIT 

 +32                           SET BGPCLN($PIECE(BGPCLNL,R,I))=$PIECE(BGPCLNL,R,I)

                           End DoDot:2

                           IF $PIECE(BGPCLNL,R,I)=""

                               QUIT 

                   End DoDot:1

 +33       IF BGPPATL]""

               Begin DoDot:1

 +34               NEW J

 +35               FOR J=1:1

                       Begin DoDot:2

 +36                       IF $PIECE(BGPPATL,R,J)=""

                               QUIT 

 +37                       SET BGPPAT($PIECE(BGPPATL,R,J))=$PIECE(BGPPATL,R,J)

                       End DoDot:2

                       IF $PIECE(BGPPATL,R,J)=""

                           QUIT 

               End DoDot:1

 +38       IF $GET(BGPST)

               Begin DoDot:1

 +39               NEW BGPDA

 +40               SET BGPCNT=0

 +41               SET BGPDA=0

                   FOR 

                       SET BGPDA=$ORDER(^DIBT(BGPST,1,BGPDA))

                       IF 'BGPDA

                           QUIT 

                       Begin DoDot:2

 +42                       SET BGPCNT=BGPCNT+1

 +43                       SET BGPPAT(BGPCNT)=BGPDA

                       End DoDot:2

               End DoDot:1

 +44       SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)

 +45       DO EP^BGP8GFOR(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLST,BGPDIV,BGPBADT,BGPEADT,.BGPCLN,.BGPPAT,BGPRT,BGPFN,BGPANY,BGPAO,BGPAOD,BGPSTM,BGPGY)

 +46       SET BGPI=BGPI+1

 +47       SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)

 +48       SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)

 +49       DO EN^XBVK("BGP")

 +50       QUIT 

 +51      ;

FORD(RETVAL,BGPSTR) ;-- return the patient forecast denominator

 +1       ; m error trap

           SET X="MERR^BGP8GU"

           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 18 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^BGP8DPA"

           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^BGP8GU"

           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 18 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      ;D EP^BGP8GAEO(.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="^BGPGUIR("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=90560.19

           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^BGP8GU"

           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 18 PATIENT FORECAST REPORT 11"

 +7        IF $GET(BGPSTR)=""

               DO CATSTR^BGP8GU(.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^BGP8GFO9(.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^BGP8GU"