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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMA30 7001 printed Nov 22, 2024@17:20:59 Page 2
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
