BWGRVL4.m

BWGRVL4 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 25-JUN-1996 ; [ 08/16/01  3:49 PM ]

 ;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996

 ;IHS/CMI/LAB - modified file numbers

 ;; ;

EN ; -- main entry point for BWGR GENRET SELECT ITEMS

 K BWGRCSEL

 D EN^VALM("BWGR GENRET SELECT ITEMS")

 D CLEAR^VALM1

 K BWGRDISP,BWGRSEL,BWGRLIST,C,X,I,K,J,BWGRHIGH,BWGRCUT,BWGRCSEL,BWGRCNTL

 K VALMHDR,VALMCNT

 Q

 ;

HDR ; -- header code

 D @("HDR"_BWGRCNTL)

 Q

HDRS ;

 S VALMHDR(1)="                        "_$G(IORVON)_$S(BWGRPTVS="R":"WH PROCEDURE ",1:"PATIENT ")_"Selection Menu"_$G(IORVOFF)

 S VALMHDR(2)=$S(BWGRPTVS="R":"Procedures",1:"Patients")_" can be selected based upon any of the following items.  Select"

 S VALMHDR(3)="as many as you wish, in any order or combination.  An (*) asterisk indicates"

 S VALMHDR(4)="items already selected.  To bypass screens and select all "_$S(BWGRPTVS="R":"visits",1:"patients")_" hit Q."

 Q

 ;

HDRP ;print selection header

 S VALMHDR(1)="                        "_$G(IORVON)_"PRINT ITEM SELECTION MENU"_$G(IORVOFF)

 S VALMHDR(2)="The following data items can be printed.  Choose the items in the order you"

 S VALMHDR(3)="want them to appear on the printout.  Keep in mind that you have an 80"

 S VALMHDR(4)="column screen available, or a printer with either 80 or 132 column width."

 Q

 ;

HDRR ;sort header

 S VALMHDR(1)=""

 S VALMHDR(2)="                        "_$G(IORVON)_"SORT ITEM SELECTION MENU"_$G(IORVOFF)

 S VALMHDR(3)="The "_$S(BWGRPTVS="P":"patients",1:"visits")_" displayed can be SORTED by ONLY ONE of the following items."

 S VALMHDR(4)="If you don't select a sort item, the report will be sorted by "_$S(BWGRPTVS="R":"visit date.",1:"patient name.")

 Q

 ;

INIT ; -- init variables and list array

 K BWGRDISP,BWGRSEL,BWGRHIGH,BWGRLIST

 S BWGRHIGH=0,X=0 F  S X=$O(^BWGRI("C",X)) Q:X'=+X  S Y=$O(^BWGRI("C",X,"")) I $P(^BWGRI(Y,0),U,5)[BWGRCNTL,$P(^(0),U,11)[BWGRPTVS S BWGRHIGH=BWGRHIGH+1,BWGRSEL(BWGRHIGH)=Y

 S BWGRCUT=((BWGRHIGH/3)+1)\1

 S (C,I)=0,J=1,K=1 F  S I=$O(BWGRSEL(I)) Q:I'=+I!($D(BWGRDISP(I)))  D

 .S C=C+1,BWGRLIST(C,0)=I_") "_$S($D(BWGRCSEL(I)):"*",1:" ")_$S($P(^BWGRI(BWGRSEL(I),0),U,12)="":$E($P(^(0),U),1,20),1:$P(^(0),U,12)) S BWGRDISP(I)="",BWGRLIST("IDX",C,C)=""

 .S J=I+BWGRCUT I $D(BWGRSEL(J)),'$D(BWGRDISP(J)) S $E(BWGRLIST(C,0),28)=J_") "_$S($D(BWGRCSEL(J)):"*",1:" ")_$S($P(^BWGRI(BWGRSEL(J),0),U,12)="":$E($P(^BWGRI(BWGRSEL(J),0),U),1,20),1:$P(^(0),U,12)) S BWGRDISP(J)=""

 .S K=J+BWGRCUT I $D(BWGRSEL(K)),'$D(BWGRDISP(K)) S $E(BWGRLIST(C,0),55)=K_") "_$S($D(BWGRCSEL(K)):"*",1:" ")_$S($P(^BWGRI(BWGRSEL(K),0),U,12)="":$E($P(^BWGRI(BWGRSEL(K),0),U),1,20),1:$P(^(0),U,12)) S BWGRDISP(K)=""

 K BWGRDISP

 S VALMCNT=C

 Q

 ;

