source: FOIAVistA/tag/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XINDX51.m@ 1764

Last change on this file since 1764 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1XINDX51 ;ISC/REL,GRK,RWF - PRINT ROUTINE ;04/17/2002 12:42
2 ;;7.3;TOOLKIT;**20,48,61**;Apr 25, 1995
3 ;Setup Local IO paramiters
4B S RTN="$",INL(1)=IOM-2,INL(2)=IOSL-4,INL(3)="C"[$E(IOST),INL(4)=IOM-1,PG=0,INL(5)="Compiled list of Errors and Warnings "
5 K ER,HED D HD1 ;Do header
6 ;Show Errors
7 F S RTN=$O(^UTILITY($J,RTN)) Q:RTN=""!$D(IND("QUIT")) I $D(^UTILITY($J,1,RTN,"E"))>9 S HED=RTN D HD,WERR(1)
8 W:'$D(ER) !,"No errors or warnings to report",!
9 ;Did they want more?
10 G END:'INP(1)!$D(IND("QUIT")),CR:INP(6)
11 ;Show detail on each routine
12 W !!,"--- Routine Detail"
13 W:INP(5)?1A " --- with "_$S(INP(5)["R":"REGULAR",INP(5)["S":"STRUCTURED",INP(5)["B":"R/S",1:"")_" ROUTINE LISTING" W " ---"
14 S RTN="$",INDB="R" ;Report on each routine
15BL F S RTN=$O(^UTILITY($J,RTN)) Q:RTN=""!('INP(4)&(RTN?1"|"1.4L.NP))!$D(IND("QUIT")) D B1,CHK
16 G END:NRO<2,END:$D(IND("QUIT")),CR
17 ;
18 ;
19WERR(FL) ;Write error message
20 N ER2
21 F ER=1:1 Q:'$D(^UTILITY($J,1,RTN,"E",ER))!$D(IND("QUIT")) S %=^(ER) D
22 . I $Y'<INL(2) D HD K ER2
23 . D:FL&(%>0)&($G(ER2)'=+%) WORL(^UTILITY($J,1,RTN,0,+%,0)) W !?3,$P(%,$C(9),2) S ER2=+%
24 Q
25 ;
26WR ;Write one routine
27 S X=^UTILITY($J,1,RTN,0),INL(5)=$E(RTN_" ",1,8)_" * * "_$P(X,"^",2)_" Lines, "_(+X)_" Bytes" D HD1 W !,?14,$P(X,"^",3)_" bytes in comments" G:'INP(2) B2
28 F I=1:1 Q:'$D(^UTILITY($J,1,RTN,0,I)) S X=^(I,0) D
29 . D:$Y'<INL(2) HD1 I $D(IND("QUIT")) S I=99999 Q
30 . D WORL(X) ;Write routine line
31 . Q
32 Q
33 ;
34WORL(D) ;Write one routine line
35 N J,L
36 S L=$P(D," ",1),D=$P(D," ",2,999)
37 F J=6,7:0 W !,L,?J," " W:$X>8 "--",!,?7 W $E(D,1,INL(4)-J) S D=$E(D,INL(4)-J+1,999),L="" Q:D=""
38 Q
39 ;
40CHK I $D(ZTQUEUED),$$S^%ZTLOAD S IND("QUIT")=1,ZTSTOP=1
41 S:$D(IND("QUIT")) RTN="~"
42 Q
43 ;
44B1 I '$D(^UTILITY($J,1,RTN,0)) Q ;No data to show
45 D:INP(5)["S"!(INP(5)["B") ^XINDX8 ;Show structured listing
46 D:INP(5)["F" SC
47 D:INP(5)["R"!(INP(5)["B") WR ;Show normal listing
48B2 ;
49 G:'INP(3)!('$D(^UTILITY($J,1,RTN,"E",0))) B3
50 S HED="***** ERRORS & WARNINGS IN "_RTN_" *****" W !,HED
51 D WERR(0) ;Show errors
52B3 ;
53 S INL(5)="***** INDEX OF "_RTN_" *****" W !!,INL(5),!
54 S HED="Local Variables Line Occurrences ( >> not killed explicitly)",HED(1)=$J("",40)_"( * Changed ! Killed ~ Newed)" D P("L","") Q:$D(IND("QUIT"))
55 S HED="Global Variables ( * Changed ! Killed)" D P("G","") Q:$D(IND("QUIT"))
56 S HED="Naked Globals" D P("N","") Q:$D(IND("QUIT"))
57 S HED="Marked Items" D P("MK","") Q:$D(IND("QUIT"))
58 S HED="Label References" D P("I","") Q:$D(IND("QUIT"))
59 S HED="External References" D P("X","^") Q:$D(IND("QUIT"))
60 W !!,"***** END *****",!
61 Q
62 ;
63P(LOC,SYM) ;
64 S L="",PC="",TAB=$S("XG"[LOC:23,1:16) D HD Q:$D(IND("QUIT"))
65P1 S L=$O(^UTILITY($J,1,RTN,LOC,L)) G:L="" PX
66 I LOC="X",L?1L.LNP Q
67 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:" ")
68 S PC(1)=(PC(1)["!")!(PC(1)["~"),PC="*"
69 F J=0:1 S X=$S($D(^UTILITY($J,1,RTN,LOC,L,J)):^(J),1:"") Q:X=""!$D(IND("QUIT")) D P2,P3
70 G P1
71PX W:PC="" !?3,"NONE" K HED
72 Q
73P2 I $Y'<INL(2) D HD S PC="*"
74 Q:PC=L
75 I LOC="L" W !,$S(('PC(1)):">> ",1:" "),SYM,L," ",?TAB Q
76 I LOC'="X" W !," ",SYM,L,?TAB Q
77 W !?3,$P(L," ",2),SYM,$P(L," ",1)," ",?TAB
78 Q
79P3 W:$X>TAB !,?TAB
80 S PC=L F I=1:1 S ARG=$P(X,",",I) Q:ARG="" W:$X+$L(ARG)>INL(1) !?TAB W:$X'=TAB "," W ARG
81 Q
82HD D:$Y'<INL(2) HD1 D HD2
83 Q
84HD1 D WAIT:INL(3) S PG=PG+1 W @IOF,!,INL(5) W:(IOM-30)<$X ! W ?(IOM-30),INDXDT," page ",PG
85 Q
86HD2 W !!,HED W:$D(HED(1)) !,HED(1)
87 Q
88CR S INDB="C" U IO(0) W !!,"--- CROSS-REFERENCING ALL ROUTINES ---" U IO
89 S RTN="$" D CRX^XINDX5
90 S INL(5)="***** Cross Reference of all Routines *****",RTN="***" D HD1
91 S HED="Local Variables Routines ( >> not killed explicitly)",HED(1)=$J("",30)_"( * Changed ! Killed ~ Newed)" D P("L","") G:$D(IND("QUIT")) END
92 S HED="Global Variables" D P("G","") G:$D(IND("QUIT")) END
93 S HED="Naked Globals" D P("N","") Q:$D(IND("QUIT"))
94 S HED="Marked Items" D P("MK","") G:$D(IND("QUIT")) END
95 S HED="Routine Invokes:" D P("Z","") G:$D(IND("QUIT")) END
96 S HED="Routine is Invoked by:" D P("X","^")
97 W !!,"***** END *****",!
98END K INL,HED Q
99SC ;Print a command chart
100 S INL(5)=RTN_" Command chart" D HD1
101 F I=0:0 S I=$O(^UTILITY($J,1,RTN,"COM",I)) Q:I'>0 W !,^(I)
102 Q
103WAIT N % W !," Press return to continue:" R %:300 S:'$T %="^"
104 I %["?" W !,"Press return to continue the report, ^ to exit the report" G WAIT
105 S:%="^" IND("QUIT")=1 Q
Note: See TracBrowser for help on using the repository browser.