BPSOPR ;ALB/PHH - OPECC Productivity Report ;9/21/2015
;;1.0;E CLAIMS MGMT ENGINE;**20**;JUN 2004;Build 27
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; Main report entry point
N BPGLTMP,BPNOW,X,BPPHARM,BPELIG,BPUSER,BPBEGDT,BPENDDT,BPSUMDET
N BPSSORD,BPEXCEL
;
W @IOF,!,"OPECC Productivity Report",!!
;
S BPGLTMP=$NA(^TMP($J,"BPSOPR"))
;
; Get current Date/Time
S BPNOW=$$FMTE^XLFDT($$NOW^XLFDT)
;
; Prompt for ECME Pharmacy Division(s)
; Sets up BPPHARM variable and array where BPPHARM=0 for ALL
; or BPPHARM=1 and BPPHARM(IEN) = IEN^NAME for list.
S X=$$SELPHARM(.BPPHARM)
I X="^" Q
;
; Prompt for Eligibility Type(s)
; Sets up BPELIG variable and array where BPELIG=0 for ALL
; or BPELIG=1 and BPELIG(IEN) = IEN^NAME for list.
S X=$$SELELIG(.BPELIG)
I X="^" Q
;
; Prompt for ECME User(s)
; Sets up BPUSER variable and array where BPUSER=0 for ALL
; or BPUSER=1 and BPUSER(IEN) = IEN^NAME for list.
S X=$$SELUSER(.BPUSER)
I X="^" Q
;
; Prompt to select Date Range
; Returns (Start Date^End Date)
S BPBEGDT=$$SELDATE^BPSRPT3(1)
I BPBEGDT="^" Q
S BPENDDT=$P(BPBEGDT,U,2)
S BPBEGDT=$P(BPBEGDT,U)
;
; Prompt to Display Summary or Detail Format (Default to Detail)
; Set to 1 for Summary, 0 for Detail
S BPSUMDET=$$SELSMDET^BPSRPT3(2)
I BPSUMDET="^" Q
;
; Prompt for Sort Order
; Set to 1 for User Name, 0 for Division
S BPSSORD=$$SELSORT(1)
I BPSSORD="^" Q
;
; Prompt for Excel Capture
; Set to 1 for YES (capture data), 0 for NO (DO NOT capture data)
S BPEXCEL=0
I 'BPSUMDET S BPEXCEL=$$SELEXCEL I BPEXCEL="^" Q
;
; Device selection
I '$$DEVICE() Q
;
Q
;
SELSORT(DFLT) ; Select Sort Order
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
S DFLT=$S($G(DFLT)=1:"User Name",$G(DFLT)=0:"Division",1:"User Name")
S DIR(0)="S^D:Division;U:User Name",DIR("A")="Sort: (D/U)",DIR("B")=DFLT
;
W !!,"Enter a code from the list to indicate the sort order."
D ^DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
S Y=$S(Y="U":1,Y="D":0,1:Y)
Q Y
;
SELEXCEL() ; Select whether to capture data for Excel report.
N BPEXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
;
S BPEXCEL=0
S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
S DIR("A")="Do you want to capture report data for an Excel document"
S DIR("?")="^D HEXC^BPSRPT4"
;
D ^DIR
K DIR
I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^"
I Y S BPEXCEL=1
;
;Display Excel display message
I BPEXCEL=1 D
.W !!?5,"Before continuing, please set up your terminal to capture the"
.W !?5,"detail report data and save the detail report data in a text file"
.W !?5,"to a local drive. This report may take a while to run."
.W !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
.W !?5," please enter '0;256;99999' at the 'DEVICE:' prompt.",!
;
Q BPEXCEL
;
DEVICE() ; Device Selection
N ZTRTN,ZTDESC,ZTSAVE,POP,RET,ZTSK,DIR,X,Y
S RET=1
;
I 'BPEXCEL D
.W !!,"WARNING - THIS REPORT REQUIRES THAT A DEVICE WITH 132 COLUMN WIDTH BE USED."
.W !,"IT WILL NOT DISPLAY CORRECTLY USING 80 COLUMN WIDTH DEVICES",!
;
S ZTRTN="COMPILE^BPSOPR2"
S ZTDESC="OPECC Productivity Report"
S ZTSAVE("BPGLTMP")=""
S ZTSAVE("BPPHARM")=""
S ZTSAVE("BPELIG")=""
S ZTSAVE("BPUSER")=""
S ZTSAVE("BPBEGDT")=""
S ZTSAVE("BPENDDT")=""
S ZTSAVE("BPSUMDET")=""
S ZTSAVE("BPSSORD")=""
S ZTSAVE("BPEXCEL")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
I POP S RET=0
I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR
Q RET
;
SELPHARM(BPPHARM) ; Select Pharmacies
N DIR,BPSFPTR,BPSPTX,X
;
S DIR(0)="S^D:DIVISION;A:ALL"
S DIR("A")="Select Certain Pharmacy (D)ivisions or (A)LL"
S DIR("B")="A"
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)=" D DIVISION"
S DIR("L",4)=" A ALL"
S BPSFPTR=9002313.56
S BPSPTX="Select ECME Pharmacy Division(s): "
;
S X=$$SELMULTI(.DIR,.BPPHARM,BPSFPTR,BPSPTX)
Q X
;
SELELIG(BPELIG) ;Select Eligibility Types
N DIR,X
;
S DIR(0)="SO^V:VETERAN;T:TRICARE;C:CHAMPVA;A:ALL"
S DIR("A")="Include Certain Eligibility Type or (A)ll"
S DIR("B")="A"
;
S X=$$SELMULTI(.DIR,.BPELIG)
Q X
;
SELUSER(BPUSER) ; Select Users
N DIR,BPSFPTR,BPSPTX,X
;
S DIR(0)="S^U:USER;A:ALL"
S DIR("A")="Display ECME (U)ser or (A)LL"
S DIR("B")="A"
S BPSFPTR=200
S BPSPTX="Select ECME User(s): "
;
S X=$$SELMULTI(.DIR,.BPUSER,BPSFPTR,BPSPTX)
Q X
;
SELMULTI(BPSDIR,BPSVAR,BPSFPTR,BPSPTX) ;
; Input Variable -> BPSDIR - DIR array
; BPSVAR - Variable array
; BPSFPTR - File pointer (optional)
; BPSPTX - Prompt text for DIC("A") (optional)
; Return Value -> "" = Valid Entry or Entries Selected
; ^ = Exit
;
; Output Variable -> BPSVAR = 1 One or more items selected
; = 0 User entered 'ALL'
;
; If BPSVAR = 1 then the BPSVAR array will be defined where:
; BPSVAR(ptr) = ptr ^ NAME and
; ptr = Internal pointer to file passed in
;
N BPDELFLG,DIR,DIC,DIRUT,DTOUT,DUOUT,X,Y
;
S BPSFPTR=$G(BPSFPTR,"")
S BPSPTX=$G(BPSPTX,"")
;
;First see if they want to enter individual items or ALL
S BPDELFLG=0 ;Only used for DIR. Not used for DIC.
M DIR=BPSDIR
D ^DIR
K DIR
;
;Check for "^" or timeout, otherwise define BPSVAR
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
E S BPSVAR=$S(Y="A":0,1:1)
;
;If item selected, ask prompt
I $G(BPSVAR)=1 F D Q:Y="^"!(Y="")
.;
.;Prompt for entry
.I BPSFPTR'="" D
..K X
..S DIC(0)="QEAM",DIC=BPSFPTR,DIC("A")=BPSPTX
..W !
..D ^DIC
.;
.I BPSFPTR="" D
..I 'BPDELFLG D
...S BPSVAR(Y)=Y_"^"_Y(0)
...S BPSVAR("B",Y(0),Y)=""
..K DIR
..M DIR=BPSDIR
..K DIR("B")
..D ^DIR
.;
.;Check for "^" or timeout
.I ($G(DUOUT)=1)!($G(DTOUT)=1) K BPSVAR S Y="^" Q
.;
.;Check for blank entry, quit if no previous selections
.I $G(X)="" S Y=$S($D(BPSVAR)>9:"",1:"^") K:Y="^" BPSVAR Q
.;
.;Handle deletes
.I BPSFPTR'="" D
..I $D(BPSVAR(+Y)) D Q:Y="^" I 1
...N P
...S P=Y ;Save Original Value
...S DIR(0)="S^Y:YES;N:NO",DIR("A")="Delete "_$P(P,U,2)_" from your list?"
...S DIR("B")="NO" D ^DIR
...I ($G(DUOUT)=1)!($G(DTOUT)=1) K BPSVAR S Y="^" Q
...I Y="Y" K BPSVAR(+P),BPSVAR("B",$P(P,U,2),+P)
...S Y=P ;Restore Original Value
...K P
..E D
...;Define new entries in BPSVAR array
...S BPSVAR(+Y)=Y
...S BPSVAR("B",$P(Y,U,2),+Y)=""
.;
.I BPSFPTR="" D
..I $D(BPSVAR(Y)) D Q:Y="^" I 1
...N P
...S P=Y,P(0)=Y(0) ;Save Original Value
...S DIR(0)="S^Y:YES;N:NO",DIR("A")="Delete "_P(0)_" from your list?"
...S DIR("B")="NO" D ^DIR
...I ($G(DUOUT)=1)!($G(DTOUT)=1) K BPSVAR S Y="^" Q
...S BPDELFLG=0
...I Y="Y" S BPDELFLG=1 K BPSVAR(P),BPSVAR("B",P(0),P)
...S Y=P,Y(0)=P(0) ;Restore Original Value
...K P
..E D
...;Define new entries in BPSVAR array
...S BPSVAR(Y)=Y_"^"_Y(0)
...S BPSVAR("B",Y(0),Y)=""
.;
.;Display a list of selected items
.I $D(BPSVAR)>9 D
..N X
..W !,?2,"Selected:"
..S X=""
..F S X=$O(BPSVAR("B",X)) Q:X="" D
...W !,?10,X
..K X
;
K BPSVAR("B")
I $G(BPSVAR)=1,$G(BPSVAR("A"))="A^ALL" K BPSVAR S BPSVAR=0
Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOPR 7417 printed Sep 23, 2025@19:27:35 Page 2
BPSOPR ;ALB/PHH - OPECC Productivity Report ;9/21/2015
+1 ;;1.0;E CLAIMS MGMT ENGINE;**20**;JUN 2004;Build 27
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; Main report entry point
+1 NEW BPGLTMP,BPNOW,X,BPPHARM,BPELIG,BPUSER,BPBEGDT,BPENDDT,BPSUMDET
+2 NEW BPSSORD,BPEXCEL
+3 ;
+4 WRITE @IOF,!,"OPECC Productivity Report",!!
+5 ;
+6 SET BPGLTMP=$NAME(^TMP($JOB,"BPSOPR"))
+7 ;
+8 ; Get current Date/Time
+9 SET BPNOW=$$FMTE^XLFDT($$NOW^XLFDT)
+10 ;
+11 ; Prompt for ECME Pharmacy Division(s)
+12 ; Sets up BPPHARM variable and array where BPPHARM=0 for ALL
+13 ; or BPPHARM=1 and BPPHARM(IEN) = IEN^NAME for list.
+14 SET X=$$SELPHARM(.BPPHARM)
+15 IF X="^"
QUIT
+16 ;
+17 ; Prompt for Eligibility Type(s)
+18 ; Sets up BPELIG variable and array where BPELIG=0 for ALL
+19 ; or BPELIG=1 and BPELIG(IEN) = IEN^NAME for list.
+20 SET X=$$SELELIG(.BPELIG)
+21 IF X="^"
QUIT
+22 ;
+23 ; Prompt for ECME User(s)
+24 ; Sets up BPUSER variable and array where BPUSER=0 for ALL
+25 ; or BPUSER=1 and BPUSER(IEN) = IEN^NAME for list.
+26 SET X=$$SELUSER(.BPUSER)
+27 IF X="^"
QUIT
+28 ;
+29 ; Prompt to select Date Range
+30 ; Returns (Start Date^End Date)
+31 SET BPBEGDT=$$SELDATE^BPSRPT3(1)
+32 IF BPBEGDT="^"
QUIT
+33 SET BPENDDT=$PIECE(BPBEGDT,U,2)
+34 SET BPBEGDT=$PIECE(BPBEGDT,U)
+35 ;
+36 ; Prompt to Display Summary or Detail Format (Default to Detail)
+37 ; Set to 1 for Summary, 0 for Detail
+38 SET BPSUMDET=$$SELSMDET^BPSRPT3(2)
+39 IF BPSUMDET="^"
QUIT
+40 ;
+41 ; Prompt for Sort Order
+42 ; Set to 1 for User Name, 0 for Division
+43 SET BPSSORD=$$SELSORT(1)
+44 IF BPSSORD="^"
QUIT
+45 ;
+46 ; Prompt for Excel Capture
+47 ; Set to 1 for YES (capture data), 0 for NO (DO NOT capture data)
+48 SET BPEXCEL=0
+49 IF 'BPSUMDET
SET BPEXCEL=$$SELEXCEL
IF BPEXCEL="^"
QUIT
+50 ;
+51 ; Device selection
+52 IF '$$DEVICE()
QUIT
+53 ;
+54 QUIT
+55 ;
SELSORT(DFLT) ; Select Sort Order
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 ;
+3 SET DFLT=$SELECT($GET(DFLT)=1:"User Name",$GET(DFLT)=0:"Division",1:"User Name")
+4 SET DIR(0)="S^D:Division;U:User Name"
SET DIR("A")="Sort: (D/U)"
SET DIR("B")=DFLT
+5 ;
+6 WRITE !!,"Enter a code from the list to indicate the sort order."
+7 DO ^DIR
+8 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+9 SET Y=$SELECT(Y="U":1,Y="D":0,1:Y)
+10 QUIT Y
+11 ;
SELEXCEL() ; Select whether to capture data for Excel report.
+1 NEW BPEXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
+2 ;
+3 SET BPEXCEL=0
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("T")=DTIME
WRITE !
+5 SET DIR("A")="Do you want to capture report data for an Excel document"
+6 SET DIR("?")="^D HEXC^BPSRPT4"
+7 ;
+8 DO ^DIR
+9 KILL DIR
+10 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT "^"
+11 IF Y
SET BPEXCEL=1
+12 ;
+13 ;Display Excel display message
+14 IF BPEXCEL=1
Begin DoDot:1
+15 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
+16 WRITE !?5,"detail report data and save the detail report data in a text file"
+17 WRITE !?5,"to a local drive. This report may take a while to run."
+18 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
+19 WRITE !?5," please enter '0;256;99999' at the 'DEVICE:' prompt.",!
End DoDot:1
+20 ;
+21 QUIT BPEXCEL
+22 ;
DEVICE() ; Device Selection
+1 NEW ZTRTN,ZTDESC,ZTSAVE,POP,RET,ZTSK,DIR,X,Y
+2 SET RET=1
+3 ;
+4 IF 'BPEXCEL
Begin DoDot:1
+5 WRITE !!,"WARNING - THIS REPORT REQUIRES THAT A DEVICE WITH 132 COLUMN WIDTH BE USED."
+6 WRITE !,"IT WILL NOT DISPLAY CORRECTLY USING 80 COLUMN WIDTH DEVICES",!
End DoDot:1
+7 ;
+8 SET ZTRTN="COMPILE^BPSOPR2"
+9 SET ZTDESC="OPECC Productivity Report"
+10 SET ZTSAVE("BPGLTMP")=""
+11 SET ZTSAVE("BPPHARM")=""
+12 SET ZTSAVE("BPELIG")=""
+13 SET ZTSAVE("BPUSER")=""
+14 SET ZTSAVE("BPBEGDT")=""
+15 SET ZTSAVE("BPENDDT")=""
+16 SET ZTSAVE("BPSUMDET")=""
+17 SET ZTSAVE("BPSSORD")=""
+18 SET ZTSAVE("BPEXCEL")=""
+19 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
+20 IF POP
SET RET=0
+21 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
SET DIR(0)="E"
DO ^DIR
+22 QUIT RET
+23 ;
SELPHARM(BPPHARM) ; Select Pharmacies
+1 NEW DIR,BPSFPTR,BPSPTX,X
+2 ;
+3 SET DIR(0)="S^D:DIVISION;A:ALL"
+4 SET DIR("A")="Select Certain Pharmacy (D)ivisions or (A)LL"
+5 SET DIR("B")="A"
+6 SET DIR("L",1)="Select one of the following:"
+7 SET DIR("L",2)=""
+8 SET DIR("L",3)=" D DIVISION"
+9 SET DIR("L",4)=" A ALL"
+10 SET BPSFPTR=9002313.56
+11 SET BPSPTX="Select ECME Pharmacy Division(s): "
+12 ;
+13 SET X=$$SELMULTI(.DIR,.BPPHARM,BPSFPTR,BPSPTX)
+14 QUIT X
+15 ;
SELELIG(BPELIG) ;Select Eligibility Types
+1 NEW DIR,X
+2 ;
+3 SET DIR(0)="SO^V:VETERAN;T:TRICARE;C:CHAMPVA;A:ALL"
+4 SET DIR("A")="Include Certain Eligibility Type or (A)ll"
+5 SET DIR("B")="A"
+6 ;
+7 SET X=$$SELMULTI(.DIR,.BPELIG)
+8 QUIT X
+9 ;
SELUSER(BPUSER) ; Select Users
+1 NEW DIR,BPSFPTR,BPSPTX,X
+2 ;
+3 SET DIR(0)="S^U:USER;A:ALL"
+4 SET DIR("A")="Display ECME (U)ser or (A)LL"
+5 SET DIR("B")="A"
+6 SET BPSFPTR=200
+7 SET BPSPTX="Select ECME User(s): "
+8 ;
+9 SET X=$$SELMULTI(.DIR,.BPUSER,BPSFPTR,BPSPTX)
+10 QUIT X
+11 ;
SELMULTI(BPSDIR,BPSVAR,BPSFPTR,BPSPTX) ;
+1 ; Input Variable -> BPSDIR - DIR array
+2 ; BPSVAR - Variable array
+3 ; BPSFPTR - File pointer (optional)
+4 ; BPSPTX - Prompt text for DIC("A") (optional)
+5 ; Return Value -> "" = Valid Entry or Entries Selected
+6 ; ^ = Exit
+7 ;
+8 ; Output Variable -> BPSVAR = 1 One or more items selected
+9 ; = 0 User entered 'ALL'
+10 ;
+11 ; If BPSVAR = 1 then the BPSVAR array will be defined where:
+12 ; BPSVAR(ptr) = ptr ^ NAME and
+13 ; ptr = Internal pointer to file passed in
+14 ;
+15 NEW BPDELFLG,DIR,DIC,DIRUT,DTOUT,DUOUT,X,Y
+16 ;
+17 SET BPSFPTR=$GET(BPSFPTR,"")
+18 SET BPSPTX=$GET(BPSPTX,"")
+19 ;
+20 ;First see if they want to enter individual items or ALL
+21 ;Only used for DIR. Not used for DIC.
SET BPDELFLG=0
+22 MERGE DIR=BPSDIR
+23 DO ^DIR
+24 KILL DIR
+25 ;
+26 ;Check for "^" or timeout, otherwise define BPSVAR
+27 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+28 IF '$TEST
SET BPSVAR=$SELECT(Y="A":0,1:1)
+29 ;
+30 ;If item selected, ask prompt
+31 IF $GET(BPSVAR)=1
FOR
Begin DoDot:1
+32 ;
+33 ;Prompt for entry
+34 IF BPSFPTR'=""
Begin DoDot:2
+35 KILL X
+36 SET DIC(0)="QEAM"
SET DIC=BPSFPTR
SET DIC("A")=BPSPTX
+37 WRITE !
+38 DO ^DIC
End DoDot:2
+39 ;
+40 IF BPSFPTR=""
Begin DoDot:2
+41 IF 'BPDELFLG
Begin DoDot:3
+42 SET BPSVAR(Y)=Y_"^"_Y(0)
+43 SET BPSVAR("B",Y(0),Y)=""
End DoDot:3
+44 KILL DIR
+45 MERGE DIR=BPSDIR
+46 KILL DIR("B")
+47 DO ^DIR
End DoDot:2
+48 ;
+49 ;Check for "^" or timeout
+50 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
KILL BPSVAR
SET Y="^"
QUIT
+51 ;
+52 ;Check for blank entry, quit if no previous selections
+53 IF $GET(X)=""
SET Y=$SELECT($DATA(BPSVAR)>9:"",1:"^")
if Y="^"
KILL BPSVAR
QUIT
+54 ;
+55 ;Handle deletes
+56 IF BPSFPTR'=""
Begin DoDot:2
+57 IF $DATA(BPSVAR(+Y))
Begin DoDot:3
+58 NEW P
+59 ;Save Original Value
SET P=Y
+60 SET DIR(0)="S^Y:YES;N:NO"
SET DIR("A")="Delete "_$PIECE(P,U,2)_" from your list?"
+61 SET DIR("B")="NO"
DO ^DIR
+62 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
KILL BPSVAR
SET Y="^"
QUIT
+63 IF Y="Y"
KILL BPSVAR(+P),BPSVAR("B",$PIECE(P,U,2),+P)
+64 ;Restore Original Value
SET Y=P
+65 KILL P
End DoDot:3
if Y="^"
QUIT
IF 1
+66 IF '$TEST
Begin DoDot:3
+67 ;Define new entries in BPSVAR array
+68 SET BPSVAR(+Y)=Y
+69 SET BPSVAR("B",$PIECE(Y,U,2),+Y)=""
End DoDot:3
End DoDot:2
+70 ;
+71 IF BPSFPTR=""
Begin DoDot:2
+72 IF $DATA(BPSVAR(Y))
Begin DoDot:3
+73 NEW P
+74 ;Save Original Value
SET P=Y
SET P(0)=Y(0)
+75 SET DIR(0)="S^Y:YES;N:NO"
SET DIR("A")="Delete "_P(0)_" from your list?"
+76 SET DIR("B")="NO"
DO ^DIR
+77 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
KILL BPSVAR
SET Y="^"
QUIT
+78 SET BPDELFLG=0
+79 IF Y="Y"
SET BPDELFLG=1
KILL BPSVAR(P),BPSVAR("B",P(0),P)
+80 ;Restore Original Value
SET Y=P
SET Y(0)=P(0)
+81 KILL P
End DoDot:3
if Y="^"
QUIT
IF 1
+82 IF '$TEST
Begin DoDot:3
+83 ;Define new entries in BPSVAR array
+84 SET BPSVAR(Y)=Y_"^"_Y(0)
+85 SET BPSVAR("B",Y(0),Y)=""
End DoDot:3
End DoDot:2
+86 ;
+87 ;Display a list of selected items
+88 IF $DATA(BPSVAR)>9
Begin DoDot:2
+89 NEW X
+90 WRITE !,?2,"Selected:"
+91 SET X=""
+92 FOR
SET X=$ORDER(BPSVAR("B",X))
if X=""
QUIT
Begin DoDot:3
+93 WRITE !,?10,X
End DoDot:3
+94 KILL X
End DoDot:2
End DoDot:1
if Y="^"!(Y="")
QUIT
+95 ;
+96 KILL BPSVAR("B")
+97 IF $GET(BPSVAR)=1
IF $GET(BPSVAR("A"))="A^ALL"
KILL BPSVAR
SET BPSVAR=0
+98 QUIT Y
+99 ;
