Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMD

XMD.m

Go to the documentation of this file. 
  1. XMD ;ISC-SF/GMB-Send/Forward/Add text to a message APIs ;08/27/2003  11:01
  1.  ;;8.0;MailMan;**21**;Jun 28, 2002
  1.  ; Was (WASH ISC)/THM/CAP
  1.  ;
  1.  ; Entry points (DBIA 10070) are:
  1.  ; ^XMD         Send a message.
  1.  ;              If no recipients defined, prompt for them.
  1.  ; EN1^XMD      Put text in a message.
  1.  ;              If no recipients defined, prompt for them.
  1.  ;              Send the message.
  1.  ; ENL^XMD      Add text to an existing message.
  1.  ; ENT^XMD      Interactive 'send a message'.  (Same as menu)
  1.  ; ENT1^XMD     Forward a message.
  1.  ; ENT2^XMD     Forward a message.
  1.  ;              Prompt for recipients, whether or not any are already
  1.  ;              defined.
  1.  ;
  1.  ; I/O Variables to the various APIs:
  1.  ; XMDUZ   (in, optional) Sender DUZ or string (default=DUZ)
  1.  ;              For new messages, XMDUZ may be a string, which will be
  1.  ;              put in the 'message from' field.
  1.  ;              For forwarded messages, XMDUZ may be a string, which
  1.  ;              will be put in the 'forwarded by' field.
  1.  ; XMSUB   (in) Message subject
  1.  ; XMTEXT  (in) @location of message.  For example, the following are
  1.  ;              among the acceptable:
  1.  ;              XMTEXT="array("
  1.  ;              XMTEXT="array(""node"","
  1.  ;              XMTEXT="^TMP(""namespace"",$J,""array"","
  1.  ;              The array must be in the acceptable FM word processing
  1.  ;              format.
  1.  ; XMSTRIP (in, optional) Characters that user wants stripped from text
  1.  ;              of message (default=none)
  1.  ; XMY     (in, optional) Array of recipients, XMY(x)="", where
  1.  ;               x is a valid local or internet address.
  1.  ;               XMY(x,0)=basket to deliver to, if x=sender's DUZ or .6
  1.  ;               (Basket may be its number or name.  If name, and it
  1.  ;               doesn't exist, it will be created.)
  1.  ;               XMY(x,1)=recipient type, either "I" (info only) or
  1.  ;               "C" (carbon copy)
  1.  ;               XMY(x,"D")=delete date, if x=.6 ("SHARED,MAIL")
  1.  ;               A local address may be a user's name or DUZ, a G.group
  1.  ;               name or S.server name.
  1.  ;               If not supplied and the process is not queued,
  1.  ;               you will be prompted.
  1.  ; XMMG    (in, optional) If XMY is not supplied and the process is not
  1.  ;               queued, XMMG is used as the default for the first
  1.  ;               'send to:' prompt.  It is ignored otherwise.
  1.  ;         (out) Contains error message if error occurs.
  1.  ;               Undefined if no error.
  1.  ; DIFROM  (in, optional) ?
  1.  ; XMROU   (in, optional) Array of routines to be loaded in a PackMan
  1.  ;               message.   XMROU(x)="", where x=routine name.
  1.  ; XMYBLOB (in, optional) Array of images from the imaging system to be
  1.  ;               loaded.  XMYBLOB(y)=x, where y and x are ?
  1.  ;
  1.  ; Local Variables:
  1.  ; XMDF    Flag that programmer interface is in use.
  1.  ;         Therefore do not check for Security Keys on domains.
  1.  ;
  1.  ; Entry point ^XMD
  1.  ; Needs:   DUZ,XMSUB,XMTEXT
  1.  ; Accepts: XMDUZ,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,
  1.  ;          and, if $D(DIFROM), XMDF
  1.  ; Ignores: N/A
  1.  ; Returns: XMZ(if no error),XMMG(if error)
  1.  ; Kills:   XMSUB,XMTEXT,XMY,XMSTRIP,XMMG(if no error),XMYBLOB
  1.  N XMV,XMINSTR,XMBLOBER,XMABORT
  1.  I '$D(DIFROM) N XMDF S XMDF=1
  1.  I '$G(DUZ) N DUZ D DUZ^XUP(.5)
  1.  I $G(XMDUZ)=""!($G(XMDUZ)=0) S XMDUZ=DUZ
  1.  I XMDUZ'?.N S %=XMDUZ N XMDUZ S XMDUZ=% K %
  1.  K XMERR,^TMP("XMERR",$J)
  1.  S XMABORT=0
  1.  I '$D(XMTEXT) S XMMG="Error = No message text" Q
  1.  I '$O(@(XMTEXT_"0)")) S XMMG="Error = No message text" Q
  1.  I '$D(XMSUB)  S XMMG="Error = No message subject" Q
  1.  ;I $L(XMSUB)<3!($L(XMSUB)>65) S XMMG="Error = Message subject too long or too short" Q
  1.  I $L(XMSUB)<3 S XMSUB=XMSUB_"..."
  1.  I $L(XMSUB)>65 S XMSUB=$E(XMSUB,1,65)
  1.  I $D(XMY)'<10 K XMMG
  1.  I XMDUZ'?.N D SETFROM(.XMDUZ,.XMINSTR) Q:$G(XMMG)["Error ="  ; If XMDUZ=.5, becomes POSTMASTER
  1.  D INITAPI^XMVVITAE
  1.  D INITLATR^XMXADDR
  1.  I '$D(XMROU),'$D(DIFROM),'$D(XMYBLOB),$D(XMY) D  Q
  1.  . D SEND(XMDUZ,XMSUB,XMTEXT,.XMSTRIP,.XMY,.XMINSTR,.XMMG,.XMZ)
  1.  . D QUIT
  1.  D CLEANUP^XMXADDR
  1.  S XMSUB=$$ENCODEUP^XMXUTIL1(XMSUB)
  1.  F  D CRE8XMZ^XMXSEND(XMSUB,.XMZ) Q:XMZ>0  D
  1.  . K XMERR,^TMP("XMERR",$J)
  1.  . I $D(ZTQUEUED) H 1 Q
  1.  . W !,$C(7),$$EZBLD^DIALOG(34101),! ;Waiting for access to the Message File
  1.  . N I F I=1:1:10 H 1 W "."
  1.  I $D(XMYBLOB)>9 D  Q:XMBLOBER
  1.  . ; Add BLOBS to message
  1.  . S XMBLOBER=$$MULTI^XMBBLOB(XMZ)
  1.  . K XMYBLOB
  1.  . Q:'XMBLOBER
  1.  . D KILLMSG^XMXUTIL(XMZ)
  1.  . K XMZ
  1.  D EN1A
  1.  Q
  1. SEND(XMDUZ,XMSUBJ,XMBODY,XMSTRIP,XMTO,XMINSTR,XMMG,XMZ) ;
  1.  S XMBODY=$$CREF^DILF(XMBODY)
  1.  S:$D(XMSTRIP) XMINSTR("STRIP")=XMSTRIP
  1.  D CHKBSKT(.XMTO,.XMINSTR)
  1.  D SENDMSG^XMXPARM(.XMDUZ,.XMSUBJ,.XMBODY,.XMTO,.XMINSTR)
  1.  I $D(XMERR) D ERR1 Q
  1.  S:$D(XMDF) XMINSTR("ADDR FLAGS")="R" ; Ignore addressee restrictions
  1.  D SENDMSG^XMXSEND(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,.XMZ)
  1.  D:$D(XMERR) ERR1
  1.  Q
  1. ERR1 ;
  1.  S XMMG="Error = "_^TMP("XMERR",$J,1,"TEXT",1)
  1.  K XMERR,^TMP("XMERR",$J)
  1.  Q
  1. EN1 ; Enter text in the msg, ask for recipients if there aren't any,
  1.  ; and send the msg.
  1.  ; Needs:   DUZ,XMZ,XMTEXT
  1.  ; Accepts: XMDF,XMY,XMMG,XMSTRIP,XMROU,DIFROM
  1.  ; Ignores: XMDUZ,XMSUB
  1.  ; Returns: N/A
  1.  ; Kills:   XMTEXT,XMY,XMSTRIP,XMMG
  1.  N XMV,XMABORT,XMDUZ,XMFROM,XMINSTR,XMSUB ; (XMSUB is newed so it isn't killed in QUIT)
  1.  S XMABORT=0
  1.  S XMDUZ=DUZ
  1.  D INITAPI^XMVVITAE
  1.  D INITLATR^XMXADDR
  1.  K XMERR,^TMP("XMERR",$J)
  1.  I $D(XMY)'<10 K XMMG
  1.  S XMFROM=$P($G(^XMB(3.9,XMZ,0)),U,2)
  1.  I XMFROM'="",XMFROM'=XMDUZ S XMINSTR("FROM")=XMFROM
  1.  D EN1A
  1.  Q
  1. EN1A ;
  1.  D EN2A
  1.  Q:$D(DIFROM)
  1.  D EN3A
  1.  D QUIT
  1.  Q
  1. EN2A ;
  1.  N XMI,XMBODY
  1.  S XMI=0
  1.  I $D(XMROU)>9,'$O(^XMB(3.9,XMZ,2,0)) D NEW^XMP S XMI=1,^XMB(3.9,XMZ,2,0)="^^1^1"
  1.  S XMBODY=$$CREF^DILF(XMTEXT)
  1.  D MOVEBODY^XMXSEND(XMZ,XMBODY,"A")
  1.  D CHEKBODY^XMXSEND(XMZ,.XMSTRIP,XMI)
  1.  S XCNP=+$P($G(^XMB(3.9,XMZ,2,0)),U,3)
  1.  Q:$D(DIFROM)
  1.  Q:$D(XMROU)'>9
  1.  D XMROU^XMPH
  1.  K XMROU
  1.  D PSECURE^XMPSEC(XMZ,.XMABORT)
  1.  Q
  1. EN3 ; called from XPDTP (KIDS)
  1.  ; XMDUZ must be valid DUZ, if provided.  It may not be a string.
  1.  N XMV,XMINSTR
  1.  I '$G(DUZ) N DUZ D DUZ^XUP(.5)
  1.  I '$D(XMDUZ) S XMDUZ=DUZ
  1.  D INITAPI^XMVVITAE
  1.  D INITLATR^XMXADDR
  1.  D EN3A
  1.  D QUIT
  1.  Q
  1. EN3A ;
  1.  N XMABORT
  1.  S XMABORT=0
  1.  S:$D(XMDF) XMINSTR("ADDR FLAGS")="R" ; Ignore addressee restrictions
  1.  I $D(XMY)<10,'$$GOTADDR^XMXADDR,'$D(ZTQUEUED) D
  1.  . I $D(XMMG) S XMINSTR("TO PROMPT")=XMMG K XMMG
  1.  . D TOWHOM^XMJMT($G(XMDUZ,DUZ),$$EZBLD^DIALOG(34110),.XMINSTR,"",.XMABORT) ;Send
  1.  E  D
  1.  . D CHKBSKT(.XMY,.XMINSTR)
  1.  . D CHKADDR^XMXADDR(XMDUZ,.XMY,.XMINSTR) K:$D(XMERR) XMERR,^TMP("XMERR",$J)
  1.  Q:XMABORT
  1.  I '$$GOTADDR^XMXADDR S:'$D(XMMG) XMMG="Error = No recipients." Q
  1.  D BLDNSND^XMXSEND(XMDUZ,XMZ,.XMINSTR)
  1.  Q
  1. QUIT ;
  1.  K XMSUB,XMTEXT,XMY,XMSTRIP
  1.  D CLEANUP^XMXADDR
  1.  Q
  1. ENT ; Entry for outside users
  1.  ; All input variables ignored
  1.  I '$G(DUZ) W "  User ID needed (DUZ) !!" Q
  1.  D EN^XM,SEND^XMJMS
  1.  Q
  1. INIT ; From DIFROM
  1.  D XMZ^XMA2 Q:XMZ<1  S $P(^XMB(3.9,XMZ,0),U,7)="X" D NEW^XMP
  1.  Q
  1. ENT1 ; Forward a msg, do not ask for recipients
  1.  ; Needs:   DUZ,XMZ,XMY
  1.  ; Accepts: XMDUZ
  1.  ; Ignores: XMSUB,XMTEXT,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB
  1.  ; Returns: N/A
  1.  ; Kills:   XMDUZ,XMY
  1.  N XMDF
  1.  S XMDF=1
  1.  D ENT1A(0)
  1.  Q
  1. ENT1A(XMASK) ;
  1.  N XMV,XMINSTR,XMABORT
  1.  K XMERR,^TMP("XMERR",$J)
  1.  I '$G(DUZ) N DUZ D DUZ^XUP(.5)
  1.  I $G(XMDUZ)=""!($G(XMDUZ)=0) S XMDUZ=DUZ
  1.  S XMABORT=0
  1.  D:XMDUZ'?.N SETFWD(.XMDUZ,.XMINSTR)
  1.  D INITAPI^XMVVITAE
  1.  D INIT^XMXADDR
  1.  S:$D(XMDF) XMINSTR("ADDR FLAGS")="R" ; Ignore addressee restrictions
  1.  I XMASK D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT) Q:XMABORT  ;Forward
  1.  D CHKBSKT(.XMY,.XMINSTR)
  1.  D CHKADDR^XMXADDR(XMDUZ,.XMY,.XMINSTR) K:$D(XMERR) XMERR,^TMP("XMERR",$J)
  1.  I $$GOTADDR^XMXADDR D
  1.  . D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
  1.  . D CHECK^XMKPL
  1.  E  S:'$D(XMMG) XMMG="Error = No recipients."
  1.  K XMDUZ,XMY
  1.  D CLEANUP^XMXADDR
  1.  Q
  1. ENT2 ; Forward a msg, ask for (more) recipients
  1.  ; Needs:   DUZ,XMZ
  1.  ; Accepts: XMDUZ,XMY,XMDF
  1.  ; Ignores: XMSUB,XMTEXT,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB
  1.  ; Returns: N/A
  1.  ; Kills:   XMDUZ,XMY
  1.  D ENT1A($S($D(ZTQUEUED):0,1:1))
  1.  Q
  1. ENX ;FROM MAILMAN
  1.  S %=XMDUZ N XMDUZ,XMK S XMDUZ=% D XMD K %
  1.  Q
  1. ENL ; Add text to an existing message
  1.  ; Needs:   XMZ,XMTEXT
  1.  ; Accepts: XMSTRIP
  1.  ; Ignores: DUZ,XMDUZ,XMSUB,XMMG,XMY,XMROU,DIFROM,XMYBLOB
  1.  ; Returns: N/A
  1.  ; Kills:   XMSTRIP
  1.  N XMI,XMBODY
  1.  K XMERR,^TMP("XMERR",$J)
  1.  S XMBODY=$$CREF^DILF(XMTEXT)
  1.  S XMI=+$P($G(^XMB(3.9,XMZ,2,0)),U,3)
  1.  D MOVEBODY^XMXSEND(XMZ,XMBODY,"A")
  1.  D CHEKBODY^XMXSEND(XMZ,.XMSTRIP,XMI)
  1.  K XMSTRIP
  1.  Q
  1. CHKBSKT(XMTO,XMINSTR) ;
  1.  I $D(XMTO(XMDUZ,0)) S XMINSTR("SELF BSKT")=XMTO(XMDUZ,0)
  1.  I $D(XMTO(.6,0)) S XMINSTR("SHARE BSKT")=XMTO(.6,0)
  1.  I $D(XMTO(.6,"D")) S XMINSTR("SHARE DATE")=XMTO(.6,"D")
  1.  N XMADDR
  1.  S XMADDR=""
  1.  F  S XMADDR=$O(XMTO(XMADDR)) Q:XMADDR=""  I $D(XMTO(XMADDR,1)) D
  1.  . S XMTO(XMTO(XMADDR,1)_":"_XMADDR)=""
  1.  . K XMTO(XMADDR)
  1.  Q
  1. SETFROM(XMDUZ,XMINSTR) ;
  1.  Q:XMDUZ=DUZ
  1.  N XMPOSTPR
  1.  I XMDUZ=.5 D  Q:XMPOSTPR
  1.  . S XMPOSTPR=+$O(^XMB(3.7,"AB",DUZ,.5,0))
  1.  . Q:'XMPOSTPR
  1.  . I $P($G(^XMB(3.7,.5,9,XMPOSTPR,0)),U,3)'="y" S XMPOSTPR=0
  1.  I XMDUZ'="POSTMASTER",XMDUZ'=.5 D CHKUSER(.XMDUZ) Q:+XMDUZ=XMDUZ
  1.  S XMINSTR("FROM")=$$XMFROM^XMXPARM("XMDUZ",XMDUZ)
  1.  I $D(XMERR) D ERR1 Q
  1.  S XMDUZ=DUZ
  1.  Q
  1. SETFWD(XMDUZ,XMINSTR) ;
  1.  Q:XMDUZ=DUZ
  1.  I XMDUZ=.5,$D(^XMB(3.7,"AB",DUZ,.5)) Q
  1.  I XMDUZ=.5,'$D(^XMB(3.7,"AB",DUZ,.5)) S XMDUZ="POSTMASTER"
  1.  E  D CHKUSER(.XMDUZ) Q:+XMDUZ=XMDUZ
  1.  S XMINSTR("FWD BY")=$$XMFROM^XMXPARM("XMDUZ",XMDUZ)
  1.  I $D(XMERR) D ERR1 Q
  1.  S XMDUZ=DUZ
  1.  Q
  1. CHKUSER(XMDUZ) ;
  1.  N XMERR
  1.  D CHKUSER^XMXPARM1(.XMDUZ)
  1.  I $D(XMERR) K ^TMP("XMERR",$J),DIERR,^TMP("DIERR",$J)
  1.  Q