- XMR3A ;ISC-SF/GMB-XMR3 (cont.) ;04/17/2002 11:16
- ;;8.0;MailMan;;Jun 28, 2002
- CHEKDUP ;
- N XMZCHK,XMTO
- ;REJECT ON PURGED MESSAGE PROTECT FOC-AUSTIN
- ;DO NOT CHANGE WITHOUT COORDINATING
- S XMZCHK=$$LOCALXMZ(XMREMID)
- ;Set up "AI" cross reference -- since XMBX is replicated at FOC-Austin
- ;set pseudo node first so that if DDP is down, failure will occur before
- ;message is considered received.
- ;
- ;Accept as new message if NOT HERE
- Q:'XMZCHK
- ; We already have the message
- I $P(XMZCHK,U,3)'="E"!(XMZ=+XMZCHK) D Q
- . S XMSG="554 Duplicate (purged). Msg rejected." X XMSEN
- . D KILLIT
- . S XMREJECT=1
- S XMTO=""
- F S XMTO=$O(^TMP("XMY",$J,XMTO)) Q:XMTO="" I $D(^XMB(3.7,"M",+XMZCHK,XMTO)) K ^TMP("XMY",$J,XMTO)
- I $O(^TMP("XMY",$J,""))="" D Q
- . S XMSG="254 Duplicate (no add'l recipients). Msg rejected." X XMSEN
- . D KILLIT
- . S XMREJECT=1
- ; We are forwarding a msg which already exists on our system
- ; to recipients who don't currently have it in their mailbox.
- K XMZFDA ; When we implement true 'forwarded by', we'll have to retain that.
- D KILLIT
- S XMZ=+XMZCHK
- Q
- KILLIT ;
- K XMREMID
- D ZAPIT^XMXMSGS2(.5,.95,XMZ)
- D KILLMSG^XMXUTIL(XMZ)
- Q
- LOCALXMZ(XMREMID) ; Given a remote id, function returns XMZ if the message
- ; can be or was ever found locally.
- ; If no record of it, returns null.
- ; Otherwise, returns:
- ; Piece 1: local XMZ
- ; Piece 2: originated here? (0=no; 1=yes)
- ; Piece 3: still exists? (P=no, purged;
- ; R=no, purged, & replaced with something else;
- ; E=yes, it still exists here)
- N XMZCHK,XMP1,XMP2
- S XMP1=$P(XMREMID,"@",1),XMP2=$P(XMREMID,"@",2)
- I XMP1=""!(XMP2="") Q ""
- S XMZCHK=$$FINDXMZ(XMP1,XMP2)
- I XMZCHK Q XMZCHK
- S XMZCHK=$$FINDXMZ(XMP2,XMP1)
- I XMZCHK Q XMZCHK
- Q ""
- FINDXMZ(XMP1,XMP2) ;
- 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)
- N XMZ
- TRY S XMZ=$O(^XMBX(3.9,"AI",$E(XMP2,1,64),$E(XMP1,1,64),0))
- I XMZ Q $$REMXMZ(XMZ,XMP2,XMP1)
- I XMP1?.N1"."7N S XMP1=$P(XMP1,".") G TRY
- Q ""
- LOCXMZ(XMZ) ; Message originated here.
- I XMZ'["." Q XMZ_"^1^"_$S($D(^XMB(3.9,XMZ,0)):"E",1:"P")
- ; The following code won't activate until MailMan message IDs contain
- ; dates. Message IDs are created in $$NETID^XMS3.
- N XMCRE8
- S XMCRE8=$P(XMZ,".",2),XMZ=$P(XMZ,".",1)
- Q XMZ_"^1^"_$S('$D(^XMB(3.9,XMZ,0)):"P",$P($G(^XMB(3.9,XMZ,.6)),U,1)=XMCRE8:"E",1:"R")
- REMXMZ(XMZ,XMP2,XMP1) ; Message originated somewhere else.
- I '$D(^XMB(3.9,XMZ,0)) Q XMZ_"^0^P"
- N XMREMID
- S XMREMID=$G(^XMB(3.9,XMZ,5))
- I XMREMID="" Q XMZ_"^0^R"
- I XMP1_"@"_XMP2=XMREMID Q XMZ_"^0^E"
- I XMP2_"@"_XMP1=XMREMID Q XMZ_"^0^E"
- Q XMZ_"^0^R"
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMR3A 2759 printed Feb 18, 2025@23:39:06 Page 2
- XMR3A ;ISC-SF/GMB-XMR3 (cont.) ;04/17/2002 11:16
- +1 ;;8.0;MailMan;;Jun 28, 2002
- CHEKDUP ;
- +1 NEW XMZCHK,XMTO
- +2 ;REJECT ON PURGED MESSAGE PROTECT FOC-AUSTIN
- +3 ;DO NOT CHANGE WITHOUT COORDINATING
- +4 SET XMZCHK=$$LOCALXMZ(XMREMID)
- +5 ;Set up "AI" cross reference -- since XMBX is replicated at FOC-Austin
- +6 ;set pseudo node first so that if DDP is down, failure will occur before
- +7 ;message is considered received.
- +8 ;
- +9 ;Accept as new message if NOT HERE
- +10 if 'XMZCHK
- QUIT
- +11 ; We already have the message
- +12 IF $PIECE(XMZCHK,U,3)'="E"!(XMZ=+XMZCHK)
- Begin DoDot:1
- +13 SET XMSG="554 Duplicate (purged). Msg rejected."
- XECUTE XMSEN
- +14 DO KILLIT
- +15 SET XMREJECT=1
- End DoDot:1
- QUIT
- +16 SET XMTO=""
- +17 FOR
- SET XMTO=$ORDER(^TMP("XMY",$JOB,XMTO))
- if XMTO=""
- QUIT
- IF $DATA(^XMB(3.7,"M",+XMZCHK,XMTO))
- KILL ^TMP("XMY",$JOB,XMTO)
- +18 IF $ORDER(^TMP("XMY",$JOB,""))=""
- Begin DoDot:1
- +19 SET XMSG="254 Duplicate (no add'l recipients). Msg rejected."
- XECUTE XMSEN
- +20 DO KILLIT
- +21 SET XMREJECT=1
- End DoDot:1
- QUIT
- +22 ; We are forwarding a msg which already exists on our system
- +23 ; to recipients who don't currently have it in their mailbox.
- +24 ; When we implement true 'forwarded by', we'll have to retain that.
- KILL XMZFDA
- +25 DO KILLIT
- +26 SET XMZ=+XMZCHK
- +27 QUIT
- KILLIT ;
- +1 KILL XMREMID
- +2 DO ZAPIT^XMXMSGS2(.5,.95,XMZ)
- +3 DO KILLMSG^XMXUTIL(XMZ)
- +4 QUIT
- LOCALXMZ(XMREMID) ; Given a remote id, function returns XMZ if the message
- +1 ; can be or was ever found locally.
- +2 ; If no record of it, returns null.
- +3 ; Otherwise, returns:
- +4 ; Piece 1: local XMZ
- +5 ; Piece 2: originated here? (0=no; 1=yes)
- +6 ; Piece 3: still exists? (P=no, purged;
- +7 ; R=no, purged, & replaced with something else;
- +8 ; E=yes, it still exists here)
- +9 NEW XMZCHK,XMP1,XMP2
- +10 SET XMP1=$PIECE(XMREMID,"@",1)
- SET XMP2=$PIECE(XMREMID,"@",2)
- +11 IF XMP1=""!(XMP2="")
- QUIT ""
- +12 SET XMZCHK=$$FINDXMZ(XMP1,XMP2)
- +13 IF XMZCHK
- QUIT XMZCHK
- +14 SET XMZCHK=$$FINDXMZ(XMP2,XMP1)
- +15 IF XMZCHK
- QUIT XMZCHK
- +16 QUIT ""
- FINDXMZ(XMP1,XMP2) ;
- +1 IF XMP1?.N!(XMP1?.N1"."7N)
- if XMP2=^XMB("NETNAME")
- QUIT $$LOCXMZ(XMP1)
- if $$FIND1^DIC(4.2,"","QX",XMP2,"B^C")=^XMB("NUM")
- QUIT $$LOCXMZ(XMP1)
- +2 NEW XMZ
- TRY SET XMZ=$ORDER(^XMBX(3.9,"AI",$EXTRACT(XMP2,1,64),$EXTRACT(XMP1,1,64),0))
- +1 IF XMZ
- QUIT $$REMXMZ(XMZ,XMP2,XMP1)
- +2 IF XMP1?.N1"."7N
- SET XMP1=$PIECE(XMP1,".")
- GOTO TRY
- +3 QUIT ""
- LOCXMZ(XMZ) ; Message originated here.
- +1 IF XMZ'["."
- QUIT XMZ_"^1^"_$SELECT($DATA(^XMB(3.9,XMZ,0)):"E",1:"P")
- +2 ; The following code won't activate until MailMan message IDs contain
- +3 ; dates. Message IDs are created in $$NETID^XMS3.
- +4 NEW XMCRE8
- +5 SET XMCRE8=$PIECE(XMZ,".",2)
- SET XMZ=$PIECE(XMZ,".",1)
- +6 QUIT XMZ_"^1^"_$SELECT('$DATA(^XMB(3.9,XMZ,0)):"P",$PIECE($GET(^XMB(3.9,XMZ,.6)),U,1)=XMCRE8:"E",1:"R")
- REMXMZ(XMZ,XMP2,XMP1) ; Message originated somewhere else.
- +1 IF '$DATA(^XMB(3.9,XMZ,0))
- QUIT XMZ_"^0^P"
- +2 NEW XMREMID
- +3 SET XMREMID=$GET(^XMB(3.9,XMZ,5))
- +4 IF XMREMID=""
- QUIT XMZ_"^0^R"
- +5 IF XMP1_"@"_XMP2=XMREMID
- QUIT XMZ_"^0^E"
- +6 IF XMP2_"@"_XMP1=XMREMID
- QUIT XMZ_"^0^E"
- +7 QUIT XMZ_"^0^R"
