| 1 | XMTDL ;ISC-SF/GMB-Deliver local mail to mailbox ;10/23/2002 06:37
|
|---|
| 2 | ;;8.0;MailMan;**1,6**;Jun 28, 2002
|
|---|
| 3 | ; Replaces ^XMAD0,GO^XMADGO,STATS^XMADJF0,^XMADJF1,^XMADJF1A (ISC-WASH/CAP)
|
|---|
| 4 | GO ;
|
|---|
| 5 | ; Variables provided through TASKMAN: XMHANG,XMGROUP,XMQUEUE
|
|---|
| 6 | N XMTSTAMP,XMUID,XMIDLE,X,XMMCNT,XMRCNT,XMACNT
|
|---|
| 7 | ; XMMCNT # of messages/responses processed
|
|---|
| 8 | ; XMRCNT # of potential local recipients to process
|
|---|
| 9 | ; XMACNT # of actual local recipients processed
|
|---|
| 10 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 11 | Q:$P($G(^XMB(1,1,0)),U,16)
|
|---|
| 12 | I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D R^XMCTRAP"
|
|---|
| 13 | E S X="R^XMCTRAP",@^%ZOSF("TRAP")
|
|---|
| 14 | I $D(^%ZOSF("TRAP")) S X="^%ET",@^("TRAP")
|
|---|
| 15 | I $D(^%ZOSF("PRIORITY")) S X=$S(+$G(^XMB(1,1,.13)):+^(.13),1:5) X ^%ZOSF("PRIORITY")
|
|---|
| 16 | L +^XMBPOST(XMGROUP,XMQUEUE):0 E H 0 Q
|
|---|
| 17 | S XMIDLE=0
|
|---|
| 18 | F D Q:$P($G(^XMB(1,1,0)),U,16)!($$TSTAMP^XMXUTIL1-XMIDLE>900)
|
|---|
| 19 | . F S XMTSTAMP=$O(^XMBPOST(XMGROUP,XMQUEUE,"")) Q:XMTSTAMP'>0 D
|
|---|
| 20 | . . S XMIDLE=0
|
|---|
| 21 | . . F S XMUID=$O(^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,"")) Q:XMUID="" D
|
|---|
| 22 | . . . I XMGROUP="M" D
|
|---|
| 23 | . . . . D MDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,.XMMCNT,.XMRCNT,.XMACNT)
|
|---|
| 24 | . . . E D
|
|---|
| 25 | . . . . D RDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,.XMMCNT,.XMRCNT,.XMACNT)
|
|---|
| 26 | . . . K ^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMUID)
|
|---|
| 27 | . . . D:'$D(^XMBPOST("STATS","OFF")) STATS^XMTDL1(XMGROUP,XMQUEUE,XMMCNT,XMRCNT,XMACNT) ; Delivered to # users
|
|---|
| 28 | . L +^XMBPOST("QSTATS",XMGROUP,XMQUEUE):0
|
|---|
| 29 | . S ^XMBPOST(XMGROUP,XMQUEUE)=""
|
|---|
| 30 | . L -^XMBPOST("QSTATS",XMGROUP,XMQUEUE)
|
|---|
| 31 | . S:XMIDLE=0 XMIDLE=$$TSTAMP^XMXUTIL1
|
|---|
| 32 | . H XMHANG
|
|---|
| 33 | L -^XMBPOST(XMGROUP,XMQUEUE)
|
|---|
| 34 | Q
|
|---|
| 35 | RDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMMCNT,XMRCNT,XMACNT) ; was ^XMADJF1
|
|---|
| 36 | ; Note: We know that XMGROUP="R" here
|
|---|
| 37 | N XMZR,XMREC,XMFROM,XMFLIST,XMFIRST,XMFDA,I,XMZREC,XMZSUBJ,XMZFROM,XMZDATE,XMRESPS,XMTO,XMZRLIST
|
|---|
| 38 | ; XMFIRST sender of the first response processed
|
|---|
| 39 | K ^XMBPOST(XMGROUP,XMQUEUE,"B",XMZ,XMTSTAMP) ; Accept no more additions to this batch of replies
|
|---|
| 40 | ;Post responses to message response multiple, keeping track of number of deliveries
|
|---|
| 41 | S (XMMCNT,XMRCNT,XMACNT)=0
|
|---|
| 42 | I '$D(^XMB(3.9,XMZ,0)) D Q
|
|---|
| 43 | . D BADERR(36240,XMZ) ; Message |1| does not exist. Can't post responses to it.
|
|---|
| 44 | . S XMZR=""
|
|---|
| 45 | . F S XMZR=$O(^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMZR)) Q:XMZR="" S XMRCNT=XMRCNT+^(XMZR),XMMCNT=XMMCNT+1
|
|---|
| 46 | S XMZREC=^XMB(3.9,XMZ,0)
|
|---|
| 47 | S XMZSUBJ=$P(XMZREC,U),XMZFROM=$P(XMZREC,U,2),XMZDATE=$P(XMZREC,U,3)
|
|---|
| 48 | S:XMZFROM="" XMZFROM=.5
|
|---|
| 49 | ; If the sender of the original msg is not a recipient, make him one.
|
|---|
| 50 | I XMZFROM=+XMZFROM,'$D(^XMB(3.9,XMZ,1,"C",XMZFROM)) D
|
|---|
| 51 | . D ADDRECP(XMZ,$P(XMZREC,U,7)["P",XMZFROM)
|
|---|
| 52 | . ;D LASTREAD(XMZ,XMZFROM,XMZDATE)
|
|---|
| 53 | S XMZR=""
|
|---|
| 54 | F S XMZR=$O(^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMZR)) Q:XMZR="" S XMREC=^(XMZR) D
|
|---|
| 55 | . S XMMCNT=XMMCNT+1
|
|---|
| 56 | . S XMRCNT=XMRCNT+$P(XMREC,U,1)
|
|---|
| 57 | . I '$D(^XMB(3.9,XMZR)) D Q
|
|---|
| 58 | . . N XMPARM S XMPARM(1)=XMZ,XMPARM(2)=XMZR
|
|---|
| 59 | . . D BADERR(36241,.XMPARM) ; Response |2| to message |1| does not exist. Can't deliver it.
|
|---|
| 60 | . ;S XMFDA(3.9001,"+1,"_XMZ_",",.01)=XMZR ; *** Moved to ^XMKP ***
|
|---|
| 61 | . ;D UPDATE^DIE("","XMFDA") ; Add to response multiple in original msg
|
|---|
| 62 | . S XMZRLIST(XMZR)="" ; (not used, but helps in debugging)
|
|---|
| 63 | . S XMFROM=$P(XMREC,U,2)
|
|---|
| 64 | . S:'$D(XMFIRST) XMFIRST=XMFROM
|
|---|
| 65 | . S XMFLIST(XMFROM)=$G(XMFLIST(XMFROM))+1 ; Number of replies by this user
|
|---|
| 66 | . 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.
|
|---|
| 67 | . ; If the sender of the reply is not a recipient, make him one.
|
|---|
| 68 | . I XMFROM,'$D(^XMB(3.9,XMZ,1,"C",XMFROM)) D ADDRECP(XMZ,$P(XMZREC,U,7)["P",XMFROM)
|
|---|
| 69 | Q:'$D(XMFLIST)
|
|---|
| 70 | I $O(XMFLIST(""))=XMFIRST,$O(XMFLIST(XMFIRST))="" S XMFROM=XMFIRST ; There's one sender
|
|---|
| 71 | E S XMFROM="" ; There's multiple senders
|
|---|
| 72 | ; At this point, XMFROM has the sender's DUZ (or 'NR' if remote)
|
|---|
| 73 | ; if there was only 1 sender.
|
|---|
| 74 | ; If there was more than 1 sender, then XMFROM="", so that ^XMTDL1 will
|
|---|
| 75 | ; make the msg new for all recipients.
|
|---|
| 76 | ; Now, deliver replies...
|
|---|
| 77 | S XMRESPS=$P(^XMB(3.9,XMZ,3,0),U,4) ; Number of replies to msg
|
|---|
| 78 | S XMTO=""
|
|---|
| 79 | F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:XMTO'>0 D
|
|---|
| 80 | . S I=$O(^XMB(3.9,XMZ,1,"C",XMTO,0))
|
|---|
| 81 | . Q:$G(^XMB(3.9,XMZ,1,I,"D")) ; User terminated
|
|---|
| 82 | . 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.
|
|---|
| 83 | . Q:$P(^XMB(3.9,XMZ,1,I,0),U,2)=XMRESPS ; Don't deliver if recipient has already seen all responses
|
|---|
| 84 | . S XMACNT=XMACNT+1
|
|---|
| 85 | . D DELIVER^XMTDL2(XMTO,XMZ,XMZSUBJ,XMZFROM,XMFROM,1)
|
|---|
| 86 | Q
|
|---|
| 87 | ADDRECP(XMZ,XMPRI,XMRECP) ; Add a recipient to the message
|
|---|
| 88 | N XMFDA
|
|---|
| 89 | S XMFDA(3.91,"+1,"_XMZ_",",.01)=XMRECP
|
|---|
| 90 | 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
|
|---|
| 91 | D UPDATE^DIE("","XMFDA")
|
|---|
| 92 | S XMFDA(3.911,"+1,"_XMZ_",",.01)=$$NAME^XMXUTIL(XMRECP)
|
|---|
| 93 | D UPDATE^DIE("","XMFDA")
|
|---|
| 94 | Q
|
|---|
| 95 | LASTREAD(XMZ,XMZFROM,XMZDATE) ; Note that the sender has read the original message
|
|---|
| 96 | N XMFDA,XMIEN
|
|---|
| 97 | S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMZFROM,0)) Q:'XMIEN
|
|---|
| 98 | S XMFDA(3.91,XMIEN_","_XMZ_",",1)=0 ; Read the original msg
|
|---|
| 99 | S XMFDA(3.91,XMIEN_","_XMZ_",",2)=XMZDATE ; Last Read
|
|---|
| 100 | S XMFDA(3.91,XMIEN_","_XMZ_",",11)=XMZDATE ; First Read
|
|---|
| 101 | D FILE^DIE("","XMFDA")
|
|---|
| 102 | Q
|
|---|
| 103 | GOTREPLY(XMZ,XMRESPS,XMIEN,XMRNEW) ; Note that recipient has seen his own reply.
|
|---|
| 104 | N XMFDA
|
|---|
| 105 | ; If last reply seen + # responses made = total responses...
|
|---|
| 106 | I $P(^XMB(3.9,XMZ,1,XMIEN,0),U,2)+XMRNEW=XMRESPS D
|
|---|
| 107 | . S XMFDA(3.91,XMIEN_","_XMZ_",",1)=XMRESPS
|
|---|
| 108 | . D FILE^DIE("","XMFDA")
|
|---|
| 109 | Q
|
|---|
| 110 | MDELIVER(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,XMMCNT,XMRCNT,XMACNT) ; was ^XMADJF1
|
|---|
| 111 | N XMZSUBJ,XMZFROM,XMZDATE,XMZPDATE,XMZBSKT,XMREC,XMZ,XMK,XMDEL,XMBCAST
|
|---|
| 112 | ; Note: We know that XMGROUP="M" here
|
|---|
| 113 | ; If $L(XMUID,U)>1, it's a forwarded message, else it's a new message.
|
|---|
| 114 | S XMMCNT=1
|
|---|
| 115 | S XMREC=^XMBPOST(XMGROUP,XMQUEUE,XMTSTAMP,XMUID)
|
|---|
| 116 | S XMRCNT=+$P(XMREC,U,1)
|
|---|
| 117 | S XMACNT=0
|
|---|
| 118 | S XMZ=+XMUID
|
|---|
| 119 | I '$D(^XMB(3.9,XMZ,0)) D Q
|
|---|
| 120 | . I $L(XMUID,U)>1 K ^XMBPOST("FWD",XMUID_U_XMTSTAMP)
|
|---|
| 121 | . D BADERR(36242,XMZ) ; Message |1| does not exist. Can't deliver it.
|
|---|
| 122 | S XMZSUBJ=$P(^XMB(3.9,XMZ,0),U),XMZFROM=$P(^(0),U,2),XMZDATE=$P(^(0),U,3),XMZPDATE=$P(^(0),U,6)
|
|---|
| 123 | S:XMZFROM="" XMZFROM=.5
|
|---|
| 124 | I XMZPDATE,XMZPDATE'>DT D Q ; If purge date has passed, don't deliver
|
|---|
| 125 | . I $L(XMUID,U)>1 K ^XMBPOST("FWD",XMUID_U_XMTSTAMP)
|
|---|
| 126 | I $P(XMREC,U,2)'="" D ; basket selection
|
|---|
| 127 | . I $L(XMUID,U)=1 S XMK(XMZFROM)=$P(XMREC,U,2) Q ; sending person
|
|---|
| 128 | . I $P(XMUID,U,2) S XMK($P(XMUID,U,2))=$P(XMREC,U,2) ; forwarding person
|
|---|
| 129 | I $P(XMREC,U,3)'="" S XMK(.6)=$P(XMREC,U,3)
|
|---|
| 130 | I $P(XMREC,U,4) S XMDEL(.6)=$P(XMREC,U,4)
|
|---|
| 131 | S XMBCAST=($P(XMREC,U,5)'="")
|
|---|
| 132 | S XMZBSKT=$P($G(^XMB(3.9,XMZ,.5)),U,1)
|
|---|
| 133 | I $L(XMUID,U)=1 D NEW(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMBCAST,.XMK,.XMDEL,XMZSUBJ,XMZFROM,XMZDATE,XMZPDATE,XMZBSKT,.XMACNT) Q
|
|---|
| 134 | D FORWARD(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,XMZ,XMBCAST,.XMK,.XMDEL,XMZSUBJ,XMZFROM,XMZPDATE,XMZBSKT,.XMACNT)
|
|---|
| 135 | Q
|
|---|
| 136 | NEW(XMGROUP,XMQUEUE,XMTSTAMP,XMZ,XMBCAST,XMK,XMDEL,XMZSUBJ,XMZFROM,XMZDATE,XMZPDATE,XMZBSKT,XMACNT) ;
|
|---|
| 137 | D:XMZFROM=+XMZFROM LASTREAD(XMZ,XMZFROM,XMZDATE)
|
|---|
| 138 | I XMBCAST D BRODCAST^XMTDL1(XMZ,XMZSUBJ,XMZFROM,XMZFROM,.XMK,.XMDEL,XMZPDATE,XMZBSKT,.XMACNT)
|
|---|
| 139 | N XMTO
|
|---|
| 140 | S XMTO=0 ; Q: on next line ensures only local user delivery
|
|---|
| 141 | F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:XMTO'>0 D
|
|---|
| 142 | . I XMBCAST,$D(^XMB(3.7,"M",XMZ,XMTO)) Q
|
|---|
| 143 | . S XMACNT=XMACNT+1
|
|---|
| 144 | . D DELIVER^XMTDL2(XMTO,XMZ,XMZSUBJ,XMZFROM,XMZFROM,0,$G(XMK(XMTO)),$G(XMDEL(XMTO),XMZPDATE),XMZBSKT)
|
|---|
| 145 | Q
|
|---|
| 146 | FORWARD(XMGROUP,XMQUEUE,XMTSTAMP,XMUID,XMZ,XMBCAST,XMK,XMDEL,XMZSUBJ,XMZFROM,XMZPDATE,XMZBSKT,XMACNT) ;
|
|---|
| 147 | N I,J,XMFROM,XMTO,XMTOLIST
|
|---|
| 148 | S XMFROM=$P(XMUID,U,2)
|
|---|
| 149 | S XMUID=XMUID_U_XMTSTAMP
|
|---|
| 150 | I XMBCAST D BRODCAST^XMTDL1(XMZ,XMZSUBJ,XMZFROM,XMFROM,.XMK,.XMDEL,XMZPDATE,XMZBSKT,.XMACNT) Q:'$D(^XMBPOST("FWD",XMUID))
|
|---|
| 151 | S I=0
|
|---|
| 152 | F S I=$O(^XMBPOST("FWD",XMUID,I)) Q:'I S XMTOLIST=^(I) D
|
|---|
| 153 | . F J=1:1:$L(XMTOLIST,U) D
|
|---|
| 154 | . . S XMTO=$P(XMTOLIST,U,J)
|
|---|
| 155 | . . Q:$O(^XMB(3.7,"M",XMZ,XMTO,"")) ; User already has msg
|
|---|
| 156 | . . Q:'$D(^XMB(3.9,XMZ,1,"C",XMTO)) ; User is not on recipient list (Should never happen
|
|---|
| 157 | . . S XMACNT=XMACNT+1
|
|---|
| 158 | . . D DELIVER^XMTDL2(XMTO,XMZ,XMZSUBJ,XMZFROM,XMFROM,0,$G(XMK(XMTO)),$G(XMDEL(XMTO),XMZPDATE),XMZBSKT)
|
|---|
| 159 | K ^XMBPOST("FWD",XMUID)
|
|---|
| 160 | Q
|
|---|
| 161 | BADERR(XMDIALOG,XMPARM) ;
|
|---|
| 162 | N XMTEXT,XMINSTR
|
|---|
| 163 | D BLD^DIALOG(XMDIALOG,.XMPARM,"","XMTEXT")
|
|---|
| 164 | S XMINSTR("FROM")="MailMan"
|
|---|
| 165 | D TASKBULL^XMXBULL(DUZ,"XM_TRANSMISSION_ERROR","","XMTEXT",.5,.XMINSTR)
|
|---|
| 166 | Q
|
|---|
