source: FOIAVistA/trunk/r/MAILMAN-XM/XMXMSGS1.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.0 KB
Line 
1XMXMSGS1 ;ISC-SF/GMB-Message APIs (cont.) ;04/19/2002 11:58
2 ;;8.0;MailMan;;Jun 28, 2002
3FWD(XMDUZ,XMZ,XMINSTR,XMCNT) ;
4XFWD ; (Need XMDUZ, XMZ, XMINSTR. XMK not needed.)
5 ; XMZREC Zero node of the msg record
6 N XMZREC,%X,%Y,XMRESTR
7 S XMZREC=^XMB(3.9,XMZ,0)
8 Q:'$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC)
9 D GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,.XMINSTR,.XMRESTR)
10 D CHKSHARE(XMDUZ,XMZ,.XMRESTR)
11 I $G(XMINSTR("ADDR FLAGS"))'["R" D CHKRESTR(XMDUZ,XMZ,.XMRESTR)
12 D FWDIT(XMDUZ,XMZ,.XMINSTR,.XMCNT)
13 I $D(^TMP("XM",$J,"SAVE")) D RESTADDR
14 Q
15CHKSHARE(XMDUZ,XMZ,XMRESTR) ;
16 I $G(XMRESTR("FLAGS"))["C",$D(^TMP("XMY",$J,.6)) D
17 . D ERRSET^XMXUTIL(39200,XMZ,XMZ)
18 . ;Confidential messages may not be forwarded to SHARED,MAIL.
19 . D SAVEADDR
20 . D CHKADDR^XMXADDR(XMDUZ,"-.6")
21 I $G(XMRESTR("FLAGS"))["X",$D(^TMP("XMY",$J,.6)) D
22 . D ERRSET^XMXUTIL(39201,XMZ,XMZ)
23 . ;Message |1| is closed. SHARED,MAIL removed as recipient.
24 . ;Closed messages may not be forwarded to SHARED,MAIL.
25 . D SAVEADDR
26 . D CHKADDR^XMXADDR(XMDUZ,"-.6")
27 Q
28CHKRESTR(XMDUZ,XMZ,XMRESTR) ;
29 N XMTO
30 I $D(XMRESTR("NOBCAST")) D
31 . ; The user is not allowed to forward this message to broadcast
32 . ; because it has replies, and users with autoforward would not
33 . ; see the replies. Search for any broadcasts and delete them.
34 . N XMOK
35 . S XMTO="",XMOK=1
36 . F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
37 . . Q:$E(XMTO)'="*"
38 . . S XMOK=0
39 . . I '$D(^TMP("XM",$J,"SAVE")) D SAVEADDR
40 . . D CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
41 . Q:XMOK
42 . D ERRSET^XMXUTIL(39205,XMZ,XMZ)
43 I $D(XMRESTR("NOFPG")) D
44 . ; The user is not allowed to forward this priority message to groups
45 . ; because s/he is not the originator and does not possess the proper
46 . ; security key. Search for any groups and delete them.
47 . N XMOK
48 . S XMTO="",XMOK=1
49 . F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
50 . . Q:$E(XMTO,1,2)'="G."
51 . . S XMOK=0
52 . . I '$D(^TMP("XM",$J,"SAVE")) D SAVEADDR
53 . . D CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
54 . Q:XMOK
55 . D ERRSET^XMXUTIL(39202,XMZ,XMZ)
56 . ;Priority message |1| not forwarded.
57 . ;Only message originator or XM GROUP PRIORITY key holders
58 . ;may forward priority messages to groups.
59 I $D(XMRESTR("NONET")) D
60 . ; The user is not allowed to forward this message to remote sites
61 . ; because it exceeds the site maximum number of lines and
62 . ; s/he does not possess the proper security key.
63 . ; Search for any remote addressees and delete them.
64 . N XMOK
65 . S XMTO="",XMOK=1
66 . F S XMTO=$O(^TMP("XMY0",$J,XMTO)) Q:XMTO="" D
67 . . Q:XMTO'["@"
68 . . S XMOK=0
69 . . I '$D(^TMP("XM",$J,"SAVE")) D SAVEADDR
70 . . D CHKADDR^XMXADDR(XMDUZ,"-"_XMTO)
71 . Q:XMOK
72 . N XMPARM S XMPARM(1)=XMZ,XMPARM(2)=XMRESTR("NONET")
73 . D ERRSET^XMXUTIL(39203,.XMPARM,XMZ)
74 . ;Message |1| not forwarded to remote recipients.
75 . ;Only XMMGR key holders may forward to remotes sites
76 . ;messages which exceed site maximum of |2| lines.
77 Q
78SAVEADDR ; Save addressees
79 S %X="^TMP(""XMY"",$J,",%Y="^TMP(""XM"",$J,""SAVE"",""XMY""," D %XY^%RCR
80 S %X="^TMP(""XMY0"",$J,",%Y="^TMP(""XM"",$J,""SAVE"",""XMY0""," D %XY^%RCR
81 Q
82RESTADDR ; Restore addressees
83 S %X="^TMP(""XM"",$J,""SAVE"",""XMY"",",%Y="^TMP(""XMY"",$J," D %XY^%RCR
84 S %X="^TMP(""XM"",$J,""SAVE"",""XMY0"",",%Y="^TMP(""XMY0"",$J," D %XY^%RCR
85 K ^TMP("XM",$J,"SAVE")
86 Q
87FWDONE(XMDUZ,XMZ,XMTO,XMINSTR,XMCNT) ; Forward one message
88XFWDONE ;
89 N XMZREC,XMRESTR
90 S XMZREC=^XMB(3.9,XMZ,0)
91 Q:'$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC)
92 D:$G(XMINSTR("ADDR FLAGS"))'["I" INIT^XMXADDR
93 D:$G(XMINSTR("ADDR FLAGS"))'["R" GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,.XMRESTR)
94 D CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR,.XMRESTR)
95 D FWDIT(XMDUZ,XMZ,.XMINSTR,.XMCNT)
96 Q
97FWDIT(XMDUZ,XMZ,XMINSTR,XMCNT) ;
98 I $$GOTADDR^XMXADDR D Q
99 . D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
100 . S:$D(XMCNT) XMCNT=XMCNT+1
101 ;Message |1| has no addressees. Not forwarded.
102 D ERRSET^XMXUTIL(39204,XMZ,XMZ)
103 Q
104PRT(XMDUZ,XMZ) ; Print
105XPRT ;
106 S ^TMP("XM",$J,"XMZ",XMZ)=""
107 S XMCNT=$G(XMCNT)+1
108 Q
109XP(XMDUZ,XMK,XMZ,XMTPRI,XMCNT) ; Toggle Transmission Priority
110XXP ;
111 S:'$G(XMK) XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
112 I XMDUZ'=.5!(XMK'>999) D Q ;Transmit priority toggle valid only
113 . D ERRSET^XMXUTIL(37219.5) ;for Postmaster transmission queues.
114 Q:XMTPRI=$P(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0),U,6)
115 N XMFDA
116 S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",6)=XMTPRI
117 D FILE^DIE("","XMFDA")
118 S:$D(XMCNT) XMCNT=XMCNT+1
119 Q
120PUTSERV(XMKN,XMZ) ; Replaces SETSB^XMA1C (ISC-WASH/ACC/IHS)
121 ; Put message in Postmaster's basket for this server.
122 ; Create server basket as needed.
123 ; XMKN Full server name (with S.)
124 ; XMZ Message number
125 ;
126 ; Messages to server are saved in a mail basket of the
127 ; Postmaster much like transmission queues. But while
128 ; Domain queues point at the domain file (domain#+1000),
129 ; Server baskets point at the option file (option#+10000).
130 N XMK
131 S XMK=$O(^DIC(19,"B",$E(XMKN,3,999),0)) Q:'XMK
132 S XMK=XMK+10000
133 D PUTMSG^XMXMSGS2(.5,XMK,XMKN,XMZ)
134 Q
135ZAPSERV(XMKN,XMZ) ; Replaces REMSBMSG^XMA1C (ISC-WASH/ACC/IHS)
136 ; Remove message from server basket
137 ; XMKN Full server name (with S.)
138 ; XMZ Message number
139 N XMK
140 S XMK=$O(^XMB(3.7,.5,2,"B",XMKN,0)) Q:'XMK Q:XMK'>10000
141 D ZAPIT^XMXMSGS2(.5,XMK,XMZ)
142 Q
Note: See TracBrowser for help on using the repository browser.