source: IHS-VA_UTILITIES-XB/trunk/ZIBGCHR.m@ 1680

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

Modified directory structure; moved routines.
File size: 4.7 KB
Line 
1ZIBGCHR ; IHS/ADC/GTH - SEARCH FOR CONTROL CHAR. IN GLOBALS ; [ 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 Cache' mods.
4 ;
5%GLCHR ;SEARCH FOR CONTROL CHAR. IN GLOBALS [ 04/15/85 9:13 AM ]
6%ST ;
7 S %DEF=0,%TRM=$I,%TMO=60 ;,$ZE="%ERR^%GL"
8%STL ;
9 I $D(%IOD) C:%IOD'=%TRM %IOD
10 S %QTY=2
11 D ^%ZIS
12 G:'$D(IO) %END
13 S %DEF=IO,%PAG=IOSL-4
14 ;I "SC^LP^TRM"'[%DTY!(%DTY="") W !?5,"Improper device selection.",!?5,"Must choose a terminal, a printer, or the system console." G %ST
15%SCR ;
16 S %LN=132
17 ;S:IOT="TRM" %LN=80 ;IHS/SET/GTH XB*3*9 10/29/2002
18 S:IOT["TRM" %LN=80 ;IHS/SET/GTH XB*3*9 10/29/2002
19 ;I IOT'="TRM" S %SC=0,%DCC=2 G %DO ;IHS/SET/GTH XB*3*9 10/29/2002
20 I IOT'["TRM" S %SC=0,%DCC=2 G %DO ;IHS/SET/GTH XB*3*9 10/29/2002
21IHS1 ;
22 S %SC=0,%DCC=2,TGL=0
23 G %DO
24 ;
25 ; -- UNreachable code follows (?) GTH 07-06-95
26 R !,"Scroll ? <N> ",%SC:%TMO
27 G:%SC="?" %Q1
28 G:%SC="^"!('$T) %STL
29 G:%SC="^Q" %END
30 S:%SC="" %SC="N"
31 I "Y^N"'[$E(%SC) W " 'Y' or 'N'" G %SCR
32 S %SC=($E(%SC)="Y"),%PAG=20
33%PAG ;
34 G:'%SC %ASKC
35 W !,"Lines/Page <",%PAG R "> ",%X:%TMO
36 G:%X="^"!('$T) %SCR
37 G:%X="^Q" %END
38 S:%X="" %X=%PAG
39 I %X'?1N.N!(%X<1) G %Q2
40 S %PAG=%X
41%ASKC ;
42 R !,"Do you want to display control characters ? <NO> ",%X:%TMO
43 G:%X="?" %Q3
44 G:%X="^Q" %END
45 S:%X="" %X="NO"
46 I %X="^"!('$T) G:%SC %PAG G:%DTY'="TRM" %STL G %SCR
47 I "Y^N"'[$E(%X) W " 'Y' or 'N'" G %ASKC
48 I $E(%X)="N" S %DCC=0 G %DO
49%OPT ;
50 W !,"Specify one of the following:",!?5,"1. Line display",!?5,"2. Block display (with ASCII codes)"
51%OPT1 ;
52 R !,"Display type <1> ",%X:%TMO
53 G:%X="?" %HELP
54 G:%X="^"!('$T) %ASKC
55 G:%X="^Q" %END
56 S:%X="" %X=1
57 I %X'=1,%X'=2 G %OPT
58 S %DCC=%X
59%DO ;
60 D %START
61 C:IO'=%TRM IO
62 G %END
63 ;
64%START ;
65 S %NCR=%LN-5,%BAR="\"
66 ;D ^%GSEL ;IHS/SET/GTH XB*3*9 10/29/2002
67 I $ZV["MSM" D ^%GSEL ;IHS/SET/GTH XB*3*9 10/29/2002
68 I $ZV["Cache" D ^%GSET ;IHS/SET/GTH XB*3*9 10/29/2002
69 S (%GL,%GN)="",%LIN=0
70 ;I $ZS(^UTILITY($J,%GL))="" Q ;IHS/SET/GTH XB*3*9 10/29/2002
71 I $O(^UTILITY($J,%GL))="" Q ;IHS/SET/GTH XB*3*9 10/29/2002
72 U IO
73 D %GET
74 S %LC=1
75 D %LIN
76 W #
77 U IO
78 G %START
79 ;
80%GET ;
81 KILL %DX,%CK,FLG
82 ;S %GN=$ZS(^UTILITY($J,%GN)) ;IHS/SET/GTH XB*3*9 10/29/2002
83 S %GN=$O(^UTILITY($J,%GN)) ;IHS/SET/GTH XB*3*9 10/29/2002
84 Q:%GN=""
85 S GLREF=^UTILITY($J,%GN)
86 I GLREF="" S %CK="" G %WT
87 D %START^%GL1
88 Q
89 ;
90%WT ;
91 S %GL="^"_%GN
92 S %LC=2
93 D %LIN
94 W %GL
95 I $D(@%GL)#2 S IN=@%GL I IN]"" W " = " D %OUT
96 S %LC=1
97 D %LIN
98 S %GL=%GL_"("""")"
99%NEXT ;
100 ;S %GL=$ZN(@%GL) ;IHS/SET/GTH XB*3*9 10/29/2002
101 S %GL=$Q(@%GL) ;IHS/SET/GTH XB*3*9 10/29/2002
102 ;G:%GL=-1 IHS3 ;IHS/SET/GTH XB*3*9 10/29/2002
103 G:%GL="" IHS3 ;IHS/SET/GTH XB*3*9 10/29/2002
104 S IN=@%GL
105 I IN?.E1C.E S TGL=TGL+1 W %GL," = " D %OUT
106IHS2 ;
107 G %NEXT
108 ;
109IHS3 ;
110 U IO
111 W !!,"TOTAL CORRUPT GLOBALS FOUND: ",TGL
112 D PAUSE^XB
113 S TGL=0
114 G %GET
115 ;
116%OUT ;
117 I '(IN?.E1C.E) G %OUT1
118 D:%DCC=1 %DSP1
119 D:%DCC=2 %DSP2
120%OUT1 ;
121 S %LC=1
122 D %LIN
123 Q
124 ;
125%DSP1 ;
126 F I=1:1:$L(IN) S %CHR=$E(IN,I) D %WRT
127 Q
128 ;
129%WRT ;
130 I $A(%CHR)<32 W %BAR Q
131 I $A(%CHR)=92 W "\\" Q
132 W %CHR
133 Q
134 ;
135%DSP2 ;
136 F I=1:1:4 S A(I)=""
137 F I=1:1:$L(IN) S %CHR=$E(IN,I) D:$A(%CHR)<32 %CTL D:$A(%CHR)'<32 %NML
138 S %FCR=1,%NLN=($L(IN)-1)\%NCR+1
139 F I=1:1:%NLN S %LCR=%FCR+%NCR-1 D %LST
140 Q
141 ;
142%CTL ;
143 S A(1)=A(1)_%BAR
144 D %FIXO
145 F K=2:1:4 S A(K)=A(K)_$E(%ASCII,K-1)
146 Q
147 ;
148%NML ;
149 S A(1)=A(1)_%CHR
150 D %FIXO
151 F K=2:1:4 S A(K)=A(K)_$E(%ASCII,K-1)
152 Q
153 ;
154%FIXO ;
155 S %ALN=3-$L($A(%CHR)),%ASCII=$A(%CHR)
156 F M=1:1:%ALN S %ASCII="0"_%ASCII
157 KILL %ALN
158 Q
159 ;
160%LST ;
161 I $D(%SC) D:%LIN+4>%PAG %SC
162 F %J=1:1:4 S %LC=1 D %LIN W ?3,$E(A(%J),%FCR,%LCR)
163 S %LC=1
164 D %LIN
165 S %FCR=%LCR+1
166 Q
167 ;
168%LIN ;
169 I $D(%SC) D:%LIN+%LC>%PAG %SC S %LIN=%LIN+%LC
170 F %K=1:1:%LC W !
171 Q
172 ;
173%SC ;
174 U 0
175 R !,"Type <CR> to continue",%X:60
176 S:'$T %X="^"
177 U IO
178 S %LIN=0
179 Q
180 ;
181%HELP ;
182 W !!?5,"Enter '1' to display control characters as ""\""."
183 W !?5,"Enter '2' to also display the ASCII code below each character."
184 W !?8,"Example: ^AA(""1"",""3"",""5"") ="
185 W !?22,"AB\C\\DEF",!?22,"000000000",!?22,"661612667",!?22,"562773890"
186 D %EX
187 G %OPT1
188 ;
189%Q1 ;
190 W !?5,"Enter Y(ES) to specify the number of lines to be displayed per page"
191 W !?8,"or N(O) to have a continuous display."
192 D %EX
193 G %SCR
194 ;
195%Q2 ;
196 W !?5,"Enter the number of lines to be displayed per page."
197 W !?5,"(Should not exceed 20 lines per page for video terminals.)"
198 D %EX
199 G %PAG
200 ;
201%Q3 ;
202 W !?5,"Enter Y(ES) for special treatment of control characters upon output.",!?5,"Otherwise enter N(O)."
203 D %EX
204 G %ASKC
205 ;
206%EX ;
207 W !?5,"Enter ^ to return to the previous question,",!?8,"or ^Q to exit the routine."
208 Q
209 ;
210%ERR ;
211 U 0
212 I $ZE?1"<INRPT".E W !?5,"Unexpected interrupt",!
213 E W !,$ZE,!
214%END ;
215 I $D(IO) C:IO'=%TRM IO
216 KILL %ASCII,%BAR,%CHR,%CK,%DCC,%DCF,%DEF,%DTY,%FCR,%GL,%GN,%GO,%IOD,%K,%LC,%LCR,%LIN,%LN,%NCR,%NLN,%PAG,%QTY,%SC,%ST,%TMO,%TRM,%UCIN,%X,A,GLREF,I,IN,K,M,TGL
217 Q
218 ;
Note: See TracBrowser for help on using the repository browser.