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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1XUCSXGR ;CLKS/SO Rank Global Access/sec High to Low ;4/11/96 05:57
2 ;;7.3;Toolkit;**14**;Jan 26, 1996
3ALL ; Entry Point to lump accesses as if a single VG
4 D GDATE
5 I XUCSEND G XIT
6 S XUCSALL="ALL"
7 G GETIO
8VG ; Entry Point split accesses by VG
9 D GDATE
10 I XUCSEND G XIT
11GETIO ; Get I/O Device
12 I XUCSEND G XIT
13 S %ZIS="MQ" D ^%ZIS I POP D HOME^%ZIS G XIT
14 I $D(IO("Q")) D G XIT
15 . S ZTRTN="DEQUE^XUCSXGR",ZTDESC="GLOBAL ACCESS RANKING",ZTSAVE("XUCS*")=""
16 . S %DT="AEFRX",%DT("A")="Queue for what Date/Time: ",%DT("B")="Now",%DT(0)="NOW" D ^%DT K %DT
17 . I +Y'<0 S ZTDTH=Y D ^%ZTLOAD,HOME^%ZIS
18 . K ZTRTN,ZTDESC,ZTDTH,ZTSAVE,IO("Q")
19 U IO D:$E(IOST)="C" WAIT^DICD
20DEQUE ;
21 K ^TMP($J)
22REMOVE ; Remove *FS*
23 S XX2=""
24 S XUCSTBL=""
25 F S XX2=$O(^XUCS(8987.2,"B",XX2)) Q:XX2="" D
26 . I XX2["FS" Q
27 . S XUCSTBL(+$O(^XUCS(8987.2,"B",XX2,"")))=""
28GETRAW ; Now Loop thru XUCS(8987.2,"C",<date/time>,<.01ien>,<sub-ien>
29 S XET=0 ; initialize Elapse Time counter
30 S XX1=XUCSBD-1
31 F S XX1=$O(^XUCS(8987.2,"C",XX1)) Q:+XX1<1!($P(XX1,".")>XUCSED) D
32 . S XD0=0 ; equals D0
33 . F S XD0=$O(^XUCS(8987.2,"C",+XX1,XD0)) Q:+XD0<1 D
34 .. I '$D(XUCSTBL(+XD0))#2 Q ; Not a CS* or PS*
35 .. S XD1=0 ; equals D1
36 .. F S XD1=$O(^XUCS(8987.2,"C",+XX1,+XD0,XD1)) Q:+XD1<1 D
37 ... I '$D(^XUCS(8987.2,+XD0,1,+XD1,2,0))#2 Q ; no global info
38 ... S XET=XET+$P(^XUCS(8987.2,+XD0,1,+XD1,0),U,3)
39 ... S XD2=0 ; equals D2
40 ... F S XD2=$O(^XUCS(8987.2,+XD0,1,+XD1,2,XD2)) Q:+XD2<1 S XXS=^(+XD2,0) D
41 .... ;TMP($J,"XUCS-RAW",<uci>_","_<vg>,<gbl name>)=tot ref.
42 .... S XX2=$P(XXS,U,2)_","_$S($D(XUCSALL):XUCSALL,$P(XXS,U,7)'="":$P(XXS,U,7),1:"xxx"),XX3=$P(XXS,U,1)
43 .... I '$D(^TMP($J,"XUCS-RAW",XX2,XX3))#2 S ^TMP($J,"XUCS-RAW",XX2,XX3)=""
44 .... S ^TMP($J,"XUCS-RAW",XX2,XX3)=^TMP($J,"XUCS-RAW",XX2,XX3)+$P(XXS,U,4)
45 .... K XXS,XX2,XX3
46ORDER ; Order by References/sec low to high
47 N UCIVG,GBL,RATE
48 S UCIVG="" ; <uci>_","_<vg>
49 F S UCIVG=$O(^TMP($J,"XUCS-RAW",UCIVG)) Q:UCIVG="" D
50 . S GBL="" ; <global name>
51 . F S GBL=$O(^TMP($J,"XUCS-RAW",UCIVG,GBL)) Q:GBL="" S XX1=^(GBL) D
52 .. S RATE=XX1/XET,RATE=+$J(RATE,0,1)
53 .. ; TMP($J,"XUCS-ORDERED",<uci>_","_<vg>,<ref/sec>,<global name>
54 .. S ^TMP($J,"XUCS-ORDERED",UCIVG,RATE,GBL)=""
55 .. K XX1,RATE
56REPORT ; Print the report
57 S (PAGE,COL,ROW)=1
58 S PGLEN=IOSL-5
59 S UCIVG="" ; <uci>_","_<vg>
60 F S UCIVG=$O(^TMP($J,"XUCS-ORDERED",UCIVG)) Q:UCIVG="" D SUBHDR D
61 . S RATE=999999 ; Global access rate/sec
62 . F S RATE=$O(^TMP($J,"XUCS-ORDERED",UCIVG,RATE),-1) Q:+RATE<.1 D
63 .. S GBL="" ; <global name>
64 .. F S GBL=$O(^TMP($J,"XUCS-ORDERED",UCIVG,RATE,GBL)) Q:GBL="" D
65 ... N X
66 ... S X=" ",GBLX=$S($L(GBL)<8:GBL_$E(X,($L(GBL)+1),8),1:GBL)
67 ... I '$D(A(PAGE,ROW)) S A(PAGE,ROW)=""
68 ... S A(PAGE,ROW)=A(PAGE,ROW)_GBLX_$J(RATE,6,1)_" " D POS
69PRINT ; Print Report
70 S PAGE=0
71 F S PAGE=$O(A(PAGE)) Q:PAGE="" D:PAGE>1 PAUSE^XUCSUTL I 'XUCSEND D HDR D
72 . S ROW=0
73 . F S ROW=$O(A(PAGE,ROW)) Q:ROW="" W !,A(PAGE,ROW)
74XIT ; Common eXIT Point
75 I '$D(ZTQUEUED),$E(IOST)="P" D ^%ZISC
76 K ^TMP($J)
77 K A,COL,GBL,GBLX,HDR,HDRX,PAGE,PGLEN,RATE,RDT,ROW,UCIVG
78 K X1,X2,XD0,XD1,XD2,XET,XUCSDAYS,XUCSEND,XUCSALL,XUCSTBL,XUCSNOA2,XUCSBD,XUCSED
79 K XX1,XX2,XX3,XXS
80 Q
81HDR ; Print Header Subroutine
82 W:$D(HDR) @IOF
83 I '$D(HDR) S HDR=1 D NOW^%DTC S Y=% D DD^%DT S RDT=$P(Y,"@")_"@"_$P($P(Y,":",1,2),"@",2) W:$E(IOST)="C" @IOF
84 W !,"Global Access/Sec. Ranking Report",?(IOM-10),"Page: ",PAGE
85 W !,"From: ",$E(XUCSBD,4,5)_"/"_$E(XUCSBD,6,7)_"/"_$E(XUCSBD,2,3)," To: ",$E(XUCSED,4,5)_"/"_$E(XUCSED,6,7)_"/"_$E(XUCSED,2,3)," (",XUCSDAYS," day",$S(XUCSDAYS>1:"s",1:""),")",?(IOM-20),RDT
86 S HDRX="",$P(HDRX,"-",IOM)="" W !,HDRX
87 Q
88SUBHDR ; Change of UCI subheader
89 I '$D(A(PAGE,ROW)) S A(PAGE,ROW)=""
90 S A(PAGE,ROW)=A(PAGE,ROW)_" "_$P(UCIVG,",")_$S($P(UCIVG,",",2)'="ALL":","_$P(UCIVG,",",2)_" ",1:" ")_" " D POS
91 Q
92POS ; Position on Spread Sheet
93 S ROW=ROW+1
94 I ROW>PGLEN S ROW=1 D
95 . S COL=COL+1
96 . I COL>4 S PAGE=PAGE+1,COL=1
97 . D SUBHDR
98 Q
99GDATE ; Get Date Range
100 S XUCSEND=0
101 S XUCSNOA2=1 D A3^XUCSUTL3
102 I XUCSEND Q
103 S X1=XUCSBD,X2=XUCSED D ^%DTC S:X<0 X=X*(-1)
104 S XUCSDAYS=X+1
105 Q
Note: See TracBrowser for help on using the repository browser.