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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMTDL 8515 printed Apr 09, 2024@21:13:57 Page 2
XMTDL ;ISC-SF/GMB-Deliver local mail to mailbox ;10/23/2002 06:37
+1 ;;8.0;MailMan;**1,6**;Jun 28, 2002
+2 ; Replaces ^XMAD0,GO^XMADGO,STATS^XMADJF0,^XMADJF1,^XMADJF1A (ISC-WASH/CAP)
GO ;
+1 ; Variables provided through TASKMAN: XMHANG,XMGROUP,XMQUEUE
+2 NEW XMTSTAMP,XMUID,XMIDLE,X,XMMCNT,XMRCNT,XMACNT
+3 ; XMMCNT # of messages/responses processed
+4 ; XMRCNT # of potential local recipients to process
+5 ; XMACNT # of actual local recipients processed
+6 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 if $PIECE($GET(^XMB(1,1,0)),U,16)
QUIT
+8 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D R^XMCTRAP"
+9 IF '$TEST
SET X="R^XMCTRAP"
SET @^%ZOSF("TRAP")
+10 IF $DATA(^%ZOSF("TRAP"))
SET X="^%ET"
SET @^("TRAP")
+11 IF $DATA(^%ZOSF("PRIORITY"))
SET X=$SELECT(+$GET(^XMB(1,1,.13)):+^(.13),1:5)
XECUTE ^%ZOSF("PRIORITY")
+12 LOCK +^XMBPOST(XMGROUP,XMQUEUE):0
IF '$TEST
HANG 0
QUIT
+13 SET XMIDLE=0
+14 FOR
Begin DoDot:1
+15 FOR
SET XMTSTAMP=$ORDER(^XMBPOST(XMGROUP,XMQUEUE,""))
if XMTSTAMP'>0
QUIT
Begin DoDot:2
+16 SET XMIDLE=0
+17 FOR
SET XMUID=$ORDER(^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,""))
if XMUID=""
QUIT
Begin DoDot:3
+18 IF XMGROUP="M"
Begin DoDot:4
+19 DO MDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,.XMMCNT,.XMRCNT,.XMACNT)
End DoDot:4
+20 IF '$TEST
Begin DoDot:4
+21 DO RDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,.XMMCNT,.XMRCNT,.XMACNT)
End DoDot:4
+22 KILL ^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMUID)
+23 ; Delivered to # users
if '$DATA(^XMBPOST("STATS","OFF"))
DO STATS^XMTDL1(XMGROUP,XMQUEUE,XMMCNT,XMRCNT,XMACNT)
End DoDot:3
End DoDot:2
+24 LOCK +^XMBPOST("QSTATS",XMGROUP,XMQUEUE):0
+25 SET ^XMBPOST(XMGROUP,XMQUEUE)=""
+26 LOCK -^XMBPOST("QSTATS",XMGROUP,XMQUEUE)
+27 if XMIDLE=0
SET XMIDLE=$$TSTAMP^XMXUTIL1
+28 HANG XMHANG
End DoDot:1
if $PIECE($GET(^XMB(1,1,0)),U,16)!($$TSTAMP^XMXUTIL1-XMIDLE>900)
QUIT
+29 LOCK -^XMBPOST(XMGROUP,XMQUEUE)
+30 QUIT
RDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMMCNT,XMRCNT,XMACNT) ; was ^XMADJF1
+1 ; Note: We know that XMGROUP="R" here
+2 NEW XMZR,XMREC,XMFROM,XMFLIST,XMFIRST,XMFDA,I,XMZREC,XMZSUBJ,XMZFROM,XMZDATE,XMRESPS,XMTO,XMZRLIST
+3 ; XMFIRST sender of the first response processed
+4 ; Accept no more additions to this batch of replies
KILL ^XMBPOST(XMGROUP,XMQUEUE,"B",XMZ,XMTSTAMP)
+5 ;Post responses to message response multiple, keeping track of number of deliveries
+6 SET (XMMCNT,XMRCNT,XMACNT)=0
+7 IF '$DATA(^XMB(3.9,XMZ,0))
Begin DoDot:1
+8 ; Message |1| does not exist. Can't post responses to it.
DO BADERR(36240,XMZ)
+9 SET XMZR=""
+10 FOR
SET XMZR=$ORDER(^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMZR))
if XMZR=""
QUIT
SET XMRCNT=XMRCNT+^(XMZR)
SET XMMCNT=XMMCNT+1
End DoDot:1
QUIT
+11 SET XMZREC=^XMB(3.9,XMZ,0)
+12 SET XMZSUBJ=$PIECE(XMZREC,U)
SET XMZFROM=$PIECE(XMZREC,U,2)
SET XMZDATE=$PIECE(XMZREC,U,3)
+13 if XMZFROM=""
SET XMZFROM=.5
+14 ; If the sender of the original msg is not a recipient, make him one.
+15 IF XMZFROM=+XMZFROM
IF '$DATA(^XMB(3.9,XMZ,1,"C",XMZFROM))
Begin DoDot:1
+16 DO ADDRECP(XMZ,$PIECE(XMZREC,U,7)["P",XMZFROM)
+17 ;D LASTREAD(XMZ,XMZFROM,XMZDATE)
End DoDot:1
+18 SET XMZR=""
+19 FOR
SET XMZR=$ORDER(^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMZR))
if XMZR=""
QUIT
SET XMREC=^(XMZR)
Begin DoDot:1
+20 SET XMMCNT=XMMCNT+1
+21 SET XMRCNT=XMRCNT+$PIECE(XMREC,U,1)
+22 IF '$DATA(^XMB(3.9,XMZR))
Begin DoDot:2
+23 NEW XMPARM
SET XMPARM(1)=XMZ
SET XMPARM(2)=XMZR
+24 ; Response |2| to message |1| does not exist. Can't deliver it.
DO BADERR(36241,.XMPARM)
End DoDot:2
QUIT
+25 ;S XMFDA(3.9001,"+1,"_XMZ_",",.01)=XMZR ; *** Moved to ^XMKP ***
+26 ;D UPDATE^DIE("","XMFDA") ; Add to response multiple in original msg
+27 ; (not used, but helps in debugging)
SET XMZRLIST(XMZR)=""
+28 SET XMFROM=$PIECE(XMREC,U,2)
+29 if '$DATA(XMFIRST)
SET XMFIRST=XMFROM
+30 ; Number of replies by this user
SET XMFLIST(XMFROM)=$GET(XMFLIST(XMFROM))+1
+31 ; 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 XMFROM="NR"
QUIT
+32 ; If the sender of the reply is not a recipient, make him one.
+33 IF XMFROM
IF '$DATA(^XMB(3.9,XMZ,1,"C",XMFROM))
DO ADDRECP(XMZ,$PIECE(XMZREC,U,7)["P",XMFROM)
End DoDot:1
+34 if '$DATA(XMFLIST)
QUIT
+35 ; There's one sender
IF $ORDER(XMFLIST(""))=XMFIRST
IF $ORDER(XMFLIST(XMFIRST))=""
SET XMFROM=XMFIRST
+36 ; There's multiple senders
IF '$TEST
SET XMFROM=""
+37 ; At this point, XMFROM has the sender's DUZ (or 'NR' if remote)
+38 ; if there was only 1 sender.
+39 ; If there was more than 1 sender, then XMFROM="", so that ^XMTDL1 will
+40 ; make the msg new for all recipients.
+41 ; Now, deliver replies...
+42 ; Number of replies to msg
SET XMRESPS=$PIECE(^XMB(3.9,XMZ,3,0),U,4)
+43 SET XMTO=""
+44 FOR
SET XMTO=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO))
if XMTO'>0
QUIT
Begin DoDot:1
+45 SET I=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO,0))
+46 ; User terminated
if $GET(^XMB(3.9,XMZ,1,I,"D"))
QUIT
+47 ; If recipient is the only sender, don't bother delivering to him, because he's already seen it.
IF $DATA(XMFLIST(XMTO))
if XMTO=XMFIRST
DO GOTREPLY(XMZ,XMRESPS,I,XMFLIST(XMTO))
if XMTO=XMFROM
QUIT
+48 ; Don't deliver if recipient has already seen all responses
if $PIECE(^XMB(3.9,XMZ,1,I,0),U,2)=XMRESPS
QUIT
+49 SET XMACNT=XMACNT+1
+50 DO DELIVER^XMTDL2(XMTO,XMZ,XMZSUBJ,XMZFROM,XMFROM,1)
End DoDot:1
+51 QUIT
ADDRECP(XMZ,XMPRI,XMRECP) ; Add a recipient to the message
+1 NEW XMFDA
+2 SET XMFDA(3.91,"+1,"_XMZ_",",.01)=XMRECP
+3 ; priority response flag
IF XMPRI
IF +XMRECP=XMRECP
IF $PIECE($GET(^XMB(3.7,XMRECP,0)),U,11)
SET XMFDA(3.91,"+1,"_XMZ_",",10)=$PIECE(^(0),U,11)
+4 DO UPDATE^DIE("","XMFDA")
+5 SET XMFDA(3.911,"+1,"_XMZ_",",.01)=$$NAME^XMXUTIL(XMRECP)
+6 DO UPDATE^DIE("","XMFDA")
+7 QUIT
LASTREAD(XMZ,XMZFROM,XMZDATE) ; Note that the sender has read the original message
+1 NEW XMFDA,XMIEN
+2 SET XMIEN=$ORDER(^XMB(3.9,XMZ,1,"C",XMZFROM,0))
if 'XMIEN
QUIT
+3 ; Read the original msg
SET XMFDA(3.91,XMIEN_","_XMZ_",",1)=0
+4 ; Last Read
SET XMFDA(3.91,XMIEN_","_XMZ_",",2)=XMZDATE
+5 ; First Read
SET XMFDA(3.91,XMIEN_","_XMZ_",",11)=XMZDATE
+6 DO FILE^DIE("","XMFDA")
+7 QUIT
GOTREPLY(XMZ,XMRESPS,XMIEN,XMRNEW) ; Note that recipient has seen his own reply.
+1 NEW XMFDA
+2 ; If last reply seen + # responses made = total responses...
+3 IF $PIECE(^XMB(3.9,XMZ,1,XMIEN,0),U,2)+XMRNEW=XMRESPS
Begin DoDot:1
+4 SET XMFDA(3.91,XMIEN_","_XMZ_",",1)=XMRESPS
+5 DO FILE^DIE("","XMFDA")
End DoDot:1
+6 QUIT
MDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,XMMCNT,XMRCNT,XMACNT) ; was ^XMADJF1
+1 NEW XMZSUBJ,XMZFROM,XMZDATE,XMZPDATE,XMZBSKT,XMREC,XMZ,XMK,XMDEL,XMBCAST
+2 ; Note: We know that XMGROUP="M" here
+3 ; If $L(XMUID,U)>1, it's a forwarded message, else it's a new message.
+4 SET XMMCNT=1
+5 SET XMREC=^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMUID)
+6 SET XMRCNT=+$PIECE(XMREC,U,1)
+7 SET XMACNT=0
+8 SET XMZ=+XMUID
+9 IF '$DATA(^XMB(3.9,XMZ,0))
Begin DoDot:1
+10 IF $LENGTH(XMUID,U)>1
KILL ^XMBPOST("FWD",XMUID_U_XMTSTAMP)
+11 ; Message |1| does not exist. Can't deliver it.
DO BADERR(36242,XMZ)
End DoDot:1
QUIT
+12 SET XMZSUBJ=$PIECE(^XMB(3.9,XMZ,0),U)
SET XMZFROM=$PIECE(^(0),U,2)
SET XMZDATE=$PIECE(^(0),U,3)
SET XMZPDATE=$PIECE(^(0),U,6)
+13 if XMZFROM=""
SET XMZFROM=.5
+14 ; If purge date has passed, don't deliver
IF XMZPDATE
IF XMZPDATE'>DT
Begin DoDot:1
+15 IF $LENGTH(XMUID,U)>1
KILL ^XMBPOST("FWD",XMUID_U_XMTSTAMP)
End DoDot:1
QUIT
+16 ; basket selection
IF $PIECE(XMREC,U,2)'=""
Begin DoDot:1
+17 ; sending person
IF $LENGTH(XMUID,U)=1
SET XMK(XMZFROM)=$PIECE(XMREC,U,2)
QUIT
+18 ; forwarding person
IF $PIECE(XMUID,U,2)
SET XMK($PIECE(XMUID,U,2))=$PIECE(XMREC,U,2)
End DoDot:1
+19 IF $PIECE(XMREC,U,3)'=""
SET XMK(.6)=$PIECE(XMREC,U,3)
+20 IF $PIECE(XMREC,U,4)
SET XMDEL(.6)=$PIECE(XMREC,U,4)
+21 SET XMBCAST=($PIECE(XMREC,U,5)'="")
+22 SET XMZBSKT=$PIECE($GET(^XMB(3.9,XMZ,.5)),U,1)
+23 IF $LENGTH(XMUID,U)=1
DO NEW(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMBCAST,.XMK,.XMDEL,XMZSUBJ,XMZFROM,XMZDATE,XMZPDATE,XMZBSKT,.XMACNT)
QUIT
+24 DO FORWARD(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,XMZ,XMBCAST,.XMK,.XMDEL,XMZSUBJ,XMZFROM,XMZPDATE,XMZBSKT,.XMACNT)
+25 QUIT
NEW(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMBCAST,XMK,XMDEL,XMZSUBJ,XMZFROM,XMZDATE,XMZPDATE,XMZBSKT,XMACNT) ;
+1 if XMZFROM=+XMZFROM
DO LASTREAD(XMZ,XMZFROM,XMZDATE)
+2 IF XMBCAST
DO BRODCAST^XMTDL1(XMZ,XMZSUBJ,XMZFROM,XMZFROM,.XMK,.XMDEL,XMZPDATE,XMZBSKT,.XMACNT)
+3 NEW XMTO
+4 ; Q: on next line ensures only local user delivery
SET XMTO=0
+5 FOR
SET XMTO=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO))
if XMTO'>0
QUIT
Begin DoDot:1
+6 IF XMBCAST
IF $DATA(^XMB(3.7,"M",XMZ,XMTO))
QUIT
+7 SET XMACNT=XMACNT+1
+8 DO DELIVER^XMTDL2(XMTO,XMZ,XMZSUBJ,XMZFROM,XMZFROM,0,$GET(XMK(XMTO)),$GET(XMDEL(XMTO),XMZPDATE),XMZBSKT)
End DoDot:1
+9 QUIT
FORWARD(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,XMZ,XMBCAST,XMK,XMDEL,XMZSUBJ,XMZFROM,XMZPDATE,XMZBSKT,XMACNT) ;
+1 NEW I,J,XMFROM,XMTO,XMTOLIST
+2 SET XMFROM=$PIECE(XMUID,U,2)
+3 SET XMUID=XMUID_U_XMTSTAMP
+4 IF XMBCAST
DO BRODCAST^XMTDL1(XMZ,XMZSUBJ,XMZFROM,XMFROM,.XMK,.XMDEL,XMZPDATE,XMZBSKT,.XMACNT)
if '$DATA(^XMBPOST("FWD",XMUID))
QUIT
+5 SET I=0
+6 FOR
SET I=$ORDER(^XMBPOST("FWD",XMUID,I))
if 'I
QUIT
SET XMTOLIST=^(I)
Begin DoDot:1
+7 FOR J=1:1:$LENGTH(XMTOLIST,U)
Begin DoDot:2
+8 SET XMTO=$PIECE(XMTOLIST,U,J)
+9 ; User already has msg
if $ORDER(^XMB(3.7,"M",XMZ,XMTO,""))
QUIT
+10 ; User is not on recipient list (Should never happen
if '$DATA(^XMB(3.9,XMZ,1,"C",XMTO))
QUIT
+11 SET XMACNT=XMACNT+1
+12 DO DELIVER^XMTDL2(XMTO,XMZ,XMZSUBJ,XMZFROM,XMFROM,0,$GET(XMK(XMTO)),$GET(XMDEL(XMTO),XMZPDATE),XMZBSKT)
End DoDot:2
End DoDot:1
+13 KILL ^XMBPOST("FWD",XMUID)
+14 QUIT
BADERR(XMDIALOG,XMPARM) ;
+1 NEW XMTEXT,XMINSTR
+2 DO BLD^DIALOG(XMDIALOG,.XMPARM,"","XMTEXT")
+3 SET XMINSTR("FROM")="MailMan"
+4 DO TASKBULL^XMXBULL(DUZ,"XM_TRANSMISSION_ERROR","","XMTEXT",.5,.XMINSTR)
+5 QUIT
