source: FOIAVistA/trunk/r/MAILMAN-XM/XMXADDR.m@ 1420

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1XMXADDR ;ISC-SF/GMB-Address checker ;04/29/2003 08:51
2 ;;8.0;MailMan;**18**;Jun 28, 2002
3 ; Replaces ^XMA21,^XMA210,^XMA24 (ISC-WASH/CAP/AML/LL)
4 ; XMIA 1=Interactive; 0=not
5CHKADDR(XMDUZ,XMTO,XMINSTR,XMRESTR,XMFULL) ; Check addressee(s) NON-INTERACTIVE
6 ; This entry point is meant for calls in which the addressees are
7 ; already in an array:
8 ; XMTO("addressee 1")=""
9 ; XMTO("addressee 2")=""
10 ; or for just a single addressee: "addressee 1"
11 N XMADDR,XMIA
12 ;K XMERR,^TMP("XMERR",$J) DO NOT PUT THIS LINE IN HERE!
13 S XMIA=0
14 I $G(XMTO)]"",$O(XMTO(""))="" D Q
15 . N XMERROR K XMFULL
16 . D ADDRESS(XMDUZ,XMTO,.XMFULL,.XMERROR) Q:'$D(XMERROR)
17 . S XMERROR("PARAM","ID")="XMTO",XMERROR("PARAM","VALUE")=XMTO
18 . D ERRSET^XMXUTIL(XMERROR,.XMERROR)
19 . S:'$D(XMFULL) ^TMP("XMERR",$J,XMERR,"PARM")=XMTO
20 I $O(XMTO(""))="" D Q
21 . ;S XMERR=$G(XMERR)+1,^TMP("XMERR",$J,XMERR,"TEXT",1)="Null addressee"
22 S XMADDR=""
23 F S XMADDR=$O(XMTO(XMADDR)) Q:XMADDR="" D
24 . N XMERROR,XMFULL,XMFWDADD
25 . D ADDRESS(XMDUZ,XMADDR,.XMFULL,.XMERROR) Q:'$D(XMERROR)
26 . S XMERROR("PARAM","ID")="XMTO",XMERROR("PARAM","VALUE")=XMADDR
27 . D ERRSET^XMXUTIL(XMERROR,.XMERROR)
28 . S:'$D(XMFULL) ^TMP("XMERR",$J,XMERR,"PARM")=XMADDR
29 Q
30INIT ;
31 K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP("XMYL",$J)
32INITLATR ;
33 N XMNOW
34 S XMNOW=$$NOW^XLFDT
35 S XMINLATR=$E($$FMADD^XLFDT(XMNOW,"","",5),1,12) ; Staggered delivery must be at least 5 minutes from now
36 S XMAXLATR=$$SCH^XLFDT("1M",XMNOW) ; Staggered delivery must be at most 1 month from now
37 S XMBIGGRP=$P(^XMB(1,1,0),U,7) ; Big group size
38 Q
39CLEANUP ;
40 K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP("XMYL",$J),XMINLATR,XMAXLATR,XMBIGGRP
41 Q
42ADDR(XMDUZ,XMADDR,XMINSTR,XMRESTR,XMFULL) ; Check one addressee (INTERACTIVE)
43 N XMIA,XMFWDADD
44 S XMIA=1
45 D ADDRESS(XMDUZ,XMADDR,.XMFULL)
46 Q
47ADDRESS(XMDUZ,XMADDR,XMFULL,XMERROR) ; Check one addressee
48 ; XMADDR (in) Addressee (if number, assumed to be a person's DUZ)
49 ; XMFULL (out) The full address of the addressee
50 N XMSTRIKE,XMPREFIX,XMLATER,XMGCIRCL,XMGMBRS,XMG
51 D CHKPARM(.XMADDR,.XMSTRIKE,.XMPREFIX,.XMLATER) Q:$D(XMERROR)
52 I $G(XMINSTR("ADDR FLAGS"))["X",$G(XMINSTR("ADDR FLAGS"))'["Y" S XMSTRIKE=0,XMLATER="",XMPREFIX=""
53 I XMADDR["@"!(XMADDR["!") D
54 . I $D(XMRESTR("NONET")) D Q
55 . . ;Messages longer than |1| lines may not be sent across the network.
56 . . D SETERR^XMXADDR4($G(XMIA),"!",39001,XMRESTR("NONET"))
57 . D REMOTE^XMXADDR3(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL)
58 E D LOCAL(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL,.XMG)
59 D:'$D(XMERROR) SET(XMFULL,$G(XMG),XMSTRIKE,XMPREFIX,XMLATER)
60 Q
61LOCAL(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMFULL,XMG) ;
62 I $E(XMADDR,1)="*" D Q
63 . D BRODCAST^XMXADDR2(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL)
64 I $L(XMADDR)>2,".G.g.D.d.H.h.S.s."[("."_$E(XMADDR,1,2)) D Q
65 . N XMADDR1
66 . S XMADDR1=$E(XMADDR,1)
67 . I "Gg"[XMADDR1 D EXPAND^XMXADDRG(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL,.XMG) Q
68 . I "Ss"[XMADDR1 D SERVER^XMXADDR3(XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL) Q
69 . I "DdHh"[XMADDR1 D DEVICE^XMXADDR3(XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL) Q
70 I XMADDR?1N.N,$L(XMADDR)>25 D Q
71 . D SETERR^XMXADDR4($G(XMIA),"!,$C(7)",39002) ;Not found.
72 I $G(XMIA) D
73 . D IPERSON^XMXADDR1(XMDUZ,.XMADDR,XMSTRIKE,XMPREFIX,.XMLATER,.XMG,.XMFULL) Q:$D(XMERROR)
74 . I XMLATER="?",XMG'=.6 D QLATER(XMFULL,.XMLATER)
75 E D
76 . D PERSON^XMXADDR1(XMDUZ,.XMADDR,XMSTRIKE,XMPREFIX,XMLATER,.XMG,.XMFULL)
77 Q:$D(XMERROR)
78 D:XMFULL'["@" INDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER)
79 Q
80INDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
81 N XMGREC,XMIASAVE
82 I $D(XMFWDADD) D Q
83 . ;You can't have a message forwarded to a local user.
84 . D SETERR^XMXADDR4(0,"",38001)
85 S XMGREC=^XMB(3.7,XMG,0)
86 I $P(XMGREC,U,2)=""!(XMG=DUZ) D SETEXP(XMG,"",XMSTRIKE,XMPREFIX,XMLATER) Q
87 ; Addressee has a forwarding address.
88 ; 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).
89 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
90 N XMFULL,XMERROR
91 S XMFWDADD=XMG
92 I $G(XMIA) S XMIA=0,XMIASAVE=1
93 D REMOTE^XMXADDR3(XMDUZ,$P(XMGREC,U,2),XMSTRIKE,XMPREFIX,.XMLATER,.XMFULL)
94 K XMFWDADD
95 I $G(XMIASAVE) S XMIA=1
96 I '$D(XMERROR) D Q:'$P(XMGREC,U,8) ; quit if no local delivery
97 . Q:XMSTRIKE
98 . ; Note that recipient fwded
99 . I $D(XMINSTR("NET FWD BY")),$D(XMRESTR("NET RECEIVE")) S ^TMP("XMY",$J,XMFULL,"F")=XMG_U_XMINSTR("NET FWD BY") Q
100 . S ^TMP("XMY",$J,XMFULL,"F")=XMG
101 D SETEXP(XMG,"",XMSTRIKE,XMPREFIX,XMLATER)
102 Q:'$D(XMERROR)
103 D DELFWD^XMVVITA(XMG,$P(XMGREC,U,2),.XMERROR)
104 I $G(XMIA),'$D(XMGCIRCL) W !,$C(7)," ",$$EZBLD^DIALOG(38130.3) ; Forwarding Address ignored.
105 Q
106SET(XMTO,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
107 I $G(XMINSTR("ADDR FLAGS"))["X",$G(XMINSTR("ADDR FLAGS"))'["Y" Q
108 I XMSTRIKE D Q
109 . I $G(XMIA) D
110 . . I $E(XMTO,1,2)="G."!($E(XMTO,1,2)="*;") D
111 . . . I $D(^TMP("XMY0",$J,XMTO,"L")) D Q
112 . . . . W $$EZBLD^DIALOG(39003) ;Later'd Group Deleted.
113 . . . . K ^TMP("XMYL",$J,XMTO)
114 . . . W !,$$EZBLD^DIALOG(39004) ;Members Deleted.
115 . . E W:$X>70 ! W $$EZBLD^DIALOG(39005) ;Deleted.
116 . . ; 39006 - * (Broadcast to all local users)
117 . . 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
118 . . Q:'$D(^TMP("XMYL",$J))
119 . . N XMGRP,XMTEXT ;But message will still go to all members of the following later'd group(s):
120 . . D BLD^DIALOG(39008,"","","XMTEXT","F")
121 . . D MSG^DIALOG("WM","","","","XMTEXT")
122 . . S XMGRP="" F S XMGRP=$O(^TMP("XMYL",$J,XMGRP)) Q:XMGRP="" W !,XMGRP
123 . K ^TMP("XMY0",$J,XMTO)
124 . K:$D(^TMP("XMYL",$J,XMTO)) ^TMP("XMYL",$J,XMTO)
125 S ^TMP("XMY0",$J,XMTO)=XMG ; =XMIEN
126 I XMPREFIX'="" S ^TMP("XMY0",$J,XMTO,1)=$$UP^XLFSTR(XMPREFIX)
127 I XMLATER S ^TMP("XMY0",$J,XMTO,"L")=XMLATER I $E(XMTO,1,2)="G."!($E(XMTO,1,2)="*;") S ^TMP("XMYL",$J,XMTO)=""
128 I XMLATER="?",$G(XMIA) W !,$C(7),$$EZBLD^DIALOG(39009) ;'Later' not appropriate for this addressee
129 Q
130SETEXP(XMTO,XMIEN,XMSTRIKE,XMPREFIX,XMLATER) ;
131 Q:$G(XMINSTR("ADDR FLAGS"))["X"
132 I XMSTRIKE K ^TMP("XMY",$J,XMTO) Q
133 I XMLATER,XMTO'=XMDUZ Q
134 S ^TMP("XMY",$J,XMTO)=XMIEN
135 I XMPREFIX'="" S ^TMP("XMY",$J,XMTO,1)=$$UP^XLFSTR(XMPREFIX)
136 I $D(XMINSTR("NET FWD BY")),$D(XMRESTR("NET RECEIVE")) S ^TMP("XMY",$J,XMTO,"F")=XMINSTR("NET FWD BY")
137 Q
138GOTADDR() ; Function returns 1 if addressees exist; 0 if not.
139 Q:$D(^TMP("XMY",$J)) 1
140 Q:$D(^TMP("XMYL",$J)) 1
141 Q:'$D(^TMP("XMY0",$J)) 0
142 N XMTO
143 S XMTO=$O(^TMP("XMY0",$J,""))
144 Q:$D(^TMP("XMY0",$J,XMTO,"L")) 1
145 Q 0
146CHKPARM(XMADDR,XMSTRIKE,XMPREFIX,XMLATER) ;
147 I $E(XMADDR,1)="-" D
148 . S XMSTRIKE=1
149 . S XMADDR=$E(XMADDR,2,999)
150 E S XMSTRIKE=0
151 I $E(XMADDR,1)=" "!($E(XMADDR,$L(XMADDR))=" ") S XMADDR=$$STRIP^XMXUTIL1(XMADDR)
152 I $P(XMADDR,"@",1)="" D Q
153 . D SETERR^XMXADDR4($G(XMIA),"!",39010) ;Null addressee
154 I $E(XMADDR,1)'="""",XMADDR[":" D Q
155 . D PREFIX(.XMADDR,.XMPREFIX,.XMLATER)
156 . I XMSTRIKE,XMLATER="?" S XMLATER=""
157 S XMPREFIX=""
158 S XMLATER=""
159 Q
160PREFIX(XMADDR,XMPREFIX,XMLATER) ;
161 N XMPRE
162 S XMPRE=$P(XMADDR,":",1)
163 I XMPRE="" D Q
164 . D SETERR^XMXADDR4($G(XMIA),"!",39011) ;Null recipient type
165 S (XMLATER,XMPREFIX)=""
166 S XMPRE=$$UP^XLFSTR(XMPRE)
167 I $P(XMPRE,"@",1)["L",'$D(XMRESTR("NET RECEIVE")) D
168 . D LATER($P(XMPRE,"@",2,99),.XMLATER)
169 . S XMPRE=$TR($P(XMPRE,"@",1),"L")
170 D:XMPRE'="" RTYPE(XMPRE,.XMPREFIX)
171 I $D(XMERROR),$D(XMRESTR("NET RECEIVE")),$$FIND1^DIC(4.2,"","QX",$P(XMADDR,"@",2),"B^C")'=^XMB("NUM") K XMERROR Q
172 S XMADDR=$P(XMADDR,":",2)
173 Q
174LATER(XMWHEN,XMLATER) ; (XMWHEN=user-supplied date/time)
175 I $G(XMIA),XMWHEN="" S XMLATER="?" Q
176 I '$D(XMINLATR) D INITLATR
177 D DT^DILF("FTX",XMWHEN,.XMLATER,XMINLATR)
178 Q:XMLATER>0
179 S XMLATER=$S($G(XMIA):"?",1:"")
180 Q
181RTYPE(XMPRE,XMPREFIX) ;
182 N XMINTRNL
183 D CHK^DIE(3.91,6.5,"",XMPRE,.XMINTRNL)
184 I XMINTRNL="^" D Q ;Invalid recipient type '|1|'
185 . D SETERR^XMXADDR4($G(XMIA),"!",39012,XMPRE)
186 S XMPREFIX=XMINTRNL
187 Q
188QLATER(XMFULL,XMLATER) ;
189 N DIR,Y
190 I '$D(XMINLATR) D INITLATR
191 W !
192 S DIR(0)="DO^"_XMINLATR_":"_XMAXLATR_":EXT"
193 ;Later Delivery must be at least 5 minutes from now.
194 D BLD^DIALOG(39013,"","","DIR(""A"")") ;When Later
195 S DIR("B")=$$MMDT^XMXUTIL1($$FMADD^XLFDT($$NOW^XLFDT,"","",5)) ; (in 5 minutes)
196 S DIR("B")=$P(DIR("B")," ",1,3)_"@"_$P(DIR("B")," ",4)
197 D ^DIR I $D(DIRUT) D Q
198 . S XMLATER=""
199 . D SETERR^XMXADDR4(0,"",37002) ;up-arrow or time out.
200 . W !,XMFULL,$$EZBLD^DIALOG(39015) ;removed from recipient list.
201 S XMLATER=Y
202 ;>> Remember, you won't be able to 'minus' anyone from the ...
203 I $E(XMFULL,1,2)="G." W !!,$$EZBLD^DIALOG(39016) ; group <<
204 I $E(XMFULL,1,2)="*;" W !!,$$EZBLD^DIALOG(39017) ; limited broadcast <<
205 Q
Note: See TracBrowser for help on using the repository browser.