AZOGCHR ; IHS/ADC/GTH - SEARCH FOR CONTROL CHAR. IN GLOBALS ; [ 05/24/2000 2:30 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
%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
I IOT'="TRM" S %SC=0,%DCC=2 G %DO
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
S (%GL,%GN)="",%LIN=0
I $ZS(^UTILITY($J,%GL))="" Q
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))
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)
G:%GL=-1 IHS3
S IN=@%GL
I IN?.E1C.E S TGL=TGL+1 W %GL," = " D %OUT D
.;--- ADDED THE REMOVAL OF CONTROL CHARACTERS IHS/OKCAO/POC 4/30/99
.S AZOLEN=$L(IN),AZONEW=""
.F AZOI=1:1:AZOLEN D
..S AZOP=$E(IN,AZOI)
..I AZOP'?1C S AZONEW=AZONEW_AZOP
.S @%GL=AZONEW
.K AZOLEN,AZONEW,AZOI,AZOP
.;--- END OF CHANGES IHS/OKCAO/POC
IHS2 ;
G %NEXT
;
IHS3 ;
U IO
W !!,"TOTAL CORRUPT GLOBALS FOUND: ",TGL
;D PAUSE^XB ;LET'S TAKE THIS OUT IHS/OKCAO/POC 5/24/00
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
;LET'S TAKE NEXT TWO LINES OUT IHS/OKCAO/POC 5/24/00
;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
;
AZOGCHR ; IHS/ADC/GTH - SEARCH FOR CONTROL CHAR. IN GLOBALS ; [ 05/24/2000 2:30 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
%GLCHR ;SEARCH FOR CONTROL CHAR. IN GLOBALS [ 04/15/85 9:13 AM ]
%ST ;
+1 ;,$ZE="%ERR^%GL"
SET %DEF=0
SET %TRM=$IO
SET %TMO=60
%STL ;
+1 IF $DATA(%IOD)
IF %IOD'=%TRM
CLOSE %IOD
+2 SET %QTY=2
+3 DO ^%ZIS
+4 IF '$DATA(IO)
GOTO %END
+5 SET %DEF=IO
SET %PAG=IOSL-4
+6 ;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 ;
+1 SET %LN=132
+2 IF IOT="TRM"
SET %LN=80
+3 IF IOT'="TRM"
SET %SC=0
SET %DCC=2
GOTO %DO
IHS1 ;
+1 SET %SC=0
SET %DCC=2
SET TGL=0
+2 GOTO %DO
+3 ;
+4 ; -- UNreachable code follows (?) GTH 07-06-95
+5 READ !,"Scroll ? <N> ",%SC:%TMO
+6 IF %SC="?"
GOTO %Q1
+7 IF %SC="^"!('$TEST)
GOTO %STL
+8 IF %SC="^Q"
GOTO %END
+9 IF %SC=""
SET %SC="N"
+10 IF "Y^N"'[$EXTRACT(%SC)
WRITE " 'Y' or 'N'"
GOTO %SCR
+11 SET %SC=($EXTRACT(%SC)="Y")
SET %PAG=20
%PAG ;
+1 IF '%SC
GOTO %ASKC
+2 WRITE !,"Lines/Page <",%PAG
READ "> ",%X:%TMO
+3 IF %X="^"!('$TEST)
GOTO %SCR
+4 IF %X="^Q"
GOTO %END
+5 IF %X=""
SET %X=%PAG
+6 IF %X'?1N.N!(%X<1)
GOTO %Q2
+7 SET %PAG=%X
%ASKC ;
+1 READ !,"Do you want to display control characters ? <NO> ",%X:%TMO
+2 IF %X="?"
GOTO %Q3
+3 IF %X="^Q"
GOTO %END
+4 IF %X=""
SET %X="NO"
+5 IF %X="^"!('$TEST)
IF %SC
GOTO %PAG
IF %DTY'="TRM"
GOTO %STL
GOTO %SCR
+6 IF "Y^N"'[$EXTRACT(%X)
WRITE " 'Y' or 'N'"
GOTO %ASKC
+7 IF $EXTRACT(%X)="N"
SET %DCC=0
GOTO %DO
%OPT ;
+1 WRITE !,"Specify one of the following:",!?5,"1. Line display",!?5,"2. Block display (with ASCII codes)"
%OPT1 ;
+1 READ !,"Display type <1> ",%X:%TMO
+2 IF %X="?"
GOTO %HELP
+3 IF %X="^"!('$TEST)
GOTO %ASKC
+4 IF %X="^Q"
GOTO %END
+5 IF %X=""
SET %X=1
+6 IF %X'=1
IF %X'=2
GOTO %OPT
+7 SET %DCC=%X
%DO ;
+1 DO %START
+2 IF IO'=%TRM
CLOSE IO
+3 GOTO %END
+4 ;
%START ;
+1 SET %NCR=%LN-5
SET %BAR="\"
+2 DO ^%GSEL
+3 SET (%GL,%GN)=""
SET %LIN=0
+4 IF $ZS(^UTILITY($JOB,%GL))=""
QUIT
+5 USE IO
+6 DO %GET
+7 SET %LC=1
+8 DO %LIN
+9 WRITE #
+10 USE IO
+11 GOTO %START
+12 ;
%GET ;
+1 KILL %DX,%CK,FLG
+2 SET %GN=$ZS(^UTILITY($JOB,%GN))
+3 IF %GN=""
QUIT
+4 SET GLREF=^UTILITY($JOB,%GN)
+5 IF GLREF=""
SET %CK=""
GOTO %WT
+6 DO %START^%GL1
+7 QUIT
+8 ;
%WT ;
+1 SET %GL="^"_%GN
+2 SET %LC=2
+3 DO %LIN
+4 WRITE %GL
+5 IF $DATA(@%GL)#2
SET IN=@%GL
IF IN]""
WRITE " = "
DO %OUT
+6 SET %LC=1
+7 DO %LIN
+8 SET %GL=%GL_"("""")"
%NEXT ;
+1 SET %GL=$ZN(@%GL)
+2 IF %GL=-1
GOTO IHS3
+3 SET IN=@%GL
+4 IF IN?.E1C.E
SET TGL=TGL+1
WRITE %GL," = "
DO %OUT
Begin DoDot:1
+5 ;--- ADDED THE REMOVAL OF CONTROL CHARACTERS IHS/OKCAO/POC 4/30/99
+6 SET AZOLEN=$LENGTH(IN)
SET AZONEW=""
+7 FOR AZOI=1:1:AZOLEN
Begin DoDot:2
+8 SET AZOP=$EXTRACT(IN,AZOI)
+9 IF AZOP'?1C
SET AZONEW=AZONEW_AZOP
End DoDot:2
+10 SET @%GL=AZONEW
+11 KILL AZOLEN,AZONEW,AZOI,AZOP
+12 ;--- END OF CHANGES IHS/OKCAO/POC
End DoDot:1
IHS2 ;
+1 GOTO %NEXT
+2 ;
IHS3 ;
+1 USE IO
+2 WRITE !!,"TOTAL CORRUPT GLOBALS FOUND: ",TGL
+3 ;D PAUSE^XB ;LET'S TAKE THIS OUT IHS/OKCAO/POC 5/24/00
+4 SET TGL=0
+5 GOTO %GET
+6 ;
%OUT ;
+1 IF '(IN?.E1C.E)
GOTO %OUT1
+2 IF %DCC=1
DO %DSP1
+3 IF %DCC=2
DO %DSP2
%OUT1 ;
+1 SET %LC=1
+2 DO %LIN
+3 QUIT
+4 ;
%DSP1 ;
+1 FOR I=1:1:$LENGTH(IN)
SET %CHR=$EXTRACT(IN,I)
DO %WRT
+2 QUIT
+3 ;
%WRT ;
+1 IF $ASCII(%CHR)<32
WRITE %BAR
QUIT
+2 IF $ASCII(%CHR)=92
WRITE "\\"
QUIT
+3 WRITE %CHR
+4 QUIT
+5 ;
%DSP2 ;
+1 FOR I=1:1:4
SET A(I)=""
+2 FOR I=1:1:$LENGTH(IN)
SET %CHR=$EXTRACT(IN,I)
IF $ASCII(%CHR)<32
DO %CTL
IF $ASCII(%CHR)'<32
DO %NML
+3 SET %FCR=1
SET %NLN=($LENGTH(IN)-1)\%NCR+1
+4 FOR I=1:1:%NLN
SET %LCR=%FCR+%NCR-1
DO %LST
+5 QUIT
+6 ;
%CTL ;
+1 SET A(1)=A(1)_%BAR
+2 DO %FIXO
+3 FOR K=2:1:4
SET A(K)=A(K)_$EXTRACT(%ASCII,K-1)
+4 QUIT
+5 ;
%NML ;
+1 SET A(1)=A(1)_%CHR
+2 DO %FIXO
+3 FOR K=2:1:4
SET A(K)=A(K)_$EXTRACT(%ASCII,K-1)
+4 QUIT
+5 ;
%FIXO ;
+1 SET %ALN=3-$LENGTH($ASCII(%CHR))
SET %ASCII=$ASCII(%CHR)
+2 FOR M=1:1:%ALN
SET %ASCII="0"_%ASCII
+3 KILL %ALN
+4 QUIT
+5 ;
%LST ;
+1 IF $DATA(%SC)
IF %LIN+4>%PAG
DO %SC
+2 FOR %J=1:1:4
SET %LC=1
DO %LIN
WRITE ?3,$EXTRACT(A(%J),%FCR,%LCR)
+3 SET %LC=1
+4 DO %LIN
+5 SET %FCR=%LCR+1
+6 QUIT
+7 ;
%LIN ;
+1 IF $DATA(%SC)
IF %LIN+%LC>%PAG
DO %SC
SET %LIN=%LIN+%LC
+2 FOR %K=1:1:%LC
WRITE !
+3 QUIT
+4 ;
%SC ;
+1 USE 0
+2 ;LET'S TAKE NEXT TWO LINES OUT IHS/OKCAO/POC 5/24/00
+3 ;R !,"Type <CR> to continue",%X:60
+4 ;S:'$T %X="^"
+5 USE IO
+6 SET %LIN=0
+7 QUIT
+8 ;
%HELP ;
+1 WRITE !!?5,"Enter '1' to display control characters as ""\""."
+2 WRITE !?5,"Enter '2' to also display the ASCII code below each character."
+3 WRITE !?8,"Example: ^AA(""1"",""3"",""5"") ="
+4 WRITE !?22,"AB\C\\DEF",!?22,"000000000",!?22,"661612667",!?22,"562773890"
+5 DO %EX
+6 GOTO %OPT1
+7 ;
%Q1 ;
+1 WRITE !?5,"Enter Y(ES) to specify the number of lines to be displayed per page"
+2 WRITE !?8,"or N(O) to have a continuous display."
+3 DO %EX
+4 GOTO %SCR
+5 ;
%Q2 ;
+1 WRITE !?5,"Enter the number of lines to be displayed per page."
+2 WRITE !?5,"(Should not exceed 20 lines per page for video terminals.)"
+3 DO %EX
+4 GOTO %PAG
+5 ;
%Q3 ;
+1 WRITE !?5,"Enter Y(ES) for special treatment of control characters upon output.",!?5,"Otherwise enter N(O)."
+2 DO %EX
+3 GOTO %ASKC
+4 ;
%EX ;
+1 WRITE !?5,"Enter ^ to return to the previous question,",!?8,"or ^Q to exit the routine."
+2 QUIT
+3 ;
%ERR ;
+1 USE 0
+2 IF $ZE?1"<INRPT".E
WRITE !?5,"Unexpected interrupt",!
+3 IF '$TEST
WRITE !,$ZE,!
%END ;
+1 IF $DATA(IO)
IF IO'=%TRM
CLOSE IO
+2 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
+3 QUIT
+4 ;
