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