source: IHS-VA_UTILITIES-XB/ZIBGCHR.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: 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.