XMUT5C ;(WASH ISC)/CAP-Response Time Logger/Purge ;04/17/2002  11:59
 ;;8.0;MailMan;;Jun 28, 2002
 ; Entry points used by MailMan options (not covered by DBIA):
 ; GO     XMMGR-RESPONSE-TIME-COMPILER
 ; LOGON  XMMGR-RESPONSE-TIME-TOGGLER
 I '$D(ZTQUEUED) U IO(0) W !!,"Compiling Data..."
GO ;Entry for Tasked report
 ;
 S XMV=^%ZOSF("PROD"),(D,Z)=0
 ;
 ;Are there statistics to gather ?  Only gather statistics till T-1.
 ;
 ;Is there a date ?
Z S Z=$O(^%ZRTL(3,XMV,Z)) G Q:$H-Z'>0,Q:Z=""
 ;Is there Response Time data for MailMan ?
 S J=$O(^%ZRTL(3,XMV,Z,"XMA1-DEL/TERM",0)) D S:J
 ;
 ;Kill off Response time data for this date (stored in XMBX now)
 K ^%ZRTL(3,XMV,Z,"XMA1-DEL/TERM") G Z
 ;
 ;Gather 1 days' statistics
S S %H=Z D YMD^%DTC S (E,XMA)=X,S=0
 I '$D(ZTQUEUED) W !,"DATE="_$$FMTE^XLFDT($P(XMA,".",1),"2Z"),! S D=D+1
0 S XMA=$O(^XMBX(4.2998,"B",XMA)) I $S('XMA:1,XMA-E>.999:1,1:0) Q
 S %=$P(XMA,".",2),L=$E(%,1,2)*3600+($E(%,3,4)*60)+$E(%,5,6),(C,T)=0 D G
 S %=$O(^XMBX(4.2998,"B",XMA,0)),$P(^XMBX(4.2998,%,0),U,8)=$S(C>0:$FN(T/C,"",1),1:"")
 G 0
 ;
 ;Get response time out of %ZRTL
G S S=$O(^%ZRTL(3,XMV,Z,"XMA1-DEL/TERM",S)) Q:S=""  I S>L S S=L Q
 S %=^(S),C=C+1,T=S-$P($P(%,"^"),",",2)+T I '$D(ZTQUEUED),C#100=0 W "."
 G G
 ;
 ;Write totals and quit
Q I '$D(ZTQUEUED) W !!,?2,$S(D:D_" Dates Processed and Purged",1:"<<<< Nothing to process >>>>"),!
 K %,%H,%I,C,D,E,J,L,S,T,X,Y,Z,XMA,XMC,XMD,XMV
 Q
ZTSK S ZTRTN="GO^XMUT5C",ZTDTH=$S($D(ZTQUEUED):1,1:0)+$H_","_(3600*18),ZTDESC="Response Time accumulator for file 4.2998",ZTIO="" D ^%ZTLOAD
 Q
LOGON ;Turn ON response time logging
 S X="y" D LOG
 ;Schedule next task
 K ZTREQ S ZTIO="",ZTRTN="LOGOFF^XMUT5C",X=$P($H,",",2),ZTDESC="Turn OFF response Time Logging"
 K % I X<28800 S %=+$H_",29100"
 I X>57600 S %=$H+1_",29100"
 I $D(%) S ZTDTH=%
 E  S %=$H*86400+X+300,ZTDTH=%\86400_","_(%#86400)
 D ^%ZTLOAD S ZTREQ="@" Q
LOGOFF ;Turn OFF response time logging
 S X="n"
 ;Update Kernel Site Parameters LOG RESPONSE TIME FIELD
LOG L +^XTV(8989.3,1)
 S %=^%ZOSF("VOL"),%=$O(^XTV(8989.3,1,4,"B",%,0)),$P(^XTV(8989.3,1,4,%,0),U,6)=X
 L -^XTV(8989.3,1) K %,X S ZTREQ="@"
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMUT5C   2185     printed  Sep 23, 2025@19:49:37                                                                                                                                                                                                      Page 2
XMUT5C    ;(WASH ISC)/CAP-Response Time Logger/Purge ;04/17/2002  11:59
 +1       ;;8.0;MailMan;;Jun 28, 2002
 +2       ; Entry points used by MailMan options (not covered by DBIA):
 +3       ; GO     XMMGR-RESPONSE-TIME-COMPILER
 +4       ; LOGON  XMMGR-RESPONSE-TIME-TOGGLER
 +5        IF '$DATA(ZTQUEUED)
               USE IO(0)
               WRITE !!,"Compiling Data..."
GO        ;Entry for Tasked report
 +1       ;
 +2        SET XMV=^%ZOSF("PROD")
           SET (D,Z)=0
 +3       ;
 +4       ;Are there statistics to gather ?  Only gather statistics till T-1.
 +5       ;
 +6       ;Is there a date ?
Z          SET Z=$ORDER(^%ZRTL(3,XMV,Z))
           if $HOROLOG-Z'>0
               GOTO Q
           if Z=""
               GOTO Q
 +1       ;Is there Response Time data for MailMan ?
 +2        SET J=$ORDER(^%ZRTL(3,XMV,Z,"XMA1-DEL/TERM",0))
           if J
               DO S
 +3       ;
 +4       ;Kill off Response time data for this date (stored in XMBX now)
 +5        KILL ^%ZRTL(3,XMV,Z,"XMA1-DEL/TERM")
           GOTO Z
 +6       ;
 +7       ;Gather 1 days' statistics
S          SET %H=Z
           DO YMD^%DTC
           SET (E,XMA)=X
           SET S=0
 +1        IF '$DATA(ZTQUEUED)
               WRITE !,"DATE="_$$FMTE^XLFDT($PIECE(XMA,".",1),"2Z"),!
               SET D=D+1
0          SET XMA=$ORDER(^XMBX(4.2998,"B",XMA))
           IF $SELECT('XMA:1,XMA-E>.999:1,1:0)
               QUIT 
 +1        SET %=$PIECE(XMA,".",2)
           SET L=$EXTRACT(%,1,2)*3600+($EXTRACT(%,3,4)*60)+$EXTRACT(%,5,6)
           SET (C,T)=0
           DO G
 +2        SET %=$ORDER(^XMBX(4.2998,"B",XMA,0))
           SET $PIECE(^XMBX(4.2998,%,0),U,8)=$SELECT(C>0:$FNUMBER(T/C,"",1),1:"")
 +3        GOTO 0
 +4       ;
 +5       ;Get response time out of %ZRTL
G          SET S=$ORDER(^%ZRTL(3,XMV,Z,"XMA1-DEL/TERM",S))
           if S=""
               QUIT 
           IF S>L
               SET S=L
               QUIT 
 +1        SET %=^(S)
           SET C=C+1
           SET T=S-$PIECE($PIECE(%,"^"),",",2)+T
           IF '$DATA(ZTQUEUED)
               IF C#100=0
                   WRITE "."
 +2        GOTO G
 +3       ;
 +4       ;Write totals and quit
Q          IF '$DATA(ZTQUEUED)
               WRITE !!,?2,$SELECT(D:D_" Dates Processed and Purged",1:"<<<< Nothing to process >>>>"),!
 +1        KILL %,%H,%I,C,D,E,J,L,S,T,X,Y,Z,XMA,XMC,XMD,XMV
 +2        QUIT 
ZTSK       SET ZTRTN="GO^XMUT5C"
           SET ZTDTH=$SELECT($DATA(ZTQUEUED):1,1:0)+$HOROLOG_","_(3600*18)
           SET ZTDESC="Response Time accumulator for file 4.2998"
           SET ZTIO=""
           DO ^%ZTLOAD
 +1        QUIT 
LOGON     ;Turn ON response time logging
 +1        SET X="y"
           DO LOG
 +2       ;Schedule next task
 +3        KILL ZTREQ
           SET ZTIO=""
           SET ZTRTN="LOGOFF^XMUT5C"
           SET X=$PIECE($HOROLOG,",",2)
           SET ZTDESC="Turn OFF response Time Logging"
 +4        KILL %
           IF X<28800
               SET %=+$HOROLOG_",29100"
 +5        IF X>57600
               SET %=$HOROLOG+1_",29100"
 +6        IF $DATA(%)
               SET ZTDTH=%
 +7       IF '$TEST
               SET %=$HOROLOG*86400+X+300
               SET ZTDTH=%\86400_","_(%#86400)
 +8        DO ^%ZTLOAD
           SET ZTREQ="@"
           QUIT 
LOGOFF    ;Turn OFF response time logging
 +1        SET X="n"
 +2       ;Update Kernel Site Parameters LOG RESPONSE TIME FIELD
LOG        LOCK +^XTV(8989.3,1)
 +1        SET %=^%ZOSF("VOL")
           SET %=$ORDER(^XTV(8989.3,1,4,"B",%,0))
           SET $PIECE(^XTV(8989.3,1,4,%,0),U,6)=X
 +2        LOCK -^XTV(8989.3,1)
           KILL %,X
           SET ZTREQ="@"
 +3        QUIT