ADD ;EP - add an item to the selected list - called from a protocol

 G:BWGRCNTL="R" SELECTR

 W ! S DIR(0)="LO^1:"_BWGRHIGH,DIR("A")="Which "_$S(BWGRPTVS="P":"patient",1:"visit")_" item(s)" D DIRQ^BWGRVLS1,^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No items selected." G ADDX

 I $D(DIRUT) W !,"No items selected." G ADDX

 D FULL^VALM1 W:$D(IOF) @IOF

 D @("SELECT"_BWGRCNTL)

ADDX ;

 S DIR(0)="EO",DIR("A")="Hit return to continue..." K DA D ^DIR K DIR

 D BACK

 Q

SELECTS ;select screen items

 S BWGRANS=Y,BWGRC="" F BWGRI=1:1 S BWGRC=$P(BWGRANS,",",BWGRI) Q:BWGRC=""  S BWGRCRIT=BWGRSEL(BWGRC) D

 .S BWGRTEXT=$P(^BWGRI(BWGRCRIT,0),U)

 .S BWGRVAR=$P(^BWGRI(BWGRCRIT,0),U,6) K ^BWGRTRPT(BWGRRPT,11,BWGRCRIT),^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT)

 .W !!,BWGRC,") ",BWGRTEXT," Selection."

 .I $P(^BWGRI(BWGRCRIT,0),U,2)]"" S BWGRCNT=0,^BWGRTRPT(BWGRRPT,11,0)="^9002086.89101PA^0^0" D @($P(^BWGRI(BWGRCRIT,0),U,2)_"^BWGRVL0")

 .I $D(^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1)) S BWGRCSEL(BWGRC)=""

 .I $P(^BWGRI(BWGRCRIT,0),U,13) S BWGRDTR=1

 .Q

 D SHOW^BWGRVLS

 Q

SELECTR ;sort select

 W ! S DIR(0)="NO^1:"_BWGRHIGH_":0",DIR("A")=$S(BWGRCTYP="S":"Sub-total ",1:"Sort ")_$S(BWGRPTVS="P":"Patients",1:"visits")_" by which of the above" D ^DIR K DIR

SELECTR1 ;

 I $D(DUOUT) W !,"exiting" S BWGRQUIT=1 Q

 I Y="",BWGRCTYP="D" W !!,"No sort criteria selected ... will sort by "_$S(BWGRPTVS="P":"Patient Name",1:"Procedure Date")_"." S:BWGRPTVS="R" BWGRSORT=130,BWGRSORV="Procedure Date" S:BWGRPTVS="P" BWGRSORT=1,BWGRSORV="Patient Name" H 3 D  Q

 .S DA=BWGRRPT,DIE="^BWGRTRPT(",DR=".07////"_BWGRSORT D ^DIE K DA,DR,DIE,DIU,DIV,DIY,DIW

 I Y="",BWGRCTYP'="D" W !!,"No sub-totalling will be done.",!! D  Q

 .S BWGRCTYP="T"

 .H 3

 .S:BWGRPTVS="R" BWGRSORT=130,BWGRSORV="Procedure Date"

 .S:BWGRPTVS="P" BWGRSORT=1,BWGRSORV="Patient Name"

 S BWGRSORT=BWGRSEL(+Y),BWGRSORV=$P(^BWGRI(BWGRSORT,0),U),DA=BWGRRPT,DIE="^BWGRTRPT(",DR=".07////"_BWGRSORT D ^DIE K DA,DR,DIE,DIU,DIV,DIY,DIW

 Q

