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

XMDIRSND.m

Go to the documentation of this file.
  1. XMDIRSND ;(WASH ISC)/CMW- Send Email Directory ;04/18/2002 07:31
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. ; Entry points used by MailMan options (not covered by DBIA):
  1. ; SEND XMMGR-DIRECTORY-SEND
  1. SEND ;
  1. I $P($G(^XMB(1,1,8.4)),U) D
  1. . D OK(XQSND)
  1. E D NOTOK(XQSND)
  1. D ZAPSERV^XMXMSGS1("S."_XQSOP,XQMSG)
  1. Q
  1. NOTOK(XMTO) ;
  1. N XMTEXT,XMINSTR
  1. S XMINSTR("FROM")=.5
  1. S XMTO=$$REMADDR^XMXADDR3(XMTO)
  1. S XMTEXT(1)="User directory request at Domain "_^XMB("NETNAME")
  1. S XMTEXT(2)="is not granted."
  1. D SENDMSG^XMXSEND(.5,"Directory Request","XMTEXT",XMTO,.XMINSTR)
  1. Q
  1. OK(XMFROM) ;
  1. N XMZ,XMUSER,XMREC,XMNAME,XMINSTR,XMTO,XMNETNAM
  1. S XMINSTR("FROM")=.5,XMNETNAM=^XMB("NETNAME")
  1. S XMTO=$P($$REMADDR^XMXADDR3(XMFROM),"@",2)
  1. S XMTO="S.XMMGR-DIRECTORY-RECV"_$S(XMTO="":"",1:"@"_XMTO)
  1. D STARTMSG^XMXSEND("Collect network user address",.XMZ)
  1. S XMUSER=0
  1. F S XMUSER=$O(^XMB(3.7,XMUSER)) Q:XMUSER'>0 D
  1. . S XMREC=$G(^VA(200,XMUSER,0)) Q:'$L($P(XMREC,U,3))
  1. . S XMNAME("FILE")=200,XMNAME("IENS")=XMUSER_",",XMNAME("FIELD")=.01
  1. . S XMNAME=$$HLNAME^XLFNAME(.XMNAME)
  1. . ;Lname^Fname^Room#^MailCode^MailCode+^Location^Netname^Phone#^Phone_Ext
  1. . D BODYLINE^XMXSEND(XMZ,$P(XMNAME,U,1,2)_"^^^^^"_$TR($$NAME^XMXUTIL(XMUSER),". ,","+_.")_"@"_XMNETNAM)
  1. D ENDMSG^XMXSEND(.5,XMZ,XMTO,.XMINSTR)
  1. Q