BNIGVL4.m

BNIGVL4 ; IHS/CMI/LAB - general retrieval select ;

 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006

 ;; ;

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

 K BNIGCSEL

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

 D CLEAR^VALM1

 K BNIGDISP,BNIGSEL,BNIGLIST,C,X,I,K,J,BNIGHIGH,BNIGCUT,BNIGCSEL,BNIGCNTL

 K VALMHDR,VALMCNT

 Q

 ;

HDR ; -- header code

 D @("HDR"_BNIGCNTL)

 Q

HDRS ;

 S VALMHDR(1)="                        "_$G(IORVON)_"CPHAD Activity Record Selection Menu"_$G(IORVOFF)

 S VALMHDR(2)="Activity Records 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 records, type 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 Activity records 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 activity date."

 Q

 ;

INIT ; -- init variables and list array

 K BNIGDISP,BNIGSEL,BNIGHIGH,BNIGLIST

 S BNIGHIGH=0,X=0 F  S X=$O(^BNIGRI("C",X)) Q:X'=+X  S Y=$O(^BNIGRI("C",X,"")) I $P(^BNIGRI(Y,0),U,5)[BNIGCNTL,$P(^(0),U,11)[BNIGPTVS S BNIGHIGH=BNIGHIGH+1,BNIGSEL(BNIGHIGH)=Y

 S BNIGCUT=((BNIGHIGH/3)+1)\1

 S (C,I)=0,J=1,K=1 F  S I=$O(BNIGSEL(I)) Q:I'=+I  Q:$D(BNIGDISP(I))  D

 .S C=C+1,BNIGLIST(C,0)=I_") "_$S($D(BNIGCSEL(I)):"*",1:" ")_$S($P(^BNIGRI(BNIGSEL(I),0),U,12)="":$E($P(^(0),U),1,20),1:$P(^(0),U,12)) S BNIGDISP(I)="",BNIGLIST("IDX",C,C)=""

 .S J=I+BNIGCUT I $D(BNIGSEL(J)),'$D(BNIGDISP(J)) S $E(BNIGLIST(C,0),28)=J_") "_$S($D(BNIGCSEL(J)):"*",1:" ")_$S($P(^BNIGRI(BNIGSEL(J),0),U,12)="":$E($P(^BNIGRI(BNIGSEL(J),0),U),1,20),1:$P(^(0),U,12)) S BNIGDISP(J)=""

 .S K=J+BNIGCUT I $D(BNIGSEL(K)),'$D(BNIGDISP(K)) S $E(BNIGLIST(C,0),55)=K_") "_$S($D(BNIGCSEL(K)):"*",1:" ")_$S($P(^BNIGRI(BNIGSEL(K),0),U,12)="":$E($P(^BNIGRI(BNIGSEL(K),0),U),1,20),1:$P(^(0),U,12)) S BNIGDISP(K)=""

 K BNIGDISP

 S VALMCNT=C

 Q

 ;

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

 G:BNIGCNTL="R" SELECTR

 W ! S DIR(0)="LO^1:"_BNIGHIGH,DIR("A")="Which activity record item(s)" D DIRQ^BNIGVLS1,^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"_BNIGCNTL)

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 BNIGANS=Y,BNIGC="" F BNIGI=1:1 S BNIGC=$P(BNIGANS,",",BNIGI) Q:BNIGC=""  S BNIGCRIT=BNIGSEL(BNIGC) D

 .S BNIGTEXT=$P(^BNIGRI(BNIGCRIT,0),U)

 .S BNIGVAR=$P(^BNIGRI(BNIGCRIT,0),U,6) K ^BNIRTMP(BNIGRPT,11,BNIGCRIT),^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT)

 .W !!,BNIGC,") ",BNIGTEXT," Selection."

 .I $P(^BNIGRI(BNIGCRIT,0),U,2)]"" S BNIGCNT=0,^BNIRTMP(BNIGRPT,11,0)="^90512.81101PA^0^0" D @($P(^BNIGRI(BNIGCRIT,0),U,2)_"^BNIGVL0")

 .I $D(^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1)) S BNIGCSEL(BNIGC)=""

 .I $P(^BNIGRI(BNIGCRIT,0),U,13) S BNIGDTR=1

 .Q

 D SHOW^BNIGVLS

 Q

SELECTR ;sort select

 W ! S DIR(0)="NO^1:"_BNIGHIGH_":0",DIR("A")=$S(BNIGCTYP="S":"Sub-total ",1:"Sort ")_"records by which of the above" D ^DIR K DIR

SELECTR1 ;

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

 I Y="",BNIGCTYP="D"!(BNIGCTYP="L") W !!,"No sort criteria selected ... will sort by Activity Record date." S BNIGSORT=1,BNIGSORV="Activity Date" H 3 D  Q

 .S DA=BNIGRPT,DIE="^BNIRTMP(",DR=".07////"_BNIGSORT D ^DIE K DA,DR,DIE,DIU,DIV,DIY,DIW

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

 .S BNIGCTYP="T"

 .H 2

 .S BNIGSORT=1,BNIGSORV="Activity Date"

 S BNIGSORT=BNIGSEL(+Y),BNIGSORV=$P(^BNIGRI(BNIGSORT,0),U),DA=BNIGRPT,DIE="^BNIRTMP(",DR=".07////"_BNIGSORT D ^DIE K DA,DR,DIE,DIU,DIV,DIY,DIW

 Q

SELECTP ;print select - get columns

 S BNIGANS=Y,BNIGC="" F BNIGI=1:1 S BNIGC=$P(BNIGANS,",",BNIGI) Q:BNIGC=""  S BNIGCRIT=BNIGSEL(BNIGC),BNIGPCNT=BNIGPCNT+1 D

 .I BNIGCTYP="D" D

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

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

 .I BNIGCTYP="L" S Y=""

 .S ^BNIRTMP(BNIGRPT,12,0)="^90512.81102PA^1^1"

 .I $D(^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT)) S X=$O(^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT,"")),BNIGTCW=BNIGTCW-$P(^BNIRTMP(BNIGRPT,12,X,0),U,2)-2,^BNIRTMP(BNIGRPT,12,X,0)=BNIGCRIT_U_Y

 .S ^BNIRTMP(BNIGRPT,12,BNIGPCNT,0)=BNIGCRIT_U_Y,^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT,BNIGPCNT)="",BNIGTCW=BNIGTCW+Y+2,BNIGCSEL(BNIGC)=""

 .I BNIGCTYP="D" W !!?15,"Total Report width (including column margins - 2 spaces):   ",BNIGTCW

 .Q

 Q

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

 I '$D(BNIGCSEL) 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

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

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

 S BNIGANS=Y,BNIGC="" F BNIGI=1:1 S BNIGC=$P(BNIGANS,",",BNIGI) Q:BNIGC=""  S BNIGCRIT=BNIGSEL(BNIGC) D

 .I '$D(BNIGCSEL(BNIGC)) W !,"Item ",BNIGC," ",$P(^BNIGRI(BNIGCRIT,0),U)," has not been selected.",! Q

 .K BNIGCSEL(BNIGC)

 .I BNIGCNTL="S" K ^BNIRTMP(BNIGRPT,11,BNIGCRIT),^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT)

 .I BNIGCNTL="P" S X=$O(^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT,0)) I X K ^BNIRTMP(BNIGRPT,12,X),^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT)

 .W !,"Item ",$P(^BNIGRI(BNIGCRIT,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 BNIGCNTL="R" S Y="" G SELECTR1

 Q

EXITR ;EP - exit report called from protocol entry

 S BNIGQUIT=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(BNIGPTVS="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 BNIGDISP

 K VALMCC,VALMHDR

 Q

 ;

EXPND ; -- expand code

 Q

 ;

BNIGVL4   ; IHS/CMI/LAB - general retrieval select ;

 +1       ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006

 +2       ;; ;

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

 +1        KILL BNIGCSEL

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

 +3        DO CLEAR^VALM1

 +4        KILL BNIGDISP,BNIGSEL,BNIGLIST,C,X,I,K,J,BNIGHIGH,BNIGCUT,BNIGCSEL,BNIGCNTL

 +5        KILL VALMHDR,VALMCNT

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        DO @("HDR"_BNIGCNTL)

 +2        QUIT 

HDRS      ;

 +1        SET VALMHDR(1)="                        "_$GET(IORVON)_"CPHAD Activity Record Selection Menu"_$GET(IORVOFF)

 +2        SET VALMHDR(2)="Activity Records 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 records, type 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 Activity records 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 activity date."

 +5        QUIT 

 +6       ;

INIT      ; -- init variables and list array

 +1        KILL BNIGDISP,BNIGSEL,BNIGHIGH,BNIGLIST

 +2        SET BNIGHIGH=0

           SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

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

               IF $PIECE(^BNIGRI(Y,0),U,5)[BNIGCNTL

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

                       SET BNIGHIGH=BNIGHIGH+1

                       SET BNIGSEL(BNIGHIGH)=Y

 +3        SET BNIGCUT=((BNIGHIGH/3)+1)\1

 +4        SET (C,I)=0

           SET J=1

           SET K=1

           FOR 

               SET I=$ORDER(BNIGSEL(I))

               IF I'=+I

                   QUIT 

               IF $DATA(BNIGDISP(I))

                   QUIT 

               Begin DoDot:1

 +5                SET C=C+1

                   SET BNIGLIST(C,0)=I_") "_$SELECT($DATA(BNIGCSEL(I)):"*",1:" ")_$SELECT($PIECE(^BNIGRI(BNIGSEL(I),0),U,12)="":$EXTRACT($PIECE(^(0),U),1,20),1:$PIECE(^(0),U,12))

                   SET BNIGDISP(I)=""

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

 +6                SET J=I+BNIGCUT

                   IF $DATA(BNIGSEL(J))

                       IF '$DATA(BNIGDISP(J))

                           SET $EXTRACT(BNIGLIST(C,0),28)=J_") "_$SELECT($DATA(BNIGCSEL(J)):"*",1:" ")_$SELECT($PIECE(^BNIGRI(BNIGSEL(J),0),U,12)="":$EXTRACT($PIECE(^BNIGRI(BNIGSEL(J),0),U),1,20),1:$PIECE(^(0),U,12))

                           SET BNIGDISP(J)=""

 +7                SET K=J+BNIGCUT

                   IF $DATA(BNIGSEL(K))

                       IF '$DATA(BNIGDISP(K))

                           SET $EXTRACT(BNIGLIST(C,0),55)=K_") "_$SELECT($DATA(BNIGCSEL(K)):"*",1:" ")_$SELECT($PIECE(^BNIGRI(BNIGSEL(K),0),U,12)="":$EXTRACT($PIECE(^BNIGRI(BNIGSEL(K),0),U),1,20),1:$PIECE(^(0),U,12))

                           SET BNIGDISP(K)=""

               End DoDot:1

 +8        KILL BNIGDISP

 +9        SET VALMCNT=C

 +10       QUIT 

 +11      ;

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

 +1        IF BNIGCNTL="R"

               GOTO SELECTR

 +2        WRITE !

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

           SET DIR("A")="Which activity record item(s)"

           DO DIRQ^BNIGVLS1

           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"_BNIGCNTL)

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 BNIGANS=Y

           SET BNIGC=""

           FOR BNIGI=1:1

               SET BNIGC=$PIECE(BNIGANS,",",BNIGI)

               IF BNIGC=""

                   QUIT 

               SET BNIGCRIT=BNIGSEL(BNIGC)

               Begin DoDot:1

 +2                SET BNIGTEXT=$PIECE(^BNIGRI(BNIGCRIT,0),U)

 +3                SET BNIGVAR=$PIECE(^BNIGRI(BNIGCRIT,0),U,6)

                   KILL ^BNIRTMP(BNIGRPT,11,BNIGCRIT),^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT)

 +4                WRITE !!,BNIGC,") ",BNIGTEXT," Selection."

 +5                IF $PIECE(^BNIGRI(BNIGCRIT,0),U,2)]""

                       SET BNIGCNT=0

                       SET ^BNIRTMP(BNIGRPT,11,0)="^90512.81101PA^0^0"

                       DO @($PIECE(^BNIGRI(BNIGCRIT,0),U,2)_"^BNIGVL0")

 +6                IF $DATA(^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1))

                       SET BNIGCSEL(BNIGC)=""

 +7                IF $PIECE(^BNIGRI(BNIGCRIT,0),U,13)

                       SET BNIGDTR=1

 +8                QUIT 

               End DoDot:1

 +9        DO SHOW^BNIGVLS

 +10       QUIT 

SELECTR   ;sort select

 +1        WRITE !

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

           SET DIR("A")=$SELECT(BNIGCTYP="S":"Sub-total ",1:"Sort ")_"records by which of the above"

           DO ^DIR

           KILL DIR

SELECTR1  ;

 +1        IF $DATA(DUOUT)

               WRITE !,"exiting"

               SET BNIGQUIT=1

               QUIT 

 +2        IF Y=""

               IF BNIGCTYP="D"!(BNIGCTYP="L")

                   WRITE !!,"No sort criteria selected ... will sort by Activity Record date."

                   SET BNIGSORT=1

                   SET BNIGSORV="Activity Date"

                   HANG 3

                   Begin DoDot:1

 +3                    SET DA=BNIGRPT

                       SET DIE="^BNIRTMP("

                       SET DR=".07////"_BNIGSORT

                       DO ^DIE

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

                   End DoDot:1

                   QUIT 

 +4        IF Y=""

               IF BNIGCTYP'="D"

                   IF BNIGCTYP'="L"

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

                       Begin DoDot:1

 +5                        SET BNIGCTYP="T"

 +6                        HANG 2

 +7                        SET BNIGSORT=1

                           SET BNIGSORV="Activity Date"

                       End DoDot:1

                       QUIT 

 +8        SET BNIGSORT=BNIGSEL(+Y)

           SET BNIGSORV=$PIECE(^BNIGRI(BNIGSORT,0),U)

           SET DA=BNIGRPT

           SET DIE="^BNIRTMP("

           SET DR=".07////"_BNIGSORT

           DO ^DIE

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

 +9        QUIT 

SELECTP   ;print select - get columns

 +1        SET BNIGANS=Y

           SET BNIGC=""

           FOR BNIGI=1:1

               SET BNIGC=$PIECE(BNIGANS,",",BNIGI)

               IF BNIGC=""

                   QUIT 

               SET BNIGCRIT=BNIGSEL(BNIGC)

               SET BNIGPCNT=BNIGPCNT+1

               Begin DoDot:1

 +2                IF BNIGCTYP="D"

                       Begin DoDot:2

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

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

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

                           DO ^DIR

                           KILL DIR

                           IF $DATA(DUOUT)

                               SET DIRUT=1

 +4                        IF $DATA(DIRUT)

                               SET Y=$PIECE(^BNIGRI(BNIGCRIT,0),U,7)

                       End DoDot:2

 +5                IF BNIGCTYP="L"

                       SET Y=""

 +6                SET ^BNIRTMP(BNIGRPT,12,0)="^90512.81102PA^1^1"

 +7                IF $DATA(^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT))

                       SET X=$ORDER(^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT,""))

                       SET BNIGTCW=BNIGTCW-$PIECE(^BNIRTMP(BNIGRPT,12,X,0),U,2)-2

                       SET ^BNIRTMP(BNIGRPT,12,X,0)=BNIGCRIT_U_Y

 +8                SET ^BNIRTMP(BNIGRPT,12,BNIGPCNT,0)=BNIGCRIT_U_Y

                   SET ^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT,BNIGPCNT)=""

                   SET BNIGTCW=BNIGTCW+Y+2

                   SET BNIGCSEL(BNIGC)=""

 +9                IF BNIGCTYP="D"

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

 +10               QUIT 

               End DoDot:1

 +11       QUIT 

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

 +1        IF '$DATA(BNIGCSEL)

               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        IF Y=""

               WRITE !,"No items selected."

               GOTO REMX

 +4        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO REMX

 +5        SET BNIGANS=Y

           SET BNIGC=""

           FOR BNIGI=1:1

               SET BNIGC=$PIECE(BNIGANS,",",BNIGI)

               IF BNIGC=""

                   QUIT 

               SET BNIGCRIT=BNIGSEL(BNIGC)

               Begin DoDot:1

 +6                IF '$DATA(BNIGCSEL(BNIGC))

                       WRITE !,"Item ",BNIGC," ",$PIECE(^BNIGRI(BNIGCRIT,0),U)," has not been selected.",!

                       QUIT 

 +7                KILL BNIGCSEL(BNIGC)

 +8                IF BNIGCNTL="S"

                       KILL ^BNIRTMP(BNIGRPT,11,BNIGCRIT),^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT)

 +9                IF BNIGCNTL="P"

                       SET X=$ORDER(^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT,0))

                       IF X

                           KILL ^BNIRTMP(BNIGRPT,12,X),^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT)

 +10               WRITE !,"Item ",$PIECE(^BNIGRI(BNIGCRIT,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 BNIGCNTL="R"

               SET Y=""

               GOTO SELECTR1

 +2        QUIT 

EXITR     ;EP - exit report called from protocol entry

 +1        SET BNIGQUIT=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(BNIGPTVS="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 BNIGDISP

 +2        KILL VALMCC,VALMHDR

 +3        QUIT 

 +4       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;