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 ;
