Routine: BGP0DPEA

BGP0DPEA ; IHS/CMI/LAB - IHS GPRA 10 REPORT DRIVER 23 Oct 2008 2:04 PM ;

 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010

 W:$D(IOF) @IOF

 W !,$$CTR("IHS 2010 Area Aggregate Patient Education Report",80),!!

INTRO ;

 D XIT

 W !!,"This will produce an area aggregate report for all Patient Education"

 W !,"measures for a year period you specify.  You will be asked to provide:"

 W !,"1) the reporting period, 2) the baseline period to compare data to, and"

 W !,"3) the beneficiary/classification of the patients."

 W !!,"There are 7 topics in the Patient Education Measures Report."

 S BGPRTYPE=6,BGPAREAA=1

 S X=0 F  S X=$O(^BGPPEIT(X)) Q:X'=+X  S BGPIND(X)=""

TP ;get time period

 S BGPRTYPE=6

 S (BGPBD,BGPED,BGPTP)=""

 S DIR(0)="S^1:January 1 - December 31;2:April 1 - March 31;3:July 1 - June 30;4:October 1 - September 30;5:User defined date range",DIR("A")="Enter the date range for your report" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D XIT Q

 S BGPQTR=Y

 I BGPQTR=5 D GETDATES^BGP0DPE

 I BGPQTR'=5 D F

 I BGPPER="" W !,"Year not entered.",! G TP

 I BGPQTR=1 S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"1231"

 I BGPQTR=2 S BGPBD=($E(BGPPER,1,3)-1)_"0401",BGPED=$E(BGPPER,1,3)_"0331"

 I BGPQTR=3 S BGPBD=($E(BGPPER,1,3)-1)_"0701",BGPED=$E(BGPPER,1,3)_"0630"

 I BGPQTR=4 S BGPBD=($E(BGPPER,1,3)-1)_"1001",BGPED=$E(BGPPER,1,3)_"0930"

 I BGPQTR=5 S BGPPER=$E(BGPED,1,3)_"0000"

 I BGPED>DT D  G:BGPDO=1 TP

 .W !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."

 .W !,"The end date of this report is in the future; your data will not be",!,"complete.",!

 .K DIR S BGPDO=0 S DIR(0)="Y",DIR("A")="Do you want to change your Current Report Dates",DIR("B")="N" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S BGPDO=1 Q

 .I Y S BGPDO=1 Q

.Q

BY ;get baseline year

 S BGPVDT=""

 W !!,"Enter the Baseline Year to compare data to.",!,"Use a 4 digit year, e.g. 1999, 2000"

 S DIR(0)="D^::EP"

 S DIR("A")="Enter Year (e.g. 2000)"

 D ^DIR KILL DIR

 I $D(DIRUT) G TP

 I $D(DUOUT) S DIRUT=1 G TP

 S BGPVDT=Y

 I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G BY

 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)

 W !!,"The date ranges for this report are:"

 W !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)

 W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)

 W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)

 I BGPPBD=BGPBBD,BGPPED=BGPBED K Y D CHKY I Y K BGPBBD,BGPBED,BGPPBD,BGPPED G BY

BEN ;

 S BGPBEN=""

 S DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)",DIR("A")="Select Beneficiary Population to include in this report"

 S DIR("B")="1" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G BY

 S BGPBEN=Y

ASU ;

 S BGPSUCNT=0

 S BGPRPTT=""

 W !!!,"You will now be able to select which sites to use in the",!,"area aggregate report.",!

 S DIR(0)="E",DIR("A")="Press Enter to Continue" KILL DA D ^DIR KILL DIR

 K BGPSUL

 D EN^BGP0ASL

 I '$D(BGPSUL) W !!,"No sites selected" D XIT Q

 S X=0,C=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  S C=C+1

 W !!,"A total of ",C," facilities have been selected.",!!

 I C=1 S BGPRPTT="F",BGPSUCNT=1,Y=$O(BGPSUL(0)),X=$P(^BGPPEDCT(Y,0),U,9),X=$O(^AUTTLOC("C",X,0)) I X S BGPSUNM=$P(^DIC(4,X,0),U)

 I C>1 S BGPRPTT="A"

ZIS ;call to XBDBQUE

 D ^XBFMK

 S X=0 F  S X=$O(^BGPPEIT(X)) Q:X'=+X  S BGPIND(X)=""

 D PT^BGP0PESL

 I BGPROT="" G ASU

 K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,XIT Q

 K IOP,%ZIS W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS

 I $D(IO("Q")) G TSKMN

DRIVER ;

 U IO

 D ^BGP0PPEL

 D ^%ZISC

 D XIT

NODEV ;

 S XBRP="",XBRC="NODEV1^BGP0DPEA",XBRX="XIT^BGP0DPEA",XBNS="BGP"

 D ^XBDBQUE

 ;D XIT

NODEV1 ;

 D ^BGP0PPEL

 D ^%ZISC

 D XIT

TSKMN ;EP ENTRY POINT FROM TASKMAN

 S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST

 I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))

 I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL

 K ZTSAVE S ZTSAVE("BGP*")=""

 S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^BGP0DPEA",ZTDTH="",ZTDESC="PAT ED 09 REPORT" D ^%ZTLOAD D XIT Q

XIT ;

 D ^%ZISC

 D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"

 K DIRUT,DUOUT,DIR,DOD

 K DIADD,DLAYGO

 D KILL^AUPNPAT

 K X,X1,X2,X3,X4,X5,X6

 K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 K N,N1,N2,N3,N4,N5,N6

 K BD,ED

 D KILL^AUPNPAT

 D ^XBFMK

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

EOP ;EP - End of page.

 Q:$E(IOST)'="C"

 Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))

 NEW DIR

 K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR(0)="E" D ^DIR KILL DIR

 ;----------

USR() ;EP - Return name of current user from ^VA(200.

 Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 ;----------

LOC() ;EP - Return location name from file 4 based on DUZ(2).

 Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 ;----------

CHKY ;

 W !!,"The baseline year and the previous year time periods are the same.",!!

 S DIR(0)="Y",DIR("A")="Do you want to change the baseline year",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) S Y="" Q

F ;fiscal year

 S (BGPPER,BGPVDT)=""

 W !!,"Enter the Calendar Year for the report END date.  Use a 4 digit",!,"year, e.g. 2010"

 S DIR(0)="D^::EP"

 S DIR("A")="Enter Year"

 S DIR("?")="This report is compiled for a period.  Enter a valid date."

 D ^DIR KILL DIR

 I $D(DIRUT) Q

 I $D(DUOUT) S DIRUT=1 Q

 S BGPVDT=Y

 I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F

 S BGPPER=BGPVDT

ENDDATE ;

 W !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2010)"

 W !,"will assume a year in the past, if you want to put in a future date,"

 W !,"remember to enter the full 4 digit year.  For example, if today is"

 W !,"January 4, 2009 and you type in 6/30/07 the system will assume the year"

 W !,"as 1907 since that is a date in the past.  You must type 6/30/2009 if you"

 W !,"want a date in the future."

 S (BGPPER,BGPVDT)=""

 W ! K DIR,X,Y S DIR(0)="D^::EP",DIR("A")="Enter End Date for the Report: (e.g. 11/30/2005)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) Q

 S (BGPPER,BGPVDT)=Y

BGP0DPEA  ; IHS/CMI/LAB - IHS GPRA 10 REPORT DRIVER 23 Oct 2008 2:04 PM ;

 +1       ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010

 +2       ;

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        WRITE !,$$CTR("IHS 2010 Area Aggregate Patient Education Report",80),!!

INTRO     ;

 +1        DO XIT

 +2        WRITE !!,"This will produce an area aggregate report for all Patient Education"

 +3        WRITE !,"measures for a year period you specify.  You will be asked to provide:"

 +4        WRITE !,"1) the reporting period, 2) the baseline period to compare data to, and"

 +5        WRITE !,"3) the beneficiary/classification of the patients."

 +6        WRITE !!,"There are 7 topics in the Patient Education Measures Report."

 +7        SET BGPRTYPE=6

           SET BGPAREAA=1

 +8        SET X=0

FOR

               SET X=$ORDER(^BGPPEIT(X))

               IF X'=+X

                   QUIT

               SET BGPIND(X)=""

TP        ;get time period

 +1        SET BGPRTYPE=6

 +2        SET (BGPBD,BGPED,BGPTP)=""

 +3        SET DIR(0)="S^1:January 1 - December 31;2:April 1 - March 31;3:July 1 - June 30;4:October 1 - September 30;5:User defined date range"

           SET DIR("A")="Enter the date range for your report"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               DO XIT

               QUIT

 +5        SET BGPQTR=Y

 +6        IF BGPQTR=5

               DO GETDATES^BGP0DPE

 +7        IF BGPQTR'=5

               DO F

 +8        IF BGPPER=""

               WRITE !,"Year not entered.",!

               GOTO TP

 +9        IF BGPQTR=1

               SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"

 +10       IF BGPQTR=2

               SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0401"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"

 +11       IF BGPQTR=3

               SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0701"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"

 +12       IF BGPQTR=4

               SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"1001"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0930"

 +13       IF BGPQTR=5

               SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"

 +14       IF BGPED>DT

               Begin DoDot:1

 +15               WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."

 +16               WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!

 +17               KILL DIR

                   SET BGPDO=0

                   SET DIR(0)="Y"

                   SET DIR("A")="Do you want to change your Current Report Dates"

                   SET DIR("B")="N"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +18               IF $DATA(DIRUT)

                       SET BGPDO=1

                       QUIT

 +19               IF Y

                       SET BGPDO=1

                       QUIT

 +20               QUIT

               End DoDot:1

               IF BGPDO=1

                   GOTO TP

BY        ;get baseline year

 +1        SET BGPVDT=""

 +2        WRITE !!,"Enter the Baseline Year to compare data to.",!,"Use a 4 digit year, e.g. 1999, 2000"

 +3        SET DIR(0)="D^::EP"

 +4        SET DIR("A")="Enter Year (e.g. 2000)"

 +5        DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               GOTO TP

 +7        IF $DATA(DUOUT)

               SET DIRUT=1

               GOTO TP

 +8        SET BGPVDT=Y

 +9        IF $EXTRACT(Y,4,7)'="0000"

               WRITE !!,"Please enter a year only!",!

               GOTO BY

 +10       SET X=$EXTRACT(BGPPER,1,3)-$EXTRACT(BGPVDT,1,3)

 +11       SET X=X_"0000"

 +12       SET BGPBBD=BGPBD-X

           SET BGPBBD=$EXTRACT(BGPBBD,1,3)_$EXTRACT(BGPBD,4,7)

 +13       SET BGPBED=BGPED-X

           SET BGPBED=$EXTRACT(BGPBED,1,3)_$EXTRACT(BGPED,4,7)

 +14       SET BGPPBD=($EXTRACT(BGPBD,1,3)-1)_$EXTRACT(BGPBD,4,7)

 +15       SET BGPPED=($EXTRACT(BGPED,1,3)-1)_$EXTRACT(BGPED,4,7)

 +16       WRITE !!,"The date ranges for this report are:"

 +17       WRITE !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)

 +18       WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)

 +19       WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)

 +20       IF BGPPBD=BGPBBD

               IF BGPPED=BGPBED

                   KILL Y

                   DO CHKY

                   IF Y

                       KILL BGPBBD,BGPBED,BGPPBD,BGPPED

                       GOTO BY

BEN       ;

 +1        SET BGPBEN=""

 +2        SET DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)"

           SET DIR("A")="Select Beneficiary Population to include in this report"

 +3        SET DIR("B")="1"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO BY

 +5        SET BGPBEN=Y

ASU       ;

 +1        SET BGPSUCNT=0

 +2        SET BGPRPTT=""

 +3        WRITE !!!,"You will now be able to select which sites to use in the",!,"area aggregate report.",!

 +4        SET DIR(0)="E"

           SET DIR("A")="Press Enter to Continue"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        KILL BGPSUL

 +6        DO EN^BGP0ASL

 +7        IF '$DATA(BGPSUL)

               WRITE !!,"No sites selected"

               DO XIT

               QUIT

 +8        SET X=0

           SET C=0

FOR

               SET X=$ORDER(BGPSUL(X))

               IF X'=+X

                   QUIT

               SET C=C+1

 +9        WRITE !!,"A total of ",C," facilities have been selected.",!!

 +10       IF C=1

               SET BGPRPTT="F"

               SET BGPSUCNT=1

               SET Y=$ORDER(BGPSUL(0))

               SET X=$PIECE(^BGPPEDCT(Y,0),U,9)

               SET X=$ORDER(^AUTTLOC("C",X,0))

               IF X

                   SET BGPSUNM=$PIECE(^DIC(4,X,0),U)

 +11       IF C>1

               SET BGPRPTT="A"

ZIS       ;call to XBDBQUE

 +1        DO ^XBFMK

 +2        SET X=0

FOR

               SET X=$ORDER(^BGPPEIT(X))

               IF X'=+X

                   QUIT

               SET BGPIND(X)=""

 +3        DO PT^BGP0PESL

 +4        IF BGPROT=""

               GOTO ASU

 +5        KILL IOP,%ZIS

           IF BGPROT="D"

               IF BGPDELT="F"

                   DO NODEV

                   DO XIT

                   QUIT

 +6        KILL IOP,%ZIS

           WRITE !!

           SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")

           DO ^%ZIS

 +7        IF $DATA(IO("Q"))

               GOTO TSKMN

