BMCRL4 ; IHS/PHXAO/TMJ - NO DESCRIPTION PROVIDED 26-JUN-1996 ;
;;4.0;REFERRED CARE INFO SYSTEM;**2**;JAN 09, 2006;Build 101
;; ;
;BMC*4.0*1 3.3.06 IHS/OIT/FCJ CHNGED PAGE TITLE FR SELECTION TO SEARCH
EN ; -- main entry point for BMC GENRET SELECT ITEMS
K BMCCSEL
D EN^VALM("BMC GENRET SELECTION ITEMS")
D CLEAR^VALM1
K BMCDISP,BMCSEL,BMCLIST,C,X,I,K,J,BMCHIGH,BMCCUT,BMCCSEL,BMCCNTL
K VALMHDR,VALMCNT
Q
;
D EN^VALM("BMC GENRET SELECTION ITEMS")
Q
;
HDR ; -- header code
D @("HDR"_BMCCNTL)
Q
HDRS ;
;BMC*4.0*1 3.3.06 IHS/OIT/FCJ CHNGED SELECTION TO SEARCH IN NXT LINE
;S VALMHDR(1)=" "_$S(BMCPTVS="R":"REFERRAL ",1:"PATIENT ")_"Selection Menu"
S VALMHDR(1)=" "_$S(BMCPTVS="R":"REFERRAL ",1:"PATIENT ")_"Search Menu"
S VALMHDR(2)=$S(BMCPTVS="R":"Referrals",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(BMCPTVS="R":"referrals",1:"patients")_" hit Q."
Q
;
HDRP ;print selection header
S VALMHDR(1)=" PRINT ITEM SELECTION MENU"
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)=" SORT ITEM SELECTION MENU"
S VALMHDR(3)="The "_$S(BMCPTVS="P":"patients",1:"referrals")_" 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(BMCPTVS="R":"referral date.",1:"patient name.")
Q
;
INIT ; -- init variables and list array
K BMCDISP,BMCSEL,BMCHIGH,BMCLIST
S BMCHIGH=0,X=0 F S X=$O(^BMCTSORT("C",X)) Q:X'=+X S Y=$O(^BMCTSORT("C",X,"")) I $P(^BMCTSORT(Y,0),U,5)[BMCCNTL,$P(^(0),U,11)[BMCPTVS S BMCHIGH=BMCHIGH+1,BMCSEL(BMCHIGH)=Y
S BMCCUT=((BMCHIGH/3)+1)\1
S (C,I)=0,J=1,K=1 F S I=$O(BMCSEL(I)) Q:I'=+I!($D(BMCDISP(I))) D
.S C=C+1,BMCLIST(C,0)=I_") "_$S($D(BMCCSEL(I)):"*",1:" ")_$S($P(^BMCTSORT(BMCSEL(I),0),U,12)="":$E($P(^(0),U),1,20),1:$P(^(0),U,12)) S BMCDISP(I)="",BMCLIST("IDX",C,C)=""
.S J=I+BMCCUT I $D(BMCSEL(J)),'$D(BMCDISP(J)) S $E(BMCLIST(C,0),28)=J_") "_$S($D(BMCCSEL(J)):"*",1:" ")_$S($P(^BMCTSORT(BMCSEL(J),0),U,12)="":$E($P(^BMCTSORT(BMCSEL(J),0),U),1,20),1:$P(^(0),U,12)) S BMCDISP(J)=""
.S K=J+BMCCUT I $D(BMCSEL(K)),'$D(BMCDISP(K)) S $E(BMCLIST(C,0),55)=K_") "_$S($D(BMCCSEL(K)):"*",1:" ")_$S($P(^BMCTSORT(BMCSEL(K),0),U,12)="":$E($P(^BMCTSORT(BMCSEL(K),0),U),1,20),1:$P(^(0),U,12)) S BMCDISP(K)=""
K BMCDISP
S VALMCNT=C
Q
;
ADD ;EP - add an item to the selected list - called from a protocol
G:BMCCNTL="R" SELECTR
W ! S DIR(0)="LO^1:"_BMCHIGH,DIR("A")="Which "_$S(BMCPTVS="P":"patient",1:"referral")_" 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"_BMCCNTL)
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 BMCANS=Y,BMCC="" F BMCI=1:1 S BMCC=$P(BMCANS,",",BMCI) Q:BMCC="" S BMCCRIT=BMCSEL(BMCC) D
.S BMCTEXT=$P(^BMCTSORT(BMCCRIT,0),U)
.S BMCVAR=$P(^BMCTSORT(BMCCRIT,0),U,6) K ^BMCRTMP(BMCRPT,11,BMCCRIT),^BMCRTMP(BMCRPT,11,"B",BMCCRIT)
.W !!,BMCC,") ",BMCTEXT," Selection."
.I $P(^BMCTSORT(BMCCRIT,0),U,2)]"" S BMCCNT=0,^BMCRTMP(BMCRPT,11,0)="^90001.82101PA^0^0" D @($P(^BMCTSORT(BMCCRIT,0),U,2)_"^BMCRL0")
.I $D(^BMCRTMP(BMCRPT,11,BMCCRIT,11,1)) S BMCCSEL(BMCC)=""
.Q
D SHOW^BMCRLS
Q
SELECTR ;sort select
W ! S DIR(0)="NO^1:"_BMCHIGH_":0",DIR("A")=$S(BMCCTYP="S":"Sub-total ",1:"Sort ")_$S(BMCPTVS="P":"Patients",1:"referrals")_" by which of the above" D ^DIR K DIR
SELECTR1 ;
I $D(DUOUT) W !,"Exiting" S BMCQUIT=1 Q
I Y="",BMCCTYP="D" W !!,"No sort criteria selected ... will sort by "_$S(BMCPTVS="P":"Patient Name",1:"Referral Date")_"." S:BMCPTVS="R" BMCSORT=6,BMCSORV="Referral Date" S:BMCPTVS="P" BMCSORT=1,BMCSORV="Patient Name" H 4 D Q
.S DA=BMCRPT,DIE="^BMCRTMP(",DR=".07////"_BMCSORT D ^DIE K DA,DR,DIE,DIU,DIV,DIY,DIW
I Y="",BMCCTYP'="D" W !!,"No sub-totalling will be done.",!! D Q
.S BMCCTYP="T"
.H 3
.S:BMCPTVS="R" BMCSORT=6,BMCSORV="Referral Date"
.S:BMCPTVS="P" BMCSORT=1,BMCSORV="Patient Name"
S BMCSORT=BMCSEL(+Y),BMCSORV=$P(^BMCTSORT(BMCSORT,0),U),DA=BMCRPT,DIE="^BMCRTMP(",DR=".07////"_BMCSORT D ^DIE K DA,DR,DIE,DIU,DIV,DIY,DIW
Q
SELECTP ;print select - get columns
S BMCANS=Y,BMCC="" F BMCI=1:1 S BMCC=$P(BMCANS,",",BMCI) Q:BMCC="" S BMCCRIT=BMCSEL(BMCC),BMCPCNT=BMCPCNT+1 D
.S DIR(0)="N^2:80:0",DIR("A")="Enter Column width for "_$P(^BMCTSORT(BMCCRIT,0),U)_" (suggested: "_$P(^BMCTSORT(BMCCRIT,0),U,7)_")",DIR("B")=$P(^(0),U,7) D ^DIR K DIR S:$D(DUOUT) DIRUT=1
.I $D(DIRUT) S Y=$P(^BMCTSORT(BMCCRIT,0),U,7)
.S ^BMCRTMP(BMCRPT,12,0)="^90001.82102PA^1^1"
.I $D(^BMCRTMP(BMCRPT,12,"B",BMCCRIT)) S X=$O(^BMCRTMP(BMCRPT,12,"B",BMCCRIT,"")),BMCTCW=BMCTCW-$P(^BMCRTMP(BMCRPT,12,X,0),U,2)-2,^BMCRTMP(BMCRPT,12,X,0)=BMCCRIT_U_Y D Q
..Q
.S ^BMCRTMP(BMCRPT,12,BMCPCNT,0)=BMCCRIT_U_Y,^BMCRTMP(BMCRPT,12,"B",BMCCRIT,BMCPCNT)="",BMCTCW=BMCTCW+Y+2,BMCCSEL(BMCC)=""
.W !!?15,"Total Report width (including column margins - 2 spaces): ",BMCTCW
.Q
Q
REM ;EP - remove a selected item - called from protocol entry
I '$D(BMCCSEL) 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 BMCANS=Y,BMCC="" F BMCI=1:1 S BMCC=$P(BMCANS,",",BMCI) Q:BMCC="" S BMCCRIT=BMCSEL(BMCC) D
.I '$D(BMCCSEL(BMCC)) W !,"Item ",BMCC," ",$P(^BMCTSORT(BMCCRIT,0),U)," has not been selected.",! Q
.K BMCCSEL(BMCC)
.I BMCCNTL="S" K ^BMCRTMP(BMCRPT,11,BMCCRIT),^BMCRTMP(BMCRPT,11,"B",BMCCRIT)
.I BMCCNTL="P" S X=$O(^BMCRTMP(BMCRPT,12,"B",BMCCRIT,0)) I X K ^BMCRTMP(BMCRPT,12,X),^BMCRTMP(BMCRPT,12,"B",BMCCRIT)
.W !,"Item ",$P(^BMCTSORT(BMCCRIT,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 BMCCNTL="R" S Y="" G SELECTR1
Q
EXITR ;EP - exit report called from protocol entry
S BMCQUIT=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(BMCPTVS="R":"referrals",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 BMCDISP
K VALMCC,VALMHDR
Q
;
EXPND ; -- expand code
Q
;
BMCRL4 ; IHS/PHXAO/TMJ - NO DESCRIPTION PROVIDED 26-JUN-1996 ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**2**;JAN 09, 2006;Build 101
+2 ;; ;
+3 ;BMC*4.0*1 3.3.06 IHS/OIT/FCJ CHNGED PAGE TITLE FR SELECTION TO SEARCH
EN ; -- main entry point for BMC GENRET SELECT ITEMS
+1 KILL BMCCSEL
+2 DO EN^VALM("BMC GENRET SELECTION ITEMS")
+3 DO CLEAR^VALM1
+4 KILL BMCDISP,BMCSEL,BMCLIST,C,X,I,K,J,BMCHIGH,BMCCUT,BMCCSEL,BMCCNTL
+5 KILL VALMHDR,VALMCNT
+6 QUIT
+7 ;
+8 DO EN^VALM("BMC GENRET SELECTION ITEMS")
+9 QUIT
+10 ;
HDR ; -- header code
+1 DO @("HDR"_BMCCNTL)
+2 QUIT
HDRS ;
+1 ;BMC*4.0*1 3.3.06 IHS/OIT/FCJ CHNGED SELECTION TO SEARCH IN NXT LINE
+2 ;S VALMHDR(1)=" "_$S(BMCPTVS="R":"REFERRAL ",1:"PATIENT ")_"Selection Menu"
+3 SET VALMHDR(1)=" "_$SELECT(BMCPTVS="R":"REFERRAL ",1:"PATIENT ")_"Search Menu"
+4 SET VALMHDR(2)=$SELECT(BMCPTVS="R":"Referrals",1:"Patients")_" can be selected based upon any of the following items. Select"
+5 SET VALMHDR(3)="as many as you wish, in any order or combination. An (*) asterisk indicates"
+6 SET VALMHDR(4)="items already selected. To bypass screens and select all "_$SELECT(BMCPTVS="R":"referrals",1:"patients")_" hit Q."
+7 QUIT
+8 ;
HDRP ;print selection header
+1 SET VALMHDR(1)=" PRINT ITEM SELECTION MENU"
+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)=" SORT ITEM SELECTION MENU"
+3 SET VALMHDR(3)="The "_$SELECT(BMCPTVS="P":"patients",1:"referrals")_" 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(BMCPTVS="R":"referral date.",1:"patient name.")
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 KILL BMCDISP,BMCSEL,BMCHIGH,BMCLIST
+2 SET BMCHIGH=0
SET X=0
FOR
SET X=$ORDER(^BMCTSORT("C",X))
IF X'=+X
QUIT
SET Y=$ORDER(^BMCTSORT("C",X,""))
IF $PIECE(^BMCTSORT(Y,0),U,5)[BMCCNTL
IF $PIECE(^(0),U,11)[BMCPTVS
SET BMCHIGH=BMCHIGH+1
SET BMCSEL(BMCHIGH)=Y
+3 SET BMCCUT=((BMCHIGH/3)+1)\1
+4 SET (C,I)=0
SET J=1
SET K=1
FOR
SET I=$ORDER(BMCSEL(I))
IF I'=+I!($DATA(BMCDISP(I)))
QUIT
Begin DoDot:1
+5 SET C=C+1
SET BMCLIST(C,0)=I_") "_$SELECT($DATA(BMCCSEL(I)):"*",1:" ")_$SELECT($PIECE(^BMCTSORT(BMCSEL(I),0),U,12)="":$EXTRACT($PIECE(^(0),U),1,20),1:$PIECE(^(0),U,12))
SET BMCDISP(I)=""
SET BMCLIST("IDX",C,C)=""
+6 SET J=I+BMCCUT
IF $DATA(BMCSEL(J))
IF '$DATA(BMCDISP(J))
SET $EXTRACT(BMCLIST(C,0),28)=J_") "_$SELECT($DATA(BMCCSEL(J)):"*",1:" ")_$SELECT($PIECE(^BMCTSORT(BMCSEL(J),0),U,12)="":$EXTRACT($PIECE(^BMCTSORT(BMCSEL(J),0),U),1,20),1:$PIECE(^(0),U,12))
SET BMCDISP(J)=""
+7 SET K=J+BMCCUT
IF $DATA(BMCSEL(K))
IF '$DATA(BMCDISP(K))
SET $EXTRACT(BMCLIST(C,0),55)=K_") "_$SELECT($DATA(BMCCSEL(K)):"*",1:" ")_$SELECT($PIECE(^BMCTSORT(BMCSEL(K),0),U,12)="":$EXTRACT($PIECE(^BMCTSORT(BMCSEL(K),0),U),1,20),1:$PIECE(^(0),U,12))
SET BMCDISP(K)=""
End DoDot:1
+8 KILL BMCDISP
+9 SET VALMCNT=C
+10 QUIT
+11 ;
ADD ;EP - add an item to the selected list - called from a protocol
+1 IF BMCCNTL="R"
GOTO SELECTR
+2 WRITE !
SET DIR(0)="LO^1:"_BMCHIGH
SET DIR("A")="Which "_$SELECT(BMCPTVS="P":"patient",1:"referral")_" 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"_BMCCNTL)
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 BMCANS=Y
SET BMCC=""
FOR BMCI=1:1
SET BMCC=$PIECE(BMCANS,",",BMCI)
IF BMCC=""
QUIT
SET BMCCRIT=BMCSEL(BMCC)
Begin DoDot:1
+2 SET BMCTEXT=$PIECE(^BMCTSORT(BMCCRIT,0),U)
+3 SET BMCVAR=$PIECE(^BMCTSORT(BMCCRIT,0),U,6)
KILL ^BMCRTMP(BMCRPT,11,BMCCRIT),^BMCRTMP(BMCRPT,11,"B",BMCCRIT)
+4 WRITE !!,BMCC,") ",BMCTEXT," Selection."
+5 IF $PIECE(^BMCTSORT(BMCCRIT,0),U,2)]""
SET BMCCNT=0
SET ^BMCRTMP(BMCRPT,11,0)="^90001.82101PA^0^0"
DO @($PIECE(^BMCTSORT(BMCCRIT,0),U,2)_"^BMCRL0")
+6 IF $DATA(^BMCRTMP(BMCRPT,11,BMCCRIT,11,1))
SET BMCCSEL(BMCC)=""
+7 QUIT
End DoDot:1
+8 DO SHOW^BMCRLS
+9 QUIT
SELECTR ;sort select
+1 WRITE !
SET DIR(0)="NO^1:"_BMCHIGH_":0"
SET DIR("A")=$SELECT(BMCCTYP="S":"Sub-total ",1:"Sort ")_$SELECT(BMCPTVS="P":"Patients",1:"referrals")_" by which of the above"
DO ^DIR
KILL DIR
SELECTR1 ;
+1 IF $DATA(DUOUT)
WRITE !,"Exiting"
SET BMCQUIT=1
QUIT
+2 IF Y=""
IF BMCCTYP="D"
WRITE !!,"No sort criteria selected ... will sort by "_$SELECT(BMCPTVS="P":"Patient Name",1:"Referral Date")_"."
IF BMCPTVS="R"
SET BMCSORT=6
SET BMCSORV="Referral Date"
IF BMCPTVS="P"
SET BMCSORT=1
SET BMCSORV="Patient Name"
HANG 4
Begin DoDot:1
+3 SET DA=BMCRPT
SET DIE="^BMCRTMP("
SET DR=".07////"_BMCSORT
DO ^DIE
KILL DA,DR,DIE,DIU,DIV,DIY,DIW
End DoDot:1
QUIT
+4 IF Y=""
IF BMCCTYP'="D"
WRITE !!,"No sub-totalling will be done.",!!
Begin DoDot:1
+5 SET BMCCTYP="T"
+6 HANG 3
+7 IF BMCPTVS="R"
SET BMCSORT=6
SET BMCSORV="Referral Date"
+8 IF BMCPTVS="P"
SET BMCSORT=1
SET BMCSORV="Patient Name"
End DoDot:1
QUIT
+9 SET BMCSORT=BMCSEL(+Y)
SET BMCSORV=$PIECE(^BMCTSORT(BMCSORT,0),U)
SET DA=BMCRPT
SET DIE="^BMCRTMP("
SET DR=".07////"_BMCSORT
DO ^DIE
KILL DA,DR,DIE,DIU,DIV,DIY,DIW
+10 QUIT
SELECTP ;print select - get columns
+1 SET BMCANS=Y
SET BMCC=""
FOR BMCI=1:1
SET BMCC=$PIECE(BMCANS,",",BMCI)
IF BMCC=""
QUIT
SET BMCCRIT=BMCSEL(BMCC)
SET BMCPCNT=BMCPCNT+1
Begin DoDot:1
+2 SET DIR(0)="N^2:80:0"
SET DIR("A")="Enter Column width for "_$PIECE(^BMCTSORT(BMCCRIT,0),U)_" (suggested: "_$PIECE(^BMCTSORT(BMCCRIT,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(^BMCTSORT(BMCCRIT,0),U,7)
+4 SET ^BMCRTMP(BMCRPT,12,0)="^90001.82102PA^1^1"
+5 IF $DATA(^BMCRTMP(BMCRPT,12,"B",BMCCRIT))
SET X=$ORDER(^BMCRTMP(BMCRPT,12,"B",BMCCRIT,""))
SET BMCTCW=BMCTCW-$PIECE(^BMCRTMP(BMCRPT,12,X,0),U,2)-2
SET ^BMCRTMP(BMCRPT,12,X,0)=BMCCRIT_U_Y
Begin DoDot:2
+6 QUIT
End DoDot:2
QUIT
+7 SET ^BMCRTMP(BMCRPT,12,BMCPCNT,0)=BMCCRIT_U_Y
SET ^BMCRTMP(BMCRPT,12,"B",BMCCRIT,BMCPCNT)=""
SET BMCTCW=BMCTCW+Y+2
SET BMCCSEL(BMCC)=""
+8 WRITE !!?15,"Total Report width (including column margins - 2 spaces): ",BMCTCW
+9 QUIT
End DoDot:1
+10 QUIT
REM ;EP - remove a selected item - called from protocol entry
+1 IF '$DATA(BMCCSEL)
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 BMCANS=Y
SET BMCC=""
FOR BMCI=1:1
SET BMCC=$PIECE(BMCANS,",",BMCI)
IF BMCC=""
QUIT
SET BMCCRIT=BMCSEL(BMCC)
Begin DoDot:1
+6 IF '$DATA(BMCCSEL(BMCC))
WRITE !,"Item ",BMCC," ",$PIECE(^BMCTSORT(BMCCRIT,0),U)," has not been selected.",!
QUIT
+7 KILL BMCCSEL(BMCC)
+8 IF BMCCNTL="S"
KILL ^BMCRTMP(BMCRPT,11,BMCCRIT),^BMCRTMP(BMCRPT,11,"B",BMCCRIT)
+9 IF BMCCNTL="P"
SET X=$ORDER(^BMCRTMP(BMCRPT,12,"B",BMCCRIT,0))
IF X
KILL ^BMCRTMP(BMCRPT,12,X),^BMCRTMP(BMCRPT,12,"B",BMCCRIT)
+10 WRITE !,"Item ",$PIECE(^BMCTSORT(BMCCRIT,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 BMCCNTL="R"
SET Y=""
GOTO SELECTR1
+2 QUIT
EXITR ;EP - exit report called from protocol entry
+1 SET BMCQUIT=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(BMCPTVS="R":"referrals",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 BMCDISP
+2 KILL VALMCC,VALMHDR
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
