source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMGAPI3.m@ 1766

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1XMGAPI3 ;WASH ISC/REW/LH-Deliver Broadcast Msg & Mark for Vaporization ;04/17/2002 08:59
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; ENT XMR-BROADCAST-VA-WIDE
5 ; ENT XMYB-BROADCAST-VA-WIDE
6ENT(XMTO) ; Meant to be invoked by a server. Delivers a message
7 ; either to all users or to a specific user.
8 ; The message must have been sent by the POSTMASTER@FORUM.VA.GOV.
9 ; The AUTOMATIC DELETE DATE for this message is set for each user
10 ; to be in 7 days; 30 days if sent to a specific user.
11 ; The message is made 'information only' and 'closed'.
12 ; XMTO *=to all users
13 ; DUZ=to only one person -- typically .6 to route to SHARED,MAIL
14 ; Variables set in the server invoker:
15 ; XQSOP Server basket name
16 ; XQMSG Message number
17 ; XMFROM Who sent the message
18 N XMDUZ,XMKN
19 S (XMDUZ,DUZ)=.5
20 S XMKN="S."_XQSOP
21 I $P(XMFROM,"@")'["POSTMASTER"!($P(XMFROM,"@",2)'["FORUM.") D
22 . D ERR1(XMDUZ,XMKN,XMFROM)
23 E D
24 . D SEND(XMDUZ,XMKN,XQMSG,XMTO,XMFROM)
25 D CLEANUP(XMKN,XQMSG)
26 Q
27SEND(XMDUZ,XMKN,XMZ,XMTO,XMFROM) ;
28 K XMERR,^TMP("XMERR",$J)
29 D INIT^XMXADDR
30 D CHKADDR^XMXADDR(XMDUZ,XMTO)
31 I $D(XMERR) D Q
32 . D ERR2(XMDUZ,XMKN,XMTO,XMFROM)
33 . K XMERR,^TMP("XMERR",$J)
34 D FORCE(XMZ,$S(XMTO="*":7,1:30))
35 D SEND^XMKP(XMDUZ,XMZ)
36 Q
37FORCE(DA,XMDAYS) ; Set Info Only, Closed statuses, and Purge date
38 N DIE,DR
39 S DIE=3.9,DR="1.95///y;1.97///y;1.6///"_$$FMADD^XLFDT(DT,XMDAYS)
40 D ^DIE
41 Q
42CLEANUP(XMKN,XMZ) ; Successfully delivered message, so remove from Postmaster Server Basket
43 D CLEANUP^XMXADDR
44 D ZAPSERV^XMXMSGS1(XMKN,XMZ)
45 Q
46ERR1(XMDUZ,XMKN,XMFROM) ; Send message back to sender if not POSTMASTER@FORUM
47 N A
48 S A(1)="You may not send a message to the "_XMKN_" server."
49 S A(2)="Only the Postmaster at FORUM.VA.GOV has this permission."
50 D SENDMSG^XMXSEND(XMDUZ,"Sender of Message to Server Unacceptable","A",XMFROM)
51 K XMERR,^TMP("XMERR",$J)
52 Q
53ERR2(XMDUZ,XMKN,XMTO,XMFROM) ; Send a message back to sender if single recipient is invalid
54 N A,I,J
55 S A(1)="Your message to the "_XMKN_" server was not accepted"
56 S A(2)="because the lookup for the recipient specified ("_XMTO_")"
57 S A(3)="failed, with the following message:"
58 S J=3,I=0
59 F S I=$O(^TMP("XMERR",$J,XMERR,"TEXT",I)) Q:'I S J=J+1,A(J)=^(I)
60 D SENDMSG^XMXSEND(XMDUZ,"Server Recipient Unknown","A",XMFROM)
61 K XMERR,^TMP("XMERR",$J)
62 Q
Note: See TracBrowser for help on using the repository browser.