VistA-IHS-VA_UTILITIES-XB/ZIBGCHR.m

ZIBGCHR	; IHS/ADC/GTH - SEARCH FOR CONTROL CHAR. IN GLOBALS ; [ 10/29/2002   7:42 AM ]
	;;4.0;XB;;Jul 20, 2009;Build 2
	; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
	;
%GLCHR	;SEARCH FOR CONTROL CHAR. IN GLOBALS [ 04/15/85  9:13 AM ]
%ST	;
	S %DEF=0,%TRM=$I,%TMO=60      ;,$ZE="%ERR^%GL"
%STL	;
	I $D(%IOD) C:%IOD'=%TRM %IOD
	S %QTY=2
	D ^%ZIS
	G:'$D(IO) %END
	S %DEF=IO,%PAG=IOSL-4
	;I "SC^LP^TRM"'[%DTY!(%DTY="") W !?5,"Improper device selection.",!?5,"Must choose a terminal, a printer, or the system console." G %ST
%SCR	;
	S %LN=132
	;S:IOT="TRM" %LN=80 ;IHS/SET/GTH XB*3*9 10/29/2002
	S:IOT["TRM" %LN=80 ;IHS/SET/GTH XB*3*9 10/29/2002
	;I IOT'="TRM" S %SC=0,%DCC=2 G %DO ;IHS/SET/GTH XB*3*9 10/29/2002
	I IOT'["TRM" S %SC=0,%DCC=2 G %DO ;IHS/SET/GTH XB*3*9 10/29/2002
IHS1	;
	S %SC=0,%DCC=2,TGL=0
	G %DO
	;
	;  -- UNreachable code follows (?) GTH 07-06-95
	R !,"Scroll ? <N> ",%SC:%TMO
	G:%SC="?" %Q1
	G:%SC="^"!('$T) %STL
	G:%SC="^Q" %END
	S:%SC="" %SC="N"
	I "Y^N"'[$E(%SC) W "   'Y' or 'N'" G %SCR
	S %SC=($E(%SC)="Y"),%PAG=20
%PAG	;
	G:'%SC %ASKC
	W !,"Lines/Page <",%PAG R "> ",%X:%TMO
	G:%X="^"!('$T) %SCR
	G:%X="^Q" %END
	S:%X="" %X=%PAG
	I %X'?1N.N!(%X<1) G %Q2
	S %PAG=%X
%ASKC	;
	R !,"Do you want to display control characters ? <NO> ",%X:%TMO
	G:%X="?" %Q3
	G:%X="^Q" %END
	S:%X="" %X="NO"
	I %X="^"!('$T) G:%SC %PAG G:%DTY'="TRM" %STL G %SCR
	I "Y^N"'[$E(%X) W "   'Y' or 'N'" G %ASKC
	I $E(%X)="N" S %DCC=0 G %DO
%OPT	;
	W !,"Specify one of the following:",!?5,"1. Line display",!?5,"2. Block display (with ASCII codes)"
%OPT1	;
	R !,"Display type <1> ",%X:%TMO
	G:%X="?" %HELP
	G:%X="^"!('$T) %ASKC
	G:%X="^Q" %END
	S:%X="" %X=1
	I %X'=1,%X'=2 G %OPT
	S %DCC=%X
%DO	;
	D %START
	C:IO'=%TRM IO
	G %END
	;
%START	;
	S %NCR=%LN-5,%BAR="\"
	;D ^%GSEL ;IHS/SET/GTH XB*3*9 10/29/2002
	I $ZV["MSM" D ^%GSEL ;IHS/SET/GTH XB*3*9 10/29/2002
	I $ZV["Cache" D ^%GSET ;IHS/SET/GTH XB*3*9 10/29/2002
	S (%GL,%GN)="",%LIN=0
	;I $ZS(^UTILITY($J,%GL))="" Q ;IHS/SET/GTH XB*3*9 10/29/2002
	I $O(^UTILITY($J,%GL))="" Q  ;IHS/SET/GTH XB*3*9 10/29/2002
	U IO
	D %GET
	S %LC=1
	D %LIN
	W #
	U IO
	G %START
	;
%GET	;
	KILL %DX,%CK,FLG
	;S %GN=$ZS(^UTILITY($J,%GN)) ;IHS/SET/GTH XB*3*9 10/29/2002
	S %GN=$O(^UTILITY($J,%GN)) ;IHS/SET/GTH XB*3*9 10/29/2002
	Q:%GN=""
	S GLREF=^UTILITY($J,%GN)
	I GLREF="" S %CK="" G %WT
	D %START^%GL1
	Q
	;
%WT	;
	S %GL="^"_%GN
	S %LC=2
	D %LIN
	W %GL
	I $D(@%GL)#2 S IN=@%GL I IN]"" W " = " D %OUT
	S %LC=1
	D %LIN
	S %GL=%GL_"("""")"
%NEXT	;
	;S %GL=$ZN(@%GL) ;IHS/SET/GTH XB*3*9 10/29/2002
	S %GL=$Q(@%GL) ;IHS/SET/GTH XB*3*9 10/29/2002
	;G:%GL=-1 IHS3 ;IHS/SET/GTH XB*3*9 10/29/2002
	G:%GL="" IHS3 ;IHS/SET/GTH XB*3*9 10/29/2002
	S IN=@%GL
	I IN?.E1C.E S TGL=TGL+1 W %GL," = " D %OUT
IHS2	;
	G %NEXT
	;
IHS3	;
	U IO
	W !!,"TOTAL CORRUPT GLOBALS FOUND: ",TGL
	D PAUSE^XB
	S TGL=0
	G %GET
	;
%OUT	;
	I '(IN?.E1C.E) G %OUT1
	D:%DCC=1 %DSP1
	D:%DCC=2 %DSP2
%OUT1	;
	S %LC=1
	D %LIN
	Q
	;
%DSP1	;
	F I=1:1:$L(IN) S %CHR=$E(IN,I) D %WRT
	Q
	;
%WRT	;
	I $A(%CHR)<32 W %BAR Q
	I $A(%CHR)=92 W "\\" Q
	W %CHR
	Q
	;
%DSP2	;
	F I=1:1:4 S A(I)=""
	F I=1:1:$L(IN) S %CHR=$E(IN,I) D:$A(%CHR)<32 %CTL D:$A(%CHR)'<32 %NML
	S %FCR=1,%NLN=($L(IN)-1)\%NCR+1
	F I=1:1:%NLN S %LCR=%FCR+%NCR-1 D %LST
	Q
	;
%CTL	;
	S A(1)=A(1)_%BAR
	D %FIXO
	F K=2:1:4 S A(K)=A(K)_$E(%ASCII,K-1)
	Q
	;
%NML	;
	S A(1)=A(1)_%CHR
	D %FIXO
	F K=2:1:4 S A(K)=A(K)_$E(%ASCII,K-1)
	Q
	;
%FIXO	;
	S %ALN=3-$L($A(%CHR)),%ASCII=$A(%CHR)
	F M=1:1:%ALN S %ASCII="0"_%ASCII
	KILL %ALN
	Q
	;
%LST	;
	I $D(%SC) D:%LIN+4>%PAG %SC
	F %J=1:1:4 S %LC=1 D %LIN W ?3,$E(A(%J),%FCR,%LCR)
	S %LC=1
	D %LIN
	S %FCR=%LCR+1
	Q
	;
%LIN	;
	I $D(%SC) D:%LIN+%LC>%PAG %SC S %LIN=%LIN+%LC
	F %K=1:1:%LC W !
	Q
	;
%SC	;
	U 0
	R !,"Type <CR> to continue",%X:60
	S:'$T %X="^"
	U IO
	S %LIN=0
	Q
	;
%HELP	;
	W !!?5,"Enter '1' to display control characters as ""\""."
	W !?5,"Enter '2' to also display the ASCII code below each character."
	W !?8,"Example:  ^AA(""1"",""3"",""5"") ="
	W !?22,"AB\C\\DEF",!?22,"000000000",!?22,"661612667",!?22,"562773890"
	D %EX
	G %OPT1
	;
%Q1	;
	W !?5,"Enter Y(ES) to specify the number of lines to be displayed per page"
	W !?8,"or N(O) to have a continuous display."
	D %EX
	G %SCR
	;
%Q2	;
	W !?5,"Enter the number of lines to be displayed per page."
	W !?5,"(Should not exceed 20 lines per page for video terminals.)"
	D %EX
	G %PAG
	;
%Q3	;
	W !?5,"Enter Y(ES) for special treatment of control characters upon output.",!?5,"Otherwise enter N(O)."
	D %EX
	G %ASKC
	;
%EX	;
	W !?5,"Enter  ^ to return to the previous question,",!?8,"or ^Q to exit the routine."
	Q
	;
%ERR	;
	U 0
	I $ZE?1"<INRPT".E W !?5,"Unexpected interrupt",!
	E  W !,$ZE,!
%END	;
	I $D(IO) C:IO'=%TRM IO
	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
	Q
	;