SELECTP ;print select - get columns

 S BWGRANS=Y,BWGRC="" F BWGRI=1:1 S BWGRC=$P(BWGRANS,",",BWGRI) Q:BWGRC=""  S BWGRCRIT=BWGRSEL(BWGRC),BWGRPCNT=BWGRPCNT+1 D

 .S DIR(0)="N^2:80:0",DIR("A")="Enter Column width for "_$P(^BWGRI(BWGRCRIT,0),U)_" (suggested: "_$P(^BWGRI(BWGRCRIT,0),U,7)_")",DIR("B")=$P(^(0),U,7) D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 .I $D(DIRUT) S Y=$P(^BWGRI(BWGRCRIT,0),U,7)

 .S ^BWGRTRPT(BWGRRPT,12,0)="^9002086.89102PA^1^1"

 .I $D(^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT)) S X=$O(^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT,"")),BWGRTCW=BWGRTCW-$P(^BWGRTRPT(BWGRRPT,12,X,0),U,2)-2,^BWGRTRPT(BWGRRPT,12,X,0)=BWGRCRIT_U_Y D  Q

 ..Q

 .S ^BWGRTRPT(BWGRRPT,12,BWGRPCNT,0)=BWGRCRIT_U_Y,^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT,BWGRPCNT)="",BWGRTCW=BWGRTCW+Y+2,BWGRCSEL(BWGRC)=""

 .W !!?15,"Total Report width (including column margins - 2 spaces):   ",BWGRTCW

 .Q

 Q

REM ;EP - remove a selected item - called from protocol entry

 I '$D(BWGRCSEL) W !!,"No items have been selected.",! H 2 G REMX

 S DIR(0)="LO^:",DIR("A")="Remove which selected item" K DA D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 ;W ! S DIR(0)="LO^1:"_BWGRHIGH,DIR("A")="Remove Which "_$S(BWGRPTVS="P":"patient",1:"visit")_" item(s)" D DIRQ^BWGRVLS1,^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No items selected." G REMX

 I $D(DIRUT) W !,"No items selected." G REMX

 S BWGRANS=Y,BWGRC="" F BWGRI=1:1 S BWGRC=$P(BWGRANS,",",BWGRI) Q:BWGRC=""  S BWGRCRIT=BWGRSEL(BWGRC) D

 .I '$D(BWGRCSEL(BWGRC)) W !,"Item ",BWGRC," ",$P(^BWGRI(BWGRCRIT,0),U)," has not been selected.",! Q

 .K BWGRCSEL(BWGRC)

 .I BWGRCNTL="S" K ^BWGRTRPT(BWGRRPT,11,BWGRCRIT),^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT)

 .I BWGRCNTL="P" S X=$O(^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT,0)) I X K ^BWGRTRPT(BWGRRPT,12,X),^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT)

 .W !,"Item ",$P(^BWGRI(BWGRCRIT,0),U)," removed from selected list of items."

REMX ;

 S DIR(0)="EO",DIR("A")="Hit return to continue..." K DA D ^DIR K DIR

 D BACK

 Q

Q ;EP - quit selections

 I BWGRCNTL="R" S Y="" G SELECTR1

 Q

EXITR ;EP - exit report called from protocol entry

 S BWGRQUIT=1

 Q

HELP ; -- help code

 D FULL^VALM1

 W:$D(IOF) @IOF

 W !,"Enter an S to Select an Item, and R to remove a selected item, Q to Quit",!,"the selection process.  To exit the report, enter an E.",!,"Hit a Q to select all ",$S(BWGRPTVS="R":"visits",1:"patients"),", bypassing all screens.",!

 S X="?" D DISP^XQORM1 W !

 S DIR(0)="EO",DIR("A")="Hit return to continue..." K DA D ^DIR K DIR

 D BACK

 Q

 ;

