| 1 | XMR3A ;ISC-SF/GMB-XMR3 (cont.) ;04/17/2002 11:16
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | CHEKDUP ;
|
|---|
| 4 | N XMZCHK,XMTO
|
|---|
| 5 | ;REJECT ON PURGED MESSAGE PROTECT FOC-AUSTIN
|
|---|
| 6 | ;DO NOT CHANGE WITHOUT COORDINATING
|
|---|
| 7 | S XMZCHK=$$LOCALXMZ(XMREMID)
|
|---|
| 8 | ;Set up "AI" cross reference -- since XMBX is replicated at FOC-Austin
|
|---|
| 9 | ;set pseudo node first so that if DDP is down, failure will occur before
|
|---|
| 10 | ;message is considered received.
|
|---|
| 11 | ;
|
|---|
| 12 | ;Accept as new message if NOT HERE
|
|---|
| 13 | Q:'XMZCHK
|
|---|
| 14 | ; We already have the message
|
|---|
| 15 | I $P(XMZCHK,U,3)'="E"!(XMZ=+XMZCHK) D Q
|
|---|
| 16 | . S XMSG="554 Duplicate (purged). Msg rejected." X XMSEN
|
|---|
| 17 | . D KILLIT
|
|---|
| 18 | . S XMREJECT=1
|
|---|
| 19 | S XMTO=""
|
|---|
| 20 | F S XMTO=$O(^TMP("XMY",$J,XMTO)) Q:XMTO="" I $D(^XMB(3.7,"M",+XMZCHK,XMTO)) K ^TMP("XMY",$J,XMTO)
|
|---|
| 21 | I $O(^TMP("XMY",$J,""))="" D Q
|
|---|
| 22 | . S XMSG="254 Duplicate (no add'l recipients). Msg rejected." X XMSEN
|
|---|
| 23 | . D KILLIT
|
|---|
| 24 | . S XMREJECT=1
|
|---|
| 25 | ; We are forwarding a msg which already exists on our system
|
|---|
| 26 | ; to recipients who don't currently have it in their mailbox.
|
|---|
| 27 | K XMZFDA ; When we implement true 'forwarded by', we'll have to retain that.
|
|---|
| 28 | D KILLIT
|
|---|
| 29 | S XMZ=+XMZCHK
|
|---|
| 30 | Q
|
|---|
| 31 | KILLIT ;
|
|---|
| 32 | K XMREMID
|
|---|
| 33 | D ZAPIT^XMXMSGS2(.5,.95,XMZ)
|
|---|
| 34 | D KILLMSG^XMXUTIL(XMZ)
|
|---|
| 35 | Q
|
|---|
| 36 | LOCALXMZ(XMREMID) ; Given a remote id, function returns XMZ if the message
|
|---|
| 37 | ; can be or was ever found locally.
|
|---|
| 38 | ; If no record of it, returns null.
|
|---|
| 39 | ; Otherwise, returns:
|
|---|
| 40 | ; Piece 1: local XMZ
|
|---|
| 41 | ; Piece 2: originated here? (0=no; 1=yes)
|
|---|
| 42 | ; Piece 3: still exists? (P=no, purged;
|
|---|
| 43 | ; R=no, purged, & replaced with something else;
|
|---|
| 44 | ; E=yes, it still exists here)
|
|---|
| 45 | N XMZCHK,XMP1,XMP2
|
|---|
| 46 | S XMP1=$P(XMREMID,"@",1),XMP2=$P(XMREMID,"@",2)
|
|---|
| 47 | I XMP1=""!(XMP2="") Q ""
|
|---|
| 48 | S XMZCHK=$$FINDXMZ(XMP1,XMP2)
|
|---|
| 49 | I XMZCHK Q XMZCHK
|
|---|
| 50 | S XMZCHK=$$FINDXMZ(XMP2,XMP1)
|
|---|
| 51 | I XMZCHK Q XMZCHK
|
|---|
| 52 | Q ""
|
|---|
| 53 | FINDXMZ(XMP1,XMP2) ;
|
|---|
| 54 | I XMP1?.N!(XMP1?.N1"."7N) Q:XMP2=^XMB("NETNAME") $$LOCXMZ(XMP1) Q:$$FIND1^DIC(4.2,"","QX",XMP2,"B^C")=^XMB("NUM") $$LOCXMZ(XMP1)
|
|---|
| 55 | N XMZ
|
|---|
| 56 | TRY S XMZ=$O(^XMBX(3.9,"AI",$E(XMP2,1,64),$E(XMP1,1,64),0))
|
|---|
| 57 | I XMZ Q $$REMXMZ(XMZ,XMP2,XMP1)
|
|---|
| 58 | I XMP1?.N1"."7N S XMP1=$P(XMP1,".") G TRY
|
|---|
| 59 | Q ""
|
|---|
| 60 | LOCXMZ(XMZ) ; Message originated here.
|
|---|
| 61 | I XMZ'["." Q XMZ_"^1^"_$S($D(^XMB(3.9,XMZ,0)):"E",1:"P")
|
|---|
| 62 | ; The following code won't activate until MailMan message IDs contain
|
|---|
| 63 | ; dates. Message IDs are created in $$NETID^XMS3.
|
|---|
| 64 | N XMCRE8
|
|---|
| 65 | S XMCRE8=$P(XMZ,".",2),XMZ=$P(XMZ,".",1)
|
|---|
| 66 | Q XMZ_"^1^"_$S('$D(^XMB(3.9,XMZ,0)):"P",$P($G(^XMB(3.9,XMZ,.6)),U,1)=XMCRE8:"E",1:"R")
|
|---|
| 67 | REMXMZ(XMZ,XMP2,XMP1) ; Message originated somewhere else.
|
|---|
| 68 | I '$D(^XMB(3.9,XMZ,0)) Q XMZ_"^0^P"
|
|---|
| 69 | N XMREMID
|
|---|
| 70 | S XMREMID=$G(^XMB(3.9,XMZ,5))
|
|---|
| 71 | I XMREMID="" Q XMZ_"^0^R"
|
|---|
| 72 | I XMP1_"@"_XMP2=XMREMID Q XMZ_"^0^E"
|
|---|
| 73 | I XMP2_"@"_XMP1=XMREMID Q XMZ_"^0^E"
|
|---|
| 74 | Q XMZ_"^0^R"
|
|---|
