XBDSET ; IHS/ADC/GTH - BUILDS LIST OF FILEMAN FILES ; [ 12/11/2000 3:13 PM ]
;;3.0;IHS/VA UTILITIES;**8**;FEB 07, 1997
; XB*3*8 - IHS/ASDST/GTH 12-07-00 - Add ability to select from BUILD file.
;
; This routine selects FileMan dictionaries individually,
; by a range, or for a specific package. This routine can
; be called from another routine by setting the variables
; XBDSLO, XBDSHI and then D EN1^XBDSET.
;
; If the variable XBDSND exist upon entry no default menu
; option will be displayed.
;
START ;
S IOP=0
D ^%ZIS
KILL DIC,DIR,^UTILITY("XBDSET",$J)
S (XBDSP,XBDSQ)=0
F D GETFILES Q:XBDSQ
D EOJ
Q
;
GETFILES ;
W !
; S DIR(0)="SO^"_$S('XBDSP:"O:One file only;",1:"")_"S:Selected files;R:Range of files;P:Package;"_$S($D(^UTILITY("XBDSET",$J)):"L:List of files already selected; : ",1:" : "); XB*3*8
S DIR(0)="SO^"_$S('XBDSP:"O:One file only;",1:"")_"S:Selected files;R:Range of files;P:Package;B:Build;"_$S($D(^UTILITY("XBDSET",$J)):"L:List of files already selected; : ",1:" : ") ; XB*3*8
S DIR("A")="Choose one,"_$S(XBDSP!($D(XBDSND)):" RETURN to continue,",1:"")_" or ^ to cancel"
I 'XBDSP,'$D(XBDSND) S DIR("B")="O"
S DIR("?")=$S(XBDSP:"Do you want",1:"Do you want one file,")
; S DIR("?")=DIR("?")_" a range of files by number, files from a specific package, "_$S($D(^UTILITY("XBDSET",$J)):"individual files, or a list of files already selected?",1:"or individual files?") ; XB*3*8
S DIR("?")=DIR("?")_" a range of files by number, files from a specific package or build, "_$S($D(^UTILITY("XBDSET",$J)):"individual files, or a list of files already selected?",1:"or individual files?") ; XB*3*8
D ^DIR
KILL DIR
I $D(DIRUT) K:$D(DUOUT)!($D(DTOUT)) ^UTILITY("XBDSET",$J) S XBDSQ=1 Q
D OPTION ; Get files for selected option
I $D(^UTILITY("XBDSET",$J)) S XBDSP=1
Q
;
OPTION ; GET FILES FOR SELECTED OPTION
W !
I Y="O" D ONEFILE Q ; Get one file and exit
I Y="S" D SELECT Q ; Get selected files
I Y="R" D RANGE Q ; Get range of files
I Y="P" D PACKAGE Q ; Get files from package
I Y="L" D LIST Q ; List selected files
I Y="B" D BUILD Q ; Get files from build ; XB*3*8
Q
;
ONEFILE ; GET ONE FILE AND EXIT
S XBDSND=1
S DIC="^DIC(",DIC(0)="AEMQ"
D ^DIC
KILL DIC
Q:Y<0
S ^UTILITY("XBDSET",$J,+Y)=""
S XBDSQ=1
Q
;
SELECT ; GET SELECTED FILES
S DIC="^DIC(",DIC(0)="AEMQ"
F D ^DIC Q:Y<0 S ^UTILITY("XBDSET",$J,+Y)=""
KILL DIC
I '$O(^UTILITY("XBDSET",$J,""))!($D(DUOUT)) S XBDSQ=1 Q
Q
;
RANGE ; GET RANGE OF FILES
S DIR(0)="NO^1:99999999:3",DIR("A")="From file number"
D ^DIR
KILL DIR
I $D(DIRUT) S XBDSQ=1 Q
S XBDSFF=+Y
F S DIR(0)="NO^1:99999999:3",DIR("A")="Thru file number" D ^DIR KILL DIR Q:$D(DIRUT) D Q:'XBDSQ S XBDSQ=0
. I +Y<XBDSFF W !," 'Thru FILE' number less than 'From FILE' number!",*7 S XBDSQ=9
.Q
I $D(DIRUT) S XBDSQ=1 Q
S XBDSTF=+Y
D RANGE2
W !
I XBDSC W !?4,XBDSC," file",$S(XBDSC=1:"",1:"s")," selected" I 1
E W !?4,"No files selected",*7
Q
;
RANGE2 ; LABEL FOR EXTERNAL ENTRY POINT EN1
S XBDSFILE=XBDSFF,XBDSC=0
F D S XBDSFILE=$O(^DIC(XBDSFILE)) Q:XBDSFILE'=+XBDSFILE!(XBDSFILE>XBDSTF)
. Q:'$D(^DIC(XBDSFILE,0))
. S ^UTILITY("XBDSET",$J,XBDSFILE)=""
. S XBDSC=XBDSC+1
.Q
Q
;
PACKAGE ; GET FILES FROM SPECIFIC PACKAGE
S DIC=9.4,DIC(0)="AEMQ"
D ^DIC
KILL DIC
Q:Y<0
S Y=+Y,X=0
F S X=$O(^DIC(9.4,Y,4,X)) Q:X'=+X I $D(^DIC(^DIC(9.4,Y,4,X,0),0)) S ^UTILITY("XBDSET",$J,^DIC(9.4,Y,4,X,0))=""
Q
;
; XB*3*8 start block
BUILD ; Get files from selected BUILD
S DIC=9.6,DIC(0)="AEMQ"
D ^DIC
KILL DIC
Q:Y<0
S Y=+Y,X=0
F S X=$O(^XPD(9.6,Y,4,X)) Q:X'=+X I $D(^XPD(9.6,Y,4,X,0)) S ^UTILITY("XBDSET",$J,^XPD(9.6,Y,4,X,0))=""
Q
; XB*3*8 end block
;
LIST ; LIST FILES ALREADY SELECTED
I '$D(^UTILITY("XBDSET",$J)) W !,"No files selected." Q
W @IOF,"Files already selected:",!
S XBDSX=""
F S XBDSX=$O(^UTILITY("XBDSET",$J,XBDSX)) Q:XBDSX="" W !,XBDSX,?14,$P(^DIC(XBDSX,0),U,1) I $Y>(IOSL-3) D PXBSE Q:$D(DUOUT) W @IOF
I '$D(DUOUT),$Y>(IOSL-10) D PXBSE
Q
;
PXBSE ; GIVE USER A CHANCE TO SEE LAST PAGE AND QUIT
I IO=IO(0),$E(IOST,1,2)="C-" S Y=$$DIR^XBDIR("E")
Q
;
EN1 ;EP - Non-interactive selection of range of files.
KILL ^UTILITY("XBDSET",$J)
I '$D(XBDSLO)!('$D(XBDSHI)) Q
S XBDSFF=XBDSLO,XBDSTF=XBDSHI
D RANGE2
D EOJ
Q
;
EOJ ;
KILL XBDSC,XBDSFF,XBDSFILE,XBDSHI,XBDSL,XBDSLO,XBDSND,XBDSP,XBDSQ,XBDSTF,XBDSX
KILL DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
Q
;
XBDSET ; IHS/ADC/GTH - BUILDS LIST OF FILEMAN FILES ; [ 12/11/2000 3:13 PM ]
+1 ;;3.0;IHS/VA UTILITIES;**8**;FEB 07, 1997
+2 ; XB*3*8 - IHS/ASDST/GTH 12-07-00 - Add ability to select from BUILD file.
+3 ;
+4 ; This routine selects FileMan dictionaries individually,
+5 ; by a range, or for a specific package. This routine can
+6 ; be called from another routine by setting the variables
+7 ; XBDSLO, XBDSHI and then D EN1^XBDSET.
+8 ;
+9 ; If the variable XBDSND exist upon entry no default menu
+10 ; option will be displayed.
+11 ;
START ;
+1 SET IOP=0
+2 DO ^%ZIS
+3 KILL DIC,DIR,^UTILITY("XBDSET",$JOB)
+4 SET (XBDSP,XBDSQ)=0
+5 FOR
DO GETFILES
IF XBDSQ
QUIT
+6 DO EOJ
+7 QUIT
+8 ;
GETFILES ;
+1 WRITE !
+2 ; S DIR(0)="SO^"_$S('XBDSP:"O:One file only;",1:"")_"S:Selected files;R:Range of files;P:Package;"_$S($D(^UTILITY("XBDSET",$J)):"L:List of files already selected; : ",1:" : "); XB*3*8
+3 ; XB*3*8
SET DIR(0)="SO^"_$SELECT">SELECT('XBDSP:"O:One file only;",1:"")_"S:Selected files;R:Range of files;P:Package;B:Build;"_$SELECT">SELECT($DATA(^UTILITY("XBDSET",$JOB)):"L:List of files already selected; : ",1:" : ")
+4 SET DIR("A")="Choose one,"_$SELECT(XBDSP!($DATA(XBDSND)):" RETURN to continue,",1:"")_" or ^ to cancel"
+5 IF 'XBDSP
IF '$DATA(XBDSND)
SET DIR("B")="O"
+6 SET DIR("?")=$SELECT(XBDSP:"Do you want",1:"Do you want one file,")
+7 ; S DIR("?")=DIR("?")_" a range of files by number, files from a specific package, "_$S($D(^UTILITY("XBDSET",$J)):"individual files, or a list of files already selected?",1:"or individual files?") ; XB*3*8
+8 ; XB*3*8
SET DIR("?")=DIR("?")_" a range of files by number, files from a specific package or build, "_$SELECT($DATA(^UTILITY("XBDSET",$JOB)):"individual files, or a list of files already selected?",1:"or individual files?")
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA(DIRUT)
IF $DATA(DUOUT)!($DATA(DTOUT))
KILL ^UTILITY("XBDSET",$JOB)
SET XBDSQ=1
QUIT
+12 ; Get files for selected option
DO OPTION
+13 IF $DATA(^UTILITY("XBDSET",$JOB))
SET XBDSP=1
+14 QUIT
+15 ;
OPTION ; GET FILES FOR SELECTED OPTION
+1 WRITE !
+2 ; Get one file and exit
IF Y="O"
DO ONEFILE
QUIT
+3 ; Get selected files
IF Y="S"
DO SELECT
QUIT
+4 ; Get range of files
IF Y="R"
DO RANGE
QUIT
+5 ; Get files from package
IF Y="P"
DO PACKAGE
QUIT
+6 ; List selected files
IF Y="L"
DO LIST
QUIT
+7 ; Get files from build ; XB*3*8
IF Y="B"
DO BUILD
QUIT
+8 QUIT
+9 ;
ONEFILE ; GET ONE FILE AND EXIT
+1 SET XBDSND=1
+2 SET DIC="^DIC("
SET DIC(0)="AEMQ"
+3 DO ^DIC
+4 KILL DIC
+5 IF Y<0
QUIT
+6 SET ^UTILITY("XBDSET",$JOB,+Y)=""
+7 SET XBDSQ=1
+8 QUIT
+9 ;
SELECT ; GET SELECTED FILES
+1 SET DIC="^DIC("
SET DIC(0)="AEMQ"
+2 FOR
DO ^DIC
IF Y<0
QUIT
SET ^UTILITY("XBDSET",$JOB,+Y)=""
+3 KILL DIC
+4 IF '$ORDER(^UTILITY("XBDSET",$JOB,""))!($DATA(DUOUT))
SET XBDSQ=1
QUIT
+5 QUIT
+6 ;
RANGE ; GET RANGE OF FILES
+1 SET DIR(0)="NO^1:99999999:3"
SET DIR("A")="From file number"
+2 DO ^DIR
+3 KILL DIR
+4 IF $DATA(DIRUT)
SET XBDSQ=1
QUIT
+5 SET XBDSFF=+Y
+6 FOR
SET DIR(0)="NO^1:99999999:3"
SET DIR("A")="Thru file number"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
Begin DoDot:1
+7 IF +Y<XBDSFF
WRITE !," 'Thru FILE' number less than 'From FILE' number!",*7
SET XBDSQ=9
+8 QUIT
End DoDot:1
IF 'XBDSQ
QUIT
SET XBDSQ=0
+9 IF $DATA(DIRUT)
SET XBDSQ=1
QUIT
+10 SET XBDSTF=+Y
+11 DO RANGE2
+12 WRITE !
+13 IF XBDSC
WRITE !?4,XBDSC," file",$SELECT(XBDSC=1:"",1:"s")," selected"
IF 1
+14 IF '$TEST
WRITE !?4,"No files selected",*7
+15 QUIT
+16 ;
RANGE2 ; LABEL FOR EXTERNAL ENTRY POINT EN1
+1 SET XBDSFILE=XBDSFF
SET XBDSC=0
+2 FOR
Begin DoDot:1
+3 IF '$DATA(^DIC(XBDSFILE,0))
QUIT
+4 SET ^UTILITY("XBDSET",$JOB,XBDSFILE)=""
+5 SET XBDSC=XBDSC+1
+6 QUIT
End DoDot:1
SET XBDSFILE=$ORDER(^DIC(XBDSFILE))
IF XBDSFILE'=+XBDSFILE!(XBDSFILE>XBDSTF)
QUIT
+7 QUIT
+8 ;
PACKAGE ; GET FILES FROM SPECIFIC PACKAGE
+1 SET DIC=9.4
SET DIC(0)="AEMQ"
+2 DO ^DIC
+3 KILL DIC
+4 IF Y<0
QUIT
+5 SET Y=+Y
SET X=0
+6 FOR
SET X=$ORDER(^DIC(9.4,Y,4,X))
IF X'=+X
QUIT
IF $DATA(^DIC(^DIC(9.4,Y,4,X,0),0))
SET ^UTILITY("XBDSET",$JOB,^DIC(9.4,Y,4,X,0))=""
+7 QUIT
+8 ;
+9 ; XB*3*8 start block
BUILD ; Get files from selected BUILD
+1 SET DIC=9.6
SET DIC(0)="AEMQ"
+2 DO ^DIC
+3 KILL DIC
+4 IF Y<0
QUIT
+5 SET Y=+Y
SET X=0
+6 FOR
SET X=$ORDER(^XPD(9.6,Y,4,X))
IF X'=+X
QUIT
IF $DATA(^XPD(9.6,Y,4,X,0))
SET ^UTILITY("XBDSET",$JOB,^XPD(9.6,Y,4,X,0))=""
+7 QUIT
+8 ; XB*3*8 end block
+9 ;
LIST ; LIST FILES ALREADY SELECTED
+1 IF '$DATA(^UTILITY("XBDSET",$JOB))
WRITE !,"No files selected."
QUIT
+2 WRITE @IOF,"Files already selected:",!
+3 SET XBDSX=""
+4 FOR
SET XBDSX=$ORDER(^UTILITY("XBDSET",$JOB,XBDSX))
IF XBDSX=""
QUIT
WRITE !,XBDSX,?14,$PIECE(^DIC(XBDSX,0),U,1)
IF $Y>(IOSL-3)
DO PXBSE
IF $DATA(DUOUT)
QUIT
WRITE @IOF
+5 IF '$DATA(DUOUT)
IF $Y>(IOSL-10)
DO PXBSE
+6 QUIT
+7 ;
PXBSE ; GIVE USER A CHANCE TO SEE LAST PAGE AND QUIT
+1 IF IO=IO(0)
IF $EXTRACT(IOST,1,2)="C-"
SET Y=$$DIR^XBDIR("E")
+2 QUIT
+3 ;
EN1 ;EP - Non-interactive selection of range of files.
+1 KILL ^UTILITY("XBDSET",$JOB)
+2 IF '$DATA(XBDSLO)!('$DATA(XBDSHI))
QUIT
+3 SET XBDSFF=XBDSLO
SET XBDSTF=XBDSHI
+4 DO RANGE2
+5 DO EOJ
+6 QUIT
+7 ;
EOJ ;
+1 KILL XBDSC,XBDSFF,XBDSFILE,XBDSHI,XBDSL,XBDSLO,XBDSND,XBDSP,XBDSQ,XBDSTF,XBDSX
+2 KILL DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 QUIT
+4 ;
