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