- 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 Jan 18, 2025@03:43:32 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