source: IHS-VA_UTILITIES-XB/ZIBVLMSM.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 3.2 KB
Line 
1ZIBVLMSM ; IHS/ADC/GTH - LIST MSM VARIABLES ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; This routine lists variables that begin with the string
5 ; entered by the user. Selection of variables is case
6 ; sensitive.
7 ;
8 ; This routine is specific to Micronetics. It will work
9 ; with any M implementation that has all Type A extensions
10 ; to the 1990 M ANSI standard implemented. The front end
11 ; routine, XBVL, stops if any other than an MSM
12 ; implementation is encountered.
13 ;
14 ; Routine provided by Don Enos, OHPRD, 5 Feb 96.
15 ;
16START ;
17 NEW ZIBVLC,ZIBVLDQT,ZIBVLI,ZIBVLLC,ZIBVLNS,ZIBVLQ,ZIBVLX,ZIBVLX2,ZIBVLY,ZIBVLZ
18 S $P(ZIBVLZ,"=",40)=""
19 F D LOOP Q:ZIBVLQ
20 Q
21 ;
22LOOP ; WRITE NAME SPACED VARIABLES UNTIL USER IS THROUGH
23 D READ ; get name space
24 Q:ZIBVLQ
25 Q:ZIBVLNS=""
26 I $D(IOF) W @IOF I 1
27 E W !!
28 W ZIBVLZ,! ; write leading === line
29 I ZIBVLNS="*" D ALL I 1 ; list variables
30 E D NMSPACE
31 D:ZIBVLLC>20 PAUSE ; pause if bottom of screen
32 I 'ZIBVLQ W ZIBVLZ,! I 1 ; write trailing === line
33 E W !
34 S ZIBVLQ=0
35 Q
36 ;
37NMSPACE ; LIST VARIABLES IN NAME SPACE
38 S ZIBVLX=$O(@ZIBVLNS,-1) ; backup to variable before name space
39 S:ZIBVLX="" ZIBVLX="%" ; if none start with %
40 I ZIBVLNS="%",$D(%) D WRITE,QUERY ;if % name space list % variable
41 ; now list variables in name space and subnodes if arrays
42 ; skip ZIBVL* variables
43 F S ZIBVLX=$O(@ZIBVLX) Q:ZIBVLX="" Q:$E(ZIBVLX,1,$L(ZIBVLNS))]ZIBVLNS I $E(ZIBVLX,1,$L(ZIBVLNS))=ZIBVLNS,$E(ZIBVLX,1,5)'="ZIBVL" D WRITE Q:ZIBVLQ D QUERY Q:ZIBVLQ
44 Q
45 ;
46ALL ; LIST ALL VARIABLES
47 S ZIBVLX="%"
48 I $D(%) D WRITE,QUERY ; if % exists list it
49 ; now list all variables and subnodes if arrays
50 ; skip ZIBVL* variables
51 F S ZIBVLX=$O(@ZIBVLX) Q:ZIBVLX="" I $E(ZIBVLX,1,5)'="ZIBVL" D WRITE Q:ZIBVLQ D QUERY Q:ZIBVLQ
52 Q
53 ;
54QUERY ; $Q THROUGH ARRAYS
55 S ZIBVLX2=ZIBVLX
56 NEW ZIBVLX
57 S ZIBVLX=ZIBVLX2
58 F S ZIBVLX=$Q(@ZIBVLX) Q:ZIBVLX="" D WRITE Q:ZIBVLQ
59 Q
60 ;
61WRITE ; WRITE ONE VARIABLE NAME AND VALUE
62 Q:'($D(@ZIBVLX)#2)
63 ; quote non-numeric values (numeric = canonic < 16 digits)
64 S ZIBVLDQT=""""
65 I $L(@ZIBVLX)<16,@ZIBVLX=+@ZIBVLX S ZIBVLDQT=""
66 ; figure out # of lines that will be used
67 S ZIBVLC=$L(ZIBVLX)+1+($L(ZIBVLDQT)*2)+$L(@ZIBVLX) F ZIBVLI=1:1 S ZIBVLC=ZIBVLC-80 Q:ZIBVLC<1
68 S ZIBVLLC=ZIBVLLC+ZIBVLI
69 I ZIBVLLC>22 S ZIBVLLC=0 D PAUSE ; pause if not enough room
70 Q:ZIBVLQ
71 W ZIBVLX,"=",ZIBVLDQT,@ZIBVLX,ZIBVLDQT,! ; write name=value
72 Q
73 ;
74READ ; READ USER INPUT
75 S ZIBVLQ=1,ZIBVLLC=0
76 R !,"Enter Name Space: ",ZIBVLNS:300
77 S:'$T ZIBVLNS="^"
78 Q:ZIBVLNS=""
79 Q:ZIBVLNS["^"
80 S ZIBVLQ=0
81 I ZIBVLNS["?" D HELP Q
82 I $E(ZIBVLNS,1,5)="ZIBVL" W !!,"ZIBVL is not allowed!",*7 D HELP Q
83 I ZIBVLNS=" " W !!,"BLANK is not allowed!",*7 D HELP Q
84 I $L(ZIBVLNS)>1,$E(ZIBVLNS,$L(ZIBVLNS))="*" S ZIBVLNS=$E(ZIBVLNS,1,($L(ZIBVLNS)-1))
85 D I ZIBVLQ S ZIBVLQ=0 D HELP W *7 Q
86 . Q:ZIBVLNS?1"%".AN
87 . Q:ZIBVLNS?1A.AN
88 . Q:ZIBVLNS="*"
89 . S ZIBVLQ=1
90 . Q
91 Q
92 ;
93HELP ; DISPLAY HELP MESSAGE
94 W !!,"Enter valid variable name string (e.g IO), or * for all, or RETURN or ^ to exit.",!
95 S ZIBVLNS=""
96 Q
97 ;
98PAUSE ; PAUSE FOR USER
99 R "Press any key to continue",ZIBVLY:300 S:'$T ZIBVLY="^"
100 W !
101 I ZIBVLY["^" S ZIBVLQ=1 Q
102 W:$D(IOF) @IOF
103 Q
Note: See TracBrowser for help on using the repository browser.