Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMXADDR3

XMXADDR3.m

Go to the documentation of this file.
  1. XMXADDR3 ;ISC-SF/GMB-XMXADDR (cont.) ;04/15/2003 13:16
  1. ;;8.0;MailMan;**18**;Jun 28, 2002
  1. SERVER(XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMFULL) ;
  1. N XMG
  1. S XMADDR=$P(XMADDR,".",2,99)
  1. I $G(XMIA) D
  1. . N DIC,X
  1. . S X=XMADDR
  1. . S DIC="^DIC(19,"
  1. . S DIC(0)="FEZ"_$S($D(XMGCIRCL):"O",1:"")
  1. . D ^DIC
  1. . I Y<0 D SETERR^XMXADDR4(1,"!",39060) Q ;Invalid server name
  1. . S XMG=+Y
  1. E D
  1. . S XMG=$$FIND1^DIC(19,"","O",XMADDR) I 'XMG D SETERR^XMXADDR4(0,"",$S($D(DIERR):39061,1:39062)) ; Server ambiguous / Server not found.
  1. Q:$D(XMERROR)
  1. S XMFULL="S."_$P(^DIC(19,XMG,0),U,1)
  1. D SETEXP^XMXADDR(XMFULL,XMG,XMSTRIKE,XMPREFIX,XMLATER)
  1. Q
  1. DEVICE(XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMFULL) ;
  1. N XMG
  1. S XMADDR1=$$UP^XLFSTR($E(XMADDR,1))
  1. S XMADDR=$P(XMADDR,".",2,99)
  1. I $G(XMIA) D
  1. . N DIC,X
  1. . S X=XMADDR
  1. . S DIC="^%ZIS(1," ; file 3.5
  1. . S DIC(0)="EF"_$S($D(XMGCIRCL):"O",1:"")
  1. . D ^DIC
  1. . I Y<0 D SETERR^XMXADDR4(1,"!",39063) Q ;Invalid device name
  1. . S XMG=+Y
  1. . S XMADDR=$P(Y,U,2)
  1. E D
  1. . S XMG=$$FIND1^DIC(3.5,"","O",XMADDR) I 'XMG D SETERR^XMXADDR4(0,"",$S($D(DIERR):39064,1:39065)) Q ; Device ambiguous. / Device not found.
  1. . S XMADDR=$P(^%ZIS(1,XMG,0),U,1)
  1. Q:$D(XMERROR)
  1. I XMADDR["P-MESSAGE" D Q ;You may not use P-MESSAGE in an address.
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39066)
  1. S XMFULL=XMADDR1_"."_XMADDR
  1. D SETEXP^XMXADDR(XMFULL,XMG,XMSTRIKE,XMPREFIX,XMLATER)
  1. Q
  1. REMOTE(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMFULL) ;
  1. ; XMVIA IEN of domain in ^DIC(4.2 via which the msg will be sent
  1. ; XMVIAN Name of domain via which the msg will be sent
  1. ; XMDOMAIN Domain of the addressee
  1. ; XMNAME Name of the addressee
  1. N XMVIA,XMVIAN,XMDOMAIN,XMNAME
  1. S:XMADDR["<"!(XMADDR[" ") XMADDR=$$REMADDR(XMADDR)
  1. S XMNAME=$P(XMADDR,"@",1)
  1. I XMNAME="" D Q
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39010) ;Null addressee
  1. S XMDOMAIN=$P(XMADDR,"@",2,99)
  1. I XMDOMAIN="" D Q
  1. . ; You must specify a reachable uunet host / Null domain
  1. . D SETERR^XMXADDR4($G(XMIA),"!",$S(XMNAME["!":39067,1:39068))
  1. ; find out the full domain name, and
  1. ; whether the domain is valid, and if so, via which entry in DIC(4.2
  1. D DNS^XMXADDRD(XMDUZ,.XMDOMAIN,.XMVIA,.XMVIAN) Q:$D(XMERROR)
  1. I XMDOMAIN=^XMB("NETNAME") D ; the full domain name = the local domain
  1. . N XMQUOTED
  1. . I XMNAME?1""""1.E1"""" S XMNAME=$E(XMNAME,2,$L(XMNAME)-1),XMQUOTED=1
  1. . I $E(XMNAME,1)=" "!($E(XMNAME,$L(XMNAME))=" ") S XMNAME=$$STRIP^XMXUTIL1(XMNAME)
  1. . D LOCAL^XMXADDR(XMDUZ,XMNAME,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL)
  1. . Q:'$D(XMERROR)
  1. . Q:$G(XMQUOTED)
  1. . N XMSAVE
  1. . S XMSAVE=XMNAME
  1. . I ".G.g.D.d.H.h.S.s."[("."_$E(XMNAME,1,2)) S XMNAME=$E(XMNAME,1,2)_$TR($E(XMNAME,3,99),"._+",", .")
  1. . E S XMNAME=$TR(XMNAME,"._+",", .")
  1. . I XMSAVE'=XMNAME D Q:'$D(XMERROR)
  1. . . K XMERROR
  1. . . I $G(XMIA) D EN^DDIOL($$EZBLD^DIALOG(39069,XMNAME)) ;Checking: |1|
  1. . . D LOCAL^XMXADDR(XMDUZ,XMNAME,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL)
  1. . Q:'$G(XMRESTR("NET RECEIVE"))
  1. . Q:"^39062^39065^39132^"'[(U_XMERROR_U)
  1. . ; Server, Device, or Group not found. Try lower case.
  1. . ; (We do not need to try local user again.)
  1. . S XMSAVE=XMNAME,XMNAME=$$LOW^XLFSTR(XMNAME) Q:XMSAVE=XMNAME
  1. . K XMERROR
  1. . D LOCAL^XMXADDR(XMDUZ,XMNAME,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL)
  1. E D
  1. . I $D(XMRESTR("NONET")) D Q
  1. . . ;Messages longer than |1| lines may not be sent across the network.
  1. . . D SETERR^XMXADDR4($G(XMIA),"!",39001,XMRESTR("NONET"))
  1. . I $D(XMFWDADD),+$G(^XMB(1,1,3)) D Q:$D(XMERROR)
  1. . . ; This is an auto-forward address, and we are limiting it.
  1. . . Q:$$FWDOK(3.1,XMDOMAIN) ; Approved auto-forward site?
  1. . . I '$D(^XUSEC("XM AUTO-FORWARD WAIVER",+XMFWDADD)) D Q
  1. . . . ;You can't have your mail forwarded to a non-VA site. Waivers can
  1. . . . ;be requested through your site Information Security Officer (ISO)
  1. . . . D SETERR^XMXADDR4($G(XMIA),"P",38130.1)
  1. . . Q:$$FWDOK(3.2,XMDOMAIN) ; Waiver auto-forward site?
  1. . . ;You have been granted a waiver to have your mail forwarded to a
  1. . . ;non-VA site, but this site is not one of the sites for which a
  1. . . ;waiver has been granted. Please contact your site Information
  1. . . ;Security Officer (ISO) for further information.
  1. . . D SETERR^XMXADDR4($G(XMIA),"P",38130.2)
  1. . ; I XMDOMAIN?.E1".DOMAIN.EXT" D
  1. . ;. ; Check the address before the @ to find any obvious errors
  1. . ; Now transform spaces, commas, and periods in XMNAME
  1. . S XMFULL=XMNAME_"@"_XMDOMAIN
  1. . I XMSTRIKE D REMINUS(.XMFULL,XMNAME,XMDOMAIN) Q:$D(XMERROR)
  1. . I XMLATER="?" D QLATER^XMXADDR(XMFULL,.XMLATER) Q:$D(XMERROR)
  1. . D SETEXP^XMXADDR(XMFULL,XMVIA,XMSTRIKE,XMPREFIX,XMLATER)
  1. Q
  1. FWDOK(XMNODE,XMDOMAIN) ; Is the auto-forward domain OK?
  1. N I,XMOK
  1. S I="",XMOK=0
  1. F S I=$O(^XMB(1,1,XMNODE,"B",I)) Q:I=""!(I=$E(XMDOMAIN,$L(XMDOMAIN)-$L(I)+1,99))
  1. Q I'=""
  1. REMINUS(XMFULL,XMNAME,XMDOMAIN) ;
  1. Q:$D(^TMP("XMY",$J,XMFULL))
  1. I $O(^TMP("XMY",$J,":"))="" Q:'$G(XMIA) D Q
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39015.1) ;Not a current recipient.
  1. N XMTRY,XMTO
  1. S XMTRY=$$LOW^XLFSTR(XMNAME)_"@"_XMDOMAIN
  1. I $D(^TMP("XMY",$J,XMTRY)) S XMFULL=XMTRY Q
  1. S XMTRY=$$UP^XLFSTR(XMNAME)_"@"_XMDOMAIN
  1. I $D(^TMP("XMY",$J,XMTRY)) S XMFULL=XMTRY Q
  1. S XMTO=":"
  1. F S XMTO=$O(^TMP("XMY",$J,XMTO)) Q:XMTO="" Q:$$UP^XLFSTR(XMTO)=XMTRY
  1. I XMTO="" Q:'$G(XMIA) D SETERR^XMXADDR4($G(XMIA),"!",39015.1) Q ;Not a current recipient.
  1. S XMFULL=XMTO
  1. Q
  1. REMADDR(XMADDR) ;
  1. I XMADDR["<" Q $TR($P($P(XMADDR,">",1),"<",2,99),"<") ; handles <addr> and <<addr>>
  1. Q:XMADDR'[" " XMADDR
  1. I $E(XMADDR,1)=" "!($E(XMADDR,$L(XMADDR))=" ") S XMADDR=$$STRIP^XMXUTIL1(XMADDR)
  1. I XMADDR'["""",XMADDR'["(" Q XMADDR
  1. I XMADDR["""@" D Q XMADDR
  1. . ; "first last"@domain
  1. . N I,J,XMDOM
  1. . S I=$F(XMADDR,"""@")
  1. . S XMDOM=$E(XMADDR,I,999)
  1. . S XMDOM=$P(XMDOM," ",1)
  1. . S J=$F(XMADDR,"""")
  1. . S XMADDR=$E(XMADDR,J-1,I-J)_"@"_XMDOM
  1. ; last.first@domain (first last)
  1. N I
  1. F I=1:1:$L(XMADDR," ") Q:$P(XMADDR," ",I)["@"
  1. S XMADDR=$P(XMADDR," ",1,I)
  1. Q XMADDR