AMHRL4.m

AMHRL4 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 25-JUN-1996 ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;; ;

EN ; -- main entry point for AMH GEN SELECT ITEMS

 K AMHCSEL

 D EN^VALM("AMH GENRET SELECTION ITEMS")

 D CLEAR^VALM1

 K AMHDISP,AMHSEL,AMHLIST,C,X,I,K,J,AMHHIGH,AMHCUT,AMHCSEL,AMHCNTL

 K VALMHDR,VALMCNT

 Q

 ;

HDR ; -- header code

 D @("HDR"_AMHCNTL)

 Q

HDRS ;

 S VALMHDR(1)="                        "_$G(IORVON)_AMHPTTX_" Selection Menu"_$G(IORVOFF)

 S VALMHDR(2)=AMHPTTS_" 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 "_AMHPTTS_" 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 "_AMHPTTS_" 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(AMHPTVS="V":"visit date.",AMHPTVS="P":"patient name.",1:"Date of Suicide Act.")

 Q

 ;

INIT ; -- init variables and list array

 K AMHDISP,AMHSEL,AMHHIGH,AMHLIST

 S AMHHIGH=0,X=0 F  S X=$O(^AMHSORT(AMHXREF,X)) Q:X'=+X  S Y=$O(^AMHSORT(AMHXREF,X,"")) I $P(^AMHSORT(Y,0),U,5)[AMHCNTL,$P(^(0),U,11)[AMHPTVS S AMHHIGH=AMHHIGH+1,AMHSEL(AMHHIGH)=Y

 S AMHCUT=((AMHHIGH/3)+1)\1

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

 .S C=C+1,AMHLIST(C,0)=I_") "_$S($D(AMHCSEL(I)):"*",1:" ")_$S($P(^AMHSORT(AMHSEL(I),0),U,14)="":$E($P(^(0),U),1,20),1:$P(^(0),U,14)) S AMHDISP(I)="",AMHLIST("IDX",C,C)=""

 .S J=I+AMHCUT I $D(AMHSEL(J)),'$D(AMHDISP(J)) S $E(AMHLIST(C,0),28)=J_") "_$S($D(AMHCSEL(J)):"*",1:" ")_$S($P(^AMHSORT(AMHSEL(J),0),U,14)="":$E($P(^AMHSORT(AMHSEL(J),0),U),1,20),1:$P(^(0),U,14)) S AMHDISP(J)=""

 .S K=J+AMHCUT I $D(AMHSEL(K)),'$D(AMHDISP(K)) S $E(AMHLIST(C,0),55)=K_") "_$S($D(AMHCSEL(K)):"*",1:" ")_$S($P(^AMHSORT(AMHSEL(K),0),U,14)="":$E($P(^AMHSORT(AMHSEL(K),0),U),1,20),1:$P(^(0),U,14)) S AMHDISP(K)=""

 K AMHDISP

 S VALMCNT=C

 Q

 ;

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

 G:AMHCNTL="R" SELECTR

 W ! S DIR(0)="LO^1:"_AMHHIGH,DIR("A")="Which "_AMHPTTX_" item(s)" D ^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"_AMHCNTL)

ADDX ;

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

 D BACK

 Q

SELECTS ;select screen items

 S AMHANS=Y,AMHC="" F AMHI=1:1 S AMHC=$P(AMHANS,",",AMHI) Q:AMHC=""  S AMHCRIT=AMHSEL(AMHC) D

 .S AMHTEXT=$P(^AMHSORT(AMHCRIT,0),U)

 .S AMHVAR=$P(^AMHSORT(AMHCRIT,0),U,6) K ^AMHTRPT(AMHRPT,11,AMHCRIT),^AMHTRPT(AMHRPT,11,"B",AMHCRIT)

 .W !!,AMHC,") ",AMHTEXT," Selection."

 .I $P(^AMHSORT(AMHCRIT,0),U,2)]"" S AMHCNT=0,^AMHTRPT(AMHRPT,11,0)="^9002013.81101PA^0^0" D @($P(^AMHSORT(AMHCRIT,0),U,2)_"^AMHRL0")

 .I $D(^AMHTRPT(AMHRPT,11,AMHCRIT,11,1)) S AMHCSEL(AMHC)=""

 .I $P(^AMHSORT(AMHCRIT,0),U,13) S AMHRDTR=1

 .Q

 D SHOW^AMHRLS

 Q

