source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMXMSGS.m@ 1800

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

initial load of WorldVistAEHR
File size: 6.5 KB
RevLine 
[613]1XMXMSGS ;ISC-SF/GMB-Message APIs ;08/06/2002 06:45
2 ;;8.0;MailMan;;Jun 28, 2002
3DELMSG(XMDUZ,XMK,XMKZA,XMMSG) ; Delete msgs in mailbox
4 K XMERR,^TMP("XMERR",$J)
5 I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
6 D ACTMSG("XDEL^XMXMSGS2",34302) ;,XMDUZ,XMK,.XMKZA,"",.XMMSG)
7 Q
8FLTRMSG(XMDUZ,XMK,XMKZA,XMMSG) ; Filter msgs
9 K XMERR,^TMP("XMERR",$J)
10 I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
11 N XMKN,XMKTO,XMKNTO
12 I $G(XMK)'=.5,'$G(XMK),'$D(^XMB(3.7,XMDUZ,15,"AF")) D ERRSET^XMXUTIL(37204.1) Q ; You have no message filters defined.
13 I $G(XMK) S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
14 D ACTMSG("XFLTR^XMXMSGS2",34306) ;,XMDUZ,XMK,XMKN,.XMKZA,"",.XMMSG)
15 Q
16FWDMSG(XMDUZ,XMK,XMKZA,XMTO,XMINSTR,XMMSG) ; Forward msgs
17 ; XMINSTR("SHARE DATE") delete date if SHARED,MAIL is recipient
18 ; XMINSTR("SHARE BSKT") basket if SHARED,MAIL is recipient
19 K XMERR,^TMP("XMERR",$J)
20 I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
21 N XMRTN
22 I $$ONEMSG(.XMKZA) D
23 . S XMRTN="XFWDONE^XMXMSGS1" ; just one msg
24 E D
25 . S XMRTN="XFWD^XMXMSGS1"
26 . I $G(XMINSTR("ADDR FLAGS"))'["I" D INIT^XMXADDR
27 . D CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR)
28 D ACTMSG(XMRTN,34309) ;,XMDUZ,XMK,.XMKZA,.XMINSTR,.XMMSG)
29 D CLEANUP^XMXADDR
30 Q
31ONEMSG(XMKZA) ; Function decides if just one message
32 N XMONE,XMMSGS
33 I $G(XMKZA)]"" D Q XMONE
34 . I $O(XMKZA(""))="",+XMKZA=XMKZA S XMONE=1 Q
35 . S XMONE=0
36 S XMMSGS=$O(XMKZA(""))
37 I $O(XMKZA(XMMSGS))'="" Q 0
38 I +XMMSGS=XMMSGS Q 1
39 Q 0
40LATERMSG(XMDUZ,XMK,XMKZA,XMINSTR,XMMSG) ; Later msgs
41 ; XMINSTR("LATER") FM date/time when msg should be made new.
42 K XMERR,^TMP("XMERR",$J)
43 Q:'$$LATER^XMXSEC(XMDUZ)
44 N XMWHEN
45 S XMWHEN=$G(XMINSTR("LATER"),$G(XMINSTR))
46 D ACTMSG("XLATER^XMXMSGS2",34312) ;,XMDUZ,XMK,.XMKZA,.XMINSTR,.XMMSG)
47 Q
48MOVEMSG(XMDUZ,XMK,XMKZA,XMKTO,XMMSG) ; Move msgs to a basket
49 K XMERR,^TMP("XMERR",$J)
50 I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
51 Q:$G(XMK)=XMKTO
52 D ACTMSG("XMOVE^XMXMSGS2",34324) ;,XMDUZ,XMK,.XMKZA,XMKTO,.XMMSG)
53 Q
54NTOGLMSG(XMDUZ,XMK,XMKZA,XMMSG) ; New toggle msgs
55 K XMERR,^TMP("XMERR",$J)
56 Q:'$$LATER^XMXSEC(XMDUZ)
57 N XMKN,XMKTO,XMKNTO
58 S:XMK XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
59 D ACTMSG("XNTOGL^XMXMSGS2",34315) ;,XMDUZ,XMK,XMKN,.XMKZA,"",.XMMSG)
60 Q
61PRTMSG(XMDUZ,XMK,XMKZA,XMPRTTO,XMINSTR,XMMSG,XMTASK,XMSUBJ,XMTO) ; Print msgs
62 K XMERR,^TMP("XMERR",$J),^TMP("XM",$J,"XMZ")
63 D ACTMSG("XPRT^XMXMSGS1",34320) ;,XMDUZ,XMK,.XMKZA,.XMINSTR,.XMMSG)
64 Q:+XMMSG=0
65 I +XMMSG=1 D
66 . D PRINT1^XMXPRT(XMDUZ,$O(^TMP("XM",$J,"XMZ","")),XMPRTTO,.XMINSTR,.XMTASK,.XMSUBJ,.XMTO)
67 E D
68 . D PRINTM^XMXPRT(XMDUZ,XMPRTTO,.XMINSTR,.XMTASK,.XMSUBJ,.XMTO)
69 K ^TMP("XM",$J,"XMZ")
70 Q:$D(XMTASK)
71 S XMMSG=$$EZBLD^DIALOG(34321) ; 0 messages sent to printer. TaskMan Problem.
72 D ERRSET^XMXUTIL(34311) ; Task creation not successful.
73 Q
74TERMMSG(XMDUZ,XMK,XMKZA,XMMSG) ; Terminate msgs
75 K XMERR,^TMP("XMERR",$J)
76 I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
77 D ACTMSG("XTERM^XMXMSGS2",34329) ;,XMDUZ,XMK,.XMKZA,"",.XMMSG)
78 Q
79VAPORMSG(XMDUZ,XMK,XMKZA,XMINSTR,XMMSG) ; Set vaporize dates for msgs in mailbox
80 K XMERR,^TMP("XMERR",$J)
81 I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
82 N XMWHEN
83 S XMWHEN=$G(XMINSTR("VAPOR"),$G(XMINSTR))
84 D ACTMSG("XVAPOR^XMXMSGS2",$S(XMWHEN="@":34337.2,1:34337)) ;,XMDUZ,XMK,.XMKZA,XMWHEN,.XMMSG)
85 Q
86XPMSG(XMDUZ,XMK,XMKZA,XMINSTR,XMMSG) ; Postmaster transmit priority toggle
87 K XMERR,^TMP("XMERR",$J)
88 I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
89 I XMDUZ'=.5!(XMK'>999) D ERRSET^XMXUTIL(37219.5) Q ;Transmission Priority toggle valid only for Postmaster Transmission Queues.
90 N XMTPRI
91 S XMTPRI=$G(XMINSTR("XMIT PRI"),$G(XMINSTR))
92 D ACTMSG("XXP^XMXMSGS1",34334) ;,XMDUZ,XMK,.XMKZA,XMTPRI,.XMMSG)
93 Q
94ACTMSG(XMRTN,XMSUM) ;,XMDUZ,XMK,XMKZA,XMKTO,XMMSG)
95 ; XMKZA Array of msg numbers DEL("1-3,7,11-15")
96 ; XMKZL List of msg numbers 1-3,7,11-15
97 ; (It is OK if the list ends with a comma)
98 ; XMKZR Range of msg numbers 1-3
99 ; XMKZ1 First number in range 1
100 ; XMKZN Last number in range 3
101 ; XMKZ Message number
102 N XMCNT,XMI,XMZ,XMPIECES
103 S XMCNT=0
104 I $G(XMK) D
105 . N XMKZ,XMKZL,XMKZR,XMKZ1,XMKZN
106 . ; is this an array or a variable?
107 . I $G(XMKZA)]"",$O(XMKZA(""))="" S XMKZA(XMKZA)=""
108 . S XMKZL=""
109 . F S XMKZL=$O(XMKZA(XMKZL)) Q:XMKZL="" D
110 . . S XMPIECES=$L(XMKZL,",")
111 . . S:$P(XMKZL,",",XMPIECES)="" XMPIECES=XMPIECES-1
112 . . F XMI=1:1:XMPIECES D
113 . . . S XMKZR=$P(XMKZL,",",XMI)
114 . . . I XMKZR["-" D
115 . . . . ; deal with a range of msg #s
116 . . . . S XMKZ1=$P(XMKZR,"-",1)
117 . . . . S XMKZN=$P(XMKZR,"-",2)
118 . . . . I XMKZ1>XMKZN D Q
119 . . . . . N XMPARM
120 . . . . . S XMPARM(1)=XMKZ1,XMPARM(2)=XMKZN
121 . . . . . D ERRSET^XMXUTIL(34350,.XMPARM) ; Range '_XMKZ1_-_XMKZN_' invalid.
122 . . . . S XMKZ=XMKZ1-.1
123 . . . . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:'XMKZ!(XMKZ>XMKZN) D
124 . . . . . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
125 . . . . . I 'XMZ D Q
126 . . . . . . N XMPARM
127 . . . . . . S XMPARM(1)=XMKZ,XMPARM(2)=XMK
128 . . . . . . D ERRSET^XMXUTIL(34351,.XMPARM) ; Message _XMKZ_ in basket _XMK_ does not exist.
129 . . . . . I '$D(^XMB(3.9,XMZ,0)) D Q
130 . . . . . . N XMPARM
131 . . . . . . S XMPARM(1)=XMZ,XMPARM(2)=XMKZ,XMPARM(3)=XMK
132 . . . . . . D ERRSET^XMXUTIL(34352,.XMPARM) ; Message '_XMZ_' (message _XMKZ_ in basket _XMK_) does not exist.
133 . . . . . D @XMRTN ;(XMDUZ,XMK,XMZ)
134 . . . E D
135 . . . . S XMKZ=XMKZR
136 . . . . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
137 . . . . I 'XMZ D Q
138 . . . . . N XMPARM
139 . . . . . S XMPARM(1)=XMKZ,XMPARM(2)=XMK
140 . . . . . D ERRSET^XMXUTIL(34351,.XMPARM) ; Message _XMKZ_ in basket _XMK_ does not exist.
141 . . . . I '$D(^XMB(3.9,XMZ,0)) D Q
142 . . . . . N XMPARM
143 . . . . . S XMPARM(1)=XMZ,XMPARM(2)=XMKZ,XMPARM(3)=XMK
144 . . . . . D ERRSET^XMXUTIL(34352,.XMPARM) ; Message '_XMZ_' (message _XMKZ_ in basket _XMK_) does not exist.
145 . . . . D @XMRTN ;(XMDUZ,XMK,XMZ)
146 E D
147 . N XMZL,XMZREC
148 . ; is this an array or a variable?
149 . I $G(XMKZA)]"",$O(XMKZA(""))="" S XMKZA(XMKZA)=""
150 . S XMZL=""
151 . F S XMZL=$O(XMKZA(XMZL)) Q:XMZL="" D
152 . . I XMZL["-" D ERRSET^XMXUTIL(34353) Q ; XMZ message ranges are not allowed.
153 . . S XMPIECES=$L(XMZL,",")
154 . . S:'$P(XMZL,",",XMPIECES) XMPIECES=XMPIECES-1
155 . . F XMI=1:1:XMPIECES D
156 . . . N XMK
157 . . . S XMZ=$P(XMZL,",",XMI)
158 . . . I '$D(^XMB(3.9,XMZ,0)) D ERRSET^XMXUTIL(34354,XMZ) Q ; Message '_XMZ_' does not exist."
159 . . . S XMZREC=$G(^XMB(3.9,XMZ,0))
160 . . . Q:'$$ACCESS^XMXSEC(XMDUZ,XMZ,XMZREC)
161 . . . D @XMRTN ;(XMDUZ,XMK,XMZ)
162 S XMMSG=$$EZBLD^DIALOG($S(XMCNT=1:XMSUM+.1,1:XMSUM),XMCNT)
163 D INCRDECR(XMDUZ,.XMCNT)
164 Q
165INCRDECR(XMDUZ,XMCNT) ; Update the "new messages" counts.
166 N XMK
167 S XMK=0
168 F S XMK=$O(XMCNT(XMK)) Q:'XMK D
169 . S XMCNT=$G(XMCNT(XMK,"INCR"))-$G(XMCNT(XMK,"DECR"))
170 . Q:'XMCNT
171 . I XMCNT<0 D DECRNEW^XMXUTIL(XMDUZ,XMK,-XMCNT) Q
172 . D INCRNEW^XMXUTIL(XMDUZ,XMK,XMCNT)
173 Q
Note: See TracBrowser for help on using the repository browser.