167 lines
8.2 KiB
Mathematica
167 lines
8.2 KiB
Mathematica
XMTDL ;ISC-SF/GMB-Deliver local mail to mailbox ;10/23/2002 06:37
|
|
;;8.0;MailMan;**1,6**;Jun 28, 2002
|
|
; Replaces ^XMAD0,GO^XMADGO,STATS^XMADJF0,^XMADJF1,^XMADJF1A (ISC-WASH/CAP)
|
|
GO ;
|
|
; Variables provided through TASKMAN: XMHANG,XMGROUP,XMQUEUE
|
|
N XMTSTAMP,XMUID,XMIDLE,X,XMMCNT,XMRCNT,XMACNT
|
|
; XMMCNT # of messages/responses processed
|
|
; XMRCNT # of potential local recipients to process
|
|
; XMACNT # of actual local recipients processed
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q:$P($G(^XMB(1,1,0)),U,16)
|
|
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D R^XMCTRAP"
|
|
E S X="R^XMCTRAP",@^%ZOSF("TRAP")
|
|
I $D(^%ZOSF("TRAP")) S X="^%ET",@^("TRAP")
|
|
I $D(^%ZOSF("PRIORITY")) S X=$S(+$G(^XMB(1,1,.13)):+^(.13),1:5) X ^%ZOSF("PRIORITY")
|
|
L +^XMBPOST(XMGROUP,XMQUEUE):0 E H 0 Q
|
|
S XMIDLE=0
|
|
F D Q:$P($G(^XMB(1,1,0)),U,16)!($$TSTAMP^XMXUTIL1-XMIDLE>900)
|
|
. F S XMTSTAMP=$O(^XMBPOST(XMGROUP,XMQUEUE,"")) Q:XMTSTAMP'>0 D
|
|
. . S XMIDLE=0
|
|
. . F S XMUID=$O(^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,"")) Q:XMUID="" D
|
|
. . . I XMGROUP="M" D
|
|
. . . . D MDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,.XMMCNT,.XMRCNT,.XMACNT)
|
|
. . . E D
|
|
. . . . D RDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,.XMMCNT,.XMRCNT,.XMACNT)
|
|
. . . K ^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMUID)
|
|
. . . D:'$D(^XMBPOST("STATS","OFF")) STATS^XMTDL1(XMGROUP,XMQUEUE,XMMCNT,XMRCNT,XMACNT) ; Delivered to # users
|
|
. L +^XMBPOST("QSTATS",XMGROUP,XMQUEUE):0
|
|
. S ^XMBPOST(XMGROUP,XMQUEUE)=""
|
|
. L -^XMBPOST("QSTATS",XMGROUP,XMQUEUE)
|
|
. S:XMIDLE=0 XMIDLE=$$TSTAMP^XMXUTIL1
|
|
. H XMHANG
|
|
L -^XMBPOST(XMGROUP,XMQUEUE)
|
|
Q
|
|
RDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMMCNT,XMRCNT,XMACNT) ; was ^XMADJF1
|
|
; Note: We know that XMGROUP="R" here
|
|
N XMZR,XMREC,XMFROM,XMFLIST,XMFIRST,XMFDA,I,XMZREC,XMZSUBJ,XMZFROM,XMZDATE,XMRESPS,XMTO,XMZRLIST
|
|
; XMFIRST sender of the first response processed
|
|
K ^XMBPOST(XMGROUP,XMQUEUE,"B",XMZ,XMTSTAMP) ; Accept no more additions to this batch of replies
|
|
;Post responses to message response multiple, keeping track of number of deliveries
|
|
S (XMMCNT,XMRCNT,XMACNT)=0
|
|
I '$D(^XMB(3.9,XMZ,0)) D Q
|
|
. D BADERR(36240,XMZ) ; Message |1| does not exist. Can't post responses to it.
|
|
. S XMZR=""
|
|
. F S XMZR=$O(^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMZR)) Q:XMZR="" S XMRCNT=XMRCNT+^(XMZR),XMMCNT=XMMCNT+1
|
|
S XMZREC=^XMB(3.9,XMZ,0)
|
|
S XMZSUBJ=$P(XMZREC,U),XMZFROM=$P(XMZREC,U,2),XMZDATE=$P(XMZREC,U,3)
|
|
S:XMZFROM="" XMZFROM=.5
|
|
; If the sender of the original msg is not a recipient, make him one.
|
|
I XMZFROM=+XMZFROM,'$D(^XMB(3.9,XMZ,1,"C",XMZFROM)) D
|
|
. D ADDRECP(XMZ,$P(XMZREC,U,7)["P",XMZFROM)
|
|
. ;D LASTREAD(XMZ,XMZFROM,XMZDATE)
|
|
S XMZR=""
|
|
F S XMZR=$O(^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMZR)) Q:XMZR="" S XMREC=^(XMZR) D
|
|
. S XMMCNT=XMMCNT+1
|
|
. S XMRCNT=XMRCNT+$P(XMREC,U,1)
|
|
. I '$D(^XMB(3.9,XMZR)) D Q
|
|
. . N XMPARM S XMPARM(1)=XMZ,XMPARM(2)=XMZR
|
|
. . D BADERR(36241,.XMPARM) ; Response |2| to message |1| does not exist. Can't deliver it.
|
|
. ;S XMFDA(3.9001,"+1,"_XMZ_",",.01)=XMZR ; *** Moved to ^XMKP ***
|
|
. ;D UPDATE^DIE("","XMFDA") ; Add to response multiple in original msg
|
|
. S XMZRLIST(XMZR)="" ; (not used, but helps in debugging)
|
|
. S XMFROM=$P(XMREC,U,2)
|
|
. S:'$D(XMFIRST) XMFIRST=XMFROM
|
|
. S XMFLIST(XMFROM)=$G(XMFLIST(XMFROM))+1 ; Number of replies by this user
|
|
. Q:XMFROM="NR" ; Network reply *** If we implement fully networked mail, we must get the real sender, and make sure s/he's in the 'addressed to' and 'recipient' multiples.
|
|
. ; If the sender of the reply is not a recipient, make him one.
|
|
. I XMFROM,'$D(^XMB(3.9,XMZ,1,"C",XMFROM)) D ADDRECP(XMZ,$P(XMZREC,U,7)["P",XMFROM)
|
|
Q:'$D(XMFLIST)
|
|
I $O(XMFLIST(""))=XMFIRST,$O(XMFLIST(XMFIRST))="" S XMFROM=XMFIRST ; There's one sender
|
|
E S XMFROM="" ; There's multiple senders
|
|
; At this point, XMFROM has the sender's DUZ (or 'NR' if remote)
|
|
; if there was only 1 sender.
|
|
; If there was more than 1 sender, then XMFROM="", so that ^XMTDL1 will
|
|
; make the msg new for all recipients.
|
|
; Now, deliver replies...
|
|
S XMRESPS=$P(^XMB(3.9,XMZ,3,0),U,4) ; Number of replies to msg
|
|
S XMTO=""
|
|
F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:XMTO'>0 D
|
|
. S I=$O(^XMB(3.9,XMZ,1,"C",XMTO,0))
|
|
. Q:$G(^XMB(3.9,XMZ,1,I,"D")) ; User terminated
|
|
. I $D(XMFLIST(XMTO)) D:XMTO=XMFIRST GOTREPLY(XMZ,XMRESPS,I,XMFLIST(XMTO)) Q:XMTO=XMFROM ; If recipient is the only sender, don't bother delivering to him, because he's already seen it.
|
|
. Q:$P(^XMB(3.9,XMZ,1,I,0),U,2)=XMRESPS ; Don't deliver if recipient has already seen all responses
|
|
. S XMACNT=XMACNT+1
|
|
. D DELIVER^XMTDL2(XMTO,XMZ,XMZSUBJ,XMZFROM,XMFROM,1)
|
|
Q
|
|
ADDRECP(XMZ,XMPRI,XMRECP) ; Add a recipient to the message
|
|
N XMFDA
|
|
S XMFDA(3.91,"+1,"_XMZ_",",.01)=XMRECP
|
|
I XMPRI,+XMRECP=XMRECP,$P($G(^XMB(3.7,XMRECP,0)),U,11) S XMFDA(3.91,"+1,"_XMZ_",",10)=$P(^(0),U,11) ; priority response flag
|
|
D UPDATE^DIE("","XMFDA")
|
|
S XMFDA(3.911,"+1,"_XMZ_",",.01)=$$NAME^XMXUTIL(XMRECP)
|
|
D UPDATE^DIE("","XMFDA")
|
|
Q
|
|
LASTREAD(XMZ,XMZFROM,XMZDATE) ; Note that the sender has read the original message
|
|
N XMFDA,XMIEN
|
|
S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMZFROM,0)) Q:'XMIEN
|
|
S XMFDA(3.91,XMIEN_","_XMZ_",",1)=0 ; Read the original msg
|
|
S XMFDA(3.91,XMIEN_","_XMZ_",",2)=XMZDATE ; Last Read
|
|
S XMFDA(3.91,XMIEN_","_XMZ_",",11)=XMZDATE ; First Read
|
|
D FILE^DIE("","XMFDA")
|
|
Q
|
|
GOTREPLY(XMZ,XMRESPS,XMIEN,XMRNEW) ; Note that recipient has seen his own reply.
|
|
N XMFDA
|
|
; If last reply seen + # responses made = total responses...
|
|
I $P(^XMB(3.9,XMZ,1,XMIEN,0),U,2)+XMRNEW=XMRESPS D
|
|
. S XMFDA(3.91,XMIEN_","_XMZ_",",1)=XMRESPS
|
|
. D FILE^DIE("","XMFDA")
|
|
Q
|
|
MDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,XMMCNT,XMRCNT,XMACNT) ; was ^XMADJF1
|
|
N XMZSUBJ,XMZFROM,XMZDATE,XMZPDATE,XMZBSKT,XMREC,XMZ,XMK,XMDEL,XMBCAST
|
|
; Note: We know that XMGROUP="M" here
|
|
; If $L(XMUID,U)>1, it's a forwarded message, else it's a new message.
|
|
S XMMCNT=1
|
|
S XMREC=^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMUID)
|
|
S XMRCNT=+$P(XMREC,U,1)
|
|
S XMACNT=0
|
|
S XMZ=+XMUID
|
|
I '$D(^XMB(3.9,XMZ,0)) D Q
|
|
. I $L(XMUID,U)>1 K ^XMBPOST("FWD",XMUID_U_XMTSTAMP)
|
|
. D BADERR(36242,XMZ) ; Message |1| does not exist. Can't deliver it.
|
|
S XMZSUBJ=$P(^XMB(3.9,XMZ,0),U),XMZFROM=$P(^(0),U,2),XMZDATE=$P(^(0),U,3),XMZPDATE=$P(^(0),U,6)
|
|
S:XMZFROM="" XMZFROM=.5
|
|
I XMZPDATE,XMZPDATE'>DT D Q ; If purge date has passed, don't deliver
|
|
. I $L(XMUID,U)>1 K ^XMBPOST("FWD",XMUID_U_XMTSTAMP)
|
|
I $P(XMREC,U,2)'="" D ; basket selection
|
|
. I $L(XMUID,U)=1 S XMK(XMZFROM)=$P(XMREC,U,2) Q ; sending person
|
|
. I $P(XMUID,U,2) S XMK($P(XMUID,U,2))=$P(XMREC,U,2) ; forwarding person
|
|
I $P(XMREC,U,3)'="" S XMK(.6)=$P(XMREC,U,3)
|
|
I $P(XMREC,U,4) S XMDEL(.6)=$P(XMREC,U,4)
|
|
S XMBCAST=($P(XMREC,U,5)'="")
|
|
S XMZBSKT=$P($G(^XMB(3.9,XMZ,.5)),U,1)
|
|
I $L(XMUID,U)=1 D NEW(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMBCAST,.XMK,.XMDEL,XMZSUBJ,XMZFROM,XMZDATE,XMZPDATE,XMZBSKT,.XMACNT) Q
|
|
D FORWARD(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,XMZ,XMBCAST,.XMK,.XMDEL,XMZSUBJ,XMZFROM,XMZPDATE,XMZBSKT,.XMACNT)
|
|
Q
|
|
NEW(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMBCAST,XMK,XMDEL,XMZSUBJ,XMZFROM,XMZDATE,XMZPDATE,XMZBSKT,XMACNT) ;
|
|
D:XMZFROM=+XMZFROM LASTREAD(XMZ,XMZFROM,XMZDATE)
|
|
I XMBCAST D BRODCAST^XMTDL1(XMZ,XMZSUBJ,XMZFROM,XMZFROM,.XMK,.XMDEL,XMZPDATE,XMZBSKT,.XMACNT)
|
|
N XMTO
|
|
S XMTO=0 ; Q: on next line ensures only local user delivery
|
|
F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:XMTO'>0 D
|
|
. I XMBCAST,$D(^XMB(3.7,"M",XMZ,XMTO)) Q
|
|
. S XMACNT=XMACNT+1
|
|
. D DELIVER^XMTDL2(XMTO,XMZ,XMZSUBJ,XMZFROM,XMZFROM,0,$G(XMK(XMTO)),$G(XMDEL(XMTO),XMZPDATE),XMZBSKT)
|
|
Q
|
|
FORWARD(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,XMZ,XMBCAST,XMK,XMDEL,XMZSUBJ,XMZFROM,XMZPDATE,XMZBSKT,XMACNT) ;
|
|
N I,J,XMFROM,XMTO,XMTOLIST
|
|
S XMFROM=$P(XMUID,U,2)
|
|
S XMUID=XMUID_U_XMTSTAMP
|
|
I XMBCAST D BRODCAST^XMTDL1(XMZ,XMZSUBJ,XMZFROM,XMFROM,.XMK,.XMDEL,XMZPDATE,XMZBSKT,.XMACNT) Q:'$D(^XMBPOST("FWD",XMUID))
|
|
S I=0
|
|
F S I=$O(^XMBPOST("FWD",XMUID,I)) Q:'I S XMTOLIST=^(I) D
|
|
. F J=1:1:$L(XMTOLIST,U) D
|
|
. . S XMTO=$P(XMTOLIST,U,J)
|
|
. . Q:$O(^XMB(3.7,"M",XMZ,XMTO,"")) ; User already has msg
|
|
. . Q:'$D(^XMB(3.9,XMZ,1,"C",XMTO)) ; User is not on recipient list (Should never happen
|
|
. . S XMACNT=XMACNT+1
|
|
. . D DELIVER^XMTDL2(XMTO,XMZ,XMZSUBJ,XMZFROM,XMFROM,0,$G(XMK(XMTO)),$G(XMDEL(XMTO),XMZPDATE),XMZBSKT)
|
|
K ^XMBPOST("FWD",XMUID)
|
|
Q
|
|
BADERR(XMDIALOG,XMPARM) ;
|
|
N XMTEXT,XMINSTR
|
|
D BLD^DIALOG(XMDIALOG,.XMPARM,"","XMTEXT")
|
|
S XMINSTR("FROM")="MailMan"
|
|
D TASKBULL^XMXBULL(DUZ,"XM_TRANSMISSION_ERROR","","XMTEXT",.5,.XMINSTR)
|
|
Q
|