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