ZIBVCHV.m

ZIBVCHV ; IHS/ADC/GTH - READ VARS AND RTNS FROM A %INDEX ; [ 10/29/2002   7:42 AM ]

 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997

 ;;

 ;

 ; Thanks to Paul Wesley, DSD, for the original routine.

 ;

 I '(^%ZOSF("OS")["MSM") D OSNO^XB Q  ; IHS/SET/GTH XB*3*9 10/29/2002

OPEN ;

 D DT^DICRW,^XBCLS

 W !!,"Select a %INDEX Summary that was put to disk",!

 KILL DIR

 S DIR(0)="F^1:30",DIR("A")="Directory ",DIR("B")="/usr/mumps/"

 D ^DIR

 Q:Y["^"

 S XBDIR=Y

FNAME ;

 KILL DIR

FNAME1 ;

 S DIR(0)="F^1:15",DIR("A")="File Name "

 D ^DIR

 G:Y["^" OPEN

 I Y?.N,$D(XBFL(Y)) S DIR("B")=XBFL(Y) G FNAME1

 I Y["*" KILL XBFL S X=$$LIST^%ZISH(XBDIR,Y,.XBFL) D  G FNAME

 .F XBI=1:1 Q:'$D(XBFL(XBI))  W !?5,XBI,?10,XBFL(XBI)

 .Q

 S XBFN=Y,X=$$OPEN^%ZISH(XBDIR,XBFN,"R")

ES ;

 I X W !,"error on open of file ",XBDIR,XBFN,! KILL DIR S DIR(0)="E" D ^DIRQ:Y=1  G FNAME

 S XBJ=$J,XBVRLC=0

 KILL ^XBVROU(XBJ,"V")

 W !,"Looking for 'Indexed Routines:' ",!

READ ;

 F XBI=1:1:20 U IO R X:DTIME U IO(0) W "." I X["Indexed Routines:" S XBOK=1 W !,"Found ! ... continuing" Q

 I '$G(XBOK) KILL DIR

 F XBI=1:1 U IO R X:DTIME Q:X["Local V"

 F XBI=1:1 U IO R X:DTIME Q:X["Global "  D

 .Q:$L(X)<17

 .Q:$E(X,17)=" "

 .I X[$C(13) S X=$P(X,$C(13))

 .S XBVARL=$G(XBVAR)

 .I $E(X,4)'=" " S XBVAR="" F XBI=4:1 S XBX=$E(X,XBI) Q:" ("[XBX  S XBVAR=XBVAR_XBX

 .I XBVAR'=XBVARL S XBVRLC=0

 .S XBR=$E(X,17,999),XBR=$TR(XBR,"*!","")

 .S XBVRLC=XBVRLC+1,^XBVROU(XBJ,"V",XBVAR,XBVRLC)=XBR

 .Q

 D ^%ZISC

 S XBFILE=1

 Q

 ;

ZIBVCHV   ; IHS/ADC/GTH - READ VARS AND RTNS FROM A %INDEX ; [ 10/29/2002   7:42 AM ]

 +1       ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997

 +2       ;;

 +3       ;

 +4       ; Thanks to Paul Wesley, DSD, for the original routine.

 +5       ;

 +6       ; IHS/SET/GTH XB*3*9 10/29/2002

           IF '(^%ZOSF("OS")["MSM")

               DO OSNO^XB

               QUIT 

OPEN      ;

 +1        DO DT^DICRW

           DO ^XBCLS

 +2        WRITE !!,"Select a %INDEX Summary that was put to disk",!

 +3        KILL DIR

 +4        SET DIR(0)="F^1:30"

           SET DIR("A")="Directory "

           SET DIR("B")="/usr/mumps/"

 +5        DO ^DIR

 +6        IF Y["^"

               QUIT 

 +7        SET XBDIR=Y

FNAME     ;

 +1        KILL DIR

FNAME1    ;

 +1        SET DIR(0)="F^1:15"

           SET DIR("A")="File Name "

 +2        DO ^DIR

 +3        IF Y["^"

               GOTO OPEN

 +4        IF Y?.N

               IF $DATA(XBFL(Y))

                   SET DIR("B")=XBFL(Y)

                   GOTO FNAME1

 +5        IF Y["*"

               KILL XBFL

               SET X=$$LIST^%ZISH(XBDIR,Y,.XBFL)

               Begin DoDot:1

 +6                FOR XBI=1:1

                       IF '$DATA(XBFL(XBI))

                           QUIT 

                       WRITE !?5,XBI,?10,XBFL(XBI)

 +7                QUIT 

               End DoDot:1

               GOTO FNAME

 +8        SET XBFN=Y

           SET X=$$OPEN^%ZISH(XBDIR,XBFN,"R")

ES        ;

 +1        IF X

               WRITE !,"error on open of file ",XBDIR,XBFN,!

               KILL DIR

               SET DIR(0)="E"

               IF Y=1

                   DO ^DIRQ

               GOTO FNAME

 +2        SET XBJ=$JOB

           SET XBVRLC=0

 +3        KILL ^XBVROU(XBJ,"V")

 +4        WRITE !,"Looking for 'Indexed Routines:' ",!

READ      ;

 +1        FOR XBI=1:1:20

               USE IO

               READ X:DTIME

               USE IO(0)

               WRITE "."

               IF X["Indexed Routines:"

                   SET XBOK=1

                   WRITE !,"Found ! ... continuing"

                   QUIT 

 +2        IF '$GET(XBOK)

               KILL DIR

 +3        FOR XBI=1:1

               USE IO

               READ X:DTIME

               IF X["Local V"

                   QUIT 

 +4        FOR XBI=1:1

               USE IO

               READ X:DTIME

               IF X["Global "

                   QUIT 

               Begin DoDot:1

 +5                IF $LENGTH(X)<17

                       QUIT 

 +6                IF $EXTRACT(X,17)=" "

                       QUIT 

 +7                IF X[$CHAR(13)

                       SET X=$PIECE(X,$CHAR(13))

 +8                SET XBVARL=$GET(XBVAR)

 +9                IF $EXTRACT(X,4)'=" "

                       SET XBVAR=""

                       FOR XBI=4:1

                           SET XBX=$EXTRACT(X,XBI)

                           IF " ("[XBX

                               QUIT 

                           SET XBVAR=XBVAR_XBX

 +10               IF XBVAR'=XBVARL

                       SET XBVRLC=0

 +11               SET XBR=$EXTRACT(X,17,999)

                   SET XBR=$TRANSLATE(XBR,"*!","")

 +12               SET XBVRLC=XBVRLC+1

                   SET ^XBVROU(XBJ,"V",XBVAR,XBVRLC)=XBR

 +13               QUIT 

               End DoDot:1

 +14       DO ^%ZISC

 +15       SET XBFILE=1

 +16       QUIT 

 +17      ;