- 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 Feb 18, 2025@23:40:27 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