| [641] | 1 | ZIBVCHV ; IHS/ADC/GTH - READ VARS AND RTNS FROM A %INDEX ; [ 10/29/2002 7:42 AM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;;
|
|---|
| 4 | ;
|
|---|
| 5 | ; Thanks to Paul Wesley, DSD, for the original routine.
|
|---|
| 6 | ;
|
|---|
| 7 | I '(^%ZOSF("OS")["MSM") D OSNO^XB Q ; IHS/SET/GTH XB*3*9 10/29/2002
|
|---|
| 8 | OPEN ;
|
|---|
| 9 | D DT^DICRW,^XBCLS
|
|---|
| 10 | W !!,"Select a %INDEX Summary that was put to disk",!
|
|---|
| 11 | KILL DIR
|
|---|
| 12 | S DIR(0)="F^1:30",DIR("A")="Directory ",DIR("B")="/usr/mumps/"
|
|---|
| 13 | D ^DIR
|
|---|
| 14 | Q:Y["^"
|
|---|
| 15 | S XBDIR=Y
|
|---|
| 16 | FNAME ;
|
|---|
| 17 | KILL DIR
|
|---|
| 18 | FNAME1 ;
|
|---|
| 19 | S DIR(0)="F^1:15",DIR("A")="File Name "
|
|---|
| 20 | D ^DIR
|
|---|
| 21 | G:Y["^" OPEN
|
|---|
| 22 | I Y?.N,$D(XBFL(Y)) S DIR("B")=XBFL(Y) G FNAME1
|
|---|
| 23 | I Y["*" KILL XBFL S X=$$LIST^%ZISH(XBDIR,Y,.XBFL) D G FNAME
|
|---|
| 24 | .F XBI=1:1 Q:'$D(XBFL(XBI)) W !?5,XBI,?10,XBFL(XBI)
|
|---|
| 25 | .Q
|
|---|
| 26 | S XBFN=Y,X=$$OPEN^%ZISH(XBDIR,XBFN,"R")
|
|---|
| 27 | ES ;
|
|---|
| 28 | I X W !,"error on open of file ",XBDIR,XBFN,! KILL DIR S DIR(0)="E" D ^DIRQ:Y=1 G FNAME
|
|---|
| 29 | S XBJ=$J,XBVRLC=0
|
|---|
| 30 | KILL ^XBVROU(XBJ,"V")
|
|---|
| 31 | W !,"Looking for 'Indexed Routines:' ",!
|
|---|
| 32 | READ ;
|
|---|
| 33 | 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
|
|---|
| 34 | I '$G(XBOK) KILL DIR
|
|---|
| 35 | F XBI=1:1 U IO R X:DTIME Q:X["Local V"
|
|---|
| 36 | F XBI=1:1 U IO R X:DTIME Q:X["Global " D
|
|---|
| 37 | .Q:$L(X)<17
|
|---|
| 38 | .Q:$E(X,17)=" "
|
|---|
| 39 | .I X[$C(13) S X=$P(X,$C(13))
|
|---|
| 40 | .S XBVARL=$G(XBVAR)
|
|---|
| 41 | .I $E(X,4)'=" " S XBVAR="" F XBI=4:1 S XBX=$E(X,XBI) Q:" ("[XBX S XBVAR=XBVAR_XBX
|
|---|
| 42 | .I XBVAR'=XBVARL S XBVRLC=0
|
|---|
| 43 | .S XBR=$E(X,17,999),XBR=$TR(XBR,"*!","")
|
|---|
| 44 | .S XBVRLC=XBVRLC+1,^XBVROU(XBJ,"V",XBVAR,XBVRLC)=XBR
|
|---|
| 45 | .Q
|
|---|
| 46 | D ^%ZISC
|
|---|
| 47 | S XBFILE=1
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
