- %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
- %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
- READ %:60
- IF %="^"
- SET IND("QUIT")=1
- QUIT
