XMXBULL ;ISC-SF/GMB-Send Bulletin ;04/23/2002 08:46
;;8.0;MailMan;;Jun 28, 2002
; Replaces ^XMB (ISC-WASH/THM/RWF/CAP)
; TASKBULL creates and delivers a bulletin in background.
; SENDBULL creates bulletin in foreground; delivers in background
; TASK for use by TaskMan only
; The recipients of the message include any entries in the XMTO
; array that the caller has defined and the members of mail groups
; that are included in the definition of the entry in the Bulletin
; file (#3.6) at the time of delivery. There must be valid
; recipients or the message will not be delivered.
; Inputs:
; XMDUZ Sender DUZ
; XMBNAME The name of a bulletin (an entry in File #3.6)
; XMPARM(parameter#)=The value to be stuffed into the bulletin for each
; required parameter. (eg. XMPARM(1)=data for parameter#1
; XMBODY (optional) Additional text of the message
; XMTO (optional) Array of recipients of a bulletin
; XMINSTR("FLAGS") (optional)
; ["P" - priority
; XMINSTR("FROM") (optional) String saying from whom (default is sender)
; XMINSTR("LATER") (optional) date/time to send the bulletin (default is now)
; XMINSTR("VAPOR") (optional) date/time to vaporize the bulletin.
; If supplied, it takes precedence over the bulletin's
; RETENTION DAYS field.
; XMATTACH (in) Array of files to attach to message
; ("IMAGE",x) imaging (BLOB) files
; Output:
; XMZ (from entry SENDBULL only) Message number if successful
; XMTASK (from entry TASKBULL only) Task number (ZTSK) if successful
TASKBULL(XMDUZ,XMBNAME,XMPARM,XMBODY,XMTO,XMINSTR,XMTASK,XMATTACH) ; Tasks it
N XMBIEN
K XMERR,^TMP("XMERR",$J)
I XMDUZ=.6 D ERRSET^XMXUTIL(39321) Q ;SHARED,MAIL may not send a bulletin.
S XMBIEN=$O(^XMB(3.6,"B",XMBNAME,""))
D BULLETIN^XMKPO(XMDUZ,XMBNAME,XMBIEN,.XMPARM,.XMBODY,.XMTO,.XMINSTR,.XMTASK,.XMATTACH)
Q
TASK ; TaskMan uses this entry point, and supplies variables:
; XMDUZ,XMBIEN,XMPARM,XMBODY,XMTO,XMINSTR,XMATTACH
N XMZ
K XMERR,^TMP("XMERR",$J)
D SEND(XMDUZ,XMBIEN,.XMPARM,.XMBODY,.XMTO,.XMINSTR,.XMZ,.XMATTACH)
S ZTREQ="@"
Q
SENDBULL(XMDUZ,XMBNAME,XMPARM,XMBODY,XMTO,XMINSTR,XMZ,XMATTACH) ; Does it now
N XMBIEN
K XMERR,^TMP("XMERR",$J)
I XMDUZ=.6 D ERRSET^XMXUTIL(39321) Q ;SHARED,MAIL may not send a bulletin.
S XMBIEN=$O(^XMB(3.6,"B",XMBNAME,""))
D SEND(XMDUZ,XMBIEN,.XMPARM,.XMBODY,.XMTO,.XMINSTR,.XMZ,.XMATTACH)
Q
SEND(XMDUZ,XMBIEN,XMPARM,XMBODY,XMTO,XMINSTR,XMZ,XMATTACH) ; Create and send the bulletin
N XMREC,XMSUBJ,XMVDAYS
S XMREC=^XMB(3.6,XMBIEN,0)
S XMSUBJ=$$SUBJECT($P(XMREC,U,2),.XMPARM) Q:$D(XMERR)
S XMVDAYS=$P(XMREC,U,3)
I XMVDAYS,'$D(XMINSTR("VAPOR")) D
. S XMINSTR("VAPOR")=$$FMADD^XLFDT(DT,XMVDAYS)
E K XMVDAYS
D CRE8XMZ^XMXSEND(XMSUBJ,.XMZ) Q:$D(XMERR)
D:$G(XMINSTR("ADDR FLAGS"))'["I" INIT^XMXADDR
D BULLADDR(XMDUZ,XMBIEN,.XMINSTR)
D CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR)
I '$$GOTADDR^XMXADDR D Q
. D CLEANUP^XMXADDR
. D ERRSET^XMXUTIL(39320) ;No addressees. Bulletin not sent.
. D KILLMSG^XMXUTIL(XMZ)
. S XMZ=-1
I $P(XMREC,U,4),$G(XMINSTR("FLAGS"))'["P" S XMINSTR("FLAGS")=$G(XMINSTR("FLAGS"))_"P"
D:$D(XMATTACH("IMAGE"))>9 ADDBLOB^XMXSEND(XMZ,.XMATTACH)
D MOVEPART^XMXSEND(XMDUZ,XMZ,.XMINSTR)
D MOVEBODY^XMXSEND(XMZ,"^XMB(3.6,"_XMBIEN_",1)") ; Bulletin text
D DOPARMS(XMZ,.XMPARM)
I $G(XMBODY)'="",$D(@XMBODY)>9,$O(@XMBODY@(0)) D MOVEBODY^XMXSEND(XMZ,XMBODY,"A") ; Append the text (no parm translation)
I $E(XMREC,1,2)="XM" D CHKNONVF(XMZ,$P(XMREC,U))
D SEND^XMKP(XMDUZ,XMZ)
I $D(XMVDAYS) K XMINSTR("VAPOR")
D CLEANUP^XMXADDR
D CHECK^XMKPL
Q
BULLADDR(XMDUZ,XMBIEN,XMINSTR) ;
N XMGIEN,XMGROUP
S XMGIEN=""
F S XMGIEN=$O(^XMB(3.6,XMBIEN,2,"B",XMGIEN)) Q:XMGIEN="" D
. S XMGROUP="G."_$P($G(^XMB(3.8,XMGIEN,0)),U,1)
. D:XMGROUP]"G." CHKADDR^XMXADDR(XMDUZ,XMGROUP,.XMINSTR)
Q
SUBJECT(XMSUBJ,XMPARM) ;
D:XMSUBJ["|" FILL(.XMSUBJ,.XMPARM)
I $L(XMSUBJ)<3 S XMSUBJ=XMSUBJ_"..."
I $L(XMSUBJ)>65 S XMSUBJ=$E(XMSUBJ,1,65)
Q $$XMSUBJ^XMXPARM("XMSUBJ",XMSUBJ)
DOPARMS(XMZ,XMPARM) ;
N I,XMLINE
S I=0
F S I=$O(^XMB(3.9,XMZ,2,I)) Q:I="" D
. Q:^XMB(3.9,XMZ,2,I,0)'["|"
. S XMLINE=^XMB(3.9,XMZ,2,I,0)
. D:XMLINE["|" FILL(.XMLINE,.XMPARM)
. S ^XMB(3.9,XMZ,2,I,0)=XMLINE
Q
FILL(XMLINE,XMPARM) ;
; This gets confused by "\027||1|, your Help Request from, |2|,":
;F D Q:XMLINE'["|"
;. S XMLINE=$P(XMLINE,"|",1)_$G(XMPARM(+$P(XMLINE,"|",2)))_$P(XMLINE,"|",3,999)
; This can handle it:
Q:XMLINE'?.E1"|"1.N1"|".E
N XML
S XML=""
F D Q:XMLINE'?.E1"|"1.N1"|".E
. I $P(XMLINE,"|",2)?1N.N S XMLINE=$P(XMLINE,"|",1)_$G(XMPARM(+$P(XMLINE,"|",2)))_$P(XMLINE,"|",3,999) Q
. S XML=XML_$P(XMLINE,"|",1)_"|",XMLINE=$P(XMLINE,"|",2,999)
S XMLINE=XML_XMLINE
Q
CHKNONVF(XMZ,XMBNAME) ; (CHecK NO eNVelope From)
Q:$O(^TMP("XMY",$J,""),-1)'["@"
I XMBNAME'="XM SEND ERR RECIPIENT",XMBNAME'="XM SEND ERR MSG" Q
; This is an error bulletin sent by MailMan to someone at a remote site
; indicating that their message could not be delivered for some reason.
; We want to make sure that the 'envelope from' is null, so we pre-set
; it here. It's a little trick.
S $P(^XMB(3.9,XMZ,.7),U,1)="<>"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXBULL 5313 printed Oct 16, 2024@18:14:51 Page 2
XMXBULL ;ISC-SF/GMB-Send Bulletin ;04/23/2002 08:46
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces ^XMB (ISC-WASH/THM/RWF/CAP)
+3 ; TASKBULL creates and delivers a bulletin in background.
+4 ; SENDBULL creates bulletin in foreground; delivers in background
+5 ; TASK for use by TaskMan only
+6 ; The recipients of the message include any entries in the XMTO
+7 ; array that the caller has defined and the members of mail groups
+8 ; that are included in the definition of the entry in the Bulletin
+9 ; file (#3.6) at the time of delivery. There must be valid
+10 ; recipients or the message will not be delivered.
+11 ; Inputs:
+12 ; XMDUZ Sender DUZ
+13 ; XMBNAME The name of a bulletin (an entry in File #3.6)
+14 ; XMPARM(parameter#)=The value to be stuffed into the bulletin for each
+15 ; required parameter. (eg. XMPARM(1)=data for parameter#1
+16 ; XMBODY (optional) Additional text of the message
+17 ; XMTO (optional) Array of recipients of a bulletin
+18 ; XMINSTR("FLAGS") (optional)
+19 ; ["P" - priority
+20 ; XMINSTR("FROM") (optional) String saying from whom (default is sender)
+21 ; XMINSTR("LATER") (optional) date/time to send the bulletin (default is now)
+22 ; XMINSTR("VAPOR") (optional) date/time to vaporize the bulletin.
+23 ; If supplied, it takes precedence over the bulletin's
+24 ; RETENTION DAYS field.
+25 ; XMATTACH (in) Array of files to attach to message
+26 ; ("IMAGE",x) imaging (BLOB) files
+27 ; Output:
+28 ; XMZ (from entry SENDBULL only) Message number if successful
+29 ; XMTASK (from entry TASKBULL only) Task number (ZTSK) if successful
TASKBULL(XMDUZ,XMBNAME,XMPARM,XMBODY,XMTO,XMINSTR,XMTASK,XMATTACH) ; Tasks it
+1 NEW XMBIEN
+2 KILL XMERR,^TMP("XMERR",$JOB)
+3 ;SHARED,MAIL may not send a bulletin.
IF XMDUZ=.6
DO ERRSET^XMXUTIL(39321)
QUIT
+4 SET XMBIEN=$ORDER(^XMB(3.6,"B",XMBNAME,""))
+5 DO BULLETIN^XMKPO(XMDUZ,XMBNAME,XMBIEN,.XMPARM,.XMBODY,.XMTO,.XMINSTR,.XMTASK,.XMATTACH)
+6 QUIT
TASK ; TaskMan uses this entry point, and supplies variables:
+1 ; XMDUZ,XMBIEN,XMPARM,XMBODY,XMTO,XMINSTR,XMATTACH
+2 NEW XMZ
+3 KILL XMERR,^TMP("XMERR",$JOB)
+4 DO SEND(XMDUZ,XMBIEN,.XMPARM,.XMBODY,.XMTO,.XMINSTR,.XMZ,.XMATTACH)
+5 SET ZTREQ="@"
+6 QUIT
SENDBULL(XMDUZ,XMBNAME,XMPARM,XMBODY,XMTO,XMINSTR,XMZ,XMATTACH) ; Does it now
+1 NEW XMBIEN
+2 KILL XMERR,^TMP("XMERR",$JOB)
+3 ;SHARED,MAIL may not send a bulletin.
IF XMDUZ=.6
DO ERRSET^XMXUTIL(39321)
QUIT
+4 SET XMBIEN=$ORDER(^XMB(3.6,"B",XMBNAME,""))
+5 DO SEND(XMDUZ,XMBIEN,.XMPARM,.XMBODY,.XMTO,.XMINSTR,.XMZ,.XMATTACH)
+6 QUIT
SEND(XMDUZ,XMBIEN,XMPARM,XMBODY,XMTO,XMINSTR,XMZ,XMATTACH) ; Create and send the bulletin
+1 NEW XMREC,XMSUBJ,XMVDAYS
+2 SET XMREC=^XMB(3.6,XMBIEN,0)
+3 SET XMSUBJ=$$SUBJECT($PIECE(XMREC,U,2),.XMPARM)
if $DATA(XMERR)
QUIT
+4 SET XMVDAYS=$PIECE(XMREC,U,3)
+5 IF XMVDAYS
IF '$DATA(XMINSTR("VAPOR"))
Begin DoDot:1
+6 SET XMINSTR("VAPOR")=$$FMADD^XLFDT(DT,XMVDAYS)
End DoDot:1
+7 IF '$TEST
KILL XMVDAYS
+8 DO CRE8XMZ^XMXSEND(XMSUBJ,.XMZ)
if $DATA(XMERR)
QUIT
+9 if $GET(XMINSTR("ADDR FLAGS"))'["I"
DO INIT^XMXADDR
+10 DO BULLADDR(XMDUZ,XMBIEN,.XMINSTR)
+11 DO CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR)
+12 IF '$$GOTADDR^XMXADDR
Begin DoDot:1
+13 DO CLEANUP^XMXADDR
+14 ;No addressees. Bulletin not sent.
DO ERRSET^XMXUTIL(39320)
+15 DO KILLMSG^XMXUTIL(XMZ)
+16 SET XMZ=-1
End DoDot:1
QUIT
+17 IF $PIECE(XMREC,U,4)
IF $GET(XMINSTR("FLAGS"))'["P"
SET XMINSTR("FLAGS")=$GET(XMINSTR("FLAGS"))_"P"
+18 if $DATA(XMATTACH("IMAGE"))>9
DO ADDBLOB^XMXSEND(XMZ,.XMATTACH)
+19 DO MOVEPART^XMXSEND(XMDUZ,XMZ,.XMINSTR)
+20 ; Bulletin text
DO MOVEBODY^XMXSEND(XMZ,"^XMB(3.6,"_XMBIEN_",1)")
+21 DO DOPARMS(XMZ,.XMPARM)
+22 ; Append the text (no parm translation)
IF $GET(XMBODY)'=""
IF $DATA(@XMBODY)>9
IF $ORDER(@XMBODY@(0))
DO MOVEBODY^XMXSEND(XMZ,XMBODY,"A")
+23 IF $EXTRACT(XMREC,1,2)="XM"
DO CHKNONVF(XMZ,$PIECE(XMREC,U))
+24 DO SEND^XMKP(XMDUZ,XMZ)
+25 IF $DATA(XMVDAYS)
KILL XMINSTR("VAPOR")
+26 DO CLEANUP^XMXADDR
+27 DO CHECK^XMKPL
+28 QUIT
BULLADDR(XMDUZ,XMBIEN,XMINSTR) ;
+1 NEW XMGIEN,XMGROUP
+2 SET XMGIEN=""
+3 FOR
SET XMGIEN=$ORDER(^XMB(3.6,XMBIEN,2,"B",XMGIEN))
if XMGIEN=""
QUIT
Begin DoDot:1
+4 SET XMGROUP="G."_$PIECE($GET(^XMB(3.8,XMGIEN,0)),U,1)
+5 if XMGROUP]"G."
DO CHKADDR^XMXADDR(XMDUZ,XMGROUP,.XMINSTR)
End DoDot:1
+6 QUIT
SUBJECT(XMSUBJ,XMPARM) ;
+1 if XMSUBJ["|"
DO FILL(.XMSUBJ,.XMPARM)
+2 IF $LENGTH(XMSUBJ)<3
SET XMSUBJ=XMSUBJ_"..."
+3 IF $LENGTH(XMSUBJ)>65
SET XMSUBJ=$EXTRACT(XMSUBJ,1,65)
+4 QUIT $$XMSUBJ^XMXPARM("XMSUBJ",XMSUBJ)
DOPARMS(XMZ,XMPARM) ;
+1 NEW I,XMLINE
+2 SET I=0
+3 FOR
SET I=$ORDER(^XMB(3.9,XMZ,2,I))
if I=""
QUIT
Begin DoDot:1
+4 if ^XMB(3.9,XMZ,2,I,0)'["|"
QUIT
+5 SET XMLINE=^XMB(3.9,XMZ,2,I,0)
+6 if XMLINE["|"
DO FILL(.XMLINE,.XMPARM)
+7 SET ^XMB(3.9,XMZ,2,I,0)=XMLINE
End DoDot:1
+8 QUIT
FILL(XMLINE,XMPARM) ;
+1 ; This gets confused by "\027||1|, your Help Request from, |2|,":
+2 ;F D Q:XMLINE'["|"
+3 ;. S XMLINE=$P(XMLINE,"|",1)_$G(XMPARM(+$P(XMLINE,"|",2)))_$P(XMLINE,"|",3,999)
+4 ; This can handle it:
+5 if XMLINE'?.E1"|"1.N1"|".E
QUIT
+6 NEW XML
+7 SET XML=""
+8 FOR
Begin DoDot:1
+9 IF $PIECE(XMLINE,"|",2)?1N.N
SET XMLINE=$PIECE(XMLINE,"|",1)_$GET(XMPARM(+$PIECE(XMLINE,"|",2)))_$PIECE(XMLINE,"|",3,999)
QUIT
+10 SET XML=XML_$PIECE(XMLINE,"|",1)_"|"
SET XMLINE=$PIECE(XMLINE,"|",2,999)
End DoDot:1
if XMLINE'?.E1"|"1.N1"|".E
QUIT
+11 SET XMLINE=XML_XMLINE
+12 QUIT
CHKNONVF(XMZ,XMBNAME) ; (CHecK NO eNVelope From)
+1 if $ORDER(^TMP("XMY",$JOB,""),-1)'["@"
QUIT
+2 IF XMBNAME'="XM SEND ERR RECIPIENT"
IF XMBNAME'="XM SEND ERR MSG"
QUIT
+3 ; This is an error bulletin sent by MailMan to someone at a remote site
+4 ; indicating that their message could not be delivered for some reason.
+5 ; We want to make sure that the 'envelope from' is null, so we pre-set
+6 ; it here. It's a little trick.
+7 SET $PIECE(^XMB(3.9,XMZ,.7),U,1)="<>"
+8 QUIT
