- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMUT5Q 4420 printed Feb 18, 2025@23:39:50 Page 2
- 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