BACK ;go back to listman

 D TERM^VALM0

 S VALMBCK="R"

 D INIT

 D HDR

 K DIR

 K X,Y,Z,I

 Q

EXIT ; -- exit code

 K BWGRDISP

 K VALMCC,VALMHDR

 Q

 ;

EXPND ; -- expand code

 Q

 ;

BWGRVL4   ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 25-JUN-1996 ; [ 08/16/01  3:49 PM ]

 +1       ;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996

 +2       ;IHS/CMI/LAB - modified file numbers

 +3       ;; ;

EN        ; -- main entry point for BWGR GENRET SELECT ITEMS

 +1        KILL BWGRCSEL

 +2        DO EN^VALM("BWGR GENRET SELECT ITEMS")

 +3        DO CLEAR^VALM1

 +4        KILL BWGRDISP,BWGRSEL,BWGRLIST,C,X,I,K,J,BWGRHIGH,BWGRCUT,BWGRCSEL,BWGRCNTL

 +5        KILL VALMHDR,VALMCNT

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        DO @("HDR"_BWGRCNTL)

 +2        QUIT 

HDRS      ;

 +1        SET VALMHDR(1)="                        "_$GET(IORVON)_$SELECT(BWGRPTVS="R":"WH PROCEDURE ",1:"PATIENT ")_"Selection Menu"_$GET(IORVOFF)

 +2        SET VALMHDR(2)=$SELECT(BWGRPTVS="R":"Procedures",1:"Patients")_" can be selected based upon any of the following items.  Select"

 +3        SET VALMHDR(3)="as many as you wish, in any order or combination.  An (*) asterisk indicates"

 +4        SET VALMHDR(4)="items already selected.  To bypass screens and select all "_$SELECT(BWGRPTVS="R":"visits",1:"patients")_" hit Q."

 +5        QUIT 

 +6       ;

HDRP      ;print selection header

 +1        SET VALMHDR(1)="                        "_$GET(IORVON)_"PRINT ITEM SELECTION MENU"_$GET(IORVOFF)

 +2        SET VALMHDR(2)="The following data items can be printed.  Choose the items in the order you"

 +3        SET VALMHDR(3)="want them to appear on the printout.  Keep in mind that you have an 80"

 +4        SET VALMHDR(4)="column screen available, or a printer with either 80 or 132 column width."

 +5        QUIT 

 +6       ;

HDRR      ;sort header

 +1        SET VALMHDR(1)=""

 +2        SET VALMHDR(2)="                        "_$GET(IORVON)_"SORT ITEM SELECTION MENU"_$GET(IORVOFF)

 +3        SET VALMHDR(3)="The "_$SELECT(BWGRPTVS="P":"patients",1:"visits")_" displayed can be SORTED by ONLY ONE of the following items."

 +4        SET VALMHDR(4)="If you don't select a sort item, the report will be sorted by "_$SELECT(BWGRPTVS="R":"visit date.",1:"patient name.")

 +5        QUIT 

 +6       ;

