- 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 ;
