source: IHS-VA_UTILITIES-XB/trunk/ZIBVL.m@ 1119

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

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