- XMA30 ;ISC-SF/GMB-XMCLEAN, XMAUTOPURGE (cont.) ;01/08/2003 10:04
- ;;8.0;MailMan;**10,13**;Jun 28, 2002
- ; Was (WASH ISC)/CAP
- AUDIT ; Lists data from previous purges
- N XMLIEN,XMREC,XMSTART,XMEND,XMLEFT,XMPURGE,XMTYPE,XMABORT
- S XMABORT=0
- W @IOF
- D BLD^DIALOG(36432,"","","XMTEXT","F")
- D MSG^DIALOG("WM","","","","XMTEXT")
- ;It's a good idea to look these over.
- ;Look for multiple purges running concurrently and missing purge dates.
- ;Check the times the purge ended - do they conflict with user activity?
- W !
- D AHDR
- S XMLIEN=0
- F S XMLIEN=$O(^XMB(1,1,.1,XMLIEN)) Q:XMLIEN'>0 D Q:XMABORT
- . I $Y+3>IOSL D Q:XMABORT
- . . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
- . . W @IOF D AHDR
- . S XMREC=^XMB(1,1,.1,XMLIEN,0)
- . S XMSTART=$E($P(XMREC,U),1,12)
- . S XMLEFT=$P(XMREC,U,2)
- . S XMPURGE=$P(XMREC,U,3)
- . S XMTYPE=$P(XMREC,U,6)
- . S XMEND=$E($P(XMREC,U,8),1,12)
- . I XMTYPE="",'XMEND D ; To handle old data before XM*7.1*37
- . . S XMEND=XMSTART
- . . K XMSTART
- . W !,$$EZBLD^DIALOG($S(+XMTYPE=0:36433,XMTYPE=1:36434,1:36435)) ; "Unref Msg" / "Date" / "Test Date"
- . W ?12,$S($D(XMSTART):$J($$FMTE^XLFDT(XMSTART,5),16),1:""),$J($$FMTE^XLFDT(XMEND,5),18)
- . I $D(XMSTART),XMEND>XMSTART W $J($$FMDIFF^XLFDT(XMEND,XMSTART,3),10)
- . W ?58,$J(XMPURGE,9),$J(XMLEFT,12)
- Q
- AHDR ;
- N XMTEXT
- D BLD^DIALOG(36436,"","","XMTEXT","F")
- D MSG^DIALOG("WM","",IOM,"","XMTEXT")
- W !
- ;MailMan Purge History
- ;Type Start End Duration Purged Kept
- Q
- USERSTAT ; Display statistics
- N DIR,Y,XMTYPE,ZTSAVE,XMVAR,XMTEXT,XMDIALOG,XMI
- W !
- S XMVAR(2)=$O(^XMB(3.9,":"),-1) ; highest
- S XMVAR(1)=$J($O(^XMB(3.9,0)),$L(XMVAR(2))) ; lowest
- S XMVAR(3)=$J($P($G(^XMB(3.9,0)),U,4),$L(XMVAR(2))) ; how many
- D BLD^DIALOG(36437,.XMVAR,"","XMTEXT","F")
- D MSG^DIALOG("WM","","","","XMTEXT")
- ;Lowest numbered message: |1|
- ;Highest numbered message: |2|
- ;Number of messages: |3|
- D BLD^DIALOG(36438,"","","DIR(""A"")") ; Scan Option
- ;A:Active Mailboxes;I:Inactive Mailboxes;M:All Mailboxes"
- S DIR(0)="S^"
- F XMI=36439.1,36439.2,36439.3 D
- . S XMDIALOG(XMI)=$$EZBLD^DIALOG(XMI)
- . S DIR(0)=DIR(0)_XMDIALOG(XMI)_";"
- S DIR(0)=$E(DIR(0),1,$L(DIR(0))-1)
- S DIR("B")=$P(XMDIALOG(36439.1),":",2) ; Active Mailboxes
- D ^DIR Q:$D(DIRUT)
- S XMI=0 F S XMI=$O(XMDIALOG(XMI)) Q:$P(XMDIALOG(XMI),":",1)=Y
- S XMTYPE=$S(XMI=36439.1:"A",XMI=36439.2:"I",1:"M")
- S XMTYPE("DESC")=$P(XMDIALOG(XMI),":",2)
- S ZTSAVE("XMTYPE")="",ZTSAVE("XMTYPE(")=""
- D EN^XUTMDEVQ("DOSTATS^XMA30",$$EZBLD^DIALOG(36440),.ZTSAVE) ; MailMan: User Mailbox Statistics
- Q
- DOSTATS ;
- N XMTODAY,XMPAGE,XMABORT,XMDUZ,XMK,XMINCNT,XMZCNT,XMKCNT,XMBOXCNT,XMLMAIL,XMNAME,XMREC,XMSTAT,XMLSIGN,XMINACT
- S XMTODAY=$$FMTE^XLFDT(DT,5),(XMPAGE,XMABORT,XMBOXCNT)=0
- S:$D(ZTQUEUED) ZTREQ="@"
- W:$E(IOST,1,2)="C-" @IOF D SHDR(XMTODAY,.XMPAGE)
- S XMNAME="",XMINACT=$$EZBLD^DIALOG(36441) ; "Inactive"
- F S XMNAME=$O(^VA(200,"B",XMNAME)) Q:XMNAME="" D Q:XMABORT
- . S XMDUZ=0
- . F S XMDUZ=$O(^VA(200,"B",XMNAME,XMDUZ)) Q:XMDUZ="" D Q:XMABORT
- . . Q:'$D(^XMB(3.7,XMDUZ))
- . . S XMREC=$G(^VA(200,XMDUZ,0))
- . . I $P(XMREC,U,3)="" Q:XMTYPE="A" S XMSTAT=XMINACT
- . . E I XMTYPE="I" Q
- . . E S XMSTAT=""
- . . I $Y+3>IOSL D Q:XMABORT
- . . . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
- . . . W @IOF D SHDR(XMTODAY,.XMPAGE)
- . . S XMBOXCNT=XMBOXCNT+1
- . . W !,$E($$NAME^XMXUTIL(XMDUZ),1,30)
- . . S XMK=.9,(XMINCNT,XMZCNT)=0
- . . F XMKCNT=1:1 S XMK=$O(^XMB(3.7,XMDUZ,2,XMK)) Q:XMK'>0 D
- . . . D:'$D(^XMB(3.7,XMDUZ,2,XMK,1,0)) MAKENODE
- . . . I XMK=1 S XMINCNT=+$P($G(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4),XMZCNT=XMINCNT Q
- . . . S XMZCNT=XMZCNT+$P($G(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)
- . . S XMLSIGN=$P($G(^VA(200,XMDUZ,1.1)),U)
- . . S XMLSIGN=$S(XMSTAT'="":XMSTAT,'XMLSIGN:$$EZBLD^DIALOG(38002),1:$J($$MMDT^XMXUTIL1($P(XMLSIGN,".")),8)) ; Never
- . . S XMLMAIL=$P($G(^XMB(3.7,XMDUZ,"L")),U)
- . . S XMLMAIL=$S(XMLMAIL["@":$P(XMLMAIL,"@"),1:$P(XMLMAIL," ",1,3))
- . . W ?30,$J(XMKCNT,4),$J(XMZCNT,7),$J(XMINCNT,8),?53,XMLSIGN,?67,$S($L(XMLMAIL):XMLMAIL,1:$$EZBLD^DIALOG(38002)) ; Never
- Q:XMABORT
- W !!,XMTYPE("DESC"),": ",XMBOXCNT
- I $E(IOST,1,2)="C-" D WAIT^XMXUTIL
- Q
- MAKENODE ; Create the zero node for the message multiple
- N XMCNT,XMZ
- Q:'$O(^XMB(3.7,XMDUZ,2,XMK,1,0))
- S (XMZ,XMCNT)=0
- F S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,XMZ)) Q:XMZ'>0 S XMCNT=XMCNT+1
- S ^XMB(3.7,XMDUZ,2,XMK,1,0)="^3.702P^"_+$O(^XMB(3.7,XMDUZ,2,XMK,1,"C"),-1)_U_XMCNT
- Q
- SHDR(XMTODAY,XMPAGE) ; Header for Mailbox Statistics Report
- S XMPAGE=XMPAGE+1
- W XMTYPE("DESC"),", ",XMTODAY,?65,$J($$EZBLD^DIALOG(34542,XMPAGE),15) ; Page |1|
- D BLD^DIALOG(36443,"","","XMTEXT","F")
- D MSG^DIALOG("WM","",IOM,"","XMTEXT")
- W !
- ;User Bskts Msgs IN Bskt Last Sign on Last Mail Use"
- Q
- DONTPURG ; Find all messages which might not be in someone's mailbox,
- ; but which shouldn't be purged anyway.
- N XMDUZ,XMZ,XMZR,XMQ,XMT,XMD,XMINST,XMG
- K ^TMP("XM",$J)
- ;
- ; DON'T PURGE LOCAL MESSAGES AND REPLIES WHICH ARE ABOUT TO BE DELIVERED
- ;
- S (XMT,XMG,XMZ)="" ; new messages, forwarded messages, and replies
- F S XMT=$O(^XMBPOST("BOX",XMT)) Q:XMT="" D
- . F S XMG=$O(^XMBPOST("BOX",XMT,XMG)) Q:XMG="" D
- . . F S XMZ=$O(^XMBPOST("BOX",XMT,XMG,XMZ)) Q:XMZ="" S ^TMP("XM",$J,"NOP",+XMZ)="" I XMG="R" S ^TMP("XM",$J,"NOP",$P(XMZ,U,2))=""
- ;
- ; new messages, forwarded messages
- S (XMQ,XMT,XMZ)="" ; Queue number, Timestamp, Message IEN
- F S XMQ=$O(^XMBPOST("M",XMQ)) Q:XMQ="" D
- . F S XMT=$O(^XMBPOST("M",XMQ,XMT)) Q:XMT="" D
- . . F S XMZ=$O(^XMBPOST("M",XMQ,XMT,XMZ)) Q:XMZ="" S ^TMP("XM",$J,"NOP",+XMZ)=""
- ;
- ; replies
- S (XMQ,XMZ,XMZR)="" ; Queue number, Message IEN, Reply IEN
- F S XMQ=$O(^XMBPOST("R",XMQ)) Q:XMQ="" D
- . S XMT="" ; Timestamp
- . F S XMT=$O(^XMBPOST("R",XMQ,XMT)) Q:XMT'>0 D
- . . F S XMZ=$O(^XMBPOST("R",XMQ,XMT,XMZ)) Q:XMZ="" D
- . . . S ^TMP("XM",$J,"NOP",XMZ)="" ; Original msg to new replies
- . . . F S XMZR=$O(^XMBPOST("R",XMQ,XMT,XMZ,XMZR)) Q:XMZR="" S ^TMP("XM",$J,"NOP",XMZR)="" ; Reply
- ;
- ; DON'T PURGE MESSAGES QUEUED TO BE DELIVERED REMOTELY
- S XMINST=999 ; Institution
- F S XMINST=$O(^XMB(3.7,.5,2,XMINST)) Q:XMINST'>0 D
- . S XMZ=0
- . F S XMZ=$O(^XMB(3.7,.5,2,XMINST,1,XMZ)) Q:XMZ'>0 S ^TMP("XM",$J,"NOP",XMZ)=""
- ;
- ; DON'T PURGE LATER'D MESSAGES
- S XMD=0 ; Date to be later'd
- F S XMD=$O(^XMB(3.73,XMD)) Q:XMD'>0 D
- . S XMZ=$P(^XMB(3.73,XMD,0),U,3)
- . S:XMZ ^TMP("XM",$J,"NOP",XMZ)="" ; Msg to be later'd
- ;
- ; DON'T PURGE MESSAGES WHICH ARE BEING EDITED
- S (XMDUZ,XMZ)=""
- F S XMDUZ=$O(^XMB(3.7,"AD",XMDUZ)) Q:XMDUZ="" D
- . F S XMZ=$O(^XMB(3.7,"AD",XMDUZ,XMZ)) Q:XMZ="" S ^TMP("XM",$J,"NOP",XMZ)=""
- ;
- ; DON'T PURGE MESSAGES WHICH ARE TO BE DELIVERED LATER TO CERTAIN RECIPIENTS
- S (XMD,XMZ)=""
- F S XMD=$O(^XMB(3.9,"AL",XMD)) Q:XMD="" D
- . F S XMZ=$O(^XMB(3.9,"AL",XMD,XMZ)) Q:XMZ="" S ^TMP("XM",$J,"NOP",XMZ)=""
- Q
- XMA30 ;ISC-SF/GMB-XMCLEAN, XMAUTOPURGE (cont.) ;01/08/2003 10:04
- +1 ;;8.0;MailMan;**10,13**;Jun 28, 2002
- +2 ; Was (WASH ISC)/CAP
- AUDIT ; Lists data from previous purges
- +1 NEW XMLIEN,XMREC,XMSTART,XMEND,XMLEFT,XMPURGE,XMTYPE,XMABORT
- +2 SET XMABORT=0
- +3 WRITE @IOF
- +4 DO BLD^DIALOG(36432,"","","XMTEXT","F")
- +5 DO MSG^DIALOG("WM","","","","XMTEXT")
- +6 ;It's a good idea to look these over.
- +7 ;Look for multiple purges running concurrently and missing purge dates.
- +8 ;Check the times the purge ended - do they conflict with user activity?
- +9 WRITE !
- +10 DO AHDR
- +11 SET XMLIEN=0
- +12 FOR
- SET XMLIEN=$ORDER(^XMB(1,1,.1,XMLIEN))
- IF XMLIEN'>0
- QUIT
- Begin DoDot:1
- +13 IF $Y+3>IOSL
- Begin DoDot:2
- +14 IF $EXTRACT(IOST,1,2)="C-"
- DO PAGE^XMXUTIL(.XMABORT)
- IF XMABORT
- QUIT
- +15 WRITE @IOF
- DO AHDR
- End DoDot:2
- IF XMABORT
- QUIT
- +16 SET XMREC=^XMB(1,1,.1,XMLIEN,0)
- +17 SET XMSTART=$EXTRACT($PIECE(XMREC,U),1,12)
- +18 SET XMLEFT=$PIECE(XMREC,U,2)
- +19 SET XMPURGE=$PIECE(XMREC,U,3)
- +20 SET XMTYPE=$PIECE(XMREC,U,6)
- +21 SET XMEND=$EXTRACT($PIECE(XMREC,U,8),1,12)
- +22 ; To handle old data before XM*7.1*37
- IF XMTYPE=""
- IF 'XMEND
- Begin DoDot:2
- +23 SET XMEND=XMSTART
- +24 KILL XMSTART
- End DoDot:2
- +25 ; "Unref Msg" / "Date" / "Test Date"
- WRITE !,$$EZBLD^DIALOG($SELECT(+XMTYPE=0:36433,XMTYPE=1:36434,1:36435))
- +26 WRITE ?12,$SELECT($DATA(XMSTART):$JUSTIFY($$FMTE^XLFDT(XMSTART,5),16),1:""),$JUSTIFY($$FMTE^XLFDT(XMEND,5),18)
- +27 IF $DATA(XMSTART)
- IF XMEND>XMSTART
- WRITE $JUSTIFY($$FMDIFF^XLFDT(XMEND,XMSTART,3),10)
- +28 WRITE ?58,$JUSTIFY(XMPURGE,9),$JUSTIFY(XMLEFT,12)
- End DoDot:1
- IF XMABORT
- QUIT
- +29 QUIT
- AHDR ;
- +1 NEW XMTEXT
- +2 DO BLD^DIALOG(36436,"","","XMTEXT","F")
- +3 DO MSG^DIALOG("WM","",IOM,"","XMTEXT")
- +4 WRITE !
- +5 ;MailMan Purge History
- +6 ;Type Start End Duration Purged Kept
- +7 QUIT
- USERSTAT ; Display statistics
- +1 NEW DIR,Y,XMTYPE,ZTSAVE,XMVAR,XMTEXT,XMDIALOG,XMI
- +2 WRITE !
- +3 ; highest
- SET XMVAR(2)=$ORDER(^XMB(3.9,":"),-1)
- +4 ; lowest
- SET XMVAR(1)=$JUSTIFY($ORDER(^XMB(3.9,0)),$LENGTH(XMVAR(2)))
- +5 ; how many
- SET XMVAR(3)=$JUSTIFY($PIECE($GET(^XMB(3.9,0)),U,4),$LENGTH(XMVAR(2)))
- +6 DO BLD^DIALOG(36437,.XMVAR,"","XMTEXT","F")
- +7 DO MSG^DIALOG("WM","","","","XMTEXT")
- +8 ;Lowest numbered message: |1|
- +9 ;Highest numbered message: |2|
- +10 ;Number of messages: |3|
- +11 ; Scan Option
- DO BLD^DIALOG(36438,"","","DIR(""A"")")
- +12 ;A:Active Mailboxes;I:Inactive Mailboxes;M:All Mailboxes"
- +13 SET DIR(0)="S^"
- +14 FOR XMI=36439.1,36439.2,36439.3
- Begin DoDot:1
- +15 SET XMDIALOG(XMI)=$$EZBLD^DIALOG(XMI)
- +16 SET DIR(0)=DIR(0)_XMDIALOG(XMI)_";"
- End DoDot:1
- +17 SET DIR(0)=$EXTRACT(DIR(0),1,$LENGTH(DIR(0))-1)
- +18 ; Active Mailboxes
- SET DIR("B")=$PIECE(XMDIALOG(36439.1),":",2)
- +19 DO ^DIR
- IF $DATA(DIRUT)
- QUIT
- +20 SET XMI=0
- FOR
- SET XMI=$ORDER(XMDIALOG(XMI))
- IF $PIECE(XMDIALOG(XMI),"
- QUIT
- +21 SET XMTYPE=$SELECT(XMI=36439.1:"A",XMI=36439.2:"I",1:"M")
- +22 SET XMTYPE("DESC")=$PIECE(XMDIALOG(XMI),":",2)
- +23 SET ZTSAVE("XMTYPE")=""
- SET ZTSAVE("XMTYPE(")=""
- +24 ; MailMan: User Mailbox Statistics
- DO EN^XUTMDEVQ("DOSTATS^XMA30",$$EZBLD^DIALOG(36440),.ZTSAVE)
- +25 QUIT
- DOSTATS ;
- +1 NEW XMTODAY,XMPAGE,XMABORT,XMDUZ,XMK,XMINCNT,XMZCNT,XMKCNT,XMBOXCNT,XMLMAIL,XMNAME,XMREC,XMSTAT,XMLSIGN,XMINACT
- +2 SET XMTODAY=$$FMTE^XLFDT(DT,5)
- SET (XMPAGE,XMABORT,XMBOXCNT)=0
- +3 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +4 IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- DO SHDR(XMTODAY,.XMPAGE)
- +5 ; "Inactive"
- SET XMNAME=""
- SET XMINACT=$$EZBLD^DIALOG(36441)
- +6 FOR
- SET XMNAME=$ORDER(^VA(200,"B",XMNAME))
- IF XMNAME=""
- QUIT
- Begin DoDot:1
- +7 SET XMDUZ=0
- +8 FOR
- SET XMDUZ=$ORDER(^VA(200,"B",XMNAME,XMDUZ))
- IF XMDUZ=""
- QUIT
- Begin DoDot:2
- +9 IF '$DATA(^XMB(3.7,XMDUZ))
- QUIT
- +10 SET XMREC=$GET(^VA(200,XMDUZ,0))
- +11 IF $PIECE(XMREC,U,3)=""
- IF XMTYPE="A"
- QUIT
- SET XMSTAT=XMINACT
- +12 IF '$TEST
- IF XMTYPE="I"
- QUIT
- +13 IF '$TEST
- SET XMSTAT=""
- +14 IF $Y+3>IOSL
- Begin DoDot:3
- +15 IF $EXTRACT(IOST,1,2)="C-"
- DO PAGE^XMXUTIL(.XMABORT)
- IF XMABORT
- QUIT
- +16 WRITE @IOF
- DO SHDR(XMTODAY,.XMPAGE)
- End DoDot:3
- IF XMABORT
- QUIT
- +17 SET XMBOXCNT=XMBOXCNT+1
- +18 WRITE !,$EXTRACT($$NAME^XMXUTIL(XMDUZ),1,30)
- +19 SET XMK=.9
- SET (XMINCNT,XMZCNT)=0
- +20 FOR XMKCNT=1:1
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,2,XMK))
- IF XMK'>0
- QUIT
- Begin DoDot:3
- +21 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,0))
- DO MAKENODE
- +22 IF XMK=1
- SET XMINCNT=+$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)
- SET XMZCNT=XMINCNT
- QUIT
- +23 SET XMZCNT=XMZCNT+$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)
- End DoDot:3
- +24 SET XMLSIGN=$PIECE($GET(^VA(200,XMDUZ,1.1)),U)
- +25 ; Never
- SET XMLSIGN=$SELECT(XMSTAT'="":XMSTAT,'XMLSIGN:$$EZBLD^DIALOG(38002),1:$JUSTIFY($$MMDT^XMXUTIL1($PIECE(XMLSIGN,".")),8))
- +26 SET XMLMAIL=$PIECE($GET(^XMB(3.7,XMDUZ,"L")),U)
- +27 SET XMLMAIL=$SELECT(XMLMAIL["@":$PIECE(XMLMAIL,"@"),1:$PIECE(XMLMAIL," ",1,3))
- +28 ; Never
- WRITE ?30,$JUSTIFY(XMKCNT,4),$JUSTIFY(XMZCNT,7),$JUSTIFY(XMINCNT,8),?53,XMLSIGN,?67,$SELECT($LENGTH(XMLMAIL):XMLMAIL,1:$$EZBLD^DIALOG(38002))
- End DoDot:2
- IF XMABORT
- QUIT
- End DoDot:1
- IF XMABORT
- QUIT
- +29 IF XMABORT
- QUIT
- +30 WRITE !!,XMTYPE("DESC"),": ",XMBOXCNT
- +31 IF $EXTRACT(IOST,1,2)="C-"
- DO WAIT^XMXUTIL
- +32 QUIT
- MAKENODE ; Create the zero node for the message multiple
- +1 NEW XMCNT,XMZ
- +2 IF '$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,0))
- QUIT
- +3 SET (XMZ,XMCNT)=0
- +4 FOR
- SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,XMZ))
- IF XMZ'>0
- QUIT
- SET XMCNT=XMCNT+1
- +5 SET ^XMB(3.7,XMDUZ,2,XMK,1,0)="^3.702P^"_+$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C"),-1)_U_XMCNT
- +6 QUIT
- SHDR(XMTODAY,XMPAGE) ; Header for Mailbox Statistics Report
- +1 SET XMPAGE=XMPAGE+1
- +2 ; Page |1|
- WRITE XMTYPE("DESC"),", ",XMTODAY,?65,$JUSTIFY($$EZBLD^DIALOG(34542,XMPAGE),15)
- +3 DO BLD^DIALOG(36443,"","","XMTEXT","F")
- +4 DO MSG^DIALOG("WM","",IOM,"","XMTEXT")
- +5 WRITE !
- +6 ;User Bskts Msgs IN Bskt Last Sign on Last Mail Use"
- +7 QUIT
- DONTPURG ; Find all messages which might not be in someone's mailbox,
- +1 ; but which shouldn't be purged anyway.
- +2 NEW XMDUZ,XMZ,XMZR,XMQ,XMT,XMD,XMINST,XMG
- +3 KILL ^TMP("XM",$JOB)
- +4 ;
- +5 ; DON'T PURGE LOCAL MESSAGES AND REPLIES WHICH ARE ABOUT TO BE DELIVERED
- +6 ;
- +7 ; new messages, forwarded messages, and replies
- SET (XMT,XMG,XMZ)=""
- +8 FOR
- SET XMT=$ORDER(^XMBPOST("BOX",XMT))
- IF XMT=""
- QUIT
- Begin DoDot:1
- +9 FOR
- SET XMG=$ORDER(^XMBPOST("BOX",XMT,XMG))
- IF XMG=""
- QUIT
- Begin DoDot:2
- +10 FOR
- SET XMZ=$ORDER(^XMBPOST("BOX",XMT,XMG,XMZ))
- IF XMZ=""
- QUIT
- SET ^TMP("XM",$JOB,"NOP",+XMZ)=""
- IF XMG="R"
- SET ^TMP("XM",$JOB,"NOP",$PIECE(XMZ,U,2))=""
- End DoDot:2
- End DoDot:1
- +11 ;
- +12 ; new messages, forwarded messages
- +13 ; Queue number, Timestamp, Message IEN
- SET (XMQ,XMT,XMZ)=""
- +14 FOR
- SET XMQ=$ORDER(^XMBPOST("M",XMQ))
- IF XMQ=""
- QUIT
- Begin DoDot:1
- +15 FOR
- SET XMT=$ORDER(^XMBPOST("M",XMQ,XMT))
- IF XMT=""
- QUIT
- Begin DoDot:2
- +16 FOR
- SET XMZ=$ORDER(^XMBPOST("M",XMQ,XMT,XMZ))
- IF XMZ=""
- QUIT
- SET ^TMP("XM",$JOB,"NOP",+XMZ)=""
- End DoDot:2
- End DoDot:1
- +17 ;
- +18 ; replies
- +19 ; Queue number, Message IEN, Reply IEN
- SET (XMQ,XMZ,XMZR)=""
- +20 FOR
- SET XMQ=$ORDER(^XMBPOST("R",XMQ))
- IF XMQ=""
- QUIT
- Begin DoDot:1
- +21 ; Timestamp
- SET XMT=""
- +22 FOR
- SET XMT=$ORDER(^XMBPOST("R",XMQ,XMT))
- IF XMT'>0
- QUIT
- Begin DoDot:2
- +23 FOR
- SET XMZ=$ORDER(^XMBPOST("R",XMQ,XMT,XMZ))
- IF XMZ=""
- QUIT
- Begin DoDot:3
- +24 ; Original msg to new replies
- SET ^TMP("XM",$JOB,"NOP",XMZ)=""
- +25 ; Reply
- FOR
- SET XMZR=$ORDER(^XMBPOST("R",XMQ,XMT,XMZ,XMZR))
- IF XMZR=""
- QUIT
- SET ^TMP("XM",$JOB,"NOP",XMZR)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +26 ;
- +27 ; DON'T PURGE MESSAGES QUEUED TO BE DELIVERED REMOTELY
- +28 ; Institution
- SET XMINST=999
- +29 FOR
- SET XMINST=$ORDER(^XMB(3.7,.5,2,XMINST))
- IF XMINST'>0
- QUIT
- Begin DoDot:1
- +30 SET XMZ=0
- +31 FOR
- SET XMZ=$ORDER(^XMB(3.7,.5,2,XMINST,1,XMZ))
- IF XMZ'>0
- QUIT
- SET ^TMP("XM",$JOB,"NOP",XMZ)=""
- End DoDot:1
- +32 ;
- +33 ; DON'T PURGE LATER'D MESSAGES
- +34 ; Date to be later'd
- SET XMD=0
- +35 FOR
- SET XMD=$ORDER(^XMB(3.73,XMD))
- IF XMD'>0
- QUIT
- Begin DoDot:1
- +36 SET XMZ=$PIECE(^XMB(3.73,XMD,0),U,3)
- +37 ; Msg to be later'd
- IF XMZ
- SET ^TMP("XM",$JOB,"NOP",XMZ)=""
- End DoDot:1
- +38 ;
- +39 ; DON'T PURGE MESSAGES WHICH ARE BEING EDITED
- +40 SET (XMDUZ,XMZ)=""
- +41 FOR
- SET XMDUZ=$ORDER(^XMB(3.7,"AD",XMDUZ))
- IF XMDUZ=""
- QUIT
- Begin DoDot:1
- +42 FOR
- SET XMZ=$ORDER(^XMB(3.7,"AD",XMDUZ,XMZ))
- IF XMZ=""
- QUIT
- SET ^TMP("XM",$JOB,"NOP",XMZ)=""
- End DoDot:1
- +43 ;
- +44 ; DON'T PURGE MESSAGES WHICH ARE TO BE DELIVERED LATER TO CERTAIN RECIPIENTS
- +45 SET (XMD,XMZ)=""
- +46 FOR
- SET XMD=$ORDER(^XMB(3.9,"AL",XMD))
- IF XMD=""
- QUIT
- Begin DoDot:1
- +47 FOR
- SET XMZ=$ORDER(^XMB(3.9,"AL",XMD,XMZ))
- IF XMZ=""
- QUIT
- SET ^TMP("XM",$JOB,"NOP",XMZ)=""
- End DoDot:1
- +48 QUIT