SELECTR ;sort select

 W ! S DIR(0)="NO^1:"_AMHHIGH_":0",DIR("A")=$S(AMHCTYP="S":"Sub-total ",1:"Sort ")_AMHPTTS_" by which of the above" D ^DIR K DIR

SELECTR1 ;

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

 I Y="",AMHCTYP="D" W !!,"No sort item selected ... will sort by " S:AMHPTVS="V" AMHSORT=19,AMHSORV="Visit Date" S:AMHPTVS="P" AMHSORT=70,AMHSORV="Patient Name" S:AMHPTVS="S" AMHSORT=129,AMHSORV="Date of Suicide Act" W AMHSORV,"." H 4 D  Q

 .S DA=AMHRPT,DIE="^AMHTRPT(",DR=".07////"_AMHSORT D ^DIE K DA,DR,DIE,DIU,DIV,DIY,DIW

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

 .S AMHCTYP="T"

 .H 3

 .S:AMHPTVS="V" AMHSORT=19,AMHSORV="Visit Date"

 .S:AMHPTVS="P" AMHSORT=70,AMHSORV="Patient Name"

 .S:AMHPTVS="S" AMHSORT=129,AMHSORV="Date of Suicide Act"

 S AMHSORT=AMHSEL(+Y),AMHSORV=$P(^AMHSORT(AMHSORT,0),U),DA=AMHRPT,DIE="^AMHTRPT(",DR=".07////"_AMHSORT D ^DIE K DA,DR,DIE,DIU,DIV,DIY,DIW

 Q

SELECTP ;print select - get columns

 S AMHANS=Y,AMHC="" F AMHI=1:1 S AMHC=$P(AMHANS,",",AMHI) Q:AMHC=""  S AMHCRIT=AMHSEL(AMHC),AMHPCNT=AMHPCNT+1 D

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

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

 .S ^AMHTRPT(AMHRPT,12,0)="^9002013.81102PA^1^1"

 .I $D(^AMHTRPT(AMHRPT,12,"B",AMHCRIT)) S X=$O(^AMHTRPT(AMHRPT,12,"B",AMHCRIT,"")),AMHTCW=AMHTCW-$P(^AMHTRPT(AMHRPT,12,X,0),U,2)-2,^AMHTRPT(AMHRPT,12,X,0)=AMHCRIT_U_Y D  Q

 ..Q

 .S ^AMHTRPT(AMHRPT,12,AMHPCNT,0)=AMHCRIT_U_Y,^AMHTRPT(AMHRPT,12,"B",AMHCRIT,AMHPCNT)="",AMHTCW=AMHTCW+Y+2,AMHCSEL(AMHC)=""

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

 .Q

 Q

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

 I '$D(AMHCSEL) 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 AMHANS=Y,AMHC="" F AMHI=1:1 S AMHC=$P(AMHANS,",",AMHI) Q:AMHC=""  S AMHCRIT=AMHSEL(AMHC) D

 .I '$D(AMHCSEL(AMHC)) W !,"Item ",AMHC," ",$P(^AMHSORT(AMHCRIT,0),U)," has not been selected.",! Q

 .K AMHCSEL(AMHC)

 .I AMHCNTL="S" K ^AMHTRPT(AMHRPT,11,AMHCRIT),^AMHTRPT(AMHRPT,11,"B",AMHCRIT)

 .I AMHCNTL="P" S X=$O(^AMHTRPT(AMHRPT,12,"B",AMHCRIT,0)) I X K ^AMHTRPT(AMHRPT,12,X),^AMHTRPT(AMHRPT,12,"B",AMHCRIT)

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