INIT      ; -- init variables and list array

 +1        KILL BWGRDISP,BWGRSEL,BWGRHIGH,BWGRLIST

 +2        SET BWGRHIGH=0

           SET X=0

           FOR 

               SET X=$ORDER(^BWGRI("C",X))

               IF X'=+X

                   QUIT 

               SET Y=$ORDER(^BWGRI("C",X,""))

               IF $PIECE(^BWGRI(Y,0),U,5)[BWGRCNTL

                   IF $PIECE(^(0),U,11)[BWGRPTVS

                       SET BWGRHIGH=BWGRHIGH+1

                       SET BWGRSEL(BWGRHIGH)=Y

 +3        SET BWGRCUT=((BWGRHIGH/3)+1)\1

 +4        SET (C,I)=0

           SET J=1

           SET K=1

           FOR 

               SET I=$ORDER(BWGRSEL(I))

               IF I'=+I!($DATA(BWGRDISP(I)))

                   QUIT 

               Begin DoDot:1

 +5                SET C=C+1

                   SET BWGRLIST(C,0)=I_") "_$SELECT($DATA(BWGRCSEL(I)):"*",1:" ")_$SELECT($PIECE(^BWGRI(BWGRSEL(I),0),U,12)="":$EXTRACT($PIECE(^(0),U),1,20),1:$PIECE(^(0),U,12))

                   SET BWGRDISP(I)=""

                   SET BWGRLIST("IDX",C,C)=""

 +6                SET J=I+BWGRCUT

                   IF $DATA(BWGRSEL(J))

                       IF '$DATA(BWGRDISP(J))

                           SET $EXTRACT(BWGRLIST(C,0),28)=J_") "_$SELECT($DATA(BWGRCSEL(J)):"*",1:" ")_$SELECT($PIECE(^BWGRI(BWGRSEL(J),0),U,12)="":$EXTRACT($PIECE(^BWGRI(BWGRSEL(J),0),U),1,20),1:$PIECE(^(0),U,12))

                           SET BWGRDISP(J)=""

 +7                SET K=J+BWGRCUT

                   IF $DATA(BWGRSEL(K))

                       IF '$DATA(BWGRDISP(K))

                           SET $EXTRACT(BWGRLIST(C,0),55)=K_") "_$SELECT($DATA(BWGRCSEL(K)):"*",1:" ")_$SELECT($PIECE(^BWGRI(BWGRSEL(K),0),U,12)="":$EXTRACT($PIECE(^BWGRI(BWGRSEL(K),0),U),1,20),1:$PIECE(^(0),U,12))

                           SET BWGRDISP(K)=""

               End DoDot:1

 +8        KILL BWGRDISP

 +9        SET VALMCNT=C

 +10       QUIT 

 +11      ;

ADD       ;EP - add an item to the selected list - called from a protocol

 +1        IF BWGRCNTL="R"

               GOTO SELECTR

 +2        WRITE !

           SET DIR(0)="LO^1:"_BWGRHIGH

           SET DIR("A")="Which "_$SELECT(BWGRPTVS="P":"patient",1:"visit")_" item(s)"

           DO DIRQ^BWGRVLS1

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF Y=""

               WRITE !,"No items selected."

               GOTO ADDX

 +4        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO ADDX

 +5        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +6        DO @("SELECT"_BWGRCNTL)

ADDX      ;

 +1        SET DIR(0)="EO"

           SET DIR("A")="Hit return to continue..."

           KILL DA

           DO ^DIR

           KILL DIR

 +2        DO BACK

 +3        QUIT 

SELECTS   ;select screen items

 +1        SET BWGRANS=Y

           SET BWGRC=""

           FOR BWGRI=1:1

               SET BWGRC=$PIECE(BWGRANS,",",BWGRI)

               IF BWGRC=""

                   QUIT 

               SET BWGRCRIT=BWGRSEL(BWGRC)

               Begin DoDot:1

 +2                SET BWGRTEXT=$PIECE(^BWGRI(BWGRCRIT,0),U)

 +3                SET BWGRVAR=$PIECE(^BWGRI(BWGRCRIT,0),U,6)

                   KILL ^BWGRTRPT(BWGRRPT,11,BWGRCRIT),^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT)

 +4                WRITE !!,BWGRC,") ",BWGRTEXT," Selection."

 +5                IF $PIECE(^BWGRI(BWGRCRIT,0),U,2)]""

                       SET BWGRCNT=0

                       SET ^BWGRTRPT(BWGRRPT,11,0)="^9002086.89101PA^0^0"

                       DO @($PIECE(^BWGRI(BWGRCRIT,0),U,2)_"^BWGRVL0")

 +6                IF $DATA(^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1))

                       SET BWGRCSEL(BWGRC)=""

 +7                IF $PIECE(^BWGRI(BWGRCRIT,0),U,13)

                       SET BWGRDTR=1

 +8                QUIT 

               End DoDot:1

 +9        DO SHOW^BWGRVLS

 +10       QUIT 

