%INDX51 ;ISC/REL,GRK,RWF - PRINT ROUTINE ;8/18/93 11:12 ;
;;7.3;TOOLKIT;;Apr 25, 1995
B S RTN="$",INL(1)=IOM-10,INL(2)=IOSL-4,INL(3)="C"[$E(IOST),INL(4)=IOM-1 ;Local IO paramiters
K I W !!?10,"Compiled list of Errors and Warnings ",INDXDT,!
F INDXJ=0:0 S RTN=$O(^UTILITY($J,RTN)) Q:RTN="" I $D(^UTILITY($J,1,RTN,"E"))>9 W !,RTN F I=1:1 Q:'$D(^UTILITY($J,1,RTN,"E",I)) W !?3,^(I)
W:'$D(I) !,"No errors or warnings to report",! G END:'INP(1),CR:INP(6)
W !!,"--- Routine Detail" W:INP(5)?1A " --- with "_$S(INP(5)["R":"REGULAR",INP(5)["S":"STRUCTURED",INP(5)["B":"R/S",1:"")_" ROUTINE LISTING" W " ---"
S RTN="$",INDB="R"
BL F S RTN=$O(^UTILITY($J,RTN)) Q:RTN=""!('INP(4)&(RTN?1"|"1.4L.NP)) D B1,CHK
G END:NRO<2,END:$D(IND("QUIT")),CR
;
CHK I $D(ZTQUEUED),$$S^%ZTLOAD S IND("QUIT")=1,ZTSTOP=1
S:$D(IND("QUIT")) RTN="~" Q
;
B1 D:INP(5)["S"!(INP(5)["B") ^%INDX8 D:INP(5)["F" SC G:INP(5)["S" B2
D WAIT:INL(3) S X=^UTILITY($J,1,RTN,0) W @IOF,!,RTN," * * ",$P(X,"^",2)," Lines, ",+X," Bytes. printed on ",INDXDT,! G:'INP(2) B2
F I=1:1 Q:'$D(^UTILITY($J,1,RTN,0,I)) S X=^(I,0),L=$P(X," ",1),X=$P(X," ",2,999) F J=6,7:0 W !,L,?J," ",$E(X,1,INL(4)-J) S X=$E(X,INL(4)-J+1,999),L="" Q:X=""
B2 G:'INP(3)!('$D(^UTILITY($J,1,RTN,"E",0))) B3 W !!,"***** ERRORS & WARNINGS IN ",RTN," *****",!
F I=1:1 Q:'$D(^UTILITY($J,1,RTN,"E",I)) W !?3,^(I)
B3 S INL(5)="***** INDEX OF "_RTN_" *****" W !!,INL(5),!
S HED="Local Variables Line Occurrences ( >> not killed explicitly)",HED(1)=$J("",40)_"( * Changed ! Killed ~ Newed)",LOC="L",SYM="" D P
S HED="Global Variables ( * Changed ! Killed)",LOC="G",SYM="" D P
S HED="Naked Globals",LOC="N",SYM="" D P
S HED="Marked Items",LOC="MK",SYM="" D P
S HED="Label References",LOC="I",SYM="" D P
S HED="External References",LOC="X",SYM="^" D P
W !!,"***** END *****",! Q
;
P S L="",PC="",TAB=$S("XG"[LOC:23,1:16) D HD1 Q:$D(IND("QUIT"))
P1 S L=$O(^UTILITY($J,1,RTN,LOC,L)) I L="" W:PC="" !?3,"NONE" K HED Q
I LOC="X",L?1L.LNP Q
S PC(1)=$G(^UTILITY($J,1,RTN,LOC,$P(L,"(")))_$S("^DT^DUZ^DTIME^IO^IOF^ION^IOM^IOSL^IOST^U^"[("^"_$P(L,"(")_"^"):"!",1:" ")
S PC(1)=(PC(1)["!")!(PC(1)["~"),PC="*"
F J=0:1 S X=$S($D(^UTILITY($J,1,RTN,LOC,L,J)):^(J),1:"") Q:X="" D P2,P3
G P1
P2 I $Y'<INL(2) D HD1 S PC="*"
Q:PC=L
I LOC="L" W !,$S(('PC(1)):">> ",1:" "),SYM,L,?TAB Q
I LOC'="X" W !," ",SYM,L,?TAB Q
W !?3,$P(L," ",2),SYM,$P(L," ",1)," ",?TAB
Q
P3 W:$X>TAB !,?TAB
S PC=L F I=1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X>INL(1) !?TAB W:$X'=TAB "," W ARG
Q
HD1 I $Y'<INL(2) D WAIT:INL(3) W @IOF,!,INL(5),!
HD2 W !!,HED W:$D(HED(1)) !,HED(1)
Q
CR S INDB="C" U IO(0) W !!,"--- CROSS-REFERENCING ALL ROUTINES ---" U IO
S RTN="$" D CRX^%INDX5
S INL(5)="***** Cross Reference of all Routines printed "_INDXDT_" *****",RTN="***" D WAIT:INL(3) W @IOF,!,INL(5),!
S HED="Local Variables Routines ( >> not killed explicitly)",HED(1)=$J("",30)_"( * Changed ! Killed ~ Newed)",LOC="L",SYM="" D P
S HED="Global Variables",LOC="G",SYM="" D P
S HED="Marked Items",LOC="MK",SYM="" D P
S HED="Routine Invokes:",LOC="Z",SYM="" D P
S HED="Routine is Invoked by:",LOC="X",SYM="^" D P
W !!,"***** END *****",! G END
END K INL,HED Q
SC ;Print a command chart
D WAIT:INL(3) W @IOF,!,RTN," Command chart"
F I=0:0 S I=$O(^UTILITY($J,1,RTN,"COM",I)) Q:I'>0 W !,^(I)
Q
WAIT W !," Press return to continue:" R %:60 S:%="^" IND("QUIT")=1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZINDX51 3503 printed Apr 09, 2024@21:43:37 Page 2
%INDX51 ;ISC/REL,GRK,RWF - PRINT ROUTINE ;8/18/93 11:12 ;
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
B ;Local IO paramiters
SET RTN="$"
SET INL(1)=IOM-10
SET INL(2)=IOSL-4
SET INL(3)="C"[$EXTRACT(IOST)
SET INL(4)=IOM-1
+1 KILL I
WRITE !!?10,"Compiled list of Errors and Warnings ",INDXDT,!
+2 FOR INDXJ=0:0
SET RTN=$ORDER(^UTILITY($JOB,RTN))
if RTN=""
QUIT
IF $DATA(^UTILITY($JOB,1,RTN,"E"))>9
WRITE !,RTN
FOR I=1:1
if '$DATA(^UTILITY($JOB,1,RTN,"E",I))
QUIT
WRITE !?3,^(I)
+3 if '$DATA(I)
WRITE !,"No errors or warnings to report",!
if 'INP(1)
GOTO END
if INP(6)
GOTO CR
+4 WRITE !!,"--- Routine Detail"
if INP(5)?1A
WRITE " --- with "_$SELECT(INP(5)["R":"REGULAR",INP(5)["S":"STRUCTURED",INP(5)["B":"R/S",1:"")_" ROUTINE LISTING"
WRITE " ---"
+5 SET RTN="$"
SET INDB="R"
BL FOR
SET RTN=$ORDER(^UTILITY($JOB,RTN))
if RTN=""!('INP(4)&(RTN?1"|"1.4L.NP))
QUIT
DO B1
DO CHK
+1 if NRO<2
GOTO END
if $DATA(IND("QUIT"))
GOTO END
GOTO CR
+2 ;
CHK IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET IND("QUIT")=1
SET ZTSTOP=1
+1 if $DATA(IND("QUIT"))
SET RTN="~"
QUIT
+2 ;
B1 if INP(5)["S"!(INP(5)["B")
DO ^%INDX8
if INP(5)["F"
DO SC
if INP(5)["S"
GOTO B2
+1 if INL(3)
DO WAIT
SET X=^UTILITY($JOB,1,RTN,0)
WRITE @IOF,!,RTN," * * ",$PIECE(X,"^",2)," Lines, ",+X," Bytes. printed on ",INDXDT,!
if 'INP(2)
GOTO B2
+2 FOR I=1:1
if '$DATA(^UTILITY($JOB,1,RTN,0,I))
QUIT
SET X=^(I,0)
SET L=$PIECE(X," ",1)
SET X=$PIECE(X," ",2,999)
FOR J=6,7:0
WRITE !,L,?J," ",$EXTRACT(X,1,INL(4)-J)
SET X=$EXTRACT(X,INL(4)-J+1,999)
SET L=""
if X=""
QUIT
B2 if 'INP(3)!('$DATA(^UTILITY($JOB,1,RTN,"E",0)))
GOTO B3
WRITE !!,"***** ERRORS & WARNINGS IN ",RTN," *****",!
+1 FOR I=1:1
if '$DATA(^UTILITY($JOB,1,RTN,"E",I))
QUIT
WRITE !?3,^(I)
B3 SET INL(5)="***** INDEX OF "_RTN_" *****"
WRITE !!,INL(5),!
+1 SET HED="Local Variables Line Occurrences ( >> not killed explicitly)"
SET HED(1)=$JUSTIFY("",40)_"( * Changed ! Killed ~ Newed)"
SET LOC="L"
SET SYM=""
DO P
+2 SET HED="Global Variables ( * Changed ! Killed)"
SET LOC="G"
SET SYM=""
DO P
+3 SET HED="Naked Globals"
SET LOC="N"
SET SYM=""
DO P
+4 SET HED="Marked Items"
SET LOC="MK"
SET SYM=""
DO P
+5 SET HED="Label References"
SET LOC="I"
SET SYM=""
DO P
+6 SET HED="External References"
SET LOC="X"
SET SYM="^"
DO P
+7 WRITE !!,"***** END *****",!
QUIT
+8 ;
P SET L=""
SET PC=""
SET TAB=$SELECT("XG"[LOC:23,1:16)
DO HD1
if $DATA(IND("QUIT"))
QUIT
P1 SET L=$ORDER(^UTILITY($JOB,1,RTN,LOC,L))
IF L=""
if PC=""
WRITE !?3,"NONE"
KILL HED
QUIT
+1 IF LOC="X"
IF L?1L.LNP
QUIT
+2 SET PC(1)=$GET(^UTILITY($JOB,1,RTN,LOC,$PIECE(L,"(")))_$SELECT("^DT^DUZ^DTIME^IO^IOF^ION^IOM^IOSL^IOST^U^"[("^"_$PIECE(L,"(")_"^"):"!",1:" ")
+3 SET PC(1)=(PC(1)["!")!(PC(1)["~")
SET PC="*"
+4 FOR J=0:1
SET X=$SELECT($DATA(^UTILITY($JOB,1,RTN,LOC,L,J)):^(J),1:"")
if X=""
QUIT
DO P2
DO P3
+5 GOTO P1
P2 IF $Y'<INL(2)
DO HD1
SET PC="*"
+1 if PC=L
QUIT
+2 IF LOC="L"
WRITE !,$SELECT(('PC(1)):">> ",1:" "),SYM,L,?TAB
QUIT
+3 IF LOC'="X"
WRITE !," ",SYM,L,?TAB
QUIT
+4 WRITE !?3,$PIECE(L," ",2),SYM,$PIECE(L," ",1)," ",?TAB
+5 QUIT
P3 if $X>TAB
WRITE !,?TAB
+1 SET PC=L
FOR I=1:1
SET ARG=$PIECE(X,",",I)
if ARG=""
QUIT
if $X>INL(1)
WRITE !?TAB
if $X'=TAB
WRITE ","
WRITE ARG
+2 QUIT
HD1 IF $Y'<INL(2)
if INL(3)
DO WAIT
WRITE @IOF,!,INL(5),!
HD2 WRITE !!,HED
if $DATA(HED(1))
WRITE !,HED(1)
+1 QUIT
CR SET INDB="C"
USE IO(0)
WRITE !!,"--- CROSS-REFERENCING ALL ROUTINES ---"
USE IO
+1 SET RTN="$"
DO CRX^%INDX5
+2 SET INL(5)="***** Cross Reference of all Routines printed "_INDXDT_" *****"
SET RTN="***"
if INL(3)
DO WAIT
WRITE @IOF,!,INL(5),!
+3 SET HED="Local Variables Routines ( >> not killed explicitly)"
SET HED(1)=$JUSTIFY("",30)_"( * Changed ! Killed ~ Newed)"
SET LOC="L"
SET SYM=""
DO P
+4 SET HED="Global Variables"
SET LOC="G"
SET SYM=""
DO P
+5 SET HED="Marked Items"
SET LOC="MK"
SET SYM=""
DO P
+6 SET HED="Routine Invokes:"
SET LOC="Z"
SET SYM=""
DO P
+7 SET HED="Routine is Invoked by:"
SET LOC="X"
SET SYM="^"
DO P
+8 WRITE !!,"***** END *****",!
GOTO END
END KILL INL,HED
QUIT
SC ;Print a command chart
+1 if INL(3)
DO WAIT
WRITE @IOF,!,RTN," Command chart"
+2 FOR I=0:0
SET I=$ORDER(^UTILITY($JOB,1,RTN,"COM",I))
if I'>0
QUIT
WRITE !,^(I)
+3 QUIT
WAIT WRITE !," Press return to continue:"
READ %:60
if %="^"
SET IND("QUIT")=1
QUIT
