XMXMSGS1 ;ISC-SF/GMB-Message APIs (cont.) ;04/19/2002 11:58
;;8.0;MailMan;;Jun 28, 2002
FWD(XMDUZ,XMZ,XMINSTR,XMCNT) ;
XFWD ; (Need XMDUZ, XMZ, XMINSTR. XMK not needed.)
; XMZREC Zero node of the msg record
N XMZREC,%X,%Y,XMRESTR
S XMZREC=^XMB(3.9,XMZ,0)
Q:'$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC)
D GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,.XMINSTR,.XMRESTR)
D CHKSHARE(XMDUZ,XMZ,.XMRESTR)
I $G(XMINSTR("ADDR FLAGS"))'["R" D CHKRESTR(XMDUZ,XMZ,.XMRESTR)
D FWDIT(XMDUZ,XMZ,.XMINSTR,.XMCNT)
I $D(^TMP("XM",$J,"SAVE")) D RESTADDR
Q
CHKSHARE(XMDUZ,XMZ,XMRESTR) ;
I $G(XMRESTR("FLAGS"))["C",$D(^TMP("XMY",$J,.6)) D
. D ERRSET^XMXUTIL(39200,XMZ,XMZ)
. ;Confidential messages may not be forwarded to SHARED,MAIL.
. D SAVEADDR
. D CHKADDR^XMXADDR(XMDUZ,"-.6")
I $G(XMRESTR("FLAGS"))["X",$D(^TMP("XMY",$J,.6)) D
. D ERRSET^XMXUTIL(39201,XMZ,XMZ)
. ;Message |1| is closed. SHARED,MAIL removed as recipient.
. ;Closed messages may not be forwarded to SHARED,MAIL.
. D SAVEADDR
. D CHKADDR^XMXADDR(XMDUZ,"-.6")
Q
CHKRESTR(XMDUZ,XMZ,XMRESTR) ;
N XMTO
I $D(XMRESTR("NOBCAST")) D
. ; The user is not allowed to forward this message to broadcast
. ; because it has replies, and users with autoforward would not
. ; see the replies. Search for any broadcasts and delete them.
. N XMOK
. S XMTO="",XMOK=1
. F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
. . Q:$E(XMTO)'="*"
. . S XMOK=0
. . I '$D(^TMP("XM",$J,"SAVE")) D SAVEADDR
. . D CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
. Q:XMOK
. D ERRSET^XMXUTIL(39205,XMZ,XMZ)
I $D(XMRESTR("NOFPG")) D
. ; The user is not allowed to forward this priority message to groups
. ; because s/he is not the originator and does not possess the proper
. ; security key. Search for any groups and delete them.
. N XMOK
. S XMTO="",XMOK=1
. F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
. . Q:$E(XMTO,1,2)'="G."
. . S XMOK=0
. . I '$D(^TMP("XM",$J,"SAVE")) D SAVEADDR
. . D CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
. Q:XMOK
. D ERRSET^XMXUTIL(39202,XMZ,XMZ)
. ;Priority message |1| not forwarded.
. ;Only message originator or XM GROUP PRIORITY key holders
. ;may forward priority messages to groups.
I $D(XMRESTR("NONET")) D
. ; The user is not allowed to forward this message to remote sites
. ; because it exceeds the site maximum number of lines and
. ; s/he does not possess the proper security key.
. ; Search for any remote addressees and delete them.
. N XMOK
. S XMTO="",XMOK=1
. F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
. . Q:XMTO'["@"
. . S XMOK=0
. . I '$D(^TMP("XM",$J,"SAVE")) D SAVEADDR
. . D CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
. Q:XMOK
. N XMPARM S XMPARM(1)=XMZ,XMPARM(2)=XMRESTR("NONET")
. D ERRSET^XMXUTIL(39203,.XMPARM,XMZ)
. ;Message |1| not forwarded to remote recipients.
. ;Only XMMGR key holders may forward to remotes sites
. ;messages which exceed site maximum of |2| lines.
Q
SAVEADDR ; Save addressees
S %X="^TMP(""XMY"",$J,",%Y="^TMP(""XM"",$J,""SAVE"",""XMY""," D %XY^%RCR
S %X="^TMP(""XMY0"",$J,",%Y="^TMP(""XM"",$J,""SAVE"",""XMY0""," D %XY^%RCR
Q
RESTADDR ; Restore addressees
S %X="^TMP(""XM"",$J,""SAVE"",""XMY"",",%Y="^TMP(""XMY"",$J," D %XY^%RCR
S %X="^TMP(""XM"",$J,""SAVE"",""XMY0"",",%Y="^TMP(""XMY0"",$J," D %XY^%RCR
K ^TMP("XM",$J,"SAVE")
Q
FWDONE(XMDUZ,XMZ,XMTO,XMINSTR,XMCNT) ; Forward one message
XFWDONE ;
N XMZREC,XMRESTR
S XMZREC=^XMB(3.9,XMZ,0)
Q:'$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC)
D:$G(XMINSTR("ADDR FLAGS"))'["I" INIT^XMXADDR
D:$G(XMINSTR("ADDR FLAGS"))'["R" GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,.XMRESTR)
D CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR,.XMRESTR)
D FWDIT(XMDUZ,XMZ,.XMINSTR,.XMCNT)
Q
FWDIT(XMDUZ,XMZ,XMINSTR,XMCNT) ;
I $$GOTADDR^XMXADDR D Q
. D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
. S:$D(XMCNT) XMCNT=XMCNT+1
;Message |1| has no addressees. Not forwarded.
D ERRSET^XMXUTIL(39204,XMZ,XMZ)
Q
PRT(XMDUZ,XMZ) ; Print
XPRT ;
S ^TMP("XM",$J,"XMZ",XMZ)=""
S XMCNT=$G(XMCNT)+1
Q
XP(XMDUZ,XMK,XMZ,XMTPRI,XMCNT) ; Toggle Transmission Priority
XXP ;
S:'$G(XMK) XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
I XMDUZ'=.5!(XMK'>999) D Q ;Transmit priority toggle valid only
. D ERRSET^XMXUTIL(37219.5) ;for Postmaster transmission queues.
Q:XMTPRI=$P(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0),U,6)
N XMFDA
S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",6)=XMTPRI
D FILE^DIE("","XMFDA")
S:$D(XMCNT) XMCNT=XMCNT+1
Q
PUTSERV(XMKN,XMZ) ; Replaces SETSB^XMA1C (ISC-WASH/ACC/IHS)
; Put message in Postmaster's basket for this server.
; Create server basket as needed.
; XMKN Full server name (with S.)
; XMZ Message number
;
; Messages to server are saved in a mail basket of the
; Postmaster much like transmission queues. But while
; Domain queues point at the domain file (domain#+1000),
; Server baskets point at the option file (option#+10000).
N XMK
S XMK=$O(^DIC(19,"B",$E(XMKN,3,999),0)) Q:'XMK
S XMK=XMK+10000
D PUTMSG^XMXMSGS2(.5,XMK,XMKN,XMZ)
Q
ZAPSERV(XMKN,XMZ) ; Replaces REMSBMSG^XMA1C (ISC-WASH/ACC/IHS)
; Remove message from server basket
; XMKN Full server name (with S.)
; XMZ Message number
N XMK
S XMK=$O(^XMB(3.7,.5,2,"B",XMKN,0)) Q:'XMK Q:XMK'>10000
D ZAPIT^XMXMSGS2(.5,XMK,XMZ)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXMSGS1 5290 printed Dec 13, 2024@02:14:16 Page 2
XMXMSGS1 ;ISC-SF/GMB-Message APIs (cont.) ;04/19/2002 11:58
+1 ;;8.0;MailMan;;Jun 28, 2002
FWD(XMDUZ,XMZ,XMINSTR,XMCNT) ;
XFWD ; (Need XMDUZ, XMZ, XMINSTR. XMK not needed.)
+1 ; XMZREC Zero node of the msg record
+2 NEW XMZREC,%X,%Y,XMRESTR
+3 SET XMZREC=^XMB(3.9,XMZ,0)
+4 if '$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC)
QUIT
+5 DO GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,.XMINSTR,.XMRESTR)
+6 DO CHKSHARE(XMDUZ,XMZ,.XMRESTR)
+7 IF $GET(XMINSTR("ADDR FLAGS"))'["R"
DO CHKRESTR(XMDUZ,XMZ,.XMRESTR)
+8 DO FWDIT(XMDUZ,XMZ,.XMINSTR,.XMCNT)
+9 IF $DATA(^TMP("XM",$JOB,"SAVE"))
DO RESTADDR
+10 QUIT
CHKSHARE(XMDUZ,XMZ,XMRESTR) ;
+1 IF $GET(XMRESTR("FLAGS"))["C"
IF $DATA(^TMP("XMY",$JOB,.6))
Begin DoDot:1
+2 DO ERRSET^XMXUTIL(39200,XMZ,XMZ)
+3 ;Confidential messages may not be forwarded to SHARED,MAIL.
+4 DO SAVEADDR
+5 DO CHKADDR^XMXADDR(XMDUZ,"-.6")
End DoDot:1
+6 IF $GET(XMRESTR("FLAGS"))["X"
IF $DATA(^TMP("XMY",$JOB,.6))
Begin DoDot:1
+7 DO ERRSET^XMXUTIL(39201,XMZ,XMZ)
+8 ;Message |1| is closed. SHARED,MAIL removed as recipient.
+9 ;Closed messages may not be forwarded to SHARED,MAIL.
+10 DO SAVEADDR
+11 DO CHKADDR^XMXADDR(XMDUZ,"-.6")
End DoDot:1
+12 QUIT
CHKRESTR(XMDUZ,XMZ,XMRESTR) ;
+1 NEW XMTO
+2 IF $DATA(XMRESTR("NOBCAST"))
Begin DoDot:1
+3 ; The user is not allowed to forward this message to broadcast
+4 ; because it has replies, and users with autoforward would not
+5 ; see the replies. Search for any broadcasts and delete them.
+6 NEW XMOK
+7 SET XMTO=""
SET XMOK=1
+8 FOR
SET XMTO=$ORDER(^TMP("XMY0",$JOB,XMTO))
if XMTO=""
QUIT
Begin DoDot:2
+9 if $EXTRACT(XMTO)'="*"
QUIT
+10 SET XMOK=0
+11 IF '$DATA(^TMP("XM",$JOB,"SAVE"))
DO SAVEADDR
+12 DO CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
End DoDot:2
+13 if XMOK
QUIT
+14 DO ERRSET^XMXUTIL(39205,XMZ,XMZ)
End DoDot:1
+15 IF $DATA(XMRESTR("NOFPG"))
Begin DoDot:1
+16 ; The user is not allowed to forward this priority message to groups
+17 ; because s/he is not the originator and does not possess the proper
+18 ; security key. Search for any groups and delete them.
+19 NEW XMOK
+20 SET XMTO=""
SET XMOK=1
+21 FOR
SET XMTO=$ORDER(^TMP("XMY0",$JOB,XMTO))
if XMTO=""
QUIT
Begin DoDot:2
+22 if $EXTRACT(XMTO,1,2)'="G."
QUIT
+23 SET XMOK=0
+24 IF '$DATA(^TMP("XM",$JOB,"SAVE"))
DO SAVEADDR
+25 DO CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
End DoDot:2
+26 if XMOK
QUIT
+27 DO ERRSET^XMXUTIL(39202,XMZ,XMZ)
+28 ;Priority message |1| not forwarded.
+29 ;Only message originator or XM GROUP PRIORITY key holders
+30 ;may forward priority messages to groups.
End DoDot:1
+31 IF $DATA(XMRESTR("NONET"))
Begin DoDot:1
+32 ; The user is not allowed to forward this message to remote sites
+33 ; because it exceeds the site maximum number of lines and
+34 ; s/he does not possess the proper security key.
+35 ; Search for any remote addressees and delete them.
+36 NEW XMOK
+37 SET XMTO=""
SET XMOK=1
+38 FOR
SET XMTO=$ORDER(^TMP("XMY0",$JOB,XMTO))
if XMTO=""
QUIT
Begin DoDot:2
+39 if XMTO'["@"
QUIT
+40 SET XMOK=0
+41 IF '$DATA(^TMP("XM",$JOB,"SAVE"))
DO SAVEADDR
+42 DO CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
End DoDot:2
+43 if XMOK
QUIT
+44 NEW XMPARM
SET XMPARM(1)=XMZ
SET XMPARM(2)=XMRESTR("NONET")
+45 DO ERRSET^XMXUTIL(39203,.XMPARM,XMZ)
+46 ;Message |1| not forwarded to remote recipients.
+47 ;Only XMMGR key holders may forward to remotes sites
+48 ;messages which exceed site maximum of |2| lines.
End DoDot:1
+49 QUIT
SAVEADDR ; Save addressees
+1 SET %X="^TMP(""XMY"",$J,"
SET %Y="^TMP(""XM"",$J,""SAVE"",""XMY"","
DO %XY^%RCR
+2 SET %X="^TMP(""XMY0"",$J,"
SET %Y="^TMP(""XM"",$J,""SAVE"",""XMY0"","
DO %XY^%RCR
+3 QUIT
RESTADDR ; Restore addressees
+1 SET %X="^TMP(""XM"",$J,""SAVE"",""XMY"","
SET %Y="^TMP(""XMY"",$J,"
DO %XY^%RCR
+2 SET %X="^TMP(""XM"",$J,""SAVE"",""XMY0"","
SET %Y="^TMP(""XMY0"",$J,"
DO %XY^%RCR
+3 KILL ^TMP("XM",$JOB,"SAVE")
+4 QUIT
FWDONE(XMDUZ,XMZ,XMTO,XMINSTR,XMCNT) ; Forward one message
XFWDONE ;
+1 NEW XMZREC,XMRESTR
+2 SET XMZREC=^XMB(3.9,XMZ,0)
+3 if '$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC)
QUIT
+4 if $GET(XMINSTR("ADDR FLAGS"))'["I"
DO INIT^XMXADDR
+5 if $GET(XMINSTR("ADDR FLAGS"))'["R"
DO GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,.XMRESTR)
+6 DO CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR,.XMRESTR)
+7 DO FWDIT(XMDUZ,XMZ,.XMINSTR,.XMCNT)
+8 QUIT
FWDIT(XMDUZ,XMZ,XMINSTR,XMCNT) ;
+1 IF $$GOTADDR^XMXADDR
Begin DoDot:1
+2 DO FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
+3 if $DATA(XMCNT)
SET XMCNT=XMCNT+1
End DoDot:1
QUIT
+4 ;Message |1| has no addressees. Not forwarded.
+5 DO ERRSET^XMXUTIL(39204,XMZ,XMZ)
+6 QUIT
PRT(XMDUZ,XMZ) ; Print
XPRT ;
+1 SET ^TMP("XM",$JOB,"XMZ",XMZ)=""
+2 SET XMCNT=$GET(XMCNT)+1
+3 QUIT
XP(XMDUZ,XMK,XMZ,XMTPRI,XMCNT) ; Toggle Transmission Priority
XXP ;
+1 if '$GET(XMK)
SET XMK=$ORDER(^XMB(3.7,"M",XMZ,XMDUZ,""))
+2 ;Transmit priority toggle valid only
IF XMDUZ'=.5!(XMK'>999)
Begin DoDot:1
+3 ;for Postmaster transmission queues.
DO ERRSET^XMXUTIL(37219.5)
End DoDot:1
QUIT
+4 if XMTPRI=$PIECE(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0),U,6)
QUIT
+5 NEW XMFDA
+6 SET XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",6)=XMTPRI
+7 DO FILE^DIE("","XMFDA")
+8 if $DATA(XMCNT)
SET XMCNT=XMCNT+1
+9 QUIT
PUTSERV(XMKN,XMZ) ; Replaces SETSB^XMA1C (ISC-WASH/ACC/IHS)
+1 ; Put message in Postmaster's basket for this server.
+2 ; Create server basket as needed.
+3 ; XMKN Full server name (with S.)
+4 ; XMZ Message number
+5 ;
+6 ; Messages to server are saved in a mail basket of the
+7 ; Postmaster much like transmission queues. But while
+8 ; Domain queues point at the domain file (domain#+1000),
+9 ; Server baskets point at the option file (option#+10000).
+10 NEW XMK
+11 SET XMK=$ORDER(^DIC(19,"B",$EXTRACT(XMKN,3,999),0))
if 'XMK
QUIT
+12 SET XMK=XMK+10000
+13 DO PUTMSG^XMXMSGS2(.5,XMK,XMKN,XMZ)
+14 QUIT
ZAPSERV(XMKN,XMZ) ; Replaces REMSBMSG^XMA1C (ISC-WASH/ACC/IHS)
+1 ; Remove message from server basket
+2 ; XMKN Full server name (with S.)
+3 ; XMZ Message number
+4 NEW XMK
+5 SET XMK=$ORDER(^XMB(3.7,.5,2,"B",XMKN,0))
if 'XMK
QUIT
if XMK'>10000
QUIT
+6 DO ZAPIT^XMXMSGS2(.5,XMK,XMZ)
+7 QUIT
