XMGAPI3.m

XMGAPI3 ;WASH ISC/REW/LH-Deliver Broadcast Msg & Mark for Vaporization ;04/17/2002  08:59

 ;;8.0;MailMan;;Jun 28, 2002

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

 ; ENT    XMR-BROADCAST-VA-WIDE

 ; ENT    XMYB-BROADCAST-VA-WIDE

ENT(XMTO) ; Meant to be invoked by a server.  Delivers a message

 ; either to all users or to a specific user.

 ; The message must have been sent by the POSTMASTER@DOMAIN.NAME.

 ; The AUTOMATIC DELETE DATE for this message is set for each user

 ; to be in 7 days; 30 days if sent to a specific user.

 ; The message is made 'information only' and 'closed'.

 ; XMTO   *=to all users

 ;        DUZ=to only one person -- typically .6 to route to SHARED,MAIL

 ; Variables set in the server invoker:

 ; XQSOP  Server basket name

 ; XQMSG  Message number

 ; XMFROM Who sent the message

 N XMDUZ,XMKN

 S (XMDUZ,DUZ)=.5

 S XMKN="S."_XQSOP

 I $P(XMFROM,"@")'["POSTMASTER"!($P(XMFROM,"@",2)'["FORUM.") D

 . D ERR1(XMDUZ,XMKN,XMFROM)

 E  D

 . D SEND(XMDUZ,XMKN,XQMSG,XMTO,XMFROM)

 D CLEANUP(XMKN,XQMSG)

 Q

SEND(XMDUZ,XMKN,XMZ,XMTO,XMFROM) ;

 K XMERR,^TMP("XMERR",$J)

 D INIT^XMXADDR

 D CHKADDR^XMXADDR(XMDUZ,XMTO)

 I $D(XMERR) D  Q

 . D ERR2(XMDUZ,XMKN,XMTO,XMFROM)

 . K XMERR,^TMP("XMERR",$J)

 D FORCE(XMZ,$S(XMTO="*":7,1:30))

 D SEND^XMKP(XMDUZ,XMZ)

 Q

FORCE(DA,XMDAYS) ; Set Info Only, Closed statuses, and Purge date

 N DIE,DR

 S DIE=3.9,DR="1.95///y;1.97///y;1.6///"_$$FMADD^XLFDT(DT,XMDAYS)

 D ^DIE

 Q

CLEANUP(XMKN,XMZ) ; Successfully delivered message, so remove from Postmaster Server Basket

 D CLEANUP^XMXADDR

 D ZAPSERV^XMXMSGS1(XMKN,XMZ)

 Q

ERR1(XMDUZ,XMKN,XMFROM) ; Send message back to sender if not POSTMASTER@DOMAIN.NAME

 N A

 S A(1)="You may not send a message to the "_XMKN_" server."

 S A(2)="Only the Postmaster at DOMAIN.NAME has this permission."

 D SENDMSG^XMXSEND(XMDUZ,"Sender of Message to Server Unacceptable","A",XMFROM)

 K XMERR,^TMP("XMERR",$J)

 Q

ERR2(XMDUZ,XMKN,XMTO,XMFROM) ; Send a message back to sender if single recipient is invalid

 N A,I,J

 S A(1)="Your message to the "_XMKN_" server was not accepted"

 S A(2)="because the lookup for the recipient specified ("_XMTO_")"

 S A(3)="failed, with the following message:"

 S J=3,I=0

 F  S I=$O(^TMP("XMERR",$J,XMERR,"TEXT",I)) Q:'I  S J=J+1,A(J)=^(I)

 D SENDMSG^XMXSEND(XMDUZ,"Server Recipient Unknown","A",XMFROM)

 K XMERR,^TMP("XMERR",$J)

 Q

XMGAPI3   ;WASH ISC/REW/LH-Deliver Broadcast Msg & Mark for Vaporization ;04/17/2002  08:59

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

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

 +3       ; ENT    XMR-BROADCAST-VA-WIDE

 +4       ; ENT    XMYB-BROADCAST-VA-WIDE

