- 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 Feb 18, 2025@23:39:28 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