- 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 Jan 18, 2025@03:14:56 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