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 Apr 09, 2024@21:14:55 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"
