XUCSXGR ;CLKS/SO Rank Global Access/sec High to Low ;4/11/96 05:57
;;7.3;Toolkit;**14**;Jan 26, 1996
ALL ; Entry Point to lump accesses as if a single VG
D GDATE
I XUCSEND G XIT
S XUCSALL="ALL"
G GETIO
VG ; Entry Point split accesses by VG
D GDATE
I XUCSEND G XIT
GETIO ; Get I/O Device
I XUCSEND G XIT
S %ZIS="MQ" D ^%ZIS I POP D HOME^%ZIS G XIT
I $D(IO("Q")) D G XIT
. S ZTRTN="DEQUE^XUCSXGR",ZTDESC="GLOBAL ACCESS RANKING",ZTSAVE("XUCS*")=""
. S %DT="AEFRX",%DT("A")="Queue for what Date/Time: ",%DT("B")="Now",%DT(0)="NOW" D ^%DT K %DT
. I +Y'<0 S ZTDTH=Y D ^%ZTLOAD,HOME^%ZIS
. K ZTRTN,ZTDESC,ZTDTH,ZTSAVE,IO("Q")
U IO D:$E(IOST)="C" WAIT^DICD
DEQUE ;
K ^TMP($J)
REMOVE ; Remove *FS*
S XX2=""
S XUCSTBL=""
F S XX2=$O(^XUCS(8987.2,"B",XX2)) Q:XX2="" D
. I XX2["FS" Q
. S XUCSTBL(+$O(^XUCS(8987.2,"B",XX2,"")))=""
GETRAW ; Now Loop thru XUCS(8987.2,"C",<date/time>,<.01ien>,<sub-ien>
S XET=0 ; initialize Elapse Time counter
S XX1=XUCSBD-1
F S XX1=$O(^XUCS(8987.2,"C",XX1)) Q:+XX1<1!($P(XX1,".")>XUCSED) D
. S XD0=0 ; equals D0
. F S XD0=$O(^XUCS(8987.2,"C",+XX1,XD0)) Q:+XD0<1 D
.. I '$D(XUCSTBL(+XD0))#2 Q ; Not a CS* or PS*
.. S XD1=0 ; equals D1
.. F S XD1=$O(^XUCS(8987.2,"C",+XX1,+XD0,XD1)) Q:+XD1<1 D
... I '$D(^XUCS(8987.2,+XD0,1,+XD1,2,0))#2 Q ; no global info
... S XET=XET+$P(^XUCS(8987.2,+XD0,1,+XD1,0),U,3)
... S XD2=0 ; equals D2
... F S XD2=$O(^XUCS(8987.2,+XD0,1,+XD1,2,XD2)) Q:+XD2<1 S XXS=^(+XD2,0) D
.... ;TMP($J,"XUCS-RAW",<uci>_","_<vg>,<gbl name>)=tot ref.
.... 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)
.... I '$D(^TMP($J,"XUCS-RAW",XX2,XX3))#2 S ^TMP($J,"XUCS-RAW",XX2,XX3)=""
.... S ^TMP($J,"XUCS-RAW",XX2,XX3)=^TMP($J,"XUCS-RAW",XX2,XX3)+$P(XXS,U,4)
.... K XXS,XX2,XX3
ORDER ; Order by References/sec low to high
N UCIVG,GBL,RATE
S UCIVG="" ; <uci>_","_<vg>
F S UCIVG=$O(^TMP($J,"XUCS-RAW",UCIVG)) Q:UCIVG="" D
. S GBL="" ; <global name>
. F S GBL=$O(^TMP($J,"XUCS-RAW",UCIVG,GBL)) Q:GBL="" S XX1=^(GBL) D
.. S RATE=XX1/XET,RATE=+$J(RATE,0,1)
.. ; TMP($J,"XUCS-ORDERED",<uci>_","_<vg>,<ref/sec>,<global name>
.. S ^TMP($J,"XUCS-ORDERED",UCIVG,RATE,GBL)=""
.. K XX1,RATE
REPORT ; Print the report
S (PAGE,COL,ROW)=1
S PGLEN=IOSL-5
S UCIVG="" ; <uci>_","_<vg>
F S UCIVG=$O(^TMP($J,"XUCS-ORDERED",UCIVG)) Q:UCIVG="" D SUBHDR D
. S RATE=999999 ; Global access rate/sec
. F S RATE=$O(^TMP($J,"XUCS-ORDERED",UCIVG,RATE),-1) Q:+RATE<.1 D
.. S GBL="" ; <global name>
.. F S GBL=$O(^TMP($J,"XUCS-ORDERED",UCIVG,RATE,GBL)) Q:GBL="" D
... N X
... S X=" ",GBLX=$S($L(GBL)<8:GBL_$E(X,($L(GBL)+1),8),1:GBL)
... I '$D(A(PAGE,ROW)) S A(PAGE,ROW)=""
... S A(PAGE,ROW)=A(PAGE,ROW)_GBLX_$J(RATE,6,1)_" " D POS
PRINT ; Print Report
S PAGE=0
F S PAGE=$O(A(PAGE)) Q:PAGE="" D:PAGE>1 PAUSE^XUCSUTL I 'XUCSEND D HDR D
. S ROW=0
. F S ROW=$O(A(PAGE,ROW)) Q:ROW="" W !,A(PAGE,ROW)
XIT ; Common eXIT Point
I '$D(ZTQUEUED),$E(IOST)="P" D ^%ZISC
K ^TMP($J)
K A,COL,GBL,GBLX,HDR,HDRX,PAGE,PGLEN,RATE,RDT,ROW,UCIVG
K X1,X2,XD0,XD1,XD2,XET,XUCSDAYS,XUCSEND,XUCSALL,XUCSTBL,XUCSNOA2,XUCSBD,XUCSED
K XX1,XX2,XX3,XXS
Q
HDR ; Print Header Subroutine
W:$D(HDR) @IOF
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
W !,"Global Access/Sec. Ranking Report",?(IOM-10),"Page: ",PAGE
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
S HDRX="",$P(HDRX,"-",IOM)="" W !,HDRX
Q
SUBHDR ; Change of UCI subheader
I '$D(A(PAGE,ROW)) S A(PAGE,ROW)=""
S A(PAGE,ROW)=A(PAGE,ROW)_" "_$P(UCIVG,",")_$S($P(UCIVG,",",2)'="ALL":","_$P(UCIVG,",",2)_" ",1:" ")_" " D POS
Q
POS ; Position on Spread Sheet
S ROW=ROW+1
I ROW>PGLEN S ROW=1 D
. S COL=COL+1
. I COL>4 S PAGE=PAGE+1,COL=1
. D SUBHDR
Q
GDATE ; Get Date Range
S XUCSEND=0
S XUCSNOA2=1 D A3^XUCSUTL3
I XUCSEND Q
S X1=XUCSBD,X2=XUCSED D ^%DTC S:X<0 X=X*(-1)
S XUCSDAYS=X+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUCSXGR 4203 printed Dec 13, 2024@02:42:25 Page 2
XUCSXGR ;CLKS/SO Rank Global Access/sec High to Low ;4/11/96 05:57
+1 ;;7.3;Toolkit;**14**;Jan 26, 1996
ALL ; Entry Point to lump accesses as if a single VG
+1 DO GDATE
+2 IF XUCSEND
GOTO XIT
+3 SET XUCSALL="ALL"
+4 GOTO GETIO
VG ; Entry Point split accesses by VG
+1 DO GDATE
+2 IF XUCSEND
GOTO XIT
GETIO ; Get I/O Device
+1 IF XUCSEND
GOTO XIT
+2 SET %ZIS="MQ"
DO ^%ZIS
IF POP
DO HOME^%ZIS
GOTO XIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="DEQUE^XUCSXGR"
SET ZTDESC="GLOBAL ACCESS RANKING"
SET ZTSAVE("XUCS*")=""
+5 SET %DT="AEFRX"
SET %DT("A")="Queue for what Date/Time: "
SET %DT("B")="Now"
SET %DT(0)="NOW"
DO ^%DT
KILL %DT
+6 IF +Y'<0
SET ZTDTH=Y
DO ^%ZTLOAD
DO HOME^%ZIS
+7 KILL ZTRTN,ZTDESC,ZTDTH,ZTSAVE,IO("Q")
End DoDot:1
GOTO XIT
+8 USE IO
if $EXTRACT(IOST)="C"
DO WAIT^DICD
DEQUE ;
+1 KILL ^TMP($JOB)
REMOVE ; Remove *FS*
+1 SET XX2=""
+2 SET XUCSTBL=""
+3 FOR
SET XX2=$ORDER(^XUCS(8987.2,"B",XX2))
if XX2=""
QUIT
Begin DoDot:1
+4 IF XX2["FS"
QUIT
+5 SET XUCSTBL(+$ORDER(^XUCS(8987.2,"B",XX2,"")))=""
End DoDot:1
GETRAW ; Now Loop thru XUCS(8987.2,"C",<date/time>,<.01ien>,<sub-ien>
+1 ; initialize Elapse Time counter
SET XET=0
+2 SET XX1=XUCSBD-1
+3 FOR
SET XX1=$ORDER(^XUCS(8987.2,"C",XX1))
if +XX1<1!($PIECE(XX1,".")>XUCSED)
QUIT
Begin DoDot:1
+4 ; equals D0
SET XD0=0
+5 FOR
SET XD0=$ORDER(^XUCS(8987.2,"C",+XX1,XD0))
if +XD0<1
QUIT
Begin DoDot:2
+6 ; Not a CS* or PS*
IF '$DATA(XUCSTBL(+XD0))#2
QUIT
+7 ; equals D1
SET XD1=0
+8 FOR
SET XD1=$ORDER(^XUCS(8987.2,"C",+XX1,+XD0,XD1))
if +XD1<1
QUIT
Begin DoDot:3
+9 ; no global info
IF '$DATA(^XUCS(8987.2,+XD0,1,+XD1,2,0))#2
QUIT
+10 SET XET=XET+$PIECE(^XUCS(8987.2,+XD0,1,+XD1,0),U,3)
+11 ; equals D2
SET XD2=0
+12 FOR
SET XD2=$ORDER(^XUCS(8987.2,+XD0,1,+XD1,2,XD2))
if +XD2<1
QUIT
SET XXS=^(+XD2,0)
Begin DoDot:4
+13 ;TMP($J,"XUCS-RAW",<uci>_","_<vg>,<gbl name>)=tot ref.
+14 SET XX2=$PIECE(XXS,U,2)_","_$SELECT($DATA(XUCSALL):XUCSALL,$PIECE(XXS,U,7)'="":$PIECE(XXS,U,7),1:"xxx")
SET XX3=$PIECE(XXS,U,1)
+15 IF '$DATA(^TMP($JOB,"XUCS-RAW",XX2,XX3))#2
SET ^TMP($JOB,"XUCS-RAW",XX2,XX3)=""
+16 SET ^TMP($JOB,"XUCS-RAW",XX2,XX3)=^TMP($JOB,"XUCS-RAW",XX2,XX3)+$PIECE(XXS,U,4)
+17 KILL XXS,XX2,XX3
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
ORDER ; Order by References/sec low to high
+1 NEW UCIVG,GBL,RATE
+2 ; <uci>_","_<vg>
SET UCIVG=""
+3 FOR
SET UCIVG=$ORDER(^TMP($JOB,"XUCS-RAW",UCIVG))
if UCIVG=""
QUIT
Begin DoDot:1
+4 ; <global name>
SET GBL=""
+5 FOR
SET GBL=$ORDER(^TMP($JOB,"XUCS-RAW",UCIVG,GBL))
if GBL=""
QUIT
SET XX1=^(GBL)
Begin DoDot:2
+6 SET RATE=XX1/XET
SET RATE=+$JUSTIFY(RATE,0,1)
+7 ; TMP($J,"XUCS-ORDERED",<uci>_","_<vg>,<ref/sec>,<global name>
+8 SET ^TMP($JOB,"XUCS-ORDERED",UCIVG,RATE,GBL)=""
+9 KILL XX1,RATE
End DoDot:2
End DoDot:1
REPORT ; Print the report
+1 SET (PAGE,COL,ROW)=1
+2 SET PGLEN=IOSL-5
+3 ; <uci>_","_<vg>
SET UCIVG=""
+4 FOR
SET UCIVG=$ORDER(^TMP($JOB,"XUCS-ORDERED",UCIVG))
if UCIVG=""
QUIT
DO SUBHDR
Begin DoDot:1
+5 ; Global access rate/sec
SET RATE=999999
+6 FOR
SET RATE=$ORDER(^TMP($JOB,"XUCS-ORDERED",UCIVG,RATE),-1)
if +RATE<.1
QUIT
Begin DoDot:2
+7 ; <global name>
SET GBL=""
+8 FOR
SET GBL=$ORDER(^TMP($JOB,"XUCS-ORDERED",UCIVG,RATE,GBL))
if GBL=""
QUIT
Begin DoDot:3
+9 NEW X
+10 SET X=" "
SET GBLX=$SELECT($LENGTH(GBL)<8:GBL_$EXTRACT(X,($LENGTH(GBL)+1),8),1:GBL)
+11 IF '$DATA(A(PAGE,ROW))
SET A(PAGE,ROW)=""
+12 SET A(PAGE,ROW)=A(PAGE,ROW)_GBLX_$JUSTIFY(RATE,6,1)_" "
DO POS
End DoDot:3
End DoDot:2
End DoDot:1
PRINT ; Print Report
+1 SET PAGE=0
+2 FOR
SET PAGE=$ORDER(A(PAGE))
if PAGE=""
QUIT
if PAGE>1
DO PAUSE^XUCSUTL
IF 'XUCSEND
DO HDR
Begin DoDot:1
+3 SET ROW=0
+4 FOR
SET ROW=$ORDER(A(PAGE,ROW))
if ROW=""
QUIT
WRITE !,A(PAGE,ROW)
End DoDot:1
XIT ; Common eXIT Point
+1 IF '$DATA(ZTQUEUED)
IF $EXTRACT(IOST)="P"
DO ^%ZISC
+2 KILL ^TMP($JOB)
+3 KILL A,COL,GBL,GBLX,HDR,HDRX,PAGE,PGLEN,RATE,RDT,ROW,UCIVG
+4 KILL X1,X2,XD0,XD1,XD2,XET,XUCSDAYS,XUCSEND,XUCSALL,XUCSTBL,XUCSNOA2,XUCSBD,XUCSED
+5 KILL XX1,XX2,XX3,XXS
+6 QUIT
HDR ; Print Header Subroutine
+1 if $DATA(HDR)
WRITE @IOF
+2 IF '$DATA(HDR)
SET HDR=1
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET RDT=$PIECE(Y,"@")_"@"_$PIECE($PIECE(Y,":",1,2),"@",2)
if $EXTRACT(IOST)="C"
WRITE @IOF
+3 WRITE !,"Global Access/Sec. Ranking Report",?(IOM-10),"Page: ",PAGE
+4 WRITE !,"From: ",$EXTRACT(XUCSBD,4,5)_"/"_$EXTRACT(XUCSBD,6,7)_"/"_$EXTRACT(XUCSBD,2,3)," To: ",$EXTRACT(XUCSED,4,5)_"/"_$EXTRACT(XUCSED,6,7)_"/"_$EXTRACT(XUCSED,2,3)," (",XUCSDAYS," day",$SELECT(XUCSDAYS>1:"s",1:""),")",?(IOM-20),RDT
+5 SET HDRX=""
SET $PIECE(HDRX,"-",IOM)=""
WRITE !,HDRX
+6 QUIT
SUBHDR ; Change of UCI subheader
+1 IF '$DATA(A(PAGE,ROW))
SET A(PAGE,ROW)=""
+2 SET A(PAGE,ROW)=A(PAGE,ROW)_" "_$PIECE(UCIVG,",")_$SELECT($PIECE(UCIVG,",",2)'="ALL":","_$PIECE(UCIVG,",",2)_" ",1:" ")_" "
DO POS
+3 QUIT
POS ; Position on Spread Sheet
+1 SET ROW=ROW+1
+2 IF ROW>PGLEN
SET ROW=1
Begin DoDot:1
+3 SET COL=COL+1
+4 IF COL>4
SET PAGE=PAGE+1
SET COL=1
+5 DO SUBHDR
End DoDot:1
+6 QUIT
GDATE ; Get Date Range
+1 SET XUCSEND=0
+2 SET XUCSNOA2=1
DO A3^XUCSUTL3
+3 IF XUCSEND
QUIT
+4 SET X1=XUCSBD
SET X2=XUCSED
DO ^%DTC
if X<0
SET X=X*(-1)
+5 SET XUCSDAYS=X+1
+6 QUIT
