source: IHS-VA_UTILITIES-XB/trunk/ZIBVCHV.m@ 1742

Last change on this file since 1742 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 1.4 KB
Line 
1ZIBVCHV ; 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
8OPEN ;
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
16FNAME ;
17 KILL DIR
18FNAME1 ;
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")
27ES ;
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:' ",!
32READ ;
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 ;
Note: See TracBrowser for help on using the repository browser.