XMDIRSND.m

XMDIRSND ;(WASH ISC)/CMW- Send Email Directory ;04/18/2002  07:31

 ;;8.0;MailMan;;Jun 28, 2002

 ; Entry points used by MailMan options (not covered by DBIA):

 ; SEND    XMMGR-DIRECTORY-SEND

SEND ;

 I $P($G(^XMB(1,1,8.4)),U) D

 . D OK(XQSND)

 E  D NOTOK(XQSND)

 D ZAPSERV^XMXMSGS1("S."_XQSOP,XQMSG)

 Q

NOTOK(XMTO) ;

 N XMTEXT,XMINSTR

 S XMINSTR("FROM")=.5

 S XMTO=$$REMADDR^XMXADDR3(XMTO)

 S XMTEXT(1)="User directory request at Domain "_^XMB("NETNAME")

 S XMTEXT(2)="is not granted."

 D SENDMSG^XMXSEND(.5,"Directory Request","XMTEXT",XMTO,.XMINSTR)

 Q

OK(XMFROM) ;

 N XMZ,XMUSER,XMREC,XMNAME,XMINSTR,XMTO,XMNETNAM

 S XMINSTR("FROM")=.5,XMNETNAM=^XMB("NETNAME")

 S XMTO=$P($$REMADDR^XMXADDR3(XMFROM),"@",2)

 S XMTO="S.XMMGR-DIRECTORY-RECV"_$S(XMTO="":"",1:"@"_XMTO)

 D STARTMSG^XMXSEND("Collect network user address",.XMZ)

 S XMUSER=0

 F  S XMUSER=$O(^XMB(3.7,XMUSER)) Q:XMUSER'>0  D

 . S XMREC=$G(^VA(200,XMUSER,0)) Q:'$L($P(XMREC,U,3))

 . S XMNAME("FILE")=200,XMNAME("IENS")=XMUSER_",",XMNAME("FIELD")=.01

 . S XMNAME=$$HLNAME^XLFNAME(.XMNAME)

 . ;Lname^Fname^Room#^MailCode^MailCode+^Location^Netname^Phone#^Phone_Ext

 . D BODYLINE^XMXSEND(XMZ,$P(XMNAME,U,1,2)_"^^^^^"_$TR($$NAME^XMXUTIL(XMUSER),". ,","+_.")_"@"_XMNETNAM)

 D ENDMSG^XMXSEND(.5,XMZ,XMTO,.XMINSTR)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XMDIRSND   1302     printed  Apr 09, 2024@21:13:58                                                                                                                                                                                                    Page 2

XMDIRSND  ;(WASH ISC)/CMW- Send Email Directory ;04/18/2002  07:31

 +1       ;;8.0;MailMan;;Jun 28, 2002

 +2       ; Entry points used by MailMan options (not covered by DBIA):

 +3       ; SEND    XMMGR-DIRECTORY-SEND

SEND      ;

 +1        IF $PIECE($GET(^XMB(1,1,8.4)),U)

               Begin DoDot:1

 +2                DO OK(XQSND)

               End DoDot:1

 +3       IF '$TEST

               DO NOTOK(XQSND)

 +4        DO ZAPSERV^XMXMSGS1("S."_XQSOP,XQMSG)

 +5        QUIT 

NOTOK(XMTO) ;

 +1        NEW XMTEXT,XMINSTR

 +2        SET XMINSTR("FROM")=.5

 +3        SET XMTO=$$REMADDR^XMXADDR3(XMTO)

 +4        SET XMTEXT(1)="User directory request at Domain "_^XMB("NETNAME")

 +5        SET XMTEXT(2)="is not granted."

 +6        DO SENDMSG^XMXSEND(.5,"Directory Request","XMTEXT",XMTO,.XMINSTR)

 +7        QUIT 

OK(XMFROM) ;

 +1        NEW XMZ,XMUSER,XMREC,XMNAME,XMINSTR,XMTO,XMNETNAM

 +2        SET XMINSTR("FROM")=.5

           SET XMNETNAM=^XMB("NETNAME")

 +3        SET XMTO=$PIECE($$REMADDR^XMXADDR3(XMFROM),"@",2)

 +4        SET XMTO="S.XMMGR-DIRECTORY-RECV"_$SELECT(XMTO="":"",1:"@"_XMTO)

 +5        DO STARTMSG^XMXSEND("Collect network user address",.XMZ)

 +6        SET XMUSER=0

 +7        FOR 

               SET XMUSER=$ORDER(^XMB(3.7,XMUSER))

               if XMUSER'>0

                   QUIT 

               Begin DoDot:1

 +8                SET XMREC=$GET(^VA(200,XMUSER,0))

                   if '$LENGTH($PIECE(XMREC,U,3))

                       QUIT 

 +9                SET XMNAME("FILE")=200

                   SET XMNAME("IENS")=XMUSER_","

                   SET XMNAME("FIELD")=.01

 +10               SET XMNAME=$$HLNAME^XLFNAME(.XMNAME)

 +11      ;Lname^Fname^Room#^MailCode^MailCode+^Location^Netname^Phone#^Phone_Ext

 +12               DO BODYLINE^XMXSEND(XMZ,$PIECE(XMNAME,U,1,2)_"^^^^^"_$TRANSLATE($$NAME^XMXUTIL(XMUSER),". ,","+_.")_"@"_XMNETNAM)

               End DoDot:1

 +13       DO ENDMSG^XMXSEND(.5,XMZ,XMTO,.XMINSTR)

 +14       QUIT