XMUT5Q ;(WASH ISC)/CAP-Delivery Queue Analysis ;04/17/2002 12:03
;;8.0;MailMan;;Jun 28, 2002
Q
QUIT ;End process
D REC
QUIT1 K %,A,B,I,J,RSP,X,Y,ZTSK,ZTSAVE,ZTRTN,ZTDTH
K:'$D(ZTQUEUED) C,M,R
G ZTSK0
;
ZTSK ;SCHEDULE TO RUN
K XMUT5,XMUT5Q S ZTRTN="GO^XMUT5Q1" G GO
ZTSK0 ;Reschedules itself here
S ZTRTN="GO2^XMUT5Q1"
GO Q:$S($D(XMUT5NO):1,'$D(XMUT5F):0,'$D(XMUT5Q):0,XMUT5Q>XMUT5F:1,1:0)
S:'$D(XMUT5S) XMUT5S=1800
K XMUT5N S XMUT5Q=$G(XMUT5Q)+1,ZTSAVE("C*")="",ZTSAVE("XMZUT*")="",ZTREQ="@" I $D(ZTQUEUED) S XMUT5=1
S X=$H*86400+$P($H,",",2)+XMUT5S\XMUT5S*XMUT5S,ZTDTH=X\86400_","_(X#86400),ZTDESC="MGRMAIL "_XMUT5S_" second interval Delivery Queue Check"
S:'$D(ZTRTN) ZTRTN="GO^XMUT5Q1" S ZTIO="" D ^%ZTLOAD
Q
REC ;RECORD QUEUE STATUS
D NOW^%DTC
;
;Look to see if data already file and quit if it is there
S X=$P(%,".")_"."_$E($P(%,".",2),1,2) I $E($P(%,".",2),3)>2 S X=X_3
S X=$O(^XMBX(4.2998,"B",X)),DA=$S(X="":"",1:$O(^(X,0))) Q:DA
I 'DA S X=%,DIC="^XMBX(4.2998,",DIC(0)="FI",Y=0 D FILE^DICN
S DIE="^XMBX(4.2998,",DA=+Y,XMUSER=$$USERS^XMUT5B(0)
;zero node
S DR="1///"_(M("T")+R("T"))_";11///"_+M("T")_";12///"_+R("T")_";43///"_$P(^XMB(3.9,0),U,3)
I $G(XMUSER) S DR=DR_";39///"_XMUSER_";38///"_XMUSER
S %="LINES_READ" I $D(^XMBPOST(%)) L +^XMBPOST(%) S DR=DR_";15///"_^XMBPOST(%,0) S ^(0)=0 L -^XMBPOST(%)
;File it
D ^DIE K DR
L +^XMBPOST("GSTATS","R")
S %=$G(^XMBPOST("STATS","R")) S:%>0 DR="45///"_+% S ^("R")=0
L -^XMBPOST("GSTATS","R")
L +^XMBPOST("GSTATS","M")
S %=$G(^XMBPOST("STATS","M")) S:%>0 DR=$S($D(DR):DR_";",1:"")_"44///"_+% S ^("M")=0
L -^XMBPOST("GSTATS","M")
S (%0,%)="" F I=1:1:10 S %0=$G(^XMBPOST("M",I)) S %=%+$P(%0,U,2)
S:%>0 DR=$S($D(DR):DR_";",1:"")_"46///"_%
S (%0,%)="" F I=1:1:10 S %0=$G(^XMBPOST("R",I)) S %=%+$P(%0,U,2)
S:%>0 DR=$S($D(DR):DR_";",1:"")_"47///"_% K %0
I $D(DR) D ^DIE K DR
;1 node
S %=$P(M("T"),U,2) I % S DR=$S($D(DR):DR_";",1:"")_"101///"_($H*86400+$P($H,",",2)-%)
S %=$P(R("T"),U,2) I % S DR=$S($D(DR):DR_";",1:"")_"102///"_($H*86400+$P($H,",",2)-%)
S %=$S($D(^XMB(1,1,6)):^(6),1:"10^50,400"),DR=$S($D(DR):DR_";",1:"")_"103///"_$P(%,U,2)_";104///"_$P(%,U)
;File it
I $D(DR) D ^DIE K DR
;2 & 3 nodes
S I=201,DR="" D DR
D ^DIE:$L($G(DR)) K DR
;4 & 5 nodes
S I=401,DR="" D DR
;File it
D ^DIE:$L($G(DR)) K DR
;Nodes 6 & 7 - Deliveries
F I=1:1:10 S %=$P(R("O",I),U,3) I % S DR=$S($D(DR):DR_";",1:"")_60_I_"///"_%
F I=1:1:10 S %=$P(M("O",I),U,3) I % S DR=$S($D(DR):DR_";",1:"")_70_I_"///"_%
D ^DIE:$L($G(DR))
K %H,D,D0,DI,DIE,DIC,DA,DO,DR,DQ,X
Q
DR F I=I:1:I+9 S:$E(I)=2 %=R("O",I#100) S:$E(I)=4 %=M("O",I#100) I +% S:$L(DR) DR=$G(DR)_";" S DR=$G(DR)_(I+100)_"///"_+% I +$P(%,U,2) S DR=$G(DR)_";"_I_"///"_($H*86400+$P($H,",",2)-$P(%,U,2))
Q
GET N J S J=I N I S I=J,Z=J
GET1 W !!,"Please enter the following for "_$P("ORIGINAL MESSAGES: ,RESPONSES: ",",",Z)
R !!,"Enter up to 9 numbers separated by commas to determine statistical groupings.",!,"EG: 50,100,500 will create 4 groups: 1-49, 50-99, 100-499 & 500 and above.",!!,"Enter them now: ",X:DTIME
Q:"^"[X
F I=1:1 S A=$P(X,",",I) Q:A="" S B=$P(X,",",I+1) I $S(+A'=A:1,I>10:1,1:0)!(B'>A&B) D ERR G GET1
Q
ENUSER ;Entry point called by VMS job that calculates active logons
;Parameter passed has three comma (",") pieces for active logons
;
;**** REVISED 1/93 ****
;VMS JOB NO LONGER WORKS -- ZSLOT USER ARE KEPT TRCK OF DIFFERENTLY
;
;$P(%,",",1)=Total - $P(%,",",2)=ZSLOT - $P(%,",",3)=Non-ZSLOT
;$P(%,",",4)=VMS style date (N-MMM-YYY HH:MM:SS:xx)
;
S U="^" L +^XMBX(4.2998)
S XMA0=%,%=$P(%,",",4),DA=$P($G(^XMBX(4.2998,0)),U,3) Q:'DA
;
;Re-construct VMS date to date FileMan's conversion can handle as input
F I=0:0 Q:$E(%)'=" " S %=$E(%,2,99)
S X=$P(%,"-",2)_" "_$E("0",$L(+%))_+%_", "_+$P(%,"-",3),XMB0=$P(%," ",2)
;
;If this data applies to the last entry made for statistics (within
;1/2 hour) file it in this entry.
;
D ^%DT S X=Y_"."_$P(XMB0,":")_$P(XMB0,":",2),(%0,Y)=^XMBX(4.2998,DA,0)
I X-Y<.003 F %=22,23 S X=$P(XMA0,",",%-20) I X>$P(Y,"^",%) S $P(Y,"^",%)=X,$P(Y,"^",21)=$P(Y,"^",21)+X
S ^XMBX(4.2998,DA,0)=Y L -^XMBX(4.2998) K DA,XMA0
Q
ERR W $C(7)," ???" S X="" Q
;
NOTASK ;Run in foreground
S XMUT5NO=1,XMUT5=1
R !!,"Initialize time stamps in queue (necessary 1st run): NO// ",X:DTIME
K:$E(X)="Y" XMUT5
G 0^XMUT5Q1
XMUT5Q ;(WASH ISC)/CAP-Delivery Queue Analysis ;04/17/2002 12:03
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 QUIT
QUIT ;End process
+1 DO REC
QUIT1 KILL %,A,B,I,J,RSP,X,Y,ZTSK,ZTSAVE,ZTRTN,ZTDTH
+1 IF '$DATA(ZTQUEUED)
KILL C,M,R
+2 GOTO ZTSK0
+3 ;
ZTSK ;SCHEDULE TO RUN
+1 KILL XMUT5,XMUT5Q
SET ZTRTN="GO^XMUT5Q1"
GOTO GO
ZTSK0 ;Reschedules itself here
+1 SET ZTRTN="GO2^XMUT5Q1"
GO IF $SELECT($DATA(XMUT5NO)
QUIT
+1 IF '$DATA(XMUT5S)
SET XMUT5S=1800
+2 KILL XMUT5N
SET XMUT5Q=$GET(XMUT5Q)+1
SET ZTSAVE("C*")=""
SET ZTSAVE("XMZUT*")=""
SET ZTREQ="@"
IF $DATA(ZTQUEUED)
SET XMUT5=1
+3 SET X=$HOROLOG*86400+$PIECE($HOROLOG,",",2)+XMUT5S\XMUT5S*XMUT5S
SET ZTDTH=X\86400_","_(X#86400)
SET ZTDESC="MGRMAIL "_XMUT5S_" second interval Delivery Queue Check"
+4 IF '$DATA(ZTRTN)
SET ZTRTN="GO^XMUT5Q1"
SET ZTIO=""
DO ^%ZTLOAD
+5 QUIT
REC ;RECORD QUEUE STATUS
+1 DO NOW^%DTC
+2 ;
+3 ;Look to see if data already file and quit if it is there
+4 SET X=$PIECE(%,".")_"."_$EXTRACT($PIECE(%,".",2),1,2)
IF $EXTRACT($PIECE(%,".",2),3)>2
SET X=X_3
+5 SET X=$ORDER(^XMBX(4.2998,"B",X))
SET DA=$SELECT(X="":"",1:$ORDER(^(X,0)))
IF DA
QUIT
+6 IF 'DA
SET X=%
SET DIC="^XMBX(4.2998,"
SET DIC(0)="FI"
SET Y=0
DO FILE^DICN
+7 SET DIE="^XMBX(4.2998,"
SET DA=+Y
SET XMUSER=$$USERS^XMUT5B(0)
+8 ;zero node
+9 SET DR="1///"_(M("T")+R("T"))_";11///"_+M("T")_";12///"_+R("T")_";43///"_$PIECE(^XMB(3.9,0),U,3)
+10 IF $GET(XMUSER)
SET DR=DR_";39///"_XMUSER_";38///"_XMUSER
+11 SET %="LINES_READ"
IF $DATA(^XMBPOST(%))
LOCK +^XMBPOST(%)
SET DR=DR_";15///"_^XMBPOST(%,0)
SET ^(0)=0
LOCK -^XMBPOST(%)
+12 ;File it
+13 DO ^DIE
KILL DR
+14 LOCK +^XMBPOST("GSTATS","R")
+15 SET %=$GET(^XMBPOST("STATS","R"))
IF %>0
SET DR="45///"_+%
SET ^("R")=0
+16 LOCK -^XMBPOST("GSTATS","R")
+17 LOCK +^XMBPOST("GSTATS","M")
+18 SET %=$GET(^XMBPOST("STATS","M"))
IF %>0
SET DR=$SELECT($DATA(DR):DR_";",1:"")_"44///"_+%
SET ^("M")=0
+19 LOCK -^XMBPOST("GSTATS","M")
+20 SET (%0,%)=""
FOR I=1:1:10
SET %0=$GET(^XMBPOST("M",I))
SET %=%+$PIECE(%0,U,2)
+21 IF %>0
SET DR=$SELECT($DATA(DR):DR_";",1:"")_"46///"_%
+22 SET (%0,%)=""
FOR I=1:1:10
SET %0=$GET(^XMBPOST("R",I))
SET %=%+$PIECE(%0,U,2)
+23 IF %>0
SET DR=$SELECT($DATA(DR):DR_";",1:"")_"47///"_%
KILL %0
+24 IF $DATA(DR)
DO ^DIE
KILL DR
+25 ;1 node
+26 SET %=$PIECE(M("T"),U,2)
IF %
SET DR=$SELECT($DATA(DR):DR_";",1:"")_"101///"_($HOROLOG*86400+$PIECE($HOROLOG,",",2)-%)
+27 SET %=$PIECE(R("T"),U,2)
IF %
SET DR=$SELECT($DATA(DR):DR_";",1:"")_"102///"_($HOROLOG*86400+$PIECE($HOROLOG,",",2)-%)
+28 SET %=$SELECT($DATA(^XMB(1,1,6)):^(6),1:"10^50,400")
SET DR=$SELECT($DATA(DR):DR_";",1:"")_"103///"_$PIECE(%,U,2)_";104///"_$PIECE(%,U)
+29 ;File it
+30 IF $DATA(DR)
DO ^DIE
KILL DR
+31 ;2 & 3 nodes
+32 SET I=201
SET DR=""
DO DR
+33 IF $LENGTH($GET(DR))
DO ^DIE
KILL DR
+34 ;4 & 5 nodes
+35 SET I=401
SET DR=""
DO DR
+36 ;File it
+37 IF $LENGTH($GET(DR))
DO ^DIE
KILL DR
+38 ;Nodes 6 & 7 - Deliveries
+39 FOR I=1:1:10
SET %=$PIECE(R("O",I),U,3)
IF %
SET DR=$SELECT($DATA(DR):DR_";",1:"")_60_I_"///"_%
+40 FOR I=1:1:10
SET %=$PIECE(M("O",I),U,3)
IF %
SET DR=$SELECT($DATA(DR):DR_";",1:"")_70_I_"///"_%
+41 IF $LENGTH($GET(DR))
DO ^DIE
+42 KILL %H,D,D0,DI,DIE,DIC,DA,DO,DR,DQ,X
+43 QUIT
DR FOR I=I:1:I+9
IF $EXTRACT(I)=2
SET %=R("O",I#100)
IF $EXTRACT(I)=4
SET %=M("O",I#100)
IF +%
IF $LENGTH(DR)
SET DR=$GET(DR)_";"
SET DR=$GET(DR)_(I+100)_"///"_+%
IF +$PIECE(%,U,2)
SET DR=$GET(DR)_";"_I_"///"_($HOROLOG*86400+$PIECE($HOROLOG,",",2)-$PIECE(%,U,2))
+1 QUIT
GET NEW J
SET J=I
NEW I
SET I=J
SET Z=J
GET1 WRITE !!,"Please enter the following for "_$PIECE("ORIGINAL MESSAGES: ,RESPONSES: ",",",Z)
+1 READ !!,"Enter up to 9 numbers separated by commas to determine statistical groupings.",!,"EG: 50,100,500 will create 4 groups: 1-49, 50-99, 100-499 & 500 and above.",!!,"Enter them now: ",X:DTIME
+2 IF "^"[X
QUIT
+3 FOR I=1:1
SET A=$PIECE(X,",",I)
IF A=""
QUIT
SET B=$PIECE(X,",",I+1)
IF $SELECT(+A'=A:1,I>10:1,1:0)!(B'>A&B)
DO ERR
GOTO GET1
+4 QUIT
ENUSER ;Entry point called by VMS job that calculates active logons
+1 ;Parameter passed has three comma (",") pieces for active logons
+2 ;
+3 ;**** REVISED 1/93 ****
+4 ;VMS JOB NO LONGER WORKS -- ZSLOT USER ARE KEPT TRCK OF DIFFERENTLY
+5 ;
+6 ;$P(%,",",1)=Total - $P(%,",",2)=ZSLOT - $P(%,",",3)=Non-ZSLOT
+7 ;$P(%,",",4)=VMS style date (N-MMM-YYY HH:MM:SS:xx)
+8 ;
+9 SET U="^"
LOCK +^XMBX(4.2998)
+10 SET XMA0=%
SET %=$PIECE(%,",",4)
SET DA=$PIECE($GET(^XMBX(4.2998,0)),U,3)
IF 'DA
QUIT
+11 ;
+12 ;Re-construct VMS date to date FileMan's conversion can handle as input
+13 FOR I=0:0
IF $EXTRACT(%)'=" "
QUIT
SET %=$EXTRACT(%,2,99)
+14 SET X=$PIECE(%,"-",2)_" "_$EXTRACT("0",$LENGTH(+%))_+%_", "_+$PIECE(%,"-",3)
SET XMB0=$PIECE(%," ",2)
+15 ;
+16 ;If this data applies to the last entry made for statistics (within
+17 ;1/2 hour) file it in this entry.
+18 ;
+19 DO ^%DT
SET X=Y_"."_$PIECE(XMB0,":")_$PIECE(XMB0,":",2)
SET (%0,Y)=^XMBX(4.2998,DA,0)
+20 IF X-Y<.003
FOR %=22,23
SET X=$PIECE(XMA0,",",%-20)
IF X>$PIECE(Y,"^",%)
SET $PIECE(Y,"^",%)=X
SET $PIECE(Y,"^",21)=$PIECE(Y,"^",21)+X
+21 SET ^XMBX(4.2998,DA,0)=Y
LOCK -^XMBX(4.2998)
KILL DA,XMA0
+22 QUIT
ERR WRITE $CHAR(7)," ???"
SET X=""
QUIT
+1 ;
NOTASK ;Run in foreground
+1 SET XMUT5NO=1
SET XMUT5=1
+2 READ !!,"Initialize time stamps in queue (necessary 1st run): NO// ",X:DTIME
+3 IF $EXTRACT(X)="Y"
KILL XMUT5
+4 GOTO 0^XMUT5Q1
