source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMDIRSND.m@ 1361

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1XMDIRSND ;(WASH ISC)/CMW- Send Email Directory ;04/18/2002 07:31
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; SEND XMMGR-DIRECTORY-SEND
5SEND ;
6 I $P($G(^XMB(1,1,8.4)),U) D
7 . D OK(XQSND)
8 E D NOTOK(XQSND)
9 D ZAPSERV^XMXMSGS1("S."_XQSOP,XQMSG)
10 Q
11NOTOK(XMTO) ;
12 N XMTEXT,XMINSTR
13 S XMINSTR("FROM")=.5
14 S XMTO=$$REMADDR^XMXADDR3(XMTO)
15 S XMTEXT(1)="User directory request at Domain "_^XMB("NETNAME")
16 S XMTEXT(2)="is not granted."
17 D SENDMSG^XMXSEND(.5,"Directory Request","XMTEXT",XMTO,.XMINSTR)
18 Q
19OK(XMFROM) ;
20 N XMZ,XMUSER,XMREC,XMNAME,XMINSTR,XMTO,XMNETNAM
21 S XMINSTR("FROM")=.5,XMNETNAM=^XMB("NETNAME")
22 S XMTO=$P($$REMADDR^XMXADDR3(XMFROM),"@",2)
23 S XMTO="S.XMMGR-DIRECTORY-RECV"_$S(XMTO="":"",1:"@"_XMTO)
24 D STARTMSG^XMXSEND("Collect network user address",.XMZ)
25 S XMUSER=0
26 F S XMUSER=$O(^XMB(3.7,XMUSER)) Q:XMUSER'>0 D
27 . S XMREC=$G(^VA(200,XMUSER,0)) Q:'$L($P(XMREC,U,3))
28 . S XMNAME("FILE")=200,XMNAME("IENS")=XMUSER_",",XMNAME("FIELD")=.01
29 . S XMNAME=$$HLNAME^XLFNAME(.XMNAME)
30 . ;Lname^Fname^Room#^MailCode^MailCode+^Location^Netname^Phone#^Phone_Ext
31 . D BODYLINE^XMXSEND(XMZ,$P(XMNAME,U,1,2)_"^^^^^"_$TR($$NAME^XMXUTIL(XMUSER),". ,","+_.")_"@"_XMNETNAM)
32 D ENDMSG^XMXSEND(.5,XMZ,XMTO,.XMINSTR)
33 Q
Note: See TracBrowser for help on using the repository browser.