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

XMXMSGS1.m

Go to the documentation of this file.
  1. XMXMSGS1 ;ISC-SF/GMB-Message APIs (cont.) ;04/19/2002 11:58
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. FWD(XMDUZ,XMZ,XMINSTR,XMCNT) ;
  1. XFWD ; (Need XMDUZ, XMZ, XMINSTR. XMK not needed.)
  1. ; XMZREC Zero node of the msg record
  1. N XMZREC,%X,%Y,XMRESTR
  1. S XMZREC=^XMB(3.9,XMZ,0)
  1. Q:'$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC)
  1. D GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,.XMINSTR,.XMRESTR)
  1. D CHKSHARE(XMDUZ,XMZ,.XMRESTR)
  1. I $G(XMINSTR("ADDR FLAGS"))'["R" D CHKRESTR(XMDUZ,XMZ,.XMRESTR)
  1. D FWDIT(XMDUZ,XMZ,.XMINSTR,.XMCNT)
  1. I $D(^TMP("XM",$J,"SAVE")) D RESTADDR
  1. Q
  1. CHKSHARE(XMDUZ,XMZ,XMRESTR) ;
  1. I $G(XMRESTR("FLAGS"))["C",$D(^TMP("XMY",$J,.6)) D
  1. . D ERRSET^XMXUTIL(39200,XMZ,XMZ)
  1. . ;Confidential messages may not be forwarded to SHARED,MAIL.
  1. . D SAVEADDR
  1. . D CHKADDR^XMXADDR(XMDUZ,"-.6")
  1. I $G(XMRESTR("FLAGS"))["X",$D(^TMP("XMY",$J,.6)) D
  1. . D ERRSET^XMXUTIL(39201,XMZ,XMZ)
  1. . ;Message |1| is closed. SHARED,MAIL removed as recipient.
  1. . ;Closed messages may not be forwarded to SHARED,MAIL.
  1. . D SAVEADDR
  1. . D CHKADDR^XMXADDR(XMDUZ,"-.6")
  1. Q
  1. CHKRESTR(XMDUZ,XMZ,XMRESTR) ;
  1. N XMTO
  1. I $D(XMRESTR("NOBCAST")) D
  1. . ; The user is not allowed to forward this message to broadcast
  1. . ; because it has replies, and users with autoforward would not
  1. . ; see the replies. Search for any broadcasts and delete them.
  1. . N XMOK
  1. . S XMTO="",XMOK=1
  1. . F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
  1. . . Q:$E(XMTO)'="*"
  1. . . S XMOK=0
  1. . . I '$D(^TMP("XM",$J,"SAVE")) D SAVEADDR
  1. . . D CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
  1. . Q:XMOK
  1. . D ERRSET^XMXUTIL(39205,XMZ,XMZ)
  1. I $D(XMRESTR("NOFPG")) D
  1. . ; The user is not allowed to forward this priority message to groups
  1. . ; because s/he is not the originator and does not possess the proper
  1. . ; security key. Search for any groups and delete them.
  1. . N XMOK
  1. . S XMTO="",XMOK=1
  1. . F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
  1. . . Q:$E(XMTO,1,2)'="G."
  1. . . S XMOK=0
  1. . . I '$D(^TMP("XM",$J,"SAVE")) D SAVEADDR
  1. . . D CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
  1. . Q:XMOK
  1. . D ERRSET^XMXUTIL(39202,XMZ,XMZ)
  1. . ;Priority message |1| not forwarded.
  1. . ;Only message originator or XM GROUP PRIORITY key holders
  1. . ;may forward priority messages to groups.
  1. I $D(XMRESTR("NONET")) D
  1. . ; The user is not allowed to forward this message to remote sites
  1. . ; because it exceeds the site maximum number of lines and
  1. . ; s/he does not possess the proper security key.
  1. . ; Search for any remote addressees and delete them.
  1. . N XMOK
  1. . S XMTO="",XMOK=1
  1. . F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
  1. . . Q:XMTO'["@"
  1. . . S XMOK=0
  1. . . I '$D(^TMP("XM",$J,"SAVE")) D SAVEADDR
  1. . . D CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
  1. . Q:XMOK
  1. . N XMPARM S XMPARM(1)=XMZ,XMPARM(2)=XMRESTR("NONET")
  1. . D ERRSET^XMXUTIL(39203,.XMPARM,XMZ)
  1. . ;Message |1| not forwarded to remote recipients.
  1. . ;Only XMMGR key holders may forward to remotes sites
  1. . ;messages which exceed site maximum of |2| lines.
  1. Q
  1. SAVEADDR ; Save addressees
  1. S %X="^TMP(""XMY"",$J,",%Y="^TMP(""XM"",$J,""SAVE"",""XMY""," D %XY^%RCR
  1. S %X="^TMP(""XMY0"",$J,",%Y="^TMP(""XM"",$J,""SAVE"",""XMY0""," D %XY^%RCR
  1. Q
  1. RESTADDR ; Restore addressees
  1. S %X="^TMP(""XM"",$J,""SAVE"",""XMY"",",%Y="^TMP(""XMY"",$J," D %XY^%RCR
  1. S %X="^TMP(""XM"",$J,""SAVE"",""XMY0"",",%Y="^TMP(""XMY0"",$J," D %XY^%RCR
  1. K ^TMP("XM",$J,"SAVE")
  1. Q
  1. FWDONE(XMDUZ,XMZ,XMTO,XMINSTR,XMCNT) ; Forward one message
  1. XFWDONE ;
  1. N XMZREC,XMRESTR
  1. S XMZREC=^XMB(3.9,XMZ,0)
  1. Q:'$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC)
  1. D:$G(XMINSTR("ADDR FLAGS"))'["I" INIT^XMXADDR
  1. D:$G(XMINSTR("ADDR FLAGS"))'["R" GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,.XMRESTR)
  1. D CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR,.XMRESTR)
  1. D FWDIT(XMDUZ,XMZ,.XMINSTR,.XMCNT)
  1. Q
  1. FWDIT(XMDUZ,XMZ,XMINSTR,XMCNT) ;
  1. I $$GOTADDR^XMXADDR D Q
  1. . D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
  1. . S:$D(XMCNT) XMCNT=XMCNT+1
  1. ;Message |1| has no addressees. Not forwarded.
  1. D ERRSET^XMXUTIL(39204,XMZ,XMZ)
  1. Q
  1. PRT(XMDUZ,XMZ) ; Print
  1. XPRT ;
  1. S ^TMP("XM",$J,"XMZ",XMZ)=""
  1. S XMCNT=$G(XMCNT)+1
  1. Q
  1. XP(XMDUZ,XMK,XMZ,XMTPRI,XMCNT) ; Toggle Transmission Priority
  1. XXP ;
  1. S:'$G(XMK) XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
  1. I XMDUZ'=.5!(XMK'>999) D Q ;Transmit priority toggle valid only
  1. . D ERRSET^XMXUTIL(37219.5) ;for Postmaster transmission queues.
  1. Q:XMTPRI=$P(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0),U,6)
  1. N XMFDA
  1. S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",6)=XMTPRI
  1. D FILE^DIE("","XMFDA")
  1. S:$D(XMCNT) XMCNT=XMCNT+1
  1. Q
  1. PUTSERV(XMKN,XMZ) ; Replaces SETSB^XMA1C (ISC-WASH/ACC/IHS)
  1. ; Put message in Postmaster's basket for this server.
  1. ; Create server basket as needed.
  1. ; XMKN Full server name (with S.)
  1. ; XMZ Message number
  1. ;
  1. ; Messages to server are saved in a mail basket of the
  1. ; Postmaster much like transmission queues. But while
  1. ; Domain queues point at the domain file (domain#+1000),
  1. ; Server baskets point at the option file (option#+10000).
  1. N XMK
  1. S XMK=$O(^DIC(19,"B",$E(XMKN,3,999),0)) Q:'XMK
  1. S XMK=XMK+10000
  1. D PUTMSG^XMXMSGS2(.5,XMK,XMKN,XMZ)
  1. Q
  1. ZAPSERV(XMKN,XMZ) ; Replaces REMSBMSG^XMA1C (ISC-WASH/ACC/IHS)
  1. ; Remove message from server basket
  1. ; XMKN Full server name (with S.)
  1. ; XMZ Message number
  1. N XMK
  1. S XMK=$O(^XMB(3.7,.5,2,"B",XMKN,0)) Q:'XMK Q:XMK'>10000
  1. D ZAPIT^XMXMSGS2(.5,XMK,XMZ)
  1. Q