ENT(XMTO) ; Meant to be invoked by a server.  Delivers a message

 +1       ; either to all users or to a specific user.

 +2       ; The message must have been sent by the POSTMASTER@DOMAIN.NAME.

 +3       ; The AUTOMATIC DELETE DATE for this message is set for each user

 +4       ; to be in 7 days; 30 days if sent to a specific user.

 +5       ; The message is made 'information only' and 'closed'.

 +6       ; XMTO   *=to all users

 +7       ;        DUZ=to only one person -- typically .6 to route to SHARED,MAIL

 +8       ; Variables set in the server invoker:

 +9       ; XQSOP  Server basket name

 +10      ; XQMSG  Message number

 +11      ; XMFROM Who sent the message

 +12       NEW XMDUZ,XMKN

 +13       SET (XMDUZ,DUZ)=.5

 +14       SET XMKN="S."_XQSOP

 +15       IF $PIECE(XMFROM,"@")'["POSTMASTER"!($PIECE(XMFROM,"@",2)'["FORUM.")

               Begin DoDot:1

 +16               DO ERR1(XMDUZ,XMKN,XMFROM)

               End DoDot:1

 +17      IF '$TEST

               Begin DoDot:1

 +18               DO SEND(XMDUZ,XMKN,XQMSG,XMTO,XMFROM)

               End DoDot:1

 +19       DO CLEANUP(XMKN,XQMSG)

 +20       QUIT 

SEND(XMDUZ,XMKN,XMZ,XMTO,XMFROM) ;

 +1        KILL XMERR,^TMP("XMERR",$JOB)

 +2        DO INIT^XMXADDR

 +3        DO CHKADDR^XMXADDR(XMDUZ,XMTO)

 +4        IF $DATA(XMERR)

               Begin DoDot:1

 +5                DO ERR2(XMDUZ,XMKN,XMTO,XMFROM)

 +6                KILL XMERR,^TMP("XMERR",$JOB)

               End DoDot:1

               QUIT 

 +7        DO FORCE(XMZ,$SELECT(XMTO="*":7,1:30))

 +8        DO SEND^XMKP(XMDUZ,XMZ)

 +9        QUIT 

FORCE(DA,XMDAYS) ; Set Info Only, Closed statuses, and Purge date

 +1        NEW DIE,DR

 +2        SET DIE=3.9

           SET DR="1.95///y;1.97///y;1.6///"_$$FMADD^XLFDT(DT,XMDAYS)

 +3        DO ^DIE

 +4        QUIT 

CLEANUP(XMKN,XMZ) ; Successfully delivered message, so remove from Postmaster Server Basket

 +1        DO CLEANUP^XMXADDR

 +2        DO ZAPSERV^XMXMSGS1(XMKN,XMZ)

 +3        QUIT 

ERR1(XMDUZ,XMKN,XMFROM) ; Send message back to sender if not POSTMASTER@DOMAIN.NAME

 +1        NEW A

 +2        SET A(1)="You may not send a message to the "_XMKN_" server."

 +3        SET A(2)="Only the Postmaster at DOMAIN.NAME has this permission."

 +4        DO SENDMSG^XMXSEND(XMDUZ,"Sender of Message to Server Unacceptable","A",XMFROM)

 +5        KILL XMERR,^TMP("XMERR",$JOB)

 +6        QUIT 

ERR2(XMDUZ,XMKN,XMTO,XMFROM) ; Send a message back to sender if single recipient is invalid

 +1        NEW A,I,J

 +2        SET A(1)="Your message to the "_XMKN_" server was not accepted"

 +3        SET A(2)="because the lookup for the recipient specified ("_XMTO_")"

 +4        SET A(3)="failed, with the following message:"

 +5        SET J=3

           SET I=0

 +6        FOR 

               SET I=$ORDER(^TMP("XMERR",$JOB,XMERR,"TEXT",I))

               IF 'I

                   QUIT 

               SET J=J+1

               SET A(J)=^(I)

 +7        DO SENDMSG^XMXSEND(XMDUZ,"Server Recipient Unknown","A",XMFROM)

 +8        KILL XMERR,^TMP("XMERR",$JOB)

 +9        QUIT