- 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 Jan 18, 2025@03:15:08 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