source: FOIAVistA/trunk/r/MAILMAN-XM/XMXBULL.m@ 1061

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

initial load of FOIAVistA 6/30/08 version

File size: 5.1 KB
Line 
1XMXBULL ;ISC-SF/GMB-Send Bulletin ;04/23/2002 08:46
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Replaces ^XMB (ISC-WASH/THM/RWF/CAP)
4 ; TASKBULL creates and delivers a bulletin in background.
5 ; SENDBULL creates bulletin in foreground; delivers in background
6 ; TASK for use by TaskMan only
7 ; The recipients of the message include any entries in the XMTO
8 ; array that the caller has defined and the members of mail groups
9 ; that are included in the definition of the entry in the Bulletin
10 ; file (#3.6) at the time of delivery. There must be valid
11 ; recipients or the message will not be delivered.
12 ; Inputs:
13 ; XMDUZ Sender DUZ
14 ; XMBNAME The name of a bulletin (an entry in File #3.6)
15 ; XMPARM(parameter#)=The value to be stuffed into the bulletin for each
16 ; required parameter. (eg. XMPARM(1)=data for parameter#1
17 ; XMBODY (optional) Additional text of the message
18 ; XMTO (optional) Array of recipients of a bulletin
19 ; XMINSTR("FLAGS") (optional)
20 ; ["P" - priority
21 ; XMINSTR("FROM") (optional) String saying from whom (default is sender)
22 ; XMINSTR("LATER") (optional) date/time to send the bulletin (default is now)
23 ; XMINSTR("VAPOR") (optional) date/time to vaporize the bulletin.
24 ; If supplied, it takes precedence over the bulletin's
25 ; RETENTION DAYS field.
26 ; XMATTACH (in) Array of files to attach to message
27 ; ("IMAGE",x) imaging (BLOB) files
28 ; Output:
29 ; XMZ (from entry SENDBULL only) Message number if successful
30 ; XMTASK (from entry TASKBULL only) Task number (ZTSK) if successful
31TASKBULL(XMDUZ,XMBNAME,XMPARM,XMBODY,XMTO,XMINSTR,XMTASK,XMATTACH) ; Tasks it
32 N XMBIEN
33 K XMERR,^TMP("XMERR",$J)
34 I XMDUZ=.6 D ERRSET^XMXUTIL(39321) Q ;SHARED,MAIL may not send a bulletin.
35 S XMBIEN=$O(^XMB(3.6,"B",XMBNAME,""))
36 D BULLETIN^XMKPO(XMDUZ,XMBNAME,XMBIEN,.XMPARM,.XMBODY,.XMTO,.XMINSTR,.XMTASK,.XMATTACH)
37 Q
38TASK ; TaskMan uses this entry point, and supplies variables:
39 ; XMDUZ,XMBIEN,XMPARM,XMBODY,XMTO,XMINSTR,XMATTACH
40 N XMZ
41 K XMERR,^TMP("XMERR",$J)
42 D SEND(XMDUZ,XMBIEN,.XMPARM,.XMBODY,.XMTO,.XMINSTR,.XMZ,.XMATTACH)
43 S ZTREQ="@"
44 Q
45SENDBULL(XMDUZ,XMBNAME,XMPARM,XMBODY,XMTO,XMINSTR,XMZ,XMATTACH) ; Does it now
46 N XMBIEN
47 K XMERR,^TMP("XMERR",$J)
48 I XMDUZ=.6 D ERRSET^XMXUTIL(39321) Q ;SHARED,MAIL may not send a bulletin.
49 S XMBIEN=$O(^XMB(3.6,"B",XMBNAME,""))
50 D SEND(XMDUZ,XMBIEN,.XMPARM,.XMBODY,.XMTO,.XMINSTR,.XMZ,.XMATTACH)
51 Q
52SEND(XMDUZ,XMBIEN,XMPARM,XMBODY,XMTO,XMINSTR,XMZ,XMATTACH) ; Create and send the bulletin
53 N XMREC,XMSUBJ,XMVDAYS
54 S XMREC=^XMB(3.6,XMBIEN,0)
55 S XMSUBJ=$$SUBJECT($P(XMREC,U,2),.XMPARM) Q:$D(XMERR)
56 S XMVDAYS=$P(XMREC,U,3)
57 I XMVDAYS,'$D(XMINSTR("VAPOR")) D
58 . S XMINSTR("VAPOR")=$$FMADD^XLFDT(DT,XMVDAYS)
59 E K XMVDAYS
60 D CRE8XMZ^XMXSEND(XMSUBJ,.XMZ) Q:$D(XMERR)
61 D:$G(XMINSTR("ADDR FLAGS"))'["I" INIT^XMXADDR
62 D BULLADDR(XMDUZ,XMBIEN,.XMINSTR)
63 D CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR)
64 I '$$GOTADDR^XMXADDR D Q
65 . D CLEANUP^XMXADDR
66 . D ERRSET^XMXUTIL(39320) ;No addressees. Bulletin not sent.
67 . D KILLMSG^XMXUTIL(XMZ)
68 . S XMZ=-1
69 I $P(XMREC,U,4),$G(XMINSTR("FLAGS"))'["P" S XMINSTR("FLAGS")=$G(XMINSTR("FLAGS"))_"P"
70 D:$D(XMATTACH("IMAGE"))>9 ADDBLOB^XMXSEND(XMZ,.XMATTACH)
71 D MOVEPART^XMXSEND(XMDUZ,XMZ,.XMINSTR)
72 D MOVEBODY^XMXSEND(XMZ,"^XMB(3.6,"_XMBIEN_",1)") ; Bulletin text
73 D DOPARMS(XMZ,.XMPARM)
74 I $G(XMBODY)'="",$D(@XMBODY)>9,$O(@XMBODY@(0)) D MOVEBODY^XMXSEND(XMZ,XMBODY,"A") ; Append the text (no parm translation)
75 I $E(XMREC,1,2)="XM" D CHKNONVF(XMZ,$P(XMREC,U))
76 D SEND^XMKP(XMDUZ,XMZ)
77 I $D(XMVDAYS) K XMINSTR("VAPOR")
78 D CLEANUP^XMXADDR
79 D CHECK^XMKPL
80 Q
81BULLADDR(XMDUZ,XMBIEN,XMINSTR) ;
82 N XMGIEN,XMGROUP
83 S XMGIEN=""
84 F S XMGIEN=$O(^XMB(3.6,XMBIEN,2,"B",XMGIEN)) Q:XMGIEN="" D
85 . S XMGROUP="G."_$P($G(^XMB(3.8,XMGIEN,0)),U,1)
86 . D:XMGROUP]"G." CHKADDR^XMXADDR(XMDUZ,XMGROUP,.XMINSTR)
87 Q
88SUBJECT(XMSUBJ,XMPARM) ;
89 D:XMSUBJ["|" FILL(.XMSUBJ,.XMPARM)
90 I $L(XMSUBJ)<3 S XMSUBJ=XMSUBJ_"..."
91 I $L(XMSUBJ)>65 S XMSUBJ=$E(XMSUBJ,1,65)
92 Q $$XMSUBJ^XMXPARM("XMSUBJ",XMSUBJ)
93DOPARMS(XMZ,XMPARM) ;
94 N I,XMLINE
95 S I=0
96 F S I=$O(^XMB(3.9,XMZ,2,I)) Q:I="" D
97 . Q:^XMB(3.9,XMZ,2,I,0)'["|"
98 . S XMLINE=^XMB(3.9,XMZ,2,I,0)
99 . D:XMLINE["|" FILL(.XMLINE,.XMPARM)
100 . S ^XMB(3.9,XMZ,2,I,0)=XMLINE
101 Q
102FILL(XMLINE,XMPARM) ;
103 ; This gets confused by "\027||1|, your Help Request from, |2|,":
104 ;F D Q:XMLINE'["|"
105 ;. S XMLINE=$P(XMLINE,"|",1)_$G(XMPARM(+$P(XMLINE,"|",2)))_$P(XMLINE,"|",3,999)
106 ; This can handle it:
107 Q:XMLINE'?.E1"|"1.N1"|".E
108 N XML
109 S XML=""
110 F D Q:XMLINE'?.E1"|"1.N1"|".E
111 . I $P(XMLINE,"|",2)?1N.N S XMLINE=$P(XMLINE,"|",1)_$G(XMPARM(+$P(XMLINE,"|",2)))_$P(XMLINE,"|",3,999) Q
112 . S XML=XML_$P(XMLINE,"|",1)_"|",XMLINE=$P(XMLINE,"|",2,999)
113 S XMLINE=XML_XMLINE
114 Q
115CHKNONVF(XMZ,XMBNAME) ; (CHecK NO eNVelope From)
116 Q:$O(^TMP("XMY",$J,""),-1)'["@"
117 I XMBNAME'="XM SEND ERR RECIPIENT",XMBNAME'="XM SEND ERR MSG" Q
118 ; This is an error bulletin sent by MailMan to someone at a remote site
119 ; indicating that their message could not be delivered for some reason.
120 ; We want to make sure that the 'envelope from' is null, so we pre-set
121 ; it here. It's a little trick.
122 S $P(^XMB(3.9,XMZ,.7),U,1)="<>"
123 Q
Note: See TracBrowser for help on using the repository browser.