BRNRU2 ; IHS/OIT/LJF - REPORTING UTILITY - SCREEN SELECTION
;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
;IHS/OIT/LJF 10/25/2007 PATCH 1 Added this routine
;; ;
EN ;EP; -- main entry point for BRN VGEN SELECT ITEMS
; BRNCNTL is set to determine which selection screen
K BRNCSEL NEW VALMCNT,VALMHDR,BRNLIST,BRNHIGH
D EN^VALM("BRN RGEN SELECT ITEMS")
D CLEAR^VALM1
Q
;
HDR ;EP; -- header code
I $G(BRNCNTL)="" Q
D @("HDR"_BRNCNTL)
Q
;
HDRS ;screen selection header
S VALMHDR(1)=$$SP(24)_$G(IORVON)_"Disclosure Request Selection Menu"_$G(IORVOFF)
S VALMHDR(2)="Disclosure requests can be selected based upon any of the following items."
S VALMHDR(3)="Select as many as you wish, in any order or combination. An (*) asterisk"
S VALMHDR(4)="indicates items already selected. To select all disclosures press Q."
Q
;
HDRP ;print selection header
S VALMHDR(1)=$$SP(24)_$G(IORVON)_"Print Items 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)=$$SP(24)_$G(IORVON)_"Sorting Criteria Selection Menu"_$G(IORVOFF)
S VALMHDR(3)="The disclosure requests 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 Date Request Initiated"
Q
;
INIT ;EP; -- build list array in BRNLIST
K BRNLIST,BRNHIGH,BRNSEL
NEW BRNDISP,X,Y,BRNCUT,C,J,K,I,BRNZZ
S BRNHIGH=0,X=0 F S X=$O(^BRNSORT("C",X)) Q:X'=+X D
. S Y=$O(^BRNSORT("C",X,""))
. I $P(^BRNSORT(Y,0),U,5)[BRNCNTL S BRNHIGH=BRNHIGH+1,BRNSEL(BRNHIGH)=Y
S BRNCUT=((BRNHIGH/3)+1)\1
;
S (C,I)=0,J=1,K=1 F S I=$O(BRNSEL(I)) Q:I'=+I Q:($D(BRNDISP(I))) D
.S C=C+1,BRNZZ=$$T(I,BRNCNTL),BRNLIST(C,0)=I_")"_$S($D(BRNCSEL(I)):"*",1:" ")_BRNZZ S BRNDISP(I)="",BRNLIST("IDX",C,C)=""
.S J=I+BRNCUT
.I $D(BRNSEL(J)),'$D(BRNDISP(J)) S BRNZZ=$$T(J,BRNCNTL),$E(BRNLIST(C,0),28)=J_")"_$S($D(BRNCSEL(J)):"*",1:" ")_BRNZZ S BRNDISP(J)=""
.S K=J+BRNCUT
.I $D(BRNSEL(K)),'$D(BRNDISP(K)) S BRNZZ=$$T(K,BRNCNTL),$E(BRNLIST(C,0),55)=K_")"_$S($D(BRNCSEL(K)):"*",1:" ")_BRNZZ S BRNDISP(K)=""
S VALMCNT=C
Q
;
ADD ;EP - add an item to the selected list - called from BRN RGEN ADD ITEM protocol
I BRNCNTL="R" D SELECTR Q ;only one sort so drop to selection code
;
NEW DIR,DUOUT,DIRUT,X,Y
W ! S DIR(0)="LO^1:"_BRNHIGH,DIR("A")="Which disclosure item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No items selected." D PAUSE^BRNU,BACK Q
I $D(DIRUT) W !,"No items selected." D PAUSE^BRNU,BACK Q
D FULL^VALM1 W:$D(IOF) @IOF
D @("SELECT"_BRNCNTL)
D PAUSE^BRNU
D BACK
Q
;
SELECTS ;select screen items
; RETURNS BRNCSEL variable
NEW BRNC,BRNI,BRNANS
S BRNANS=Y ;answer from ADD subroutine
S BRNC="" F BRNI=1:1 S BRNC=$P(BRNANS,",",BRNI) Q:BRNC="" S BRNCRIT=BRNSEL(BRNC) D
. S BRNTEXT=$P(^BRNSORT(BRNCRIT,0),U) ;item name
. S BRNVAR=$P(^BRNSORT(BRNCRIT,0),U,6) ;column header
. K ^BRNRPT(BRNRPT,11,BRNCRIT),^BRNRPT(BRNRPT,11,"B",BRNCRIT) ;clean out report temp file
. W !!,BRNC,") ",BRNTEXT," Selection."
. I $P(^BRNSORT(BRNCRIT,0),U,2)]"" S BRNCNT=0,^BRNRPT(BRNRPT,11,0)="^90264.81101PA^0^0" D @($P(^BRNSORT(BRNCRIT,0),U,2)_"^BRNRU21")
. I $D(^BRNRPT(BRNRPT,11,BRNCRIT,11,1)) S BRNCSEL(BRNC)="" ;add to selection list
D SHOW^BRNRUS
Q
;
SELECTR ;sort select
; returns BRNSORT & BRNSORV variables
NEW DIR,BRNANS,DIE,DA,DR
W ! S DIR(0)="NO^1:"_BRNHIGH_":0"
S DIR("A")=$S(BRNCTYP="S":"Sub-total ",1:"Sort ")_"Disclosure requests by which of the above"
D ^DIR K DIR
;
SELCTR1 ; called by Q subrouitne in case user decided not to select a sort
;
I $D(DUOUT) W !,"exiting" S BRNQUIT=1 Q
S BRNANS=Y
;
I BRNANS="",(BRNCTYP="D"!(BRNCTYP="L")) D Q
. W !!,"No sort criteria selected ... will sort by Patient Name."
. S BRNSORT=1,BRNSORV="Patient Name" H 2 D Q
. . S DA=BRNRPT,DIE="^BRNRPT(",DR=".07////"_BRNSORT
. . D ^DIE K DIU,DIV,DIY,DIW
;
I BRNANS="",BRNCTYP'="D",BRNCTYP'="L" W !!,"No sub-totalling will be done.",!! D Q
. S BRNCTYP="T"
. H 3
. S BRNSORT=1,BRNSORV="Patient Name"
;
S BRNSORT=BRNSEL(+BRNANS),BRNSORV=$P(^BRNSORT(BRNSORT,0),U)
S DA=BRNRPT,DIE="^BRNRPT(",DR=".07////"_BRNSORT
D ^DIE K DIU,DIV,DIY,DIW
Q
;
SELECTP ;print select - get columns
NEW BRNANS,BRNC,BRNI,DIR
S BRNANS=Y,BRNC=""
F BRNI=1:1 S BRNC=$P(BRNANS,",",BRNI) Q:BRNC="" S BRNCRIT=BRNSEL(BRNC),BRNPCNT=BRNPCNT+1 D
. I BRNCTYP="D" D
. . S DIR(0)="N^2:80:0"
. . S DIR("A")="Enter Column width for "_$P(^BRNSORT(BRNCRIT,0),U)_" (suggested: "_$P(^BRNSORT(BRNCRIT,0),U,7)_")"
. . S DIR("B")=$P(^(0),U,7)
. . D ^DIR K DIR S:$D(DUOUT) DIRUT=1
. . I $D(DIRUT) S Y=$P(^BRNSORT(BRNCRIT,0),U,7)
. ;
. I BRNCTYP="L" S Y=""
. S ^BRNRPT(BRNRPT,12,0)="^9001003.81102PA^1^1"
. ;
. I $D(^BRNRPT(BRNRPT,12,"B",BRNCRIT)) D
. . S X=$O(^BRNRPT(BRNRPT,12,"B",BRNCRIT,""))
. . S BRNTCW=BRNTCW-$P(^BRNRPT(BRNRPT,12,X,0),U,2)-2
. . S ^BRNRPT(BRNRPT,12,X,0)=BRNCRIT_U_Y
. ;
. S ^BRNRPT(BRNRPT,12,BRNPCNT,0)=BRNCRIT_U_Y
. S ^BRNRPT(BRNRPT,12,"B",BRNCRIT,BRNPCNT)=""
. S BRNTCW=BRNTCW+Y+2,BRNCSEL(BRNC)=""
. I BRNCTYP="D" W !!?15,"Total Report width (including column margins - 2 spaces): ",BRNTCW
. ;
. ;new functionality to print 1 or all
. Q:'$D(^BRNRPT(BRNRPT,11,"B",BRNCRIT)) ;didn't select this item
. Q:'$P(^BRNSORT(BRNCRIT,0),U,13) ;not one of these items
. ;
. ;one or all
. W !!,"*** This item, ",$P(^BRNSORT(BRNCRIT,0),U)," was a selection item. Do you want to print"
. W !,"ALL ",$P(^BRNSORT(BRNCRIT,0),U),"'s or just those you selected.",!
. S DIR(0)="S^A:ALL items;O:Only the ones selected"
. S DIR("A")="For this item",DIR("B")="A" KILL DA
. D ^DIR KILL DIR
. I $D(DIRUT) S Y="A"
. I Y="O" S $P(^BRNRPT(BRNRPT,12,BRNPCNT,0),U,3)=1
Q
;
REM ;EP - remove a selected item - called from protocol entry
NEW BRNC,DIR,BRNI
I '$D(BRNCSEL) 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 BRNANS=Y,BRNC="" F BRNI=1:1 S BRNC=$P(BRNANS,",",BRNI) Q:BRNC="" S BRNCRIT=BRNSEL(BRNC) D
. I '$D(BRNCSEL(BRNC)) W !,"Item ",BRNC," ",$P(^BRNSORT(BRNCRIT,0),U)," has not been selected.",! Q
. K BRNCSEL(BRNC)
. I BRNCNTL="S" K ^BRNRPT(BRNRPT,11,BRNCRIT),^BRNRPT(BRNRPT,11,"B",BRNCRIT)
. I BRNCNTL="P" S X=$O(^BRNRPT(BRNRPT,12,"B",BRNCRIT,0)) I X K ^BRNRPT(BRNRPT,12,X),^BRNRPT(BRNRPT,12,"B",BRNCRIT)
. W !,"Item ",$P(^BRNSORT(BRNCRIT,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
;
T(Z,Y) ; resets print menu header if defined for this item
NEW T
S T=$P(^BRNSORT(BRNSEL(Z),0),U)
I $P(^BRNSORT(BRNSEL(Z),0),U,12)]"",Y="P" S T=$P(^BRNSORT(BRNSEL(Z),0),U,12)
Q T
;
Q ;EP - quit selections
I BRNCNTL="R" S Y="" G SELCTR1
Q
;
EXITR ;EP - exit report called from protocol entry
S BRNQUIT=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"
W !,"the selection process. To exit the report, enter an E."
W !,"Hit a Q to select all disclosure requests, 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 BRNDISP
K VALMCC,VALMHDR
Q
;
EXPND ; -- expand code
Q
;
PAD(D,L) ;EP -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ;EP -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
BRNRU2 ; IHS/OIT/LJF - REPORTING UTILITY - SCREEN SELECTION
+1 ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
+2 ;IHS/OIT/LJF 10/25/2007 PATCH 1 Added this routine
+3 ;; ;
EN ;EP; -- main entry point for BRN VGEN SELECT ITEMS
+1 ; BRNCNTL is set to determine which selection screen
+2 KILL BRNCSEL
NEW VALMCNT,VALMHDR,BRNLIST,BRNHIGH
+3 DO EN^VALM("BRN RGEN SELECT ITEMS")
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
HDR ;EP; -- header code
+1 IF $GET(BRNCNTL)=""
QUIT
+2 DO @("HDR"_BRNCNTL)
+3 QUIT
+4 ;
HDRS ;screen selection header
+1 SET VALMHDR(1)=$$SP(24)_$GET(IORVON)_"Disclosure Request Selection Menu"_$GET(IORVOFF)
+2 SET VALMHDR(2)="Disclosure requests can be selected based upon any of the following items."
+3 SET VALMHDR(3)="Select as many as you wish, in any order or combination. An (*) asterisk"
+4 SET VALMHDR(4)="indicates items already selected. To select all disclosures press Q."
+5 QUIT
+6 ;
HDRP ;print selection header
+1 SET VALMHDR(1)=$$SP(24)_$GET(IORVON)_"Print Items 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)=$$SP(24)_$GET(IORVON)_"Sorting Criteria Selection Menu"_$GET(IORVOFF)
+3 SET VALMHDR(3)="The disclosure requests 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 Date Request Initiated"
+5 QUIT
+6 ;
INIT ;EP; -- build list array in BRNLIST
+1 KILL BRNLIST,BRNHIGH,BRNSEL
+2 NEW BRNDISP,X,Y,BRNCUT,C,J,K,I,BRNZZ
+3 SET BRNHIGH=0
SET X=0
FOR
SET X=$ORDER(^BRNSORT("C",X))
IF X'=+X
QUIT
Begin DoDot:1
+4 SET Y=$ORDER(^BRNSORT("C",X,""))
+5 IF $PIECE(^BRNSORT(Y,0),U,5)[BRNCNTL
SET BRNHIGH=BRNHIGH+1
SET BRNSEL(BRNHIGH)=Y
End DoDot:1
+6 SET BRNCUT=((BRNHIGH/3)+1)\1
+7 ;
+8 SET (C,I)=0
SET J=1
SET K=1
FOR
SET I=$ORDER(BRNSEL(I))
IF I'=+I
QUIT
IF ($DATA(BRNDISP(I)))
QUIT
Begin DoDot:1
+9 SET C=C+1
SET BRNZZ=$$T(I,BRNCNTL)
SET BRNLIST(C,0)=I_")"_$SELECT($DATA(BRNCSEL(I)):"*",1:" ")_BRNZZ
SET BRNDISP(I)=""
SET BRNLIST("IDX",C,C)=""
+10 SET J=I+BRNCUT
+11 IF $DATA(BRNSEL(J))
IF '$DATA(BRNDISP(J))
SET BRNZZ=$$T(J,BRNCNTL)
SET $EXTRACT(BRNLIST(C,0),28)=J_")"_$SELECT($DATA(BRNCSEL(J)):"*",1:" ")_BRNZZ
SET BRNDISP(J)=""
+12 SET K=J+BRNCUT
+13 IF $DATA(BRNSEL(K))
IF '$DATA(BRNDISP(K))
SET BRNZZ=$$T(K,BRNCNTL)
SET $EXTRACT(BRNLIST(C,0),55)=K_")"_$SELECT($DATA(BRNCSEL(K)):"*",1:" ")_BRNZZ
SET BRNDISP(K)=""
End DoDot:1
+14 SET VALMCNT=C
+15 QUIT
+16 ;
ADD ;EP - add an item to the selected list - called from BRN RGEN ADD ITEM protocol
+1 ;only one sort so drop to selection code
IF BRNCNTL="R"
DO SELECTR
QUIT
+2 ;
+3 NEW DIR,DUOUT,DIRUT,X,Y
+4 WRITE !
SET DIR(0)="LO^1:"_BRNHIGH
SET DIR("A")="Which disclosure item(s)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No items selected."
DO PAUSE^BRNU
DO BACK
QUIT
+6 IF $DATA(DIRUT)
WRITE !,"No items selected."
DO PAUSE^BRNU
DO BACK
QUIT
+7 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+8 DO @("SELECT"_BRNCNTL)
+9 DO PAUSE^BRNU
+10 DO BACK
+11 QUIT
+12 ;
SELECTS ;select screen items
+1 ; RETURNS BRNCSEL variable
+2 NEW BRNC,BRNI,BRNANS
+3 ;answer from ADD subroutine
SET BRNANS=Y
+4 SET BRNC=""
FOR BRNI=1:1
SET BRNC=$PIECE(BRNANS,",",BRNI)
IF BRNC=""
QUIT
SET BRNCRIT=BRNSEL(BRNC)
Begin DoDot:1
+5 ;item name
SET BRNTEXT=$PIECE(^BRNSORT(BRNCRIT,0),U)
+6 ;column header
SET BRNVAR=$PIECE(^BRNSORT(BRNCRIT,0),U,6)
+7 ;clean out report temp file
KILL ^BRNRPT(BRNRPT,11,BRNCRIT),^BRNRPT(BRNRPT,11,"B",BRNCRIT)
+8 WRITE !!,BRNC,") ",BRNTEXT," Selection."
+9 IF $PIECE(^BRNSORT(BRNCRIT,0),U,2)]""
SET BRNCNT=0
SET ^BRNRPT(BRNRPT,11,0)="^90264.81101PA^0^0"
DO @($PIECE(^BRNSORT(BRNCRIT,0),U,2)_"^BRNRU21")
+10 ;add to selection list
IF $DATA(^BRNRPT(BRNRPT,11,BRNCRIT,11,1))
SET BRNCSEL(BRNC)=""
End DoDot:1
+11 DO SHOW^BRNRUS
+12 QUIT
+13 ;
SELECTR ;sort select
+1 ; returns BRNSORT & BRNSORV variables
+2 NEW DIR,BRNANS,DIE,DA,DR
+3 WRITE !
SET DIR(0)="NO^1:"_BRNHIGH_":0"
+4 SET DIR("A")=$SELECT(BRNCTYP="S":"Sub-total ",1:"Sort ")_"Disclosure requests by which of the above"
+5 DO ^DIR
KILL DIR
+6 ;
SELCTR1 ; called by Q subrouitne in case user decided not to select a sort
+1 ;
+2 IF $DATA(DUOUT)
WRITE !,"exiting"
SET BRNQUIT=1
QUIT
+3 SET BRNANS=Y
+4 ;
+5 IF BRNANS=""
IF (BRNCTYP="D"!(BRNCTYP="L"))
Begin DoDot:1
+6 WRITE !!,"No sort criteria selected ... will sort by Patient Name."
+7 SET BRNSORT=1
SET BRNSORV="Patient Name"
HANG 2
Begin DoDot:2
+8 SET DA=BRNRPT
SET DIE="^BRNRPT("
SET DR=".07////"_BRNSORT
+9 DO ^DIE
KILL DIU,DIV,DIY,DIW
End DoDot:2
QUIT
End DoDot:1
QUIT
+10 ;
+11 IF BRNANS=""
IF BRNCTYP'="D"
IF BRNCTYP'="L"
WRITE !!,"No sub-totalling will be done.",!!
Begin DoDot:1
+12 SET BRNCTYP="T"
+13 HANG 3
+14 SET BRNSORT=1
SET BRNSORV="Patient Name"
End DoDot:1
QUIT
+15 ;
+16 SET BRNSORT=BRNSEL(+BRNANS)
SET BRNSORV=$PIECE(^BRNSORT(BRNSORT,0),U)
+17 SET DA=BRNRPT
SET DIE="^BRNRPT("
SET DR=".07////"_BRNSORT
+18 DO ^DIE
KILL DIU,DIV,DIY,DIW
+19 QUIT
+20 ;
SELECTP ;print select - get columns
+1 NEW BRNANS,BRNC,BRNI,DIR
+2 SET BRNANS=Y
SET BRNC=""
+3 FOR BRNI=1:1
SET BRNC=$PIECE(BRNANS,",",BRNI)
IF BRNC=""
QUIT
SET BRNCRIT=BRNSEL(BRNC)
SET BRNPCNT=BRNPCNT+1
Begin DoDot:1
+4 IF BRNCTYP="D"
Begin DoDot:2
+5 SET DIR(0)="N^2:80:0"
+6 SET DIR("A")="Enter Column width for "_$PIECE(^BRNSORT(BRNCRIT,0),U)_" (suggested: "_$PIECE(^BRNSORT(BRNCRIT,0),U,7)_")"
+7 SET DIR("B")=$PIECE(^(0),U,7)
+8 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+9 IF $DATA(DIRUT)
SET Y=$PIECE(^BRNSORT(BRNCRIT,0),U,7)
End DoDot:2
+10 ;
+11 IF BRNCTYP="L"
SET Y=""
+12 SET ^BRNRPT(BRNRPT,12,0)="^9001003.81102PA^1^1"
+13 ;
+14 IF $DATA(^BRNRPT(BRNRPT,12,"B",BRNCRIT))
Begin DoDot:2
+15 SET X=$ORDER(^BRNRPT(BRNRPT,12,"B",BRNCRIT,""))
+16 SET BRNTCW=BRNTCW-$PIECE(^BRNRPT(BRNRPT,12,X,0),U,2)-2
+17 SET ^BRNRPT(BRNRPT,12,X,0)=BRNCRIT_U_Y
End DoDot:2
+18 ;
+19 SET ^BRNRPT(BRNRPT,12,BRNPCNT,0)=BRNCRIT_U_Y
+20 SET ^BRNRPT(BRNRPT,12,"B",BRNCRIT,BRNPCNT)=""
+21 SET BRNTCW=BRNTCW+Y+2
SET BRNCSEL(BRNC)=""
+22 IF BRNCTYP="D"
WRITE !!?15,"Total Report width (including column margins - 2 spaces): ",BRNTCW
+23 ;
+24 ;new functionality to print 1 or all
+25 ;didn't select this item
IF '$DATA(^BRNRPT(BRNRPT,11,"B",BRNCRIT))
QUIT
+26 ;not one of these items
IF '$PIECE(^BRNSORT(BRNCRIT,0),U,13)
QUIT
+27 ;
+28 ;one or all
+29 WRITE !!,"*** This item, ",$PIECE(^BRNSORT(BRNCRIT,0),U)," was a selection item. Do you want to print"
+30 WRITE !,"ALL ",$PIECE(^BRNSORT(BRNCRIT,0),U),"'s or just those you selected.",!
+31 SET DIR(0)="S^A:ALL items;O:Only the ones selected"
+32 SET DIR("A")="For this item"
SET DIR("B")="A"
KILL DA
+33 DO ^DIR
KILL DIR
+34 IF $DATA(DIRUT)
SET Y="A"
+35 IF Y="O"
SET $PIECE(^BRNRPT(BRNRPT,12,BRNPCNT,0),U,3)=1
End DoDot:1
+36 QUIT
+37 ;
REM ;EP - remove a selected item - called from protocol entry
+1 NEW BRNC,DIR,BRNI
+2 IF '$DATA(BRNCSEL)
WRITE !!,"No items have been selected.",!
HANG 2
GOTO REMX
+3 SET DIR(0)="LO^:"
SET DIR("A")="Remove which selected item"
KILL DA
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No items selected."
GOTO REMX
+6 IF $DATA(DIRUT)
WRITE !,"No items selected."
GOTO REMX
+7 SET BRNANS=Y
SET BRNC=""
FOR BRNI=1:1
SET BRNC=$PIECE(BRNANS,",",BRNI)
IF BRNC=""
QUIT
SET BRNCRIT=BRNSEL(BRNC)
Begin DoDot:1
+8 IF '$DATA(BRNCSEL(BRNC))
WRITE !,"Item ",BRNC," ",$PIECE(^BRNSORT(BRNCRIT,0),U)," has not been selected.",!
QUIT
+9 KILL BRNCSEL(BRNC)
+10 IF BRNCNTL="S"
KILL ^BRNRPT(BRNRPT,11,BRNCRIT),^BRNRPT(BRNRPT,11,"B",BRNCRIT)
+11 IF BRNCNTL="P"
SET X=$ORDER(^BRNRPT(BRNRPT,12,"B",BRNCRIT,0))
IF X
KILL ^BRNRPT(BRNRPT,12,X),^BRNRPT(BRNRPT,12,"B",BRNCRIT)
+12 WRITE !,"Item ",$PIECE(^BRNSORT(BRNCRIT,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
+4 ;
T(Z,Y) ; resets print menu header if defined for this item
+1 NEW T
+2 SET T=$PIECE(^BRNSORT(BRNSEL(Z),0),U)
+3 IF $PIECE(^BRNSORT(BRNSEL(Z),0),U,12)]""
IF Y="P"
SET T=$PIECE(^BRNSORT(BRNSEL(Z),0),U,12)
+4 QUIT T
+5 ;
Q ;EP - quit selections
+1 IF BRNCNTL="R"
SET Y=""
GOTO SELCTR1
+2 QUIT
+3 ;
EXITR ;EP - exit report called from protocol entry
+1 SET BRNQUIT=1
+2 QUIT
+3 ;
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"
+4 WRITE !,"the selection process. To exit the report, enter an E."
+5 WRITE !,"Hit a Q to select all disclosure requests, bypassing all screens.",!
+6 SET X="?"
DO DISP^XQORM1
WRITE !
+7 SET DIR(0)="EO"
SET DIR("A")="Hit return to continue..."
KILL DA
DO ^DIR
KILL DIR
+8 DO BACK
+9 QUIT
+10 ;
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
+8 ;
EXIT ; -- exit code
+1 KILL BRNDISP
+2 KILL VALMCC,VALMHDR
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PAD(D,L) ;EP -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ;EP -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
