- 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