DRIVER    ;

 +1        USE IO

 +2        DO ^BGP0PPEL

 +3        DO ^%ZISC

 +4        DO XIT

 +5        QUIT

 +6       ;

NODEV     ;

 +1        SET XBRP=""

           SET XBRC="NODEV1^BGP0DPEA"

           SET XBRX="XIT^BGP0DPEA"

           SET XBNS="BGP"

 +2        DO ^XBDBQUE

 +3       ;D XIT

 +4        QUIT

 +5       ;

NODEV1    ;

 +1        DO ^BGP0PPEL

 +2        DO ^%ZISC

 +3        DO XIT

 +4        QUIT

TSKMN     ;EP ENTRY POINT FROM TASKMAN

 +1        SET ZTIO=$SELECT($DATA(ION):ION,1:IO)

           IF $DATA(IOST)#2

               IF IOST]""

                   SET ZTIO=ZTIO_";"_IOST

 +2        IF $GET(IO("DOC"))]""

               SET ZTIO=ZTIO_";"_$GET(IO("DOC"))

 +3        IF $DATA(IOM)#2

               IF IOM

                   SET ZTIO=ZTIO_";"_IOM

                   IF $DATA(IOSL)#2

                       IF IOSL

                           SET ZTIO=ZTIO_";"_IOSL

 +4        KILL ZTSAVE

           SET ZTSAVE("BGP*")=""

 +5        SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="DRIVER^BGP0DPEA"

           SET ZTDTH=""

           SET ZTDESC="PAT ED 09 REPORT"

           DO ^%ZTLOAD

           DO XIT

           QUIT

 +6        QUIT

 +7       ;

XIT       ;

 +1        DO ^%ZISC

 +2        DO EN^XBVK("BGP")

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        KILL DIRUT,DUOUT,DIR,DOD

 +4        KILL DIADD,DLAYGO

 +5        DO KILL^AUPNPAT

 +6        KILL X,X1,X2,X3,X4,X5,X6

 +7        KILL A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 +8        KILL N,N1,N2,N3,N4,N5,N6

 +9        KILL BD,ED

 +10       DO KILL^AUPNPAT

 +11       DO ^XBFMK

 +12       QUIT

 +13      ;

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

 +2       ;----------

EOP       ;EP - End of page.

 +1        IF $EXTRACT(IOST)'="C"

               QUIT

 +2        IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))

               QUIT

 +3        NEW DIR

 +4        KILL DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 +5        SET DIR(0)="E"

           DO ^DIR

           KILL DIR

 +6        QUIT

 +7       ;----------

USR()     ;EP - Return name of current user from ^VA(200.

 +1        QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 +2       ;----------

LOC()     ;EP - Return location name from file 4 based on DUZ(2).

 +1        QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 +2       ;----------

 +3       ;

CHKY      ;

 +1        WRITE !!,"The baseline year and the previous year time periods are the same.",!!

 +2        SET DIR(0)="Y"

           SET DIR("A")="Do you want to change the baseline year"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET Y=""

               QUIT

 +4        QUIT

F         ;fiscal year

 +1        SET (BGPPER,BGPVDT)=""

 +2        WRITE !!,"Enter the Calendar Year for the report END date.  Use a 4 digit",!,"year, e.g. 2010"

 +3        SET DIR(0)="D^::EP"

 +4        SET DIR("A")="Enter Year"

 +5        SET DIR("?")="This report is compiled for a period.  Enter a valid date."

 +6        DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)

               QUIT

 +8        IF $DATA(DUOUT)

               SET DIRUT=1

               QUIT

 +9        SET BGPVDT=Y

 +10       IF $EXTRACT(Y,4,7)'="0000"

               WRITE !!,"Please enter a year only!",!

               GOTO F

 +11       SET BGPPER=BGPVDT

 +12       QUIT

ENDDATE   ;

 +1        WRITE !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2010)"

 +2        WRITE !,"will assume a year in the past, if you want to put in a future date,"

 +3        WRITE !,"remember to enter the full 4 digit year.  For example, if today is"

 +4        WRITE !,"January 4, 2009 and you type in 6/30/07 the system will assume the year"

 +5        WRITE !,"as 1907 since that is a date in the past.  You must type 6/30/2009 if you"

 +6        WRITE !,"want a date in the future."

 +7        SET (BGPPER,BGPVDT)=""

 +8        WRITE !

           KILL DIR,X,Y

           SET DIR(0)="D^::EP"

           SET DIR("A")="Enter End Date for the Report: (e.g. 11/30/2005)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +9        IF $DATA(DIRUT)

               QUIT

 +10       SET (BGPPER,BGPVDT)=Y

 +11       QUIT

BGP0DPEA.m