REMX ;

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

 D BACK

 Q

Q ;EP - quit selections

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

 Q

EXITR ;EP - exit report called from protocol entry

 S AMHQUIT=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.",!,"Type a Q to select all ",AMHPTTS,", bypassing all screens.",!

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

 S DIR(0)="EO",DIR("A")="Press enter 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 AMHDISP

 K VALMCC,VALMHDR

 Q

 ;

EXPND ; -- expand code

 Q

 ;

AMHRL4    ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 25-JUN-1996 ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;; ;

EN        ; -- main entry point for AMH GEN SELECT ITEMS

 +1        KILL AMHCSEL

 +2        DO EN^VALM("AMH GENRET SELECTION ITEMS")

 +3        DO CLEAR^VALM1

 +4        KILL AMHDISP,AMHSEL,AMHLIST,C,X,I,K,J,AMHHIGH,AMHCUT,AMHCSEL,AMHCNTL

 +5        KILL VALMHDR,VALMCNT

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        DO @("HDR"_AMHCNTL)

 +2        QUIT 

HDRS      ;

 +1        SET VALMHDR(1)="                        "_$GET(IORVON)_AMHPTTX_" Selection Menu"_$GET(IORVOFF)

 +2        SET VALMHDR(2)=AMHPTTS_" 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 "_AMHPTTS_" 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 "_AMHPTTS_" 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(AMHPTVS="V":"visit date.",AMHPTVS="P":"patient name.",1:"Date of Suicide Act.")

 +5        QUIT 

 +6       ;

INIT      ; -- init variables and list array

 +1        KILL AMHDISP,AMHSEL,AMHHIGH,AMHLIST

 +2        SET AMHHIGH=0

           SET X=0

           FOR 

               SET X=$ORDER(^AMHSORT(AMHXREF,X))

               IF X'=+X

                   QUIT 

               SET Y=$ORDER(^AMHSORT(AMHXREF,X,""))

               IF $PIECE(^AMHSORT(Y,0),U,5)[AMHCNTL

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

                       SET AMHHIGH=AMHHIGH+1

                       SET AMHSEL(AMHHIGH)=Y

 +3        SET AMHCUT=((AMHHIGH/3)+1)\1

 +4        SET (C,I)=0

           SET J=1

           SET K=1

           FOR 

               SET I=$ORDER(AMHSEL(I))

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

                   QUIT 

               Begin DoDot:1

 +5                SET C=C+1

                   SET AMHLIST(C,0)=I_") "_$SELECT($DATA(AMHCSEL(I)):"*",1:" ")_$SELECT($PIECE(^AMHSORT(AMHSEL(I),0),U,14)="":$EXTRACT($PIECE(^(0),U),1,20),1:$PIECE(^(0),U,14))

                   SET AMHDISP(I)=""

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

 +6                SET J=I+AMHCUT

                   IF $DATA(AMHSEL(J))

                       IF '$DATA(AMHDISP(J))

                           SET $EXTRACT(AMHLIST(C,0),28)=J_") "_$SELECT($DATA(AMHCSEL(J)):"*",1:" ")_$SELECT($PIECE(^AMHSORT(AMHSEL(J),0),U,14)="":$EXTRACT($PIECE(^AMHSORT(AMHSEL(J),0),U),1,20),1:$PIECE(^(0),U,14))

                           SET AMHDISP(J)=""

 +7                SET K=J+AMHCUT

                   IF $DATA(AMHSEL(K))

                       IF '$DATA(AMHDISP(K))

                           SET $EXTRACT(AMHLIST(C,0),55)=K_") "_$SELECT($DATA(AMHCSEL(K)):"*",1:" ")_$SELECT($PIECE(^AMHSORT(AMHSEL(K),0),U,14)="":$EXTRACT($PIECE(^AMHSORT(AMHSEL(K),0),U),1,20),1:$PIECE(^(0),U,14))

                           SET AMHDISP(K)=""

               End DoDot:1

 +8        KILL AMHDISP

 +9        SET VALMCNT=C

 +10       QUIT 

 +11      ;

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

 +1        IF AMHCNTL="R"

               GOTO SELECTR

 +2        WRITE !

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

           SET DIR("A")="Which "_AMHPTTX_" item(s)"

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

ADDX      ;

 +1        SET DIR(0)="EO"

           SET DIR("A")="Press enter to continue..."

           KILL DA

           DO ^DIR

           KILL DIR

 +2        DO BACK

 +3        QUIT 

SELECTS   ;select screen items

 +1        SET AMHANS=Y

           SET AMHC=""

           FOR AMHI=1:1

               SET AMHC=$PIECE(AMHANS,",",AMHI)

               IF AMHC=""

                   QUIT 

               SET AMHCRIT=AMHSEL(AMHC)

               Begin DoDot:1

 +2                SET AMHTEXT=$PIECE(^AMHSORT(AMHCRIT,0),U)

 +3                SET AMHVAR=$PIECE(^AMHSORT(AMHCRIT,0),U,6)

                   KILL ^AMHTRPT(AMHRPT,11,AMHCRIT),^AMHTRPT(AMHRPT,11,"B",AMHCRIT)

 +4                WRITE !!,AMHC,") ",AMHTEXT," Selection."

 +5                IF $PIECE(^AMHSORT(AMHCRIT,0),U,2)]""

                       SET AMHCNT=0

                       SET ^AMHTRPT(AMHRPT,11,0)="^9002013.81101PA^0^0"

                       DO @($PIECE(^AMHSORT(AMHCRIT,0),U,2)_"^AMHRL0")

 +6                IF $DATA(^AMHTRPT(AMHRPT,11,AMHCRIT,11,1))

                       SET AMHCSEL(AMHC)=""

 +7                IF $PIECE(^AMHSORT(AMHCRIT,0),U,13)

                       SET AMHRDTR=1

 +8                QUIT 

               End DoDot:1

 +9        DO SHOW^AMHRLS

 +10       QUIT 

