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

XMXADDR.m

Go to the documentation of this file.
  1. XMXADDR ;ISC-SF/GMB-Address checker ;04/29/2003 08:51
  1. ;;8.0;MailMan;**18**;Jun 28, 2002
  1. ; Replaces ^XMA21,^XMA210,^XMA24 (ISC-WASH/CAP/AML/LL)
  1. ; XMIA 1=Interactive; 0=not
  1. CHKADDR(XMDUZ,XMTO,XMINSTR,XMRESTR,XMFULL) ; Check addressee(s) NON-INTERACTIVE
  1. ; This entry point is meant for calls in which the addressees are
  1. ; already in an array:
  1. ; XMTO("addressee 1")=""
  1. ; XMTO("addressee 2")=""
  1. ; or for just a single addressee: "addressee 1"
  1. N XMADDR,XMIA
  1. ;K XMERR,^TMP("XMERR",$J) DO NOT PUT THIS LINE IN HERE!
  1. S XMIA=0
  1. I $G(XMTO)]"",$O(XMTO(""))="" D Q
  1. . N XMERROR K XMFULL
  1. . D ADDRESS(XMDUZ,XMTO,.XMFULL,.XMERROR) Q:'$D(XMERROR)
  1. . S XMERROR("PARAM","ID")="XMTO",XMERROR("PARAM","VALUE")=XMTO
  1. . D ERRSET^XMXUTIL(XMERROR,.XMERROR)
  1. . S:'$D(XMFULL) ^TMP("XMERR",$J,XMERR,"PARM")=XMTO
  1. I $O(XMTO(""))="" D Q
  1. . ;S XMERR=$G(XMERR)+1,^TMP("XMERR",$J,XMERR,"TEXT",1)="Null addressee"
  1. S XMADDR=""
  1. F S XMADDR=$O(XMTO(XMADDR)) Q:XMADDR="" D
  1. . N XMERROR,XMFULL,XMFWDADD
  1. . D ADDRESS(XMDUZ,XMADDR,.XMFULL,.XMERROR) Q:'$D(XMERROR)
  1. . S XMERROR("PARAM","ID")="XMTO",XMERROR("PARAM","VALUE")=XMADDR
  1. . D ERRSET^XMXUTIL(XMERROR,.XMERROR)
  1. . S:'$D(XMFULL) ^TMP("XMERR",$J,XMERR,"PARM")=XMADDR
  1. Q
  1. INIT ;
  1. K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP("XMYL",$J)
  1. INITLATR ;
  1. N XMNOW
  1. S XMNOW=$$NOW^XLFDT
  1. S XMINLATR=$E($$FMADD^XLFDT(XMNOW,"","",5),1,12) ; Staggered delivery must be at least 5 minutes from now
  1. S XMAXLATR=$$SCH^XLFDT("1M",XMNOW) ; Staggered delivery must be at most 1 month from now
  1. S XMBIGGRP=$P(^XMB(1,1,0),U,7) ; Big group size
  1. Q
  1. CLEANUP ;
  1. K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP("XMYL",$J),XMINLATR,XMAXLATR,XMBIGGRP
  1. Q
  1. ADDR(XMDUZ,XMADDR,XMINSTR,XMRESTR,XMFULL) ; Check one addressee (INTERACTIVE)
  1. N XMIA,XMFWDADD
  1. S XMIA=1
  1. D ADDRESS(XMDUZ,XMADDR,.XMFULL)
  1. Q
  1. ADDRESS(XMDUZ,XMADDR,XMFULL,XMERROR) ; Check one addressee
  1. ; XMADDR (in) Addressee (if number, assumed to be a person's DUZ)
  1. ; XMFULL (out) The full address of the addressee
  1. N XMSTRIKE,XMPREFIX,XMLATER,XMGCIRCL,XMGMBRS,XMG
  1. D CHKPARM(.XMADDR,.XMSTRIKE,.XMPREFIX,.XMLATER) Q:$D(XMERROR)
  1. I $G(XMINSTR("ADDR FLAGS"))["X",$G(XMINSTR("ADDR FLAGS"))'["Y" S XMSTRIKE=0,XMLATER="",XMPREFIX=""
  1. I XMADDR["@"!(XMADDR["!") 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. . D REMOTE^XMXADDR3(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL)
  1. E D LOCAL(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL,.XMG)
  1. D:'$D(XMERROR) SET(XMFULL,$G(XMG),XMSTRIKE,XMPREFIX,XMLATER)
  1. Q
  1. LOCAL(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMFULL,XMG) ;
  1. I $E(XMADDR,1)="*" D Q
  1. . D BRODCAST^XMXADDR2(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL)
  1. I $L(XMADDR)>2,".G.g.D.d.H.h.S.s."[("."_$E(XMADDR,1,2)) D Q
  1. . N XMADDR1
  1. . S XMADDR1=$E(XMADDR,1)
  1. . I "Gg"[XMADDR1 D EXPAND^XMXADDRG(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL,.XMG) Q
  1. . I "Ss"[XMADDR1 D SERVER^XMXADDR3(XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL) Q
  1. . I "DdHh"[XMADDR1 D DEVICE^XMXADDR3(XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL) Q
  1. I XMADDR?1N.N,$L(XMADDR)>25 D Q
  1. . D SETERR^XMXADDR4($G(XMIA),"!,$C(7)",39002) ;Not found.
  1. I $G(XMIA) D
  1. . D IPERSON^XMXADDR1(XMDUZ,.XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMG,.XMFULL) Q:$D(XMERROR)
  1. . I XMLATER="?",XMG'=.6 D QLATER(XMFULL,.XMLATER)
  1. E D
  1. . D PERSON^XMXADDR1(XMDUZ,.XMADDR,XMSTRIKE,XMPREFIX,XMLATER,.XMG,.XMFULL)
  1. Q:$D(XMERROR)
  1. D:XMFULL'["@" INDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER)
  1. Q
  1. INDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
  1. N XMGREC,XMIASAVE
  1. I $D(XMFWDADD) D Q
  1. . ;You can't have a message forwarded to a local user.
  1. . D SETERR^XMXADDR4(0,"",38001)
  1. S XMGREC=^XMB(3.7,XMG,0)
  1. I $P(XMGREC,U,2)=""!(XMG=DUZ) D SETEXP(XMG,"",XMSTRIKE,XMPREFIX,XMLATER) Q
  1. ; Addressee has a forwarding address.
  1. ; Ignore it if message is from remote postmaster (OR envelope from is empty) and forwarding address is to a remote site (to avoid looping error messages to bad fwding address).
  1. I $D(XMRESTR("NET RECEIVE")),($$UP^XLFSTR(XMRESTR("NET RECEIVE"))["POSTMASTER"!("<>"[XMRESTR("NET RECEIVE"))),$$FIND1^DIC(4.2,"","QX",$P($P(XMGREC,U,2),"@",2),"B^C")'=^XMB("NUM") D SETEXP(XMG,"",XMSTRIKE,XMPREFIX,XMLATER) Q
  1. N XMFULL,XMERROR
  1. S XMFWDADD=XMG
  1. I $G(XMIA) S XMIA=0,XMIASAVE=1
  1. D REMOTE^XMXADDR3(XMDUZ,$P(XMGREC,U,2),XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL)
  1. K XMFWDADD
  1. I $G(XMIASAVE) S XMIA=1
  1. I '$D(XMERROR) D Q:'$P(XMGREC,U,8) ; quit if no local delivery
  1. . Q:XMSTRIKE
  1. . ; Note that recipient fwded
  1. . I $D(XMINSTR("NET FWD BY")),$D(XMRESTR("NET RECEIVE")) S ^TMP("XMY",$J,XMFULL,"F")=XMG_U_XMINSTR("NET FWD BY") Q
  1. . S ^TMP("XMY",$J,XMFULL,"F")=XMG
  1. D SETEXP(XMG,"",XMSTRIKE,XMPREFIX,XMLATER)
  1. Q:'$D(XMERROR)
  1. D DELFWD^XMVVITA(XMG,$P(XMGREC,U,2),.XMERROR)
  1. I $G(XMIA),'$D(XMGCIRCL) W !,$C(7)," ",$$EZBLD^DIALOG(38130.3) ; Forwarding Address ignored.
  1. Q
  1. SET(XMTO,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
  1. I $G(XMINSTR("ADDR FLAGS"))["X",$G(XMINSTR("ADDR FLAGS"))'["Y" Q
  1. I XMSTRIKE D Q
  1. . I $G(XMIA) D
  1. . . I $E(XMTO,1,2)="G."!($E(XMTO,1,2)="*;") D
  1. . . . I $D(^TMP("XMY0",$J,XMTO,"L")) D Q
  1. . . . . W $$EZBLD^DIALOG(39003) ;Later'd Group Deleted.
  1. . . . . K ^TMP("XMYL",$J,XMTO)
  1. . . . W !,$$EZBLD^DIALOG(39004) ;Members Deleted.
  1. . . E W:$X>70 ! W $$EZBLD^DIALOG(39005) ;Deleted.
  1. . . ; 39006 - * (Broadcast to all local users)
  1. . . I XMTO'=$$EZBLD^DIALOG(39006),$D(^TMP("XMY0",$J,$$EZBLD^DIALOG(39006))) W !,$$EZBLD^DIALOG(39007) ;But Broadcast will still go to all local users
  1. . . Q:'$D(^TMP("XMYL",$J))
  1. . . N XMGRP,XMTEXT ;But message will still go to all members of the following later'd group(s):
  1. . . D BLD^DIALOG(39008,"","","XMTEXT","F")
  1. . . D MSG^DIALOG("WM","","","","XMTEXT")
  1. . . S XMGRP="" F S XMGRP=$O(^TMP("XMYL",$J,XMGRP)) Q:XMGRP="" W !,XMGRP
  1. . K ^TMP("XMY0",$J,XMTO)
  1. . K:$D(^TMP("XMYL",$J,XMTO)) ^TMP("XMYL",$J,XMTO)
  1. S ^TMP("XMY0",$J,XMTO)=XMG ; =XMIEN
  1. I XMPREFIX'="" S ^TMP("XMY0",$J,XMTO,1)=$$UP^XLFSTR(XMPREFIX)
  1. I XMLATER S ^TMP("XMY0",$J,XMTO,"L")=XMLATER I $E(XMTO,1,2)="G."!($E(XMTO,1,2)="*;") S ^TMP("XMYL",$J,XMTO)=""
  1. I XMLATER="?",$G(XMIA) W !,$C(7),$$EZBLD^DIALOG(39009) ;'Later' not appropriate for this addressee
  1. Q
  1. SETEXP(XMTO,XMIEN,XMSTRIKE,XMPREFIX,XMLATER) ;
  1. Q:$G(XMINSTR("ADDR FLAGS"))["X"
  1. I XMSTRIKE K ^TMP("XMY",$J,XMTO) Q
  1. I XMLATER,XMTO'=XMDUZ Q
  1. S ^TMP("XMY",$J,XMTO)=XMIEN
  1. I XMPREFIX'="" S ^TMP("XMY",$J,XMTO,1)=$$UP^XLFSTR(XMPREFIX)
  1. I $D(XMINSTR("NET FWD BY")),$D(XMRESTR("NET RECEIVE")) S ^TMP("XMY",$J,XMTO,"F")=XMINSTR("NET FWD BY")
  1. Q
  1. GOTADDR() ; Function returns 1 if addressees exist; 0 if not.
  1. Q:$D(^TMP("XMY",$J)) 1
  1. Q:$D(^TMP("XMYL",$J)) 1
  1. Q:'$D(^TMP("XMY0",$J)) 0
  1. N XMTO
  1. S XMTO=$O(^TMP("XMY0",$J,""))
  1. Q:$D(^TMP("XMY0",$J,XMTO,"L")) 1
  1. Q 0
  1. CHKPARM(XMADDR,XMSTRIKE,XMPREFIX,XMLATER) ;
  1. I $E(XMADDR,1)="-" D
  1. . S XMSTRIKE=1
  1. . S XMADDR=$E(XMADDR,2,999)
  1. E S XMSTRIKE=0
  1. I $E(XMADDR,1)=" "!($E(XMADDR,$L(XMADDR))=" ") S XMADDR=$$STRIP^XMXUTIL1(XMADDR)
  1. I $P(XMADDR,"@",1)="" D Q
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39010) ;Null addressee
  1. I $E(XMADDR,1)'="""",XMADDR[":" D Q
  1. . D PREFIX(.XMADDR,.XMPREFIX,.XMLATER)
  1. . I XMSTRIKE,XMLATER="?" S XMLATER=""
  1. S XMPREFIX=""
  1. S XMLATER=""
  1. Q
  1. PREFIX(XMADDR,XMPREFIX,XMLATER) ;
  1. N XMPRE
  1. S XMPRE=$P(XMADDR,":",1)
  1. I XMPRE="" D Q
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39011) ;Null recipient type
  1. S (XMLATER,XMPREFIX)=""
  1. S XMPRE=$$UP^XLFSTR(XMPRE)
  1. I $P(XMPRE,"@",1)["L",'$D(XMRESTR("NET RECEIVE")) D
  1. . D LATER($P(XMPRE,"@",2,99),.XMLATER)
  1. . S XMPRE=$TR($P(XMPRE,"@",1),"L")
  1. D:XMPRE'="" RTYPE(XMPRE,.XMPREFIX)
  1. I $D(XMERROR),$D(XMRESTR("NET RECEIVE")),$$FIND1^DIC(4.2,"","QX",$P(XMADDR,"@",2),"B^C")'=^XMB("NUM") K XMERROR Q
  1. S XMADDR=$P(XMADDR,":",2)
  1. Q
  1. LATER(XMWHEN,XMLATER) ; (XMWHEN=user-supplied date/time)
  1. I $G(XMIA),XMWHEN="" S XMLATER="?" Q
  1. I '$D(XMINLATR) D INITLATR
  1. D DT^DILF("FTX",XMWHEN,.XMLATER,XMINLATR)
  1. Q:XMLATER>0
  1. S XMLATER=$S($G(XMIA):"?",1:"")
  1. Q
  1. RTYPE(XMPRE,XMPREFIX) ;
  1. N XMINTRNL
  1. D CHK^DIE(3.91,6.5,"",XMPRE,.XMINTRNL)
  1. I XMINTRNL="^" D Q ;Invalid recipient type '|1|'
  1. . D SETERR^XMXADDR4($G(XMIA),"!",39012,XMPRE)
  1. S XMPREFIX=XMINTRNL
  1. Q
  1. QLATER(XMFULL,XMLATER) ;
  1. N DIR,Y
  1. I '$D(XMINLATR) D INITLATR
  1. W !
  1. S DIR(0)="DO^"_XMINLATR_":"_XMAXLATR_":EXT"
  1. ;Later Delivery must be at least 5 minutes from now.
  1. D BLD^DIALOG(39013,"","","DIR(""A"")") ;When Later
  1. S DIR("B")=$$MMDT^XMXUTIL1($$FMADD^XLFDT($$NOW^XLFDT,"","",5)) ; (in 5 minutes)
  1. S DIR("B")=$P(DIR("B")," ",1,3)_"@"_$P(DIR("B")," ",4)
  1. D ^DIR I $D(DIRUT) D Q
  1. . S XMLATER=""
  1. . D SETERR^XMXADDR4(0,"",37002) ;up-arrow or time out.
  1. . W !,XMFULL,$$EZBLD^DIALOG(39015) ;removed from recipient list.
  1. S XMLATER=Y
  1. ;>> Remember, you won't be able to 'minus' anyone from the ...
  1. I $E(XMFULL,1,2)="G." W !!,$$EZBLD^DIALOG(39016) ; group <<
  1. I $E(XMFULL,1,2)="*;" W !!,$$EZBLD^DIALOG(39017) ; limited broadcast <<
  1. Q