source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMXADDR1.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.9 KB
RevLine 
[613]1XMXADDR1 ;ISC-SF/GMB-XMXADDR (cont.) ;05/21/2002 07:00
2 ;;8.0;MailMan;;Jun 28, 2002
3PERSON(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMG,XMFULL) ;
4 N XMSCREEN,XMNOTFND
5 S XMADDR=$$UP^XLFSTR(XMADDR)
6 S XMSCREEN="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))" ; User must have an access code & mailbox
7 ; "B^BB^C^D" = name^alias^initial^nickname
8 S XMG=$$FIND1^DIC(200,"","O",$S(+XMADDR=XMADDR:"`"_XMADDR,1:XMADDR),"B^BB^C^D",XMSCREEN)
9 I XMG D Q
10 . S XMFULL=$$NAME^XMXUTIL(XMG)
11 . Q:XMG'=.6
12 . D CHKSHARE
13 . S:XMLATER XMLATER="?" ; Can't 'later' to SHARED,MAIL
14 S XMNOTFND=$S($D(DIERR):39018,1:39019) ;Addressee ambiguous. / Addressee not found.
15 I +XMADDR=XMADDR D Q
16 . D SETERR^XMXADDR4(0,"",XMNOTFND)
17 ; Not found in NEW PERSON file, see if there's a MAIL NAME
18 I $D(^XMB(3.7,"C")) D Q:XMG
19 . S XMSCREEN="I $L($P(^VA(200,+Y,0),U,3))" ; User must have an access code
20 . S XMG=$$FIND1^DIC(3.7,"","OQ",XMADDR,"C",XMSCREEN) Q:'XMG
21 . S XMFULL=$$NAME^XMXUTIL(XMG)
22 ; Not a Mail Name, see if it's in the Remote User Directory.
23 N XMINDEX,I,XMG
24 S XMINDEX="" F I="B","F" S:$D(^DIC(4.2997,I)) XMINDEX=XMINDEX_U_I
25 I XMINDEX'="" D Q:XMG
26 . S XMINDEX=$E(XMINDEX,2,99)
27 . S XMG=$$FIND1^DIC(4.2997,"","OQ",XMADDR,XMINDEX) Q:'XMG
28 . S XMADDR=$P(^XMD(4.2997,XMG,0),U,7)
29 . D CHKREM(XMG,XMADDR) Q:$D(XMERROR)
30 . D REMDT(XMG)
31 . D REMOTE^XMXADDR3(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,.XMFULL)
32 D SETERR^XMXADDR4(0,"",XMNOTFND)
33 Q
34CHKSHARE ;
35 I $G(XMINSTR("FLAGS"))["X"!($G(XMRESTR("FLAGS"))["X") D Q
36 . ;Closed messages may not be sent to SHARED,MAIL.
37 . D SETERR^XMXADDR4(0,"",39020)
38 I $G(XMINSTR("FLAGS"))["C"!($G(XMRESTR("FLAGS"))["C") D Q
39 . ;Confidential messages may not be sent to SHARED,MAIL.
40 . D SETERR^XMXADDR4(0,"",39021)
41 Q
42REMDT(XMG) ;
43 N XMFDA
44 S XMFDA(4.2997,XMG_",",6)=$E(DT,1,5) ; Date (YYYMM) remote address last used
45 D FILE^DIE("","XMFDA")
46 Q
47IPERSON(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMG,XMFULL) ;
48 N DIC,D,X,Y,XMINDEX
49 S XMADDR=$$UP^XLFSTR(XMADDR)
50 S DIC("S")="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))" ; User must have an access code & mailbox
51 I XMSTRIKE S DIC("S")=DIC("S")_",$D(^TMP(""XMY"",$J,+Y))" ; If '-', must already have been chosen
52 S DIC("W")="I Y'=DUZ D USERINFO^XMXADDR1(Y)"
53 S DIC="^VA(200,"
54 S DIC(0)="FEZMN" ; If user enters a DUZ, ask "OK?"
55 S X=XMADDR
56 ;S DIC(0)="FEZM" ; If user enters a DUZ, do NOT ask "OK?"
57 ;S X=$S(XMADDR=+XMADDR:"`"_XMADDR,1:XMADDR)
58 S (XMINDEX,D)="B^BB^C^D" ; name^alias^initial^nickname
59 D MIX^DIC1
60 I Y>0 D Q
61 . S XMG=+Y
62 . S XMFULL=$$NAME^XMXUTIL(XMG) ; $P(Y,U,2)
63 . Q:XMSTRIKE
64 . ; Sending to yourself, and ask bskt, and not creating a forwarding address
65 . I XMG=XMDUZ,$G(XMINSTR("ADDR FLAGS"))'["X",XMV("ASK BSKT") D
66 . . N XMK,XMDIC
67 . . S XMDIC("B")=$$EZBLD^DIALOG(37005) ;IN
68 . . D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(39022),"L",.XMDIC,.XMK) ;Select basket to send to:
69 . . I XMK=U D SETERR^XMXADDR4(0,"",39014) Q ;No basket selected.
70 . . S XMINSTR("SELF BSKT")=XMK
71 . E I XMG=.6 D
72 . . D CHKSHARE
73 . . I $D(XMERROR) D WRIERR^XMXADDR4("!") Q
74 . . D ASKSHARE(.XMINSTR)
75 . I $D(XMERROR) W !,XMFULL,$$EZBLD^DIALOG(39015) ;removed from recipient list.
76 I $D(DUOUT)!$D(DTOUT) D Q ;up-arrow out. / time out.
77 . D SETERR^XMXADDR4(0,"",$S($D(DUOUT):37000,1:37001))
78 D NOTFOUND(XMADDR,XMINDEX)
79 I XMADDR=+XMADDR D SETERR^XMXADDR4(0,"",39002) Q ;Not found.
80 W !,$C(7),$$EZBLD^DIALOG(39026),XMADDR ;Checking for MAIL NAME:
81 S X=XMADDR
82 K DIC("S"),DIC("W")
83 S DIC(0)="FEZ"
84 S D="C"
85 S DIC="^XMB(3.7,"
86 D IX^DIC
87 I Y>0 D Q
88 . S XMG=+Y
89 . S XMFULL=Y(0,0)
90 I $D(DUOUT)!$D(DTOUT) D Q ;up-arrow out. / time out.
91 . D SETERR^XMXADDR4(0,"",$S($D(DUOUT):37000,1:37001))
92 ; Not a Mail Name, see if it's in the Remote User Directory.
93 N XMFIND,DIR,XMG
94 S XMFIND=X
95 W !
96 D BLD^DIALOG(39025,"","","DIR(""A"")") ; Not a local user; want to check the Remote User Directory?
97 S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ; No
98 D BLD^DIALOG(39025.1,"","","DIR(""?"")")
99 D ^DIR
100 I 'Y W !
101 E D Q:$D(XMG)
102 . S X=XMFIND ;Not a local user; checking Remote User Directory
103 . W !,$C(7),$$EZBLD^DIALOG(39027),X
104 . S DIC(0)="MFEVZ"
105 . S D="B^F"
106 . S DIC="^XMD(4.2997,"
107 . D MIX^DIC1 Q:Y<0
108 . S XMG=+Y
109 . S XMADDR=$P(Y(0),U,7)
110 . D CHKREM(XMG,XMADDR) Q:$D(XMERROR)
111 . D REMDT(XMG)
112 . W !,$$EZBLD^DIALOG(39028),XMADDR ;Routing to Remote Address:
113 . D REMOTE^XMXADDR3(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL) ;Q:$D(XMERROR)
114 I $D(DUOUT)!$D(DTOUT) D Q ;up-arrow out. / time out.
115 . D SETERR^XMXADDR4(0,"",$S($D(DUOUT):37000,1:37001))
116 ; Not in Remote User Directory, see if it's a Mail Group
117 S DIC="^XMB(3.8,"
118 S D="B"
119 S DIC(0)="O"
120 D IX^DIC
121 I Y>0 D Q ;Enter 'G.groupname' to identify a mail group
122 . D SETERR^XMXADDR4(1,"!",39029)
123 D SETERR^XMXADDR4(1,"",39002) ;Not found.
124 Q
125ASKSHARE(XMINSTR) ;
126 N XMK,XMDIC
127 S XMDIC("B")=$$EZBLD^DIALOG(37005) ;IN
128 D SELBSKT^XMJBU(.6,$$EZBLD^DIALOG(39022),"L",.XMDIC,.XMK) ;Select basket to send to:
129 I XMK=U D SETERR^XMXADDR4(0,"",39014) Q ;No basket selected.
130 N DIR,X,Y
131 S DIR("A")=$$EZBLD^DIALOG(39023) ;Enter Termination Date
132 S DIR("B")="T+30"
133 S DIR(0)="D^"_DT_"::ENX"
134 ;Messages sent to SHARED,MAIL must have a delete date, so
135 ;they may be automatically removed from SHARED,MAIL's mailbox.
136 D BLD^DIALOG(39024,"","","DIR(""?"")")
137 S DIR("??")="^D HELP^%DTC"
138 D ^DIR
139 I $D(DIRUT) D SETERR^XMXADDR4(0,"",37002) Q ;up-arrow or time out.
140 S XMINSTR("SHARE BSKT")=XMK
141 S XMINSTR("SHARE DATE")=Y
142 Q
143CHKREM(DA,XMADDR) ; Is the remote address really local?
144 S XMADDR=$$UP^XLFSTR($P(XMADDR,"@",2))
145 I $$FIND1^DIC(4.2,"","QO",XMADDR,"B^C")'=^XMB("NUM") Q
146 N DIK
147 S DIK="^XMD(4.2997,"
148 D ^DIK
149 I '$G(XMIA) D SETERR^XMXADDR4(0,"",39002) Q ;Not found.
150 D SETERR^XMXADDR4(1,"!",39028.1) ; Remote address is really local. Deleting it.
151 Q
152USERINFO(XMDUZ) ;
153 N %
154 W:XMV("SHOW DUZ") " (DUZ ",XMDUZ,")"
155 S %=$P($G(^VA(200,XMDUZ,5)),U,1) ; Service/Section
156 I % S %=$P($G(^DIC(49,%,0)),U,1) W:$L(%)+$X+1>79 !,?4 W " ",%," "
157 S %=$P($G(^XMB(3.7,XMDUZ,"L"),$$EZBLD^DIALOG(38002)),U,1) ;Never
158 W:$L(%)+$X+20>79 !,?4 W $$EZBLD^DIALOG(38003),% ;Last used MailMan:
159 S %=$G(^XMB(3.7,XMDUZ,0))
160 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
161 S %=$G(^XMB(3.7,XMDUZ,"B")) W:%'="" !,?10,%
162 Q
163NOTFOUND(XMADDR,XMINDEX) ;
164 N XMI,XMREC
165 S XMI=$$FIND1^DIC(200,"","O",$S(+XMADDR=XMADDR:"`"_XMADDR,1:XMADDR),XMINDEX)
166 I 'XMI W $C(7),$$EZBLD^DIALOG(39030) Q ;Not found in NEW PERSON file.
167 ; found user, but missing access/verify/mailbox
168 S XMREC=^VA(200,XMI,0)
169 I $D(^XMB(3.7,XMI,2)),$P(XMREC,U,3)'="" Q
170 N XMPARM,XMTEXT
171 S XMPARM(1)=$$NAME^XMXUTIL(XMI)
172 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
173 ;If |1| is the person you're trying to address, you can't,
174 ;because |1| doesn't have |2|.
175 D BLD^DIALOG(39031,.XMPARM,"","XMTEXT","F")
176 D MSG^DIALOG("WH","","","","XMTEXT")
177 Q
Note: See TracBrowser for help on using the repository browser.