Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMXADDR1

XMXADDR1.m

Go to the documentation of this file.
  1. XMXADDR1 ;ISC-SF/GMB-XMXADDR (cont.) ;05/21/2002 07:00
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. PERSON(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMG,XMFULL) ;
  1. N XMSCREEN,XMNOTFND
  1. S XMADDR=$$UP^XLFSTR(XMADDR)
  1. S XMSCREEN="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))" ; User must have an access code & mailbox
  1. ; "B^BB^C^D" = name^alias^initial^nickname
  1. S XMG=$$FIND1^DIC(200,"","O",$S(+XMADDR=XMADDR:"`"_XMADDR,1:XMADDR),"B^BB^C^D",XMSCREEN)
  1. I XMG D Q
  1. . S XMFULL=$$NAME^XMXUTIL(XMG)
  1. . Q:XMG'=.6
  1. . D CHKSHARE
  1. . S:XMLATER XMLATER="?" ; Can't 'later' to SHARED,MAIL
  1. S XMNOTFND=$S($D(DIERR):39018,1:39019) ;Addressee ambiguous. / Addressee not found.
  1. I +XMADDR=XMADDR D Q
  1. . D SETERR^XMXADDR4(0,"",XMNOTFND)
  1. ; Not found in NEW PERSON file, see if there's a MAIL NAME
  1. I $D(^XMB(3.7,"C")) D Q:XMG
  1. . S XMSCREEN="I $L($P(^VA(200,+Y,0),U,3))" ; User must have an access code
  1. . S XMG=$$FIND1^DIC(3.7,"","OQ",XMADDR,"C",XMSCREEN) Q:'XMG
  1. . S XMFULL=$$NAME^XMXUTIL(XMG)
  1. ; Not a Mail Name, see if it's in the Remote User Directory.
  1. N XMINDEX,I,XMG
  1. S XMINDEX="" F I="B","F" S:$D(^DIC(4.2997,I)) XMINDEX=XMINDEX_U_I
  1. I XMINDEX'="" D Q:XMG
  1. . S XMINDEX=$E(XMINDEX,2,99)
  1. . S XMG=$$FIND1^DIC(4.2997,"","OQ",XMADDR,XMINDEX) Q:'XMG
  1. . S XMADDR=$P(^XMD(4.2997,XMG,0),U,7)
  1. . D CHKREM(XMG,XMADDR) Q:$D(XMERROR)
  1. . D REMDT(XMG)
  1. . D REMOTE^XMXADDR3(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,.XMFULL)
  1. D SETERR^XMXADDR4(0,"",XMNOTFND)
  1. Q
  1. CHKSHARE ;
  1. I $G(XMINSTR("FLAGS"))["X"!($G(XMRESTR("FLAGS"))["X") D Q
  1. . ;Closed messages may not be sent to SHARED,MAIL.
  1. . D SETERR^XMXADDR4(0,"",39020)
  1. I $G(XMINSTR("FLAGS"))["C"!($G(XMRESTR("FLAGS"))["C") D Q
  1. . ;Confidential messages may not be sent to SHARED,MAIL.
  1. . D SETERR^XMXADDR4(0,"",39021)
  1. Q
  1. REMDT(XMG) ;
  1. N XMFDA
  1. S XMFDA(4.2997,XMG_",",6)=$E(DT,1,5) ; Date (YYYMM) remote address last used
  1. D FILE^DIE("","XMFDA")
  1. Q
  1. IPERSON(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMG,XMFULL) ;
  1. N DIC,D,X,Y,XMINDEX
  1. S XMADDR=$$UP^XLFSTR(XMADDR)
  1. S DIC("S")="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))" ; User must have an access code & mailbox
  1. I XMSTRIKE S DIC("S")=DIC("S")_",$D(^TMP(""XMY"",$J,+Y))" ; If '-', must already have been chosen
  1. S DIC("W")="I Y'=DUZ D USERINFO^XMXADDR1(Y)"
  1. S DIC="^VA(200,"
  1. S DIC(0)="FEZMN" ; If user enters a DUZ, ask "OK?"
  1. S X=XMADDR
  1. ;S DIC(0)="FEZM" ; If user enters a DUZ, do NOT ask "OK?"
  1. ;S X=$S(XMADDR=+XMADDR:"`"_XMADDR,1:XMADDR)
  1. S (XMINDEX,D)="B^BB^C^D" ; name^alias^initial^nickname
  1. D MIX^DIC1
  1. I Y>0 D Q
  1. . S XMG=+Y
  1. . S XMFULL=$$NAME^XMXUTIL(XMG) ; $P(Y,U,2)
  1. . Q:XMSTRIKE
  1. . ; Sending to yourself, and ask bskt, and not creating a forwarding address
  1. . I XMG=XMDUZ,$G(XMINSTR("ADDR FLAGS"))'["X",XMV("ASK BSKT") D
  1. . . N XMK,XMDIC
  1. . . S XMDIC("B")=$$EZBLD^DIALOG(37005) ;IN
  1. . . D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(39022),"L",.XMDIC,.XMK) ;Select basket to send to:
  1. . . I XMK=U D SETERR^XMXADDR4(0,"",39014) Q ;No basket selected.
  1. . . S XMINSTR("SELF BSKT")=XMK
  1. . E I XMG=.6 D
  1. . . D CHKSHARE
  1. . . I $D(XMERROR) D WRIERR^XMXADDR4("!") Q
  1. . . D ASKSHARE(.XMINSTR)
  1. . I $D(XMERROR) W !,XMFULL,$$EZBLD^DIALOG(39015) ;removed from recipient list.
  1. I $D(DUOUT)!$D(DTOUT) D Q ;up-arrow out. / time out.
  1. . D SETERR^XMXADDR4(0,"",$S($D(DUOUT):37000,1:37001))
  1. D NOTFOUND(XMADDR,XMINDEX)
  1. I XMADDR=+XMADDR D SETERR^XMXADDR4(0,"",39002) Q ;Not found.
  1. W !,$C(7),$$EZBLD^DIALOG(39026),XMADDR ;Checking for MAIL NAME:
  1. S X=XMADDR
  1. K DIC("S"),DIC("W")
  1. S DIC(0)="FEZ"
  1. S D="C"
  1. S DIC="^XMB(3.7,"
  1. D IX^DIC
  1. I Y>0 D Q
  1. . S XMG=+Y
  1. . S XMFULL=Y(0,0)
  1. I $D(DUOUT)!$D(DTOUT) D Q ;up-arrow out. / time out.
  1. . D SETERR^XMXADDR4(0,"",$S($D(DUOUT):37000,1:37001))
  1. ; Not a Mail Name, see if it's in the Remote User Directory.
  1. N XMFIND,DIR,XMG
  1. S XMFIND=X
  1. W !
  1. D BLD^DIALOG(39025,"","","DIR(""A"")") ; Not a local user; want to check the Remote User Directory?
  1. S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ; No
  1. D BLD^DIALOG(39025.1,"","","DIR(""?"")")
  1. D ^DIR
  1. I 'Y W !
  1. E D Q:$D(XMG)
  1. . S X=XMFIND ;Not a local user; checking Remote User Directory
  1. . W !,$C(7),$$EZBLD^DIALOG(39027),X
  1. . S DIC(0)="MFEVZ"
  1. . S D="B^F"
  1. . S DIC="^XMD(4.2997,"
  1. . D MIX^DIC1 Q:Y<0
  1. . S XMG=+Y
  1. . S XMADDR=$P(Y(0),U,7)
  1. . D CHKREM(XMG,XMADDR) Q:$D(XMERROR)
  1. . D REMDT(XMG)
  1. . W !,$$EZBLD^DIALOG(39028),XMADDR ;Routing to Remote Address:
  1. . D REMOTE^XMXADDR3(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL) ;Q:$D(XMERROR)
  1. I $D(DUOUT)!$D(DTOUT) D Q ;up-arrow out. / time out.
  1. . D SETERR^XMXADDR4(0,"",$S($D(DUOUT):37000,1:37001))
  1. ; Not in Remote User Directory, see if it's a Mail Group
  1. S DIC="^XMB(3.8,"
  1. S D="B"
  1. S DIC(0)="O"
  1. D IX^DIC
  1. I Y>0 D Q ;Enter 'G.groupname' to identify a mail group
  1. . D SETERR^XMXADDR4(1,"!",39029)
  1. D SETERR^XMXADDR4(1,"",39002) ;Not found.
  1. Q
  1. ASKSHARE(XMINSTR) ;
  1. N XMK,XMDIC
  1. S XMDIC("B")=$$EZBLD^DIALOG(37005) ;IN
  1. D SELBSKT^XMJBU(.6,$$EZBLD^DIALOG(39022),"L",.XMDIC,.XMK) ;Select basket to send to:
  1. I XMK=U D SETERR^XMXADDR4(0,"",39014) Q ;No basket selected.
  1. N DIR,X,Y
  1. S DIR("A")=$$EZBLD^DIALOG(39023) ;Enter Termination Date
  1. S DIR("B")="T+30"
  1. S DIR(0)="D^"_DT_"::ENX"
  1. ;Messages sent to SHARED,MAIL must have a delete date, so
  1. ;they may be automatically removed from SHARED,MAIL's mailbox.
  1. D BLD^DIALOG(39024,"","","DIR(""?"")")
  1. S DIR("??")="^D HELP^%DTC"
  1. D ^DIR
  1. I $D(DIRUT) D SETERR^XMXADDR4(0,"",37002) Q ;up-arrow or time out.
  1. S XMINSTR("SHARE BSKT")=XMK
  1. S XMINSTR("SHARE DATE")=Y
  1. Q
  1. CHKREM(DA,XMADDR) ; Is the remote address really local?
  1. S XMADDR=$$UP^XLFSTR($P(XMADDR,"@",2))
  1. I $$FIND1^DIC(4.2,"","QO",XMADDR,"B^C")'=^XMB("NUM") Q
  1. N DIK
  1. S DIK="^XMD(4.2997,"
  1. D ^DIK
  1. I '$G(XMIA) D SETERR^XMXADDR4(0,"",39002) Q ;Not found.
  1. D SETERR^XMXADDR4(1,"!",39028.1) ; Remote address is really local. Deleting it.
  1. Q
  1. USERINFO(XMDUZ) ;
  1. N %
  1. W:XMV("SHOW DUZ") " (DUZ ",XMDUZ,")"
  1. S %=$P($G(^VA(200,XMDUZ,5)),U,1) ; Service/Section
  1. I % S %=$P($G(^DIC(49,%,0)),U,1) W:$L(%)+$X+1>79 !,?4 W " ",%," "
  1. S %=$P($G(^XMB(3.7,XMDUZ,"L"),$$EZBLD^DIALOG(38002)),U,1) ;Never
  1. W:$L(%)+$X+20>79 !,?4 W $$EZBLD^DIALOG(38003),% ;Last used MailMan:
  1. S %=$G(^XMB(3.7,XMDUZ,0))
  1. 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
  1. S %=$G(^XMB(3.7,XMDUZ,"B")) W:%'="" !,?10,%
  1. Q
  1. NOTFOUND(XMADDR,XMINDEX) ;
  1. N XMI,XMREC
  1. S XMI=$$FIND1^DIC(200,"","O",$S(+XMADDR=XMADDR:"`"_XMADDR,1:XMADDR),XMINDEX)
  1. I 'XMI W $C(7),$$EZBLD^DIALOG(39030) Q ;Not found in NEW PERSON file.
  1. ; found user, but missing access/verify/mailbox
  1. S XMREC=^VA(200,XMI,0)
  1. I $D(^XMB(3.7,XMI,2)),$P(XMREC,U,3)'="" Q
  1. N XMPARM,XMTEXT
  1. S XMPARM(1)=$$NAME^XMXUTIL(XMI)
  1. 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
  1. ;If |1| is the person you're trying to address, you can't,
  1. ;because |1| doesn't have |2|.
  1. D BLD^DIALOG(39031,.XMPARM,"","XMTEXT","F")
  1. D MSG^DIALOG("WH","","","","XMTEXT")
  1. Q