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

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
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.