source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMR3A.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1XMR3A ;ISC-SF/GMB-XMR3 (cont.) ;04/17/2002 11:16
2 ;;8.0;MailMan;;Jun 28, 2002
3CHEKDUP ;
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
31KILLIT ;
32 K XMREMID
33 D ZAPIT^XMXMSGS2(.5,.95,XMZ)
34 D KILLMSG^XMXUTIL(XMZ)
35 Q
36LOCALXMZ(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 ""
53FINDXMZ(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
56TRY 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 ""
60LOCXMZ(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")
67REMXMZ(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"
Note: See TracBrowser for help on using the repository browser.