| 1 | %ZTBKC1 ;SFISC/GJL,AC - DTM BLOCK COUNT ;5/21/91 16:51
|
|---|
| 2 | ;;8.0;KERNEL;;JUL 10, 1995
|
|---|
| 3 | I '$D(%DS) D
|
|---|
| 4 | .;Comment out(after 1st .) the next 5 lines if you want to ask for the data set.
|
|---|
| 5 | .N %,%DSLIST,%DSNAM
|
|---|
| 6 | .S %DSLIST=$$^%mdslist
|
|---|
| 7 | .F %=1:1:$L(%DSLIST,",") D Q:$D(%DS)
|
|---|
| 8 | ..S %DSNAME=$P(%DSLIST,",",%)
|
|---|
| 9 | ..I $ZNSPACE_"-GBL"=$P(%DSNAME,":") S %DS=$P(%DSNAME,":",2) Q
|
|---|
| 10 | .I '$D(%DS) S %DS=$$^%dsselect,%DS=+$P(%DS,$C(22),2)
|
|---|
| 11 | ZGETPAGE %DS+2:0:0 S %B=$V(14,0,-2),(%G,%N)="",(num,tot)=0
|
|---|
| 12 | S SIZ=$P("512,1024,2048,4096,8192,16384,32768",",",$V(14,12,-1)\4#8+1)
|
|---|
| 13 | S %G=$P(X,"(")
|
|---|
| 14 | DTMDGD ;
|
|---|
| 15 | S %T=0,%N="",%L="" G DTMPTBK
|
|---|
| 16 | G EXIT
|
|---|
| 17 | DTMPTBK ZGETPAGE %DS+1:%B:0 S (%H,%J)=0,%O=24,%E=$V(14,8,-2)
|
|---|
| 18 | DTMPTLP I %O<%E G DTMPTNT
|
|---|
| 19 | S %B=$V(14,6,-2) I %B=65535 S %B=%L
|
|---|
| 20 | I %B'=65535 S:%B=%L %L="" G DTMPTBK
|
|---|
| 21 | G EXIT
|
|---|
| 22 | DTMPTNT D DTMNODE I %I=2 D DTMPTDW S %O=%O+2 G DTMPTLP
|
|---|
| 23 | I %I=1,%L="" D DTMPTDW
|
|---|
| 24 | S %B=%L,%L="" G DTMPTBK:$V(14,0,-1)'=4 S (%H,%J)=0,%T=%T-1 G DTMDTBK
|
|---|
| 25 | DTMPTDW S %L=$V(14,%O,-2) Q
|
|---|
| 26 | ;
|
|---|
| 27 | DTMDTBK ZGETPAGE %DS:%B:0 S %O=24,%E=$V(14,8,-2),%T=%T+1,%J=0
|
|---|
| 28 | ;
|
|---|
| 29 | DTMDATA I %O<%E G DTMDTNT
|
|---|
| 30 | S %B=$V(14,6,-2) I %B'=65535 G DTMDTBK
|
|---|
| 31 | G EXIT
|
|---|
| 32 | DTMDTNT S %J=%J+1 D DTMNODE I %I=1 S:%H=0 %T=%T+1 S %H=1,%O=%E G DTMDATA ;Next BLK
|
|---|
| 33 | I %I=2 S %I=$V(14,%O,-2),%O=%O+%I+2 G DTMDATA
|
|---|
| 34 | S:%J=1 %T=%T-1 G EXIT
|
|---|
| 35 | DTMNODE S %C=$V(14,%O,-1),%W=$V(14,%O+1,-1),%N=$E(%N,1,%C)_$V(14,%O+2,%W)
|
|---|
| 36 | S %F=$E(%N,$L($P(%N,$C(0)))+1,$L(%N)),%M="",%I=0,%O=%O+2+%W
|
|---|
| 37 | I %N="" S %I=2 Q
|
|---|
| 38 | I %G]$P(%N,$C(0)) S %I=2 Q
|
|---|
| 39 | I $P(%N,$C(0))]%G S %I=3 Q
|
|---|
| 40 | DTMPROC S %I=%I+1 I %I>$L(%F) G DTMTSTN
|
|---|
| 41 | S %V=$A(%F,%I) I %V=0 S %M=%M_"," G DTMPROC
|
|---|
| 42 | I %V=128 S %I=%I+1 G DTMASCI:$A(%F,%I),DTMPROC
|
|---|
| 43 | I %V=64 S %M=%M_"0" G DTMPROC
|
|---|
| 44 | I %V>64 S %S="",%V=%V-94 G DTMPOS
|
|---|
| 45 | I %V<64 S %M=%M_"-",%S="",%V=33-%V G DTMNEG
|
|---|
| 46 | W !,"ERROR",$C(7),$C(7) G DTMPROC
|
|---|
| 47 | DTMASCI S %M=%M_$E(%F,%I) I $A(%F,%I+1) S %I=%I+1 G DTMASCI ;Also zero & pos
|
|---|
| 48 | G DTMPROC
|
|---|
| 49 | DTMPOS S %I=%I+1 S %S=%S_($A(%F,%I)-17\16)_($A(%F,%I)-17#16) I $A(%F,%I+1) G DTMPOS
|
|---|
| 50 | I %V'<0,%V<$L(%S) S %S=$E(%S,0,%V)_"."_$E(%S,%V+1,$L(%S)) S %S=+%S,%M=%M_%S G DTMPROC
|
|---|
| 51 | S @("%S="_%S_"E"_(%V-$L(%S))) S %M=%M_%S G DTMPROC
|
|---|
| 52 | DTMNEG S %I=%I+1 I $A(%F,%I)'=255 S %S=%S_(239-$A(%F,%I)\16)_(239-$A(%F,%I)#16) G DTMNEG
|
|---|
| 53 | ;
|
|---|
| 54 | I %V'<0,%V<$L(%S) S %S=$E(%S,0,%V)_"."_$E(%S,%V+1,$L(%S)) S %S=+%S,%M=%M_%S G DTMPROC
|
|---|
| 55 | S @("%S="_%S_"E"_(%V-$L(%S))) S %M=%M_%S G DTMPROC
|
|---|
| 56 | ;
|
|---|
| 57 | DTMTSTN S %M=$E(%M,2,256),%S=$P(X,"(",2),%S=$P(%S,")",1) I (%S="")!(%S=%M) S %I=1 Q
|
|---|
| 58 | DTMTSTL S %X=$P(%S,",",1),%Y=$P(%M,",",1) I +%X'=%X G DTMSTR
|
|---|
| 59 | I %Y="" S %I=2 Q
|
|---|
| 60 | I +%Y'=%Y S %I=3 Q
|
|---|
| 61 | I %X>%Y S %I=2 Q
|
|---|
| 62 | I %X<%Y S %I=3 Q
|
|---|
| 63 | DTMTSTC S %S=$P(%S,",",2,256) I %S="" S %I=1 Q
|
|---|
| 64 | S %M=$P(%M,",",2,256) I %M="" S %I=2 Q
|
|---|
| 65 | G DTMTSTL
|
|---|
| 66 | DTMSTR I +%Y=%Y S %I=2 Q
|
|---|
| 67 | I %X]%Y S %I=2 Q
|
|---|
| 68 | I %X'=%Y S %I=3 Q
|
|---|
| 69 | G DTMTSTC
|
|---|
| 70 | ALL ;All globals from current directory.
|
|---|
| 71 | S %DS=$$^%dsselect
|
|---|
| 72 | S %DS=+$P(%DS,$C(22),2)
|
|---|
| 73 | K ^UTILITY("%ZTBKC",$J) X ^%ZOSF("UCI") W !!,Y," " S %SK=$X+1 W "Globals",?(%SK+12),"Data Pages"
|
|---|
| 74 | W ?(%SK+34) D NOW^%DTC S X=%,%DT="ET" D ^%DT W !
|
|---|
| 75 | ZGETPAGE %DS+2:0:0 S %B=$V(14,0,-2),(%G,%N,%OR,%R)="",(num,tot)=0
|
|---|
| 76 | S SIZ=$P("512,1024,2048,4096,8192,16384,32768",",",$V(14,12,-1)\4#8+1)
|
|---|
| 77 | F ZGETPAGE %DS+1:%B:0 Q:$V(14,0,-1)=4 S %B=$V(14,26,-2)
|
|---|
| 78 | S %E=$V(14,8,-2),%O=24
|
|---|
| 79 | ADTMVUE ZGETPAGE %DS+1:%B:0 S %G="",%E=$V(14,8,-2),%O=24
|
|---|
| 80 | ADTMNXT G ADTMPTR:%E'>%O
|
|---|
| 81 | ADTMLOP S %C=$V(14,%O,-1),%W=$V(14,%O+1,-1),%G=$E(%G,1,%C)_$V(14,%O+2,%W)
|
|---|
| 82 | S:%C!%W %OR=%R,%R=$V(14,%O+%W+2,-2)
|
|---|
| 83 | I $P(%G,$C(0))'=%N D ADTMDATA:$L(%N)&(%OR]"") ZGETPAGE %DS+1:%B:0 S %N=$P(%G,$C(0))
|
|---|
| 84 | S %O=%O+4+%W G ADTMNXT
|
|---|
| 85 | ADTMDATA ;
|
|---|
| 86 | N %G,%B,%E,%O,%C,%W S %LD=0
|
|---|
| 87 | ZGETPAGE %DS:%OR:0 S %G="",%E=$V(14,8,-2),%O=24
|
|---|
| 88 | ADTMDTNT I %E'>%O S:$L(%N) ^UTILITY("%ZTBKC",$J,%N)="" S %N=$P(%G,$C(0)) Q
|
|---|
| 89 | S %C=$V(14,%O,-1),%W=$V(14,%O+1,-1),%G=$E(%G,1,%C)_$V(14,%O+2,%W)
|
|---|
| 90 | S:%C!%W %LD=$V(14,%O+%W+2,-2)
|
|---|
| 91 | I $P(%G,$C(0))'=%N S:$L(%N) ^UTILITY("%ZTBKC",$J,%N)="" S %N=$P(%G,$C(0))
|
|---|
| 92 | S %O=%O+4+%W+%LD G ADTMDTNT
|
|---|
| 93 | ADTMPTR S %B=$V(14,6,-2) I %B'=65535 G ADTMVUE
|
|---|
| 94 | S:$L(%N) ^UTILITY("%ZTBKC",$J,%N)="" S %N=$P(%G,$C(0))
|
|---|
| 95 | S %OR=%R D ADTMDATA:$L(%N)&(%OR]"")
|
|---|
| 96 | DONE zrelpage
|
|---|
| 97 | K %BLK,%END,%MM,%NAM,%PT,%S,%STB,%SYS,%UCI,%UCIN,%UCN,%UCNUM
|
|---|
| 98 | S (%TOT,%GLO)=0 F %II=1:1 S X=$O(^UTILITY("%ZTBKC",$J,%GLO)),%GLO=X Q:X="" W !,?%SK,X,?(%SK+15) S:X?1"^".E X=$E(X,2,255) S %T=-1 D %ZTBKC1 S X=%T S:X>0 %TOT=%TOT+X W:X<0 "-- no such global --" W:X'<0 X
|
|---|
| 99 | W !!?%SK,"Total",?(%SK+15),%TOT K %GLO,%II,%SK,%TOT,X,Y,^UTILITY("%ZTBKC",$J)
|
|---|
| 100 | K %T
|
|---|
| 101 | EXIT K %,%A,%B,%C,%D,%DT,%E,%F,%G,%H,%I,%J,%K,%L,%M,%N,%O,%S,%UT,%V,%W,%X,%Y,%Z,A
|
|---|
| 102 | Q
|
|---|
