XMCQH ;ISC-SF/GMB-Transmit Queue History ;01/08/2003 13:52
;;8.0;MailMan;**8,14**;Jun 28, 2002
; Was (WASH ISC)/CAP/AML/RJ
;
; Entry points used by MailMan options (not covered by DBIA):
; ENTER XMQHIST (was ^XMS4)
ENTER ;
N XMPARM,XMABORT
S XMABORT=0
D INIT(.XMPARM,.XMABORT) Q:XMABORT
S ZTSAVE("XMPARM(")=""
D EN^XUTMDEVQ("ENT^XMCQH",$$EZBLD^DIALOG(42100),.ZTSAVE) ; MailMan: Transmission Queue History Report
Q
INIT(XMPARM,XMABORT) ; Get period to report on. Default is current month.
S (XMPARM("START"),XMPARM("END"))=$E(DT,1,5)
Q:$D(ZTQUEUED)
D START(.XMPARM,.XMABORT) Q:XMABORT
D END(.XMPARM,.XMABORT)
Q
START(XMPARM,XMABORT) ; Start of report period
N DIR,Y,X
S DIR(0)="DO^:DT:E"
S DIR("A")=$$EZBLD^DIALOG(42107) ; Start of report period
D BLD^DIALOG(42107.1,"","","DIR(""?"")")
;Enter a month and year or just a year. Any day will be ignored.
;This is the start of the period you want reported. The report will
;start on the first day of the period you enter.
S DIR("B")=$$FMTE^XLFDT(XMPARM("START")_"00")
D ^DIR I $D(DUOUT)!$D(DTOUT) S XMABORT=1 Q
S XMPARM("START")=$E(Y,1,5)
Q
END(XMPARM,XMABORT) ; End of report period
S XMPARM("END")=XMPARM("START")
Q:$E(XMPARM("START"),1,5)=$E(DT,1,5) ; This month
Q:XMPARM("START")=($E(DT,1,3)_"00") ; This year
N DIR,Y,X,XMDT
S XMDT=XMPARM("START")
S:$E(XMDT,4,5)="00" XMDT=$E(XMDT,1,3)_"01"
S DIR(0)="DO^"_XMDT_"01:DT:E"
S DIR("A")=$$EZBLD^DIALOG(42108) ; End of report period
D BLD^DIALOG(42108.1,"","","DIR(""?"")")
;Enter a month and year or just a year. Press enter to accept the default.
;This is the end of the period you want reported. The report will go
;through the last day of the period you enter.
I $E(XMPARM("END"),4,5)="00" S XMPARM("END")=$E(XMPARM("END"),1,3)_"1200"
E S XMPARM("END")=$$SCH^XLFDT("1M(L)",XMPARM("END")_"01")
S DIR("B")=$$FMTE^XLFDT(XMPARM("END"))
D ^DIR I $D(DUOUT)!$D(DTOUT) S XMABORT=1 Q
S XMPARM("END")=$E(Y,1,5)
Q
ENT ;
N XMNAME,XMRPT,XMIEN,XMREC,XMABORT,XMQD,XMCNT,XMTITLE,XMMON,XMSENT,XMRCVD
;Transmission Queue History
;Domain Queued Sent Rcvd Domain Queued Sent Rcvd
I $E(XMPARM("END"),4,5)'="00",$E(XMPARM("START"),4,5)="00" D
. I $E(XMPARM("END"),4,5)=12 S XMPARM("END")=XMPARM("START") Q
. S $E(XMPARM("START"),4,5)="01"
I $E(XMPARM("END"),4,5)="00",$E(XMPARM("START"),4,5)'="00" D
. I $E(XMPARM("END"),1,3)=$E(DT,1,3) S XMPARM("END")=$E(DT,1,5) Q
. S $E(XMPARM("END"),4,5)=12
I XMPARM("START")=XMPARM("END") D
. S XMTITLE=$$EZBLD^DIALOG(42101,$$FMTE^XLFDT(XMPARM("START")_"00")) ;Transmission Queue History, |1|
E D
. N XMP S XMP(1)=$$FMTE^XLFDT(XMPARM("START")_"00"),XMP(2)=$$FMTE^XLFDT(XMPARM("END")_"00")
. S XMTITLE=$$EZBLD^DIALOG(42101.1,.XMP) ;Transmission Queue History, |1| - |2|
D INIT^XMCQA(.XMRPT,XMTITLE,42102)
I $E(XMPARM("END"),4,5)="00" S XMPARM("END")=$E(XMPARM("END"),1,3)_"12"
S XMNAME="",(XMCNT,XMABORT,XMCNT("SENT"),XMCNT("RCVD"),XMCNT("QD"))=0
F S XMNAME=$O(^DIC(4.2,"B",XMNAME)) Q:XMNAME="" D Q:XMABORT
. S XMIEN=""
. F S XMIEN=$O(^DIC(4.2,"B",XMNAME,XMIEN)) Q:'XMIEN D Q:XMABORT
. . S (XMSENT,XMRCVD)=0
. . S XMMON=XMPARM("START")-.01
. . F S XMMON=$O(^XMBS(4.2999,XMIEN,100,XMMON)) Q:XMMON>XMPARM("END")!'XMMON D
. . . S XMREC=$G(^XMBS(4.2999,XMIEN,100,XMMON,0))
. . . S XMSENT=XMSENT+$P(XMREC,U,2),XMRCVD=XMRCVD+$P(XMREC,U,3)
. . S XMQD=$$BMSGCT^XMXUTIL(.5,XMIEN+1000)
. . I 'XMQD,'XMSENT,'XMRCVD Q
. . S XMCNT("SENT")=XMCNT("SENT")+XMSENT
. . S XMCNT("RCVD")=XMCNT("RCVD")+XMRCVD
. . S XMCNT("QD")=XMCNT("QD")+XMQD
. . S XMCNT=XMCNT+1
. . I XMCNT#2 D Q:XMABORT
. . . I $Y+3>IOSL D Q:XMABORT
. . . . D PAGE^XMCQA(.XMABORT) Q:XMABORT
. . . . D HDR^XMCQA(.XMRPT)
. . . W !
. . E W " "
. . W $$MELD^XMXUTIL1(XMNAME,XMQD,22),$J(XMSENT,8),$J(XMRCVD,8)
Q:XMABORT
I $Y+7>IOSL D Q:XMABORT
. D PAGE^XMCQA(.XMABORT)
. D HDR^XMCQA(.XMRPT)
W !!,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42103),XMCNT,27) ; Total Domains:
W !,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42104),XMCNT("QD"),27) ; Total Queued:
W !,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42105),XMCNT("SENT"),27) ; Total Sent:
W !,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42106),XMCNT("RCVD"),27) ; Total Received:
I $D(ZTQUEUED) S ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMCQH 4327 printed Sep 23, 2025@19:47:19 Page 2
XMCQH ;ISC-SF/GMB-Transmit Queue History ;01/08/2003 13:52
+1 ;;8.0;MailMan;**8,14**;Jun 28, 2002
+2 ; Was (WASH ISC)/CAP/AML/RJ
+3 ;
+4 ; Entry points used by MailMan options (not covered by DBIA):
+5 ; ENTER XMQHIST (was ^XMS4)
ENTER ;
+1 NEW XMPARM,XMABORT
+2 SET XMABORT=0
+3 DO INIT(.XMPARM,.XMABORT)
if XMABORT
QUIT
+4 SET ZTSAVE("XMPARM(")=""
+5 ; MailMan: Transmission Queue History Report
DO EN^XUTMDEVQ("ENT^XMCQH",$$EZBLD^DIALOG(42100),.ZTSAVE)
+6 QUIT
INIT(XMPARM,XMABORT) ; Get period to report on. Default is current month.
+1 SET (XMPARM("START"),XMPARM("END"))=$EXTRACT(DT,1,5)
+2 if $DATA(ZTQUEUED)
QUIT
+3 DO START(.XMPARM,.XMABORT)
if XMABORT
QUIT
+4 DO END(.XMPARM,.XMABORT)
+5 QUIT
START(XMPARM,XMABORT) ; Start of report period
+1 NEW DIR,Y,X
+2 SET DIR(0)="DO^:DT:E"
+3 ; Start of report period
SET DIR("A")=$$EZBLD^DIALOG(42107)
+4 DO BLD^DIALOG(42107.1,"","","DIR(""?"")")
+5 ;Enter a month and year or just a year. Any day will be ignored.
+6 ;This is the start of the period you want reported. The report will
+7 ;start on the first day of the period you enter.
+8 SET DIR("B")=$$FMTE^XLFDT(XMPARM("START")_"00")
+9 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET XMABORT=1
QUIT
+10 SET XMPARM("START")=$EXTRACT(Y,1,5)
+11 QUIT
END(XMPARM,XMABORT) ; End of report period
+1 SET XMPARM("END")=XMPARM("START")
+2 ; This month
if $EXTRACT(XMPARM("START"),1,5)=$EXTRACT(DT,1,5)
QUIT
+3 ; This year
if XMPARM("START")=($EXTRACT(DT,1,3)_"00")
QUIT
+4 NEW DIR,Y,X,XMDT
+5 SET XMDT=XMPARM("START")
+6 if $EXTRACT(XMDT,4,5)="00"
SET XMDT=$EXTRACT(XMDT,1,3)_"01"
+7 SET DIR(0)="DO^"_XMDT_"01:DT:E"
+8 ; End of report period
SET DIR("A")=$$EZBLD^DIALOG(42108)
+9 DO BLD^DIALOG(42108.1,"","","DIR(""?"")")
+10 ;Enter a month and year or just a year. Press enter to accept the default.
+11 ;This is the end of the period you want reported. The report will go
+12 ;through the last day of the period you enter.
+13 IF $EXTRACT(XMPARM("END"),4,5)="00"
SET XMPARM("END")=$EXTRACT(XMPARM("END"),1,3)_"1200"
+14 IF '$TEST
SET XMPARM("END")=$$SCH^XLFDT("1M(L)",XMPARM("END")_"01")
+15 SET DIR("B")=$$FMTE^XLFDT(XMPARM("END"))
+16 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET XMABORT=1
QUIT
+17 SET XMPARM("END")=$EXTRACT(Y,1,5)
+18 QUIT
ENT ;
+1 NEW XMNAME,XMRPT,XMIEN,XMREC,XMABORT,XMQD,XMCNT,XMTITLE,XMMON,XMSENT,XMRCVD
+2 ;Transmission Queue History
+3 ;Domain Queued Sent Rcvd Domain Queued Sent Rcvd
+4 IF $EXTRACT(XMPARM("END"),4,5)'="00"
IF $EXTRACT(XMPARM("START"),4,5)="00"
Begin DoDot:1
+5 IF $EXTRACT(XMPARM("END"),4,5)=12
SET XMPARM("END")=XMPARM("START")
QUIT
+6 SET $EXTRACT(XMPARM("START"),4,5)="01"
End DoDot:1
+7 IF $EXTRACT(XMPARM("END"),4,5)="00"
IF $EXTRACT(XMPARM("START"),4,5)'="00"
Begin DoDot:1
+8 IF $EXTRACT(XMPARM("END"),1,3)=$EXTRACT(DT,1,3)
SET XMPARM("END")=$EXTRACT(DT,1,5)
QUIT
+9 SET $EXTRACT(XMPARM("END"),4,5)=12
End DoDot:1
+10 IF XMPARM("START")=XMPARM("END")
Begin DoDot:1
+11 ;Transmission Queue History, |1|
SET XMTITLE=$$EZBLD^DIALOG(42101,$$FMTE^XLFDT(XMPARM("START")_"00"))
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 NEW XMP
SET XMP(1)=$$FMTE^XLFDT(XMPARM("START")_"00")
SET XMP(2)=$$FMTE^XLFDT(XMPARM("END")_"00")
+14 ;Transmission Queue History, |1| - |2|
SET XMTITLE=$$EZBLD^DIALOG(42101.1,.XMP)
End DoDot:1
+15 DO INIT^XMCQA(.XMRPT,XMTITLE,42102)
+16 IF $EXTRACT(XMPARM("END"),4,5)="00"
SET XMPARM("END")=$EXTRACT(XMPARM("END"),1,3)_"12"
+17 SET XMNAME=""
SET (XMCNT,XMABORT,XMCNT("SENT"),XMCNT("RCVD"),XMCNT("QD"))=0
+18 FOR
SET XMNAME=$ORDER(^DIC(4.2,"B",XMNAME))
if XMNAME=""
QUIT
Begin DoDot:1
+19 SET XMIEN=""
+20 FOR
SET XMIEN=$ORDER(^DIC(4.2,"B",XMNAME,XMIEN))
if 'XMIEN
QUIT
Begin DoDot:2
+21 SET (XMSENT,XMRCVD)=0
+22 SET XMMON=XMPARM("START")-.01
+23 FOR
SET XMMON=$ORDER(^XMBS(4.2999,XMIEN,100,XMMON))
if XMMON>XMPARM("END")!'XMMON
QUIT
Begin DoDot:3
+24 SET XMREC=$GET(^XMBS(4.2999,XMIEN,100,XMMON,0))
+25 SET XMSENT=XMSENT+$PIECE(XMREC,U,2)
SET XMRCVD=XMRCVD+$PIECE(XMREC,U,3)
End DoDot:3
+26 SET XMQD=$$BMSGCT^XMXUTIL(.5,XMIEN+1000)
+27 IF 'XMQD
IF 'XMSENT
IF 'XMRCVD
QUIT
+28 SET XMCNT("SENT")=XMCNT("SENT")+XMSENT
+29 SET XMCNT("RCVD")=XMCNT("RCVD")+XMRCVD
+30 SET XMCNT("QD")=XMCNT("QD")+XMQD
+31 SET XMCNT=XMCNT+1
+32 IF XMCNT#2
Begin DoDot:3
+33 IF $Y+3>IOSL
Begin DoDot:4
+34 DO PAGE^XMCQA(.XMABORT)
if XMABORT
QUIT
+35 DO HDR^XMCQA(.XMRPT)
End DoDot:4
if XMABORT
QUIT
+36 WRITE !
End DoDot:3
if XMABORT
QUIT
+37 IF '$TEST
WRITE " "
+38 WRITE $$MELD^XMXUTIL1(XMNAME,XMQD,22),$JUSTIFY(XMSENT,8),$JUSTIFY(XMRCVD,8)
End DoDot:2
if XMABORT
QUIT
End DoDot:1
if XMABORT
QUIT
+39 if XMABORT
QUIT
+40 IF $Y+7>IOSL
Begin DoDot:1
+41 DO PAGE^XMCQA(.XMABORT)
+42 DO HDR^XMCQA(.XMRPT)
End DoDot:1
if XMABORT
QUIT
+43 ; Total Domains:
WRITE !!,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42103),XMCNT,27)
+44 ; Total Queued:
WRITE !,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42104),XMCNT("QD"),27)
+45 ; Total Sent:
WRITE !,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42105),XMCNT("SENT"),27)
+46 ; Total Received:
WRITE !,$$MELD^XMXUTIL1($$EZBLD^DIALOG(42106),XMCNT("RCVD"),27)
+47 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+48 QUIT