SELECTR   ;sort select

 +1        WRITE !

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

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

           DO ^DIR

           KILL DIR

SELECTR1  ;

 +1        IF $DATA(DIRUT)!($DATA(DUOUT))

               WRITE !,"exiting"

               SET AMHQUIT=1

               QUIT 

 +2        IF Y=""

               IF AMHCTYP="D"

                   WRITE !!,"No sort item selected ... will sort by "

                   IF AMHPTVS="V"

                       SET AMHSORT=19

                       SET AMHSORV="Visit Date"

                   IF AMHPTVS="P"

                       SET AMHSORT=70

                       SET AMHSORV="Patient Name"

                   IF AMHPTVS="S"

                       SET AMHSORT=129

                       SET AMHSORV="Date of Suicide Act"

                   WRITE AMHSORV,"."

                   HANG 4

                   Begin DoDot:1

 +3                    SET DA=AMHRPT

                       SET DIE="^AMHTRPT("

                       SET DR=".07////"_AMHSORT

                       DO ^DIE

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

                   End DoDot:1

                   QUIT 

 +4        IF Y=""

               IF AMHCTYP'="D"

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

                   Begin DoDot:1

 +5                    SET AMHCTYP="T"

 +6                    HANG 3

 +7                    IF AMHPTVS="V"

                           SET AMHSORT=19

                           SET AMHSORV="Visit Date"

 +8                    IF AMHPTVS="P"

                           SET AMHSORT=70

                           SET AMHSORV="Patient Name"

 +9                    IF AMHPTVS="S"

                           SET AMHSORT=129

                           SET AMHSORV="Date of Suicide Act"

                   End DoDot:1

                   QUIT 

 +10       SET AMHSORT=AMHSEL(+Y)

           SET AMHSORV=$PIECE(^AMHSORT(AMHSORT,0),U)

           SET DA=AMHRPT

           SET DIE="^AMHTRPT("

           SET DR=".07////"_AMHSORT

           DO ^DIE

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

 +11       QUIT 

SELECTP   ;print select - get columns

 +1        SET AMHANS=Y

           SET AMHC=""

           FOR AMHI=1:1

               SET AMHC=$PIECE(AMHANS,",",AMHI)

               IF AMHC=""

                   QUIT 

               SET AMHCRIT=AMHSEL(AMHC)

               SET AMHPCNT=AMHPCNT+1

               Begin DoDot:1

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

                   SET DIR("A")="Enter Column width for "_$PIECE(^AMHSORT(AMHCRIT,0),U)_" (suggested: "_$PIECE(^AMHSORT(AMHCRIT,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(^AMHSORT(AMHCRIT,0),U,7)

 +4                SET ^AMHTRPT(AMHRPT,12,0)="^9002013.81102PA^1^1"

 +5                IF $DATA(^AMHTRPT(AMHRPT,12,"B",AMHCRIT))

                       SET X=$ORDER(^AMHTRPT(AMHRPT,12,"B",AMHCRIT,""))

                       SET AMHTCW=AMHTCW-$PIECE(^AMHTRPT(AMHRPT,12,X,0),U,2)-2

                       SET ^AMHTRPT(AMHRPT,12,X,0)=AMHCRIT_U_Y

                       Begin DoDot:2

 +6                        QUIT 

                       End DoDot:2

                       QUIT 

 +7                SET ^AMHTRPT(AMHRPT,12,AMHPCNT,0)=AMHCRIT_U_Y

                   SET ^AMHTRPT(AMHRPT,12,"B",AMHCRIT,AMHPCNT)=""

                   SET AMHTCW=AMHTCW+Y+2

                   SET AMHCSEL(AMHC)=""

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

 +9                QUIT 

               End DoDot:1

 +10       QUIT 

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

 +1        IF '$DATA(AMHCSEL)

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

           SET AMHC=""

           FOR AMHI=1:1

               SET AMHC=$PIECE(AMHANS,",",AMHI)

               IF AMHC=""

                   QUIT 

               SET AMHCRIT=AMHSEL(AMHC)

               Begin DoDot:1

 +6                IF '$DATA(AMHCSEL(AMHC))

                       WRITE !,"Item ",AMHC," ",$PIECE(^AMHSORT(AMHCRIT,0),U)," has not been selected.",!

                       QUIT 

 +7                KILL AMHCSEL(AMHC)

 +8                IF AMHCNTL="S"

                       KILL ^AMHTRPT(AMHRPT,11,AMHCRIT),^AMHTRPT(AMHRPT,11,"B",AMHCRIT)

 +9                IF AMHCNTL="P"

                       SET X=$ORDER(^AMHTRPT(AMHRPT,12,"B",AMHCRIT,0))

                       IF X

                           KILL ^AMHTRPT(AMHRPT,12,X),^AMHTRPT(AMHRPT,12,"B",AMHCRIT)

 +10               WRITE !,"Item ",$PIECE(^AMHSORT(AMHCRIT,0),U)," removed from selected list of items."

               End DoDot:1

REMX      ;

 +1        SET DIR(0)="EO"

           SET DIR("A")="Press enter to continue..."

           KILL DA

           DO ^DIR

           KILL DIR

 +2        DO BACK

 +3        QUIT 

Q         ;EP - quit selections

 +1        IF AMHCNTL="R"

               SET Y=""

               GOTO SELECTR1

 +2        QUIT 

EXITR     ;EP - exit report called from protocol entry

 +1        SET AMHQUIT=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.",!,"Type a Q to select all ",AMHPTTS,", bypassing all screens.",!

 +4        SET X="?"

           DO DISP^XQORM1

           WRITE !

 +5        SET DIR(0)="EO"

           SET DIR("A")="Press enter 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 AMHDISP

 +2        KILL VALMCC,VALMHDR

 +3        QUIT 

 +4       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;