XMXADDR1 ;ISC-SF/GMB-XMXADDR (cont.) ;05/21/2002 07:00
;;8.0;MailMan;;Jun 28, 2002
PERSON(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMG,XMFULL) ;
N XMSCREEN,XMNOTFND
S XMADDR=$$UP^XLFSTR(XMADDR)
S XMSCREEN="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))" ; User must have an access code & mailbox
; "B^BB^C^D" = name^alias^initial^nickname
S XMG=$$FIND1^DIC(200,"","O",$S(+XMADDR=XMADDR:"`"_XMADDR,1:XMADDR),"B^BB^C^D",XMSCREEN)
I XMG D Q
. S XMFULL=$$NAME^XMXUTIL(XMG)
. Q:XMG'=.6
. D CHKSHARE
. S:XMLATER XMLATER="?" ; Can't 'later' to SHARED,MAIL
S XMNOTFND=$S($D(DIERR):39018,1:39019) ;Addressee ambiguous. / Addressee not found.
I +XMADDR=XMADDR D Q
. D SETERR^XMXADDR4(0,"",XMNOTFND)
; Not found in NEW PERSON file, see if there's a MAIL NAME
I $D(^XMB(3.7,"C")) D Q:XMG
. S XMSCREEN="I $L($P(^VA(200,+Y,0),U,3))" ; User must have an access code
. S XMG=$$FIND1^DIC(3.7,"","OQ",XMADDR,"C",XMSCREEN) Q:'XMG
. S XMFULL=$$NAME^XMXUTIL(XMG)
; Not a Mail Name, see if it's in the Remote User Directory.
N XMINDEX,I,XMG
S XMINDEX="" F I="B","F" S:$D(^DIC(4.2997,I)) XMINDEX=XMINDEX_U_I
I XMINDEX'="" D Q:XMG
. S XMINDEX=$E(XMINDEX,2,99)
. S XMG=$$FIND1^DIC(4.2997,"","OQ",XMADDR,XMINDEX) Q:'XMG
. S XMADDR=$P(^XMD(4.2997,XMG,0),U,7)
. D CHKREM(XMG,XMADDR) Q:$D(XMERROR)
. D REMDT(XMG)
. D REMOTE^XMXADDR3(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,.XMFULL)
D SETERR^XMXADDR4(0,"",XMNOTFND)
Q
CHKSHARE ;
I $G(XMINSTR("FLAGS"))["X"!($G(XMRESTR("FLAGS"))["X") D Q
. ;Closed messages may not be sent to SHARED,MAIL.
. D SETERR^XMXADDR4(0,"",39020)
I $G(XMINSTR("FLAGS"))["C"!($G(XMRESTR("FLAGS"))["C") D Q
. ;Confidential messages may not be sent to SHARED,MAIL.
. D SETERR^XMXADDR4(0,"",39021)
Q
REMDT(XMG) ;
N XMFDA
S XMFDA(4.2997,XMG_",",6)=$E(DT,1,5) ; Date (YYYMM) remote address last used
D FILE^DIE("","XMFDA")
Q
IPERSON(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMG,XMFULL) ;
N DIC,D,X,Y,XMINDEX
S XMADDR=$$UP^XLFSTR(XMADDR)
S DIC("S")="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))" ; User must have an access code & mailbox
I XMSTRIKE S DIC("S")=DIC("S")_",$D(^TMP(""XMY"",$J,+Y))" ; If '-', must already have been chosen
S DIC("W")="I Y'=DUZ D USERINFO^XMXADDR1(Y)"
S DIC="^VA(200,"
S DIC(0)="FEZMN" ; If user enters a DUZ, ask "OK?"
S X=XMADDR
;S DIC(0)="FEZM" ; If user enters a DUZ, do NOT ask "OK?"
;S X=$S(XMADDR=+XMADDR:"`"_XMADDR,1:XMADDR)
S (XMINDEX,D)="B^BB^C^D" ; name^alias^initial^nickname
D MIX^DIC1
I Y>0 D Q
. S XMG=+Y
. S XMFULL=$$NAME^XMXUTIL(XMG) ; $P(Y,U,2)
. Q:XMSTRIKE
. ; Sending to yourself, and ask bskt, and not creating a forwarding address
. I XMG=XMDUZ,$G(XMINSTR("ADDR FLAGS"))'["X",XMV("ASK BSKT") D
. . N XMK,XMDIC
. . S XMDIC("B")=$$EZBLD^DIALOG(37005) ;IN
. . D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(39022),"L",.XMDIC,.XMK) ;Select basket to send to:
. . I XMK=U D SETERR^XMXADDR4(0,"",39014) Q ;No basket selected.
. . S XMINSTR("SELF BSKT")=XMK
. E I XMG=.6 D
. . D CHKSHARE
. . I $D(XMERROR) D WRIERR^XMXADDR4("!") Q
. . D ASKSHARE(.XMINSTR)
. I $D(XMERROR) W !,XMFULL,$$EZBLD^DIALOG(39015) ;removed from recipient list.
I $D(DUOUT)!$D(DTOUT) D Q ;up-arrow out. / time out.
. D SETERR^XMXADDR4(0,"",$S($D(DUOUT):37000,1:37001))
D NOTFOUND(XMADDR,XMINDEX)
I XMADDR=+XMADDR D SETERR^XMXADDR4(0,"",39002) Q ;Not found.
W !,$C(7),$$EZBLD^DIALOG(39026),XMADDR ;Checking for MAIL NAME:
S X=XMADDR
K DIC("S"),DIC("W")
S DIC(0)="FEZ"
S D="C"
S DIC="^XMB(3.7,"
D IX^DIC
I Y>0 D Q
. S XMG=+Y
. S XMFULL=Y(0,0)
I $D(DUOUT)!$D(DTOUT) D Q ;up-arrow out. / time out.
. D SETERR^XMXADDR4(0,"",$S($D(DUOUT):37000,1:37001))
; Not a Mail Name, see if it's in the Remote User Directory.
N XMFIND,DIR,XMG
S XMFIND=X
W !
D BLD^DIALOG(39025,"","","DIR(""A"")") ; Not a local user; want to check the Remote User Directory?
S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ; No
D BLD^DIALOG(39025.1,"","","DIR(""?"")")
D ^DIR
I 'Y W !
E D Q:$D(XMG)
. S X=XMFIND ;Not a local user; checking Remote User Directory
. W !,$C(7),$$EZBLD^DIALOG(39027),X
. S DIC(0)="MFEVZ"
. S D="B^F"
. S DIC="^XMD(4.2997,"
. D MIX^DIC1 Q:Y<0
. S XMG=+Y
. S XMADDR=$P(Y(0),U,7)
. D CHKREM(XMG,XMADDR) Q:$D(XMERROR)
. D REMDT(XMG)
. W !,$$EZBLD^DIALOG(39028),XMADDR ;Routing to Remote Address:
. D REMOTE^XMXADDR3(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL) ;Q:$D(XMERROR)
I $D(DUOUT)!$D(DTOUT) D Q ;up-arrow out. / time out.
. D SETERR^XMXADDR4(0,"",$S($D(DUOUT):37000,1:37001))
; Not in Remote User Directory, see if it's a Mail Group
S DIC="^XMB(3.8,"
S D="B"
S DIC(0)="O"
D IX^DIC
I Y>0 D Q ;Enter 'G.groupname' to identify a mail group
. D SETERR^XMXADDR4(1,"!",39029)
D SETERR^XMXADDR4(1,"",39002) ;Not found.
Q
ASKSHARE(XMINSTR) ;
N XMK,XMDIC
S XMDIC("B")=$$EZBLD^DIALOG(37005) ;IN
D SELBSKT^XMJBU(.6,$$EZBLD^DIALOG(39022),"L",.XMDIC,.XMK) ;Select basket to send to:
I XMK=U D SETERR^XMXADDR4(0,"",39014) Q ;No basket selected.
N DIR,X,Y
S DIR("A")=$$EZBLD^DIALOG(39023) ;Enter Termination Date
S DIR("B")="T+30"
S DIR(0)="D^"_DT_"::ENX"
;Messages sent to SHARED,MAIL must have a delete date, so
;they may be automatically removed from SHARED,MAIL's mailbox.
D BLD^DIALOG(39024,"","","DIR(""?"")")
S DIR("??")="^D HELP^%DTC"
D ^DIR
I $D(DIRUT) D SETERR^XMXADDR4(0,"",37002) Q ;up-arrow or time out.
S XMINSTR("SHARE BSKT")=XMK
S XMINSTR("SHARE DATE")=Y
Q
CHKREM(DA,XMADDR) ; Is the remote address really local?
S XMADDR=$$UP^XLFSTR($P(XMADDR,"@",2))
I $$FIND1^DIC(4.2,"","QO",XMADDR,"B^C")'=^XMB("NUM") Q
N DIK
S DIK="^XMD(4.2997,"
D ^DIK
I '$G(XMIA) D SETERR^XMXADDR4(0,"",39002) Q ;Not found.
D SETERR^XMXADDR4(1,"!",39028.1) ; Remote address is really local. Deleting it.
Q
USERINFO(XMDUZ) ;
N %
W:XMV("SHOW DUZ") " (DUZ ",XMDUZ,")"
S %=$P($G(^VA(200,XMDUZ,5)),U,1) ; Service/Section
I % S %=$P($G(^DIC(49,%,0)),U,1) W:$L(%)+$X+1>79 !,?4 W " ",%," "
S %=$P($G(^XMB(3.7,XMDUZ,"L"),$$EZBLD^DIALOG(38002)),U,1) ;Never
W:$L(%)+$X+20>79 !,?4 W $$EZBLD^DIALOG(38003),% ;Last used MailMan:
S %=$G(^XMB(3.7,XMDUZ,0))
I $L($P(%,U,2)) W !,?5,$$EZBLD^DIALOG(38004),$P(%,U,2),$S($P(%,U,8):$$EZBLD^DIALOG(38005),1:$$EZBLD^DIALOG(38006)) ;Forwarding Address: / Local Delivery is ON / Local Delivery is OFF
S %=$G(^XMB(3.7,XMDUZ,"B")) W:%'="" !,?10,%
Q
NOTFOUND(XMADDR,XMINDEX) ;
N XMI,XMREC
S XMI=$$FIND1^DIC(200,"","O",$S(+XMADDR=XMADDR:"`"_XMADDR,1:XMADDR),XMINDEX)
I 'XMI W $C(7),$$EZBLD^DIALOG(39030) Q ;Not found in NEW PERSON file.
; found user, but missing access/verify/mailbox
S XMREC=^VA(200,XMI,0)
I $D(^XMB(3.7,XMI,2)),$P(XMREC,U,3)'="" Q
N XMPARM,XMTEXT
S XMPARM(1)=$$NAME^XMXUTIL(XMI)
S XMPARM(2)=$S($P(XMREC,U,3)'="":$$EZBLD^DIALOG(39034),$D(^XMB(3.7,XMI,2)):$$EZBLD^DIALOG(39032),1:$$EZBLD^DIALOG(39033)) ;a mailbox / an access code or a mailbox / an access code
;If |1| is the person you're trying to address, you can't,
;because |1| doesn't have |2|.
D BLD^DIALOG(39031,.XMPARM,"","XMTEXT","F")
D MSG^DIALOG("WH","","","","XMTEXT")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXADDR1 7207 printed Apr 09, 2024@21:14:40 Page 2
XMXADDR1 ;ISC-SF/GMB-XMXADDR (cont.) ;05/21/2002 07:00
+1 ;;8.0;MailMan;;Jun 28, 2002
PERSON(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMG,XMFULL) ;
+1 NEW XMSCREEN,XMNOTFND
+2 SET XMADDR=$$UP^XLFSTR(XMADDR)
+3 ; User must have an access code & mailbox
SET XMSCREEN="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))"
+4 ; "B^BB^C^D" = name^alias^initial^nickname
+5 SET XMG=$$FIND1^DIC(200,"","O",$SELECT(+XMADDR=XMADDR:"`"_XMADDR,1:XMADDR),"B^BB^C^D",XMSCREEN)
+6 IF XMG
Begin DoDot:1
+7 SET XMFULL=$$NAME^XMXUTIL(XMG)
+8 if XMG'=.6
QUIT
+9 DO CHKSHARE
+10 ; Can't 'later' to SHARED,MAIL
if XMLATER
SET XMLATER="?"
End DoDot:1
QUIT
+11 ;Addressee ambiguous. / Addressee not found.
SET XMNOTFND=$SELECT($DATA(DIERR):39018,1:39019)
+12 IF +XMADDR=XMADDR
Begin DoDot:1
+13 DO SETERR^XMXADDR4(0,"",XMNOTFND)
End DoDot:1
QUIT
+14 ; Not found in NEW PERSON file, see if there's a MAIL NAME
+15 IF $DATA(^XMB(3.7,"C"))
Begin DoDot:1
+16 ; User must have an access code
SET XMSCREEN="I $L($P(^VA(200,+Y,0),U,3))"
+17 SET XMG=$$FIND1^DIC(3.7,"","OQ",XMADDR,"C",XMSCREEN)
if 'XMG
QUIT
+18 SET XMFULL=$$NAME^XMXUTIL(XMG)
End DoDot:1
if XMG
QUIT
+19 ; Not a Mail Name, see if it's in the Remote User Directory.
+20 NEW XMINDEX,I,XMG
+21 SET XMINDEX=""
FOR I="B","F"
if $DATA(^DIC(4.2997,I))
SET XMINDEX=XMINDEX_U_I
+22 IF XMINDEX'=""
Begin DoDot:1
+23 SET XMINDEX=$EXTRACT(XMINDEX,2,99)
+24 SET XMG=$$FIND1^DIC(4.2997,"","OQ",XMADDR,XMINDEX)
if 'XMG
QUIT
+25 SET XMADDR=$PIECE(^XMD(4.2997,XMG,0),U,7)
+26 DO CHKREM(XMG,XMADDR)
if $DATA(XMERROR)
QUIT
+27 DO REMDT(XMG)
+28 DO REMOTE^XMXADDR3(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,.XMFULL)
End DoDot:1
if XMG
QUIT
+29 DO SETERR^XMXADDR4(0,"",XMNOTFND)
+30 QUIT
CHKSHARE ;
+1 IF $GET(XMINSTR("FLAGS"))["X"!($GET(XMRESTR("FLAGS"))["X")
Begin DoDot:1
+2 ;Closed messages may not be sent to SHARED,MAIL.
+3 DO SETERR^XMXADDR4(0,"",39020)
End DoDot:1
QUIT
+4 IF $GET(XMINSTR("FLAGS"))["C"!($GET(XMRESTR("FLAGS"))["C")
Begin DoDot:1
+5 ;Confidential messages may not be sent to SHARED,MAIL.
+6 DO SETERR^XMXADDR4(0,"",39021)
End DoDot:1
QUIT
+7 QUIT
REMDT(XMG) ;
+1 NEW XMFDA
+2 ; Date (YYYMM) remote address last used
SET XMFDA(4.2997,XMG_",",6)=$EXTRACT(DT,1,5)
+3 DO FILE^DIE("","XMFDA")
+4 QUIT
IPERSON(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMG,XMFULL) ;
+1 NEW DIC,D,X,Y,XMINDEX
+2 SET XMADDR=$$UP^XLFSTR(XMADDR)
+3 ; User must have an access code & mailbox
SET DIC("S")="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))"
+4 ; If '-', must already have been chosen
IF XMSTRIKE
SET DIC("S")=DIC("S")_",$D(^TMP(""XMY"",$J,+Y))"
+5 SET DIC("W")="I Y'=DUZ D USERINFO^XMXADDR1(Y)"
+6 SET DIC="^VA(200,"
+7 ; If user enters a DUZ, ask "OK?"
SET DIC(0)="FEZMN"
+8 SET X=XMADDR
+9 ;S DIC(0)="FEZM" ; If user enters a DUZ, do NOT ask "OK?"
+10 ;S X=$S(XMADDR=+XMADDR:"`"_XMADDR,1:XMADDR)
+11 ; name^alias^initial^nickname
SET (XMINDEX,D)="B^BB^C^D"
+12 DO MIX^DIC1
+13 IF Y>0
Begin DoDot:1
+14 SET XMG=+Y
+15 ; $P(Y,U,2)
SET XMFULL=$$NAME^XMXUTIL(XMG)
+16 if XMSTRIKE
QUIT
+17 ; Sending to yourself, and ask bskt, and not creating a forwarding address
+18 IF XMG=XMDUZ
IF $GET(XMINSTR("ADDR FLAGS"))'["X"
IF XMV("ASK BSKT")
Begin DoDot:2
+19 NEW XMK,XMDIC
+20 ;IN
SET XMDIC("B")=$$EZBLD^DIALOG(37005)
+21 ;Select basket to send to:
DO SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(39022),"L",.XMDIC,.XMK)
+22 ;No basket selected.
IF XMK=U
DO SETERR^XMXADDR4(0,"",39014)
QUIT
+23 SET XMINSTR("SELF BSKT")=XMK
End DoDot:2
+24 IF '$TEST
IF XMG=.6
Begin DoDot:2
+25 DO CHKSHARE
+26 IF $DATA(XMERROR)
DO WRIERR^XMXADDR4("!")
QUIT
+27 DO ASKSHARE(.XMINSTR)
End DoDot:2
+28 ;removed from recipient list.
IF $DATA(XMERROR)
WRITE !,XMFULL,$$EZBLD^DIALOG(39015)
End DoDot:1
QUIT
+29 ;up-arrow out. / time out.
IF $DATA(DUOUT)!$DATA(DTOUT)
Begin DoDot:1
+30 DO SETERR^XMXADDR4(0,"",$SELECT($DATA(DUOUT):37000,1:37001))
End DoDot:1
QUIT
+31 DO NOTFOUND(XMADDR,XMINDEX)
+32 ;Not found.
IF XMADDR=+XMADDR
DO SETERR^XMXADDR4(0,"",39002)
QUIT
+33 ;Checking for MAIL NAME:
WRITE !,$CHAR(7),$$EZBLD^DIALOG(39026),XMADDR
+34 SET X=XMADDR
+35 KILL DIC("S"),DIC("W")
+36 SET DIC(0)="FEZ"
+37 SET D="C"
+38 SET DIC="^XMB(3.7,"
+39 DO IX^DIC
+40 IF Y>0
Begin DoDot:1
+41 SET XMG=+Y
+42 SET XMFULL=Y(0,0)
End DoDot:1
QUIT
+43 ;up-arrow out. / time out.
IF $DATA(DUOUT)!$DATA(DTOUT)
Begin DoDot:1
+44 DO SETERR^XMXADDR4(0,"",$SELECT($DATA(DUOUT):37000,1:37001))
End DoDot:1
QUIT
+45 ; Not a Mail Name, see if it's in the Remote User Directory.
+46 NEW XMFIND,DIR,XMG
+47 SET XMFIND=X
+48 WRITE !
+49 ; Not a local user; want to check the Remote User Directory?
DO BLD^DIALOG(39025,"","","DIR(""A"")")
+50 ; No
SET DIR(0)="Y"
SET DIR("B")=$$EZBLD^DIALOG(39053)
+51 DO BLD^DIALOG(39025.1,"","","DIR(""?"")")
+52 DO ^DIR
+53 IF 'Y
WRITE !
+54 IF '$TEST
Begin DoDot:1
+55 ;Not a local user; checking Remote User Directory
SET X=XMFIND
+56 WRITE !,$CHAR(7),$$EZBLD^DIALOG(39027),X
+57 SET DIC(0)="MFEVZ"
+58 SET D="B^F"
+59 SET DIC="^XMD(4.2997,"
+60 DO MIX^DIC1
if Y<0
QUIT
+61 SET XMG=+Y
+62 SET XMADDR=$PIECE(Y(0),U,7)
+63 DO CHKREM(XMG,XMADDR)
if $DATA(XMERROR)
QUIT
+64 DO REMDT(XMG)
+65 ;Routing to Remote Address:
WRITE !,$$EZBLD^DIALOG(39028),XMADDR
+66 ;Q:$D(XMERROR)
DO REMOTE^XMXADDR3(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL)
End DoDot:1
if $DATA(XMG)
QUIT
+67 ;up-arrow out. / time out.
IF $DATA(DUOUT)!$DATA(DTOUT)
Begin DoDot:1
+68 DO SETERR^XMXADDR4(0,"",$SELECT($DATA(DUOUT):37000,1:37001))
End DoDot:1
QUIT
+69 ; Not in Remote User Directory, see if it's a Mail Group
+70 SET DIC="^XMB(3.8,"
+71 SET D="B"
+72 SET DIC(0)="O"
+73 DO IX^DIC
+74 ;Enter 'G.groupname' to identify a mail group
IF Y>0
Begin DoDot:1
+75 DO SETERR^XMXADDR4(1,"!",39029)
End DoDot:1
QUIT
+76 ;Not found.
DO SETERR^XMXADDR4(1,"",39002)
+77 QUIT
ASKSHARE(XMINSTR) ;
+1 NEW XMK,XMDIC
+2 ;IN
SET XMDIC("B")=$$EZBLD^DIALOG(37005)
+3 ;Select basket to send to:
DO SELBSKT^XMJBU(.6,$$EZBLD^DIALOG(39022),"L",.XMDIC,.XMK)
+4 ;No basket selected.
IF XMK=U
DO SETERR^XMXADDR4(0,"",39014)
QUIT
+5 NEW DIR,X,Y
+6 ;Enter Termination Date
SET DIR("A")=$$EZBLD^DIALOG(39023)
+7 SET DIR("B")="T+30"
+8 SET DIR(0)="D^"_DT_"::ENX"
+9 ;Messages sent to SHARED,MAIL must have a delete date, so
+10 ;they may be automatically removed from SHARED,MAIL's mailbox.
+11 DO BLD^DIALOG(39024,"","","DIR(""?"")")
+12 SET DIR("??")="^D HELP^%DTC"
+13 DO ^DIR
+14 ;up-arrow or time out.
IF $DATA(DIRUT)
DO SETERR^XMXADDR4(0,"",37002)
QUIT
+15 SET XMINSTR("SHARE BSKT")=XMK
+16 SET XMINSTR("SHARE DATE")=Y
+17 QUIT
CHKREM(DA,XMADDR) ; Is the remote address really local?
+1 SET XMADDR=$$UP^XLFSTR($PIECE(XMADDR,"@",2))
+2 IF $$FIND1^DIC(4.2,"","QO",XMADDR,"B^C")'=^XMB("NUM")
QUIT
+3 NEW DIK
+4 SET DIK="^XMD(4.2997,"
+5 DO ^DIK
+6 ;Not found.
IF '$GET(XMIA)
DO SETERR^XMXADDR4(0,"",39002)
QUIT
+7 ; Remote address is really local. Deleting it.
DO SETERR^XMXADDR4(1,"!",39028.1)
+8 QUIT
USERINFO(XMDUZ) ;
+1 NEW %
+2 if XMV("SHOW DUZ")
WRITE " (DUZ ",XMDUZ,")"
+3 ; Service/Section
SET %=$PIECE($GET(^VA(200,XMDUZ,5)),U,1)
+4 IF %
SET %=$PIECE($GET(^DIC(49,%,0)),U,1)
if $LENGTH(%)+$X+1>79
WRITE !,?4
WRITE " ",%," "
+5 ;Never
SET %=$PIECE($GET(^XMB(3.7,XMDUZ,"L"),$$EZBLD^DIALOG(38002)),U,1)
+6 ;Last used MailMan:
if $LENGTH(%)+$X+20>79
WRITE !,?4
WRITE $$EZBLD^DIALOG(38003),%
+7 SET %=$GET(^XMB(3.7,XMDUZ,0))
+8 ;Forwarding Address: / Local Delivery is ON / Local Delivery is OFF
IF $LENGTH($PIECE(%,U,2))
WRITE !,?5,$$EZBLD^DIALOG(38004),$PIECE(%,U,2),$SELECT($PIECE(%,U,8):$$EZBLD^DIALOG(38005),1:$$EZBLD^DIALOG(38006))
+9 SET %=$GET(^XMB(3.7,XMDUZ,"B"))
if %'=""
WRITE !,?10,%
+10 QUIT
NOTFOUND(XMADDR,XMINDEX) ;
+1 NEW XMI,XMREC
+2 SET XMI=$$FIND1^DIC(200,"","O",$SELECT(+XMADDR=XMADDR:"`"_XMADDR,1:XMADDR),XMINDEX)
+3 ;Not found in NEW PERSON file.
IF 'XMI
WRITE $CHAR(7),$$EZBLD^DIALOG(39030)
QUIT
+4 ; found user, but missing access/verify/mailbox
+5 SET XMREC=^VA(200,XMI,0)
+6 IF $DATA(^XMB(3.7,XMI,2))
IF $PIECE(XMREC,U,3)'=""
QUIT
+7 NEW XMPARM,XMTEXT
+8 SET XMPARM(1)=$$NAME^XMXUTIL(XMI)
+9 ;a mailbox / an access code or a mailbox / an access code
SET XMPARM(2)=$SELECT($PIECE(XMREC,U,3)'="":$$EZBLD^DIALOG(39034),$DATA(^XMB(3.7,XMI,2)):$$EZBLD^DIALOG(39032),1:$$EZBLD^DIALOG(39033))
+10 ;If |1| is the person you're trying to address, you can't,
+11 ;because |1| doesn't have |2|.
+12 DO BLD^DIALOG(39031,.XMPARM,"","XMTEXT","F")
+13 DO MSG^DIALOG("WH","","","","XMTEXT")
+14 QUIT
