XMUT2 ;(WASH ISC)/CAP-Large Msg Report ;12/04/2002 13:49
;;8.0;MailMan;**10**;Jun 28, 2002
; Entry points used by MailMan options (not covered by DBIA):
; ENTER XMMGR-LARGE-MESSAGE-REPORT
ENTER ;
N XMABORT,XML,XMD,I,XMSAVE
S XMABORT=0
D INIT(.XML,.XMD,.XMABORT) Q:XMABORT
I $D(ZTQUEUED) D PROCESS(XML,XMD) Q
F I="XML","XMD" S XMSAVE(I)=""
D EN^XUTMDEVQ("PROC^XMUT2",$$EZBLD^DIALOG(36200),.XMSAVE) ; MailMan: Large Message Report
Q
INIT(XML,XMD,XMABORT) ;
S XML=$G(^XMB(1,1,"XMUT2-LINES")) I 'XML S XML=100
S XMD=$O(^XMB(3.9,"C",""))
Q:$D(ZTQUEUED)
W !,$$EZBLD^DIALOG(36201),! ; This report lists messages longer than a certain number of lines.
D MINLINES(.XML,.XMABORT) Q:XMABORT
D STARTDT(.XMD,.XMABORT) Q:XMABORT
Q
MINLINES(XML,XMABORT) ;
N DIR,X,Y,DA
;Report on messages longer than this many lines
D BLD^DIALOG(36203,"","","DIR(""A"")")
S DIR(0)="4.3,8.14",DA=1
D ^DIR I $D(DIRUT) S XMABORT=1 Q
Q:Y=XML
S XML=Y
K DIR,X,Y,DA
;Make this the default for future reports
D BLD^DIALOG(36204,"","","DIR(""A"")")
S DIR("B")=$$EZBLD^DIALOG(39054) ; Yes
S DIR(0)="Y"
D ^DIR I $D(DIRUT) S XMABORT=1 Q
Q:'Y
S $P(^XMB(1,1,"XMUT2-LINES"),U)=XML
Q
STARTDT(XMD,XMABORT) ;
N DIR,X
;The default starting date is the date of the oldest message.
;Enter the start date
W !
D BLD^DIALOG(36202,"","","DIR(""A"")")
S DIR("B")=$$FMTE^XLFDT(XMD,5)
S DIR(0)="D^"_XMD_":"_DT_";EP"
D ^DIR I $D(DIRUT) S XMABORT=1
S XMD=Y
Q
PROCESS(XML,XMD) ;
PROC ;
N XMABORT,XMPAGE,XMCNT,XMDATE,XMREC,XMLINES,XMLEN,XMZ,XMLEFT
S XMLEN("XMZ")=$$MAX^XLFMTH($L($O(^XMB(3.9,"A"),-1)),$L($$EZBLD^DIALOG(34633))) ;Msg ID
S XMLEN("LINE")=$$MAX^XLFMTH(7,$L($$EZBLD^DIALOG(34003.1))+1) ;Lines
S XMLEN("RCPT")=$$MAX^XLFMTH(6,$L($$EZBLD^DIALOG(36207))+1) ;Rcpts
S XMLEFT=75-XMLEN("XMZ")-XMLEN("LINE")-XMLEN("RCPT")
S XMLEN("FROM")=XMLEFT\2
S XMLEN("SUBJ")=XMLEFT-XMLEN("FROM")
S (XMABORT,XMCNT,XMPAGE)=0
S XMDATE=$$FMTE^XLFDT(DT,5)
W:$E(IOST,1,2)="C-" @IOF
D HDR
S XMD=XMD-.1
S XMZ=""
F S XMD=$O(^XMB(3.9,"C",XMD)) Q:XMD="" D Q:XMABORT
. F S XMZ=$O(^XMB(3.9,"C",XMD,XMZ)) Q:XMZ="" D Q:XMABORT
. . S XMCNT=XMCNT+1
. . S XMLINES=+$P($G(^XMB(3.9,XMZ,2,0)),U,4)
. . I $E(IOST,1,2)="C-",XMCNT#1000=0 W:$X>50 ! W "."
. . Q:XMLINES'>XML
. . S XMREC=$G(^XMB(3.9,XMZ,0))
. . Q:$P(XMREC,U)?1"R"1N.N
. . S XMRECIPS=+$P($G(^XMB(3.9,XMZ,1,0)),U,4)
. . I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
. . W !,$J(XMZ,XMLEN("XMZ")),$J(XMLINES,XMLEN("LINE")),$J(XMRECIPS,XMLEN("RCPT"))," "
. . W $$LJ^XLFSTR($E($$NAME^XMXUTIL($P(XMREC,U,2)),1,XMLEN("FROM")),XMLEN("FROM"))," ",$$LJ^XLFSTR($E($$SUBJ^XMXUTIL2(XMREC),1,XMLEN("SUBJ")),XMLEN("SUBJ"))
Q:XMABORT
I $E(IOST,1,2)="C-" D WAIT^XMXUTIL
I $D(ZTQUEUED) S ZTREQ="@"
Q
PAGE(XMABORT) ;
I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
W @IOF
D HDR
Q
HDR ;
S XMPAGE=XMPAGE+1
;Messages with more than _XML_ lines,?50,Report date: _XMDATE_ _Page
W $$EZBLD^DIALOG(36205,XML),?50,$$EZBLD^DIALOG(36206,XMDATE)," ",$$EZBLD^DIALOG(34542,XMPAGE)
; Msg ID / Lines / Rcpts / From / Subject
W !!,$J($$EZBLD^DIALOG(34633),XMLEN("XMZ")),$J($$EZBLD^DIALOG(34003.1),XMLEN("LINE")),$J($$EZBLD^DIALOG(36207),XMLEN("RCPT"))," ",$$LJ^XLFSTR($$EZBLD^DIALOG(34006),XMLEN("FROM"))," ",$$EZBLD^DIALOG(34002),!
Q
ENT ;
N XML,XMD
S XML=1000,XMD=0
F I="XML","XMD" S XMSAVE(I)=""
D EN^XUTMDEVQ("PROC^XMUT2",$$EZBLD^DIALOG(36200),.XMSAVE) ; MailMan: Large Message Report
Q
XMUT2 ;(WASH ISC)/CAP-Large Msg Report ;12/04/2002 13:49
+1 ;;8.0;MailMan;**10**;Jun 28, 2002
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; ENTER XMMGR-LARGE-MESSAGE-REPORT
ENTER ;
+1 NEW XMABORT,XML,XMD,I,XMSAVE
+2 SET XMABORT=0
+3 DO INIT(.XML,.XMD,.XMABORT)
IF XMABORT
QUIT
+4 IF $DATA(ZTQUEUED)
DO PROCESS(XML,XMD)
QUIT
+5 FOR I="XML","XMD"
SET XMSAVE(I)=""
+6 ; MailMan: Large Message Report
DO EN^XUTMDEVQ("PROC^XMUT2",$$EZBLD^DIALOG(36200),.XMSAVE)
+7 QUIT
INIT(XML,XMD,XMABORT) ;
+1 SET XML=$GET(^XMB(1,1,"XMUT2-LINES"))
IF 'XML
SET XML=100
+2 SET XMD=$ORDER(^XMB(3.9,"C",""))
+3 IF $DATA(ZTQUEUED)
QUIT
+4 ; This report lists messages longer than a certain number of lines.
WRITE !,$$EZBLD^DIALOG(36201),!
+5 DO MINLINES(.XML,.XMABORT)
IF XMABORT
QUIT
+6 DO STARTDT(.XMD,.XMABORT)
IF XMABORT
QUIT
+7 QUIT
MINLINES(XML,XMABORT) ;
+1 NEW DIR,X,Y,DA
+2 ;Report on messages longer than this many lines
+3 DO BLD^DIALOG(36203,"","","DIR(""A"")")
+4 SET DIR(0)="4.3,8.14"
SET DA=1
+5 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+6 IF Y=XML
QUIT
+7 SET XML=Y
+8 KILL DIR,X,Y,DA
+9 ;Make this the default for future reports
+10 DO BLD^DIALOG(36204,"","","DIR(""A"")")
+11 ; Yes
SET DIR("B")=$$EZBLD^DIALOG(39054)
+12 SET DIR(0)="Y"
+13 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+14 IF 'Y
QUIT
+15 SET $PIECE(^XMB(1,1,"XMUT2-LINES"),U)=XML
+16 QUIT
STARTDT(XMD,XMABORT) ;
+1 NEW DIR,X
+2 ;The default starting date is the date of the oldest message.
+3 ;Enter the start date
+4 WRITE !
+5 DO BLD^DIALOG(36202,"","","DIR(""A"")")
+6 SET DIR("B")=$$FMTE^XLFDT(XMD,5)
+7 SET DIR(0)="D^"_XMD_":"_DT_";EP"
+8 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
+9 SET XMD=Y
+10 QUIT
PROCESS(XML,XMD) ;
PROC ;
+1 NEW XMABORT,XMPAGE,XMCNT,XMDATE,XMREC,XMLINES,XMLEN,XMZ,XMLEFT
+2 ;Msg ID
SET XMLEN("XMZ")=$$MAX^XLFMTH($LENGTH($ORDER(^XMB(3.9,"A"),-1)),$LENGTH($$EZBLD^DIALOG(34633)))
+3 ;Lines
SET XMLEN("LINE")=$$MAX^XLFMTH(7,$LENGTH($$EZBLD^DIALOG(34003.1))+1)
+4 ;Rcpts
SET XMLEN("RCPT")=$$MAX^XLFMTH(6,$LENGTH($$EZBLD^DIALOG(36207))+1)
+5 SET XMLEFT=75-XMLEN("XMZ")-XMLEN("LINE")-XMLEN("RCPT")
+6 SET XMLEN("FROM")=XMLEFT\2
+7 SET XMLEN("SUBJ")=XMLEFT-XMLEN("FROM")
+8 SET (XMABORT,XMCNT,XMPAGE)=0
+9 SET XMDATE=$$FMTE^XLFDT(DT,5)
+10 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+11 DO HDR
+12 SET XMD=XMD-.1
+13 SET XMZ=""
+14 FOR
SET XMD=$ORDER(^XMB(3.9,"C",XMD))
IF XMD=""
QUIT
Begin DoDot:1
+15 FOR
SET XMZ=$ORDER(^XMB(3.9,"C",XMD,XMZ))
IF XMZ=""
QUIT
Begin DoDot:2
+16 SET XMCNT=XMCNT+1
+17 SET XMLINES=+$PIECE($GET(^XMB(3.9,XMZ,2,0)),U,4)
+18 IF $EXTRACT(IOST,1,2)="C-"
IF XMCNT#1000=0
IF $X>50
WRITE !
WRITE "."
+19 IF XMLINES'>XML
QUIT
+20 SET XMREC=$GET(^XMB(3.9,XMZ,0))
+21 IF $PIECE(XMREC,U)?1"R"1N.N
QUIT
+22 SET XMRECIPS=+$PIECE($GET(^XMB(3.9,XMZ,1,0)),U,4)
+23 IF $Y+3>IOSL
DO PAGE(.XMABORT)
IF XMABORT
QUIT
+24 WRITE !,$JUSTIFY(XMZ,XMLEN("XMZ")),$JUSTIFY(XMLINES,XMLEN("LINE")),$JUSTIFY(XMRECIPS,XMLEN("RCPT"))," "
+25 WRITE $$LJ^XLFSTR($EXTRACT($$NAME^XMXUTIL($PIECE(XMREC,U,2)),1,XMLEN("FROM")),XMLEN("FROM"))," ",$$LJ^XLFSTR($EXTRACT($$SUBJ^XMXUTIL2(XMREC),1,XMLEN("SUBJ")),XMLEN("SUBJ"))
End DoDot:2
IF XMABORT
QUIT
End DoDot:1
IF XMABORT
QUIT
+26 IF XMABORT
QUIT
+27 IF $EXTRACT(IOST,1,2)="C-"
DO WAIT^XMXUTIL
+28 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+29 QUIT
PAGE(XMABORT) ;
+1 IF $EXTRACT(IOST,1,2)="C-"
DO PAGE^XMXUTIL(.XMABORT)
IF XMABORT
QUIT
+2 WRITE @IOF
+3 DO HDR
+4 QUIT
HDR ;
+1 SET XMPAGE=XMPAGE+1
+2 ;Messages with more than _XML_ lines,?50,Report date: _XMDATE_ _Page
+3 WRITE $$EZBLD^DIALOG(36205,XML),?50,$$EZBLD^DIALOG(36206,XMDATE)," ",$$EZBLD^DIALOG(34542,XMPAGE)
+4 ; Msg ID / Lines / Rcpts / From / Subject
+5 WRITE !!,$JUSTIFY($$EZBLD^DIALOG(34633),XMLEN("XMZ")),$JUSTIFY($$EZBLD^DIALOG(34003.1),XMLEN("LINE")),$JUSTIFY($$EZBLD^DIALOG(36207),XMLEN("RCPT"))," ",$$LJ^XLFSTR($$EZBLD^DIALOG(34006),XMLEN("FROM"))," ",$$EZBLD^DIALOG(34002),!
+6 QUIT
ENT ;
+1 NEW XML,XMD
+2 SET XML=1000
SET XMD=0
+3 FOR I="XML","XMD"
SET XMSAVE(I)=""
+4 ; MailMan: Large Message Report
DO EN^XUTMDEVQ("PROC^XMUT2",$$EZBLD^DIALOG(36200),.XMSAVE)
+5 QUIT
