source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZTBKC.m@ 1569

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1%ZTBKC ;SF/GJL - GLOBAL BLOCK COUNT ;05/24/2007 686246.738699
2 ;;7.3;TOOLKIT;**80**;Apr 25, 1995;Build 6
3 ;
4 ;X = FULL Global Reference: NAME(SUB1,...,SUBn)
5 ;
6 N %ZIS,DIRUT,DTOUT,DUOUT,POP
7 S U="^",%BS="",XX1=0 K ^XUTL($J)
8 I $P($G(^%ZOSF("OS")),"^")["OpenM-NT" N %ZTBKVER D G QUIT:$G(%ZTBKVER)']""!$D(DUOUT)!$D(DIRUT)
9 . S %ZTBKVER=$P($$VERSION^%ZOSV,".",1,2)
10 . I %ZTBKVER="5.0"!(%ZTBKVER'<5.2) D ASKDIR^%ZTBKC1 Q
11 . W !,"This version of the Block Count Utility does not support this version of Cache'"
12 . S %ZTBKVER=""
13READ W !!,"Block Count for Global ^" I %BS]"" W %BS,"//"
14 R X:$S($D(DTIME):DTIME,1:300),! G:'$T!(X="^") QUIT I X="" S X=%BS
15STRIP I (X?1"^".E)!(X?1" ".E) S X=$E(X,2,256) G STRIP
16 I X="" G READY
17 I X="*" S ZTBKCALL=1 G READY
18 I X["*" W !,$C(7),"Wild cards not allowed as part of the global name." G SYNTAX
19 I X?1"??".E D QQ G READ
20 I X?1"?".E G SYNTAX
21 I X?1"(".E S %BS="" G SYNTAX
22 I $P(X,"(")'?.1"^".1"%"1A.AN W !,$C(7),"Only alphanumerics are allowed in global names." G SYNTAX
23 I $L(X,"(")>1,$E(X,$L(X))'=")" G SYNTAX
24 I $L(X,"(")>1,$P($E(X,1,$L(X)-1),"(",2,255)']"" G SYNTAX
25 S %T=X,%Z=1 F %A=1:1 Q:$E(%T,%A)="" I $E(%T,%A)="""" D QUOTES
26 I %Z-1 G SYNTAX2
27 S %BS=X,X=U_%T,Y=$D(@(U_%BS)) W $S(Y=0:" doesn't exist.",1:"OK") I Y S XX1=XX1+1,^XUTL($J,XX1)=%BS_X
28 S %BS="" G READ
29QUOTES I ((%Z=0)&($E(%T,%A+1)="""")) S %T=$E(%T,0,%A)_$E(%T,%A+2,999)
30 E S %T=$E(%T,0,%A-1)_$E(%T,%A+1,999),%A=%A-1,%Z=1-%Z
31 Q
32SYNTAX W !,"Enter: * for all globals in current directory, or"
33 W !,"Enter: a FULL Global Reference, e.g. ^DD(3,""GL""), or"
34 W !," ^ " W:%BS="" "or NULL " W "to quit."
35 W !!,"Enter: ? for this help, or"
36 W !," ?? for more help."
37 G READ
38SYNTAX2 W !,?5,"I'm sorry, but I don't understand your use of quotes."
39 W !,"Please surround string subscripts with quotes and any quote"
40 W !,"which is a part of the subscript should be doubled."
41 G READ
42QQ ;Double question mark response
43 K DIR S DIR(0)="SO^S:Show current selection"
44 S DIR(0)=DIR(0)_";D:De-select from current selection"
45 S DIR(0)=DIR(0)_";M:More help"
46 D ^DIR
47 I Y="S" D SHOW G QQ
48 I Y="D" D DSEL G QQ
49 I Y="M" D XTNDHELP G QQ
50 Q
51SHOW ;Show current selection
52 I '$D(IOF) D HOME^%ZIS
53 I $O(^XUTL($J,0))'>0 D Q
54 . W !!,?20,"You have not selected any globals.",!
55 . K DIR S DIR(0)="E" D ^DIR
56 W @IOF,!,"You have selected the following globals:",!
57 S %U="" F %I=1:1 S %A=$G(^XUTL($J,%I)) Q:%A="" D
58 . W !,?8,"^"_$P(%A,U)
59 K DIR S DIR(0)="E" D ^DIR
60 Q
61DSEL ;Ask directory
62 N ZTBKCLST
63 I $O(^XUTL($J,0))'>0 D Q
64 . W !!,?20,"You have not selected any globals.",!
65 . K DIR S DIR(0)="E" D ^DIR
66 K DIR S DIR("A",1)="To de-select from the selected globals:"
67 S %U="" F %I=1:1 S %A=$G(^XUTL($J,%I)) Q:%A="" D
68 . S DIR("A",%I+1)=$J("",3)_$J(%I,3)_$J("^",7)_$P(%A,U)
69 . S ZTBKCLST(%I)=%A
70 S DIR("A")="Enter a list or a range of numbers: "
71 S DIR(0)="L^"_"1:"_(%I-1)
72 W ! D ^DIR
73 Q:$D(DTOUT)!$D(DIRUT)
74 W !
75 F %I=1:1 S %A=$P(Y,",",%I) Q:%A']"" Q:(%A'=+%A) K ZTBKCLST(%A) W "."
76 S %A=$O(ZTBKCLST("")) I %A="" D Q
77 . F %I=0:0 S %I=$O(^XUTL($J,%I)) Q:%I'>0 Q:%I'=+%I K ^XUTL($J,%I)
78 . S XX1=0
79 F %I=1:1 Q:%A']""&($G(^XUTL($J,%I))']"") D
80 . I %A]"" S ^XUTL($J,%I)=ZTBKCLST(%A),%A=$O(ZTBKCLST(%A))
81 . E K ^XUTL($J,%I)
82 S XX1=$O(XUTL($J,"@"),-1) I XX1'=+XX1 S XX1=0
83 Q
84XTNDHELP ;Extended help
85 I '$D(IOF) D HOME^%ZIS
86 W @IOF,!,?35,"More Help",!
87 W !,?10,"Globals that contain commas in subscripts may not produce accurate"
88 W !,?10,"block counts. Also, avoid specifying full global references"
89 W !,?10,"that contain commas in the subscripts when entering globals"
90 W !,?10,"at the 'Block Count for Global ^' prompt."
91 W !,?10,""
92 W !,?10,"After entering a double question mark ('??') response to the"
93 W !,?10,"'Block Count for Global ^' prompt, enter 'S' for a listing"
94 W !,?10,"of globals selected or 'D' to de-select globals from this list."
95 W ! K DIR S DIR(0)="E" D ^DIR
96 Q
97READY I '$D(ZTBKCALL),$O(^XUTL($J,0))'>0 D G QUIT
98 . W !!,?20,"No globals have been selected!!!",!
99 W !,"Output results on" S %ZIS="Q" D ^%ZIS G QUIT:POP
100 I $D(IO("Q")) S ZTRTN=$S($D(ZTBKCALL):"ALL^%ZTBKC1",1:"DQ^%ZTBKC"),ZTDESC="Global block count",ZTSAVE("^XUTL($J,")="" D ^%ZTLOAD K ZTSK U IO(0) D ^%ZISC K ZTRTN,ZTDESC,ZTSAVE G QUIT
101 I $D(ZTBKCALL) U IO D ALL^%ZTBKC1 U IO(0) D ^%ZISC G QUIT
102DQ ;
103 U IO F XX1=0:0 S XX1=$O(^XUTL($J,XX1)) Q:XX1'>0 S %T=^(XX1),%BS=$P(%T,U,1),X=$P(%T,U,2) W !,"Global ^",%BS D ENCOUNT W $S(X'>0:" doesn't exist",1:" has "_X_" data block") W:X>1 "s"
104QUIT U:$D(IO(0))#2 IO(0) D ^%ZISC K DIR,X,XX1,Y,ZTBKCALL,%A,%I,%T,%U,%Z,%BS I $D(ZTQUEUED) S ZTREQ="@"
105 Q
106ALL ;All Globals in Directory
107 S %A=$P(^%ZOSF("OS"),"^",1)
108 D ALL^%ZTBKC1 G ALLEXIT
109 ;I %A="DSM-3" D ALL^%ZTBKC1 G ALLEXIT
110 ;I %A="M/11" D ALLM11 G ALLEXIT
111 ;I %A="M/11+" D ALL^%ZTBKC1 G ALLEXIT
112 ;I %A="M/VX" D ALL^%ZTBKC1 G ALLEXIT
113 ;I %A["MSM" D ALL^%ZTBKC1 G ALLEXIT
114 ;I %A["VAX DSM" G ALL^%ZTBKC1
115ALLEXIT K %A
116 Q
117ALLM11 ;Directory at
118 W $C(7)," NOT AVAILABLE!!!!"
119 Q
120ENCOUNT ; X = Full Global Reference: NAME(SUB1,...,SUBn)
121 ; Surrounding/doubled quotes should have been removed from subscripts
122 ; The count is not accurate for subscripts containing commas
123 S %T=-1,%A=$P(^%ZOSF("OS"),"^") I X?1"^".E S X=$E(X,2,255)
124 D ^%ZTBKC1
125 ;I "^MSM-UNIX^MSM-PC^VAX DSM(V5)^DSM-3^M/11^M/11+^M/VX^"[("^"_%A_"^") D ^%ZTBKC1
126EXIT S X=%T K %A,%T
127 Q
Note: See TracBrowser for help on using the repository browser.