SELECTR   ;sort select

 +1        WRITE !

           SET DIR(0)="NO^1:"_BWGRHIGH_":0"

           SET DIR("A")=$SELECT(BWGRCTYP="S":"Sub-total ",1:"Sort ")_$SELECT(BWGRPTVS="P":"Patients",1:"visits")_" by which of the above"

           DO ^DIR

           KILL DIR

SELECTR1  ;

 +1        IF $DATA(DUOUT)

               WRITE !,"exiting"

               SET BWGRQUIT=1

               QUIT 

 +2        IF Y=""

               IF BWGRCTYP="D"

                   WRITE !!,"No sort criteria selected ... will sort by "_$SELECT(BWGRPTVS="P":"Patient Name",1:"Procedure Date")_"."

                   IF BWGRPTVS="R"

                       SET BWGRSORT=130

                       SET BWGRSORV="Procedure Date"

                   IF BWGRPTVS="P"

                       SET BWGRSORT=1

                       SET BWGRSORV="Patient Name"

                   HANG 3

                   Begin DoDot:1

 +3                    SET DA=BWGRRPT

                       SET DIE="^BWGRTRPT("

                       SET DR=".07////"_BWGRSORT

                       DO ^DIE

                       KILL DA,DR,DIE,DIU,DIV,DIY,DIW

                   End DoDot:1

                   QUIT 

 +4        IF Y=""

               IF BWGRCTYP'="D"

                   WRITE !!,"No sub-totalling will be done.",!!

                   Begin DoDot:1

 +5                    SET BWGRCTYP="T"

 +6                    HANG 3

 +7                    IF BWGRPTVS="R"

                           SET BWGRSORT=130

                           SET BWGRSORV="Procedure Date"

 +8                    IF BWGRPTVS="P"

                           SET BWGRSORT=1

                           SET BWGRSORV="Patient Name"

                   End DoDot:1

                   QUIT 

 +9        SET BWGRSORT=BWGRSEL(+Y)

           SET BWGRSORV=$PIECE(^BWGRI(BWGRSORT,0),U)

           SET DA=BWGRRPT

           SET DIE="^BWGRTRPT("

           SET DR=".07////"_BWGRSORT

           DO ^DIE

           KILL DA,DR,DIE,DIU,DIV,DIY,DIW

 +10       QUIT 

SELECTP   ;print select - get columns

 +1        SET BWGRANS=Y

           SET BWGRC=""

           FOR BWGRI=1:1

               SET BWGRC=$PIECE(BWGRANS,",",BWGRI)

               IF BWGRC=""

                   QUIT 

               SET BWGRCRIT=BWGRSEL(BWGRC)

               SET BWGRPCNT=BWGRPCNT+1

               Begin DoDot:1

 +2                SET DIR(0)="N^2:80:0"

                   SET DIR("A")="Enter Column width for "_$PIECE(^BWGRI(BWGRCRIT,0),U)_" (suggested: "_$PIECE(^BWGRI(BWGRCRIT,0),U,7)_")"

                   SET DIR("B")=$PIECE(^(0),U,7)

                   DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)

                       SET DIRUT=1

 +3                IF $DATA(DIRUT)

                       SET Y=$PIECE(^BWGRI(BWGRCRIT,0),U,7)

 +4                SET ^BWGRTRPT(BWGRRPT,12,0)="^9002086.89102PA^1^1"

 +5                IF $DATA(^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT))

                       SET X=$ORDER(^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT,""))

                       SET BWGRTCW=BWGRTCW-$PIECE(^BWGRTRPT(BWGRRPT,12,X,0),U,2)-2

                       SET ^BWGRTRPT(BWGRRPT,12,X,0)=BWGRCRIT_U_Y

                       Begin DoDot:2

 +6                        QUIT 

                       End DoDot:2

                       QUIT 

 +7                SET ^BWGRTRPT(BWGRRPT,12,BWGRPCNT,0)=BWGRCRIT_U_Y

                   SET ^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT,BWGRPCNT)=""

                   SET BWGRTCW=BWGRTCW+Y+2

                   SET BWGRCSEL(BWGRC)=""

 +8                WRITE !!?15,"Total Report width (including column margins - 2 spaces):   ",BWGRTCW

 +9                QUIT 

               End DoDot:1

 +10       QUIT 

REM       ;EP - remove a selected item - called from protocol entry

 +1        IF '$DATA(BWGRCSEL)

               WRITE !!,"No items have been selected.",!

               HANG 2

               GOTO REMX

 +2        SET DIR(0)="LO^:"

           SET DIR("A")="Remove which selected item"

           KILL DA

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3       ;W ! S DIR(0)="LO^1:"_BWGRHIGH,DIR("A")="Remove Which "_$S(BWGRPTVS="P":"patient",1:"visit")_" item(s)" D DIRQ^BWGRVLS1,^DIR K DIR S:$D(DUOUT) DIRUT=1

 +4        IF Y=""

               WRITE !,"No items selected."

               GOTO REMX

 +5        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO REMX

 +6        SET BWGRANS=Y

           SET BWGRC=""

           FOR BWGRI=1:1

               SET BWGRC=$PIECE(BWGRANS,",",BWGRI)

               IF BWGRC=""

                   QUIT 

               SET BWGRCRIT=BWGRSEL(BWGRC)

               Begin DoDot:1

 +7                IF '$DATA(BWGRCSEL(BWGRC))

                       WRITE !,"Item ",BWGRC," ",$PIECE(^BWGRI(BWGRCRIT,0),U)," has not been selected.",!

                       QUIT 

 +8                KILL BWGRCSEL(BWGRC)

 +9                IF BWGRCNTL="S"

                       KILL ^BWGRTRPT(BWGRRPT,11,BWGRCRIT),^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT)

 +10               IF BWGRCNTL="P"

                       SET X=$ORDER(^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT,0))

                       IF X

                           KILL ^BWGRTRPT(BWGRRPT,12,X),^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT)

 +11               WRITE !,"Item ",$PIECE(^BWGRI(BWGRCRIT,0),U)," removed from selected list of items."

               End DoDot:1

REMX      ;

 +1        SET DIR(0)="EO"

           SET DIR("A")="Hit return to continue..."

           KILL DA

           DO ^DIR

           KILL DIR

 +2        DO BACK

 +3        QUIT 

Q         ;EP - quit selections

 +1        IF BWGRCNTL="R"

               SET Y=""

               GOTO SELECTR1

 +2        QUIT 

EXITR     ;EP - exit report called from protocol entry

 +1        SET BWGRQUIT=1

 +2        QUIT 

HELP      ; -- help code

 +1        DO FULL^VALM1

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !,"Enter an S to Select an Item, and R to remove a selected item, Q to Quit",!,"the selection process.  To exit the report, enter an E.",!,"Hit a Q to select all ",$SELECT(BWGRPTVS="R":"visits",1:"patients"),", bypassing all screens.",!

 +4        SET X="?"

           DO DISP^XQORM1

           WRITE !

 +5        SET DIR(0)="EO"

           SET DIR("A")="Hit return to continue..."

           KILL DA

           DO ^DIR

           KILL DIR

 +6        DO BACK

 +7        QUIT 

 +8       ;

BACK      ;go back to listman

 +1        DO TERM^VALM0

 +2        SET VALMBCK="R"

 +3        DO INIT

 +4        DO HDR

 +5        KILL DIR

 +6        KILL X,Y,Z,I

 +7        QUIT 

EXIT      ; -- exit code

 +1        KILL BWGRDISP

 +2        KILL VALMCC,VALMHDR

 +3        QUIT 

 +4       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;