source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMXMSGS2.m@ 1661

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

initial load of WorldVistAEHR
File size: 7.0 KB
RevLine 
[613]1XMXMSGS2 ;ISC-SF/GMB-Message APIs (cont.) ;03/25/2003 15:04
2 ;;8.0;MailMan;**16**;Jun 28, 2002
3DEL(XMDUZ,XMK,XMZ,XMCNT) ; For many messages, pass in XMCNT; for 1, don't
4XDEL ;
5 I '$G(XMK) S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,"")) Q:'XMK
6 I XMDUZ'=DUZ,'$$DELETE^XMXSEC(XMDUZ,XMK,XMZ) Q
7 S:$D(XMCNT) XMCNT=XMCNT+1
8 D ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)
9 D WASTEIT(XMDUZ,XMK,XMZ)
10 Q
11FLTR(XMDUZ,XMK,XMKN,XMZ,XMCNT,XMKTO,XMKNTO) ; Filter message
12XFLTR ;
13 ; XMK (in) the basket # the message is currently in. (May be 0 if
14 ; the message isn't currently in a basket.)
15 ; XMKN (in) the name of basket XMK
16 ; XMKTO (out) the basket # this routine decides to put the message in
17 ; XMKNTO (out) the name of basket XMKTO
18 ; This routine decides which basket the message belongs in.
19 ; If this is the same basket it is currently in, it sets XMKTO and
20 ; XMKNTO to the current basket.
21 ; Otherwise, it moves the message (from the current basket) to the
22 ; decided-upon basket and sets XMKTO and XMKNTO to that basket.
23 ; If the message is in the WASTE basket, and no filters are defined,
24 ; it will be moved to the IN basket.
25 I '$G(XMK) D
26 . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
27 . S:XMK XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
28 I XMDUZ=.6,XMK'=.5,'$$MOVE^XMXSEC(XMDUZ,XMZ) Q
29 S:$D(XMCNT) XMCNT=XMCNT+1
30 I $D(^XMB(3.7,XMDUZ,15,"AF")) D
31 . N XMZREC
32 . S XMZREC=$G(^XMB(3.9,XMZ,0))
33 . D FILTER^XMTDF(XMDUZ,XMZ,$P(XMZREC,U,1),$P(XMZREC,U,2),.XMKTO,.XMKNTO)
34 . I XMKTO=1,XMK>1 S XMKTO=XMK,XMKNTO=XMKN
35 E I XMK>1 S XMKTO=XMK,XMKNTO=XMKN
36 E S XMKTO=1,XMKNTO=$$EZBLD^DIALOG(37005) ; "IN"
37 Q:XMK=XMKTO
38 I XMK D MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT) Q
39 D PUTMSG(XMDUZ,XMKTO,XMKNTO,XMZ)
40 Q
41LATER(XMDUZ,XMZ,XMWHEN,XMCNT) ;
42XLATER ;
43 S:$D(XMCNT) XMCNT=XMCNT+1
44 D LTRADD^XMJMD(XMDUZ,XMZ,XMWHEN)
45 Q
46MOVE(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;
47XMOVE ;
48 I XMDUZ=.6,'$$MOVE^XMXSEC(XMDUZ,XMZ) Q
49 ; If 2 users are reading the same msg at the same time, one may get an
50 ; abort if tries to save msg to another bskt, if the msg has already
51 ; been moved by the other user. So this next line makes sure no abort.
52 I '$D(^XMB(3.7,"M",XMZ,XMDUZ,+$G(XMK))) S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
53 Q:XMK=XMKTO
54 I XMKTO=.5,'$$DELETE^XMXSEC(XMDUZ,"",XMZ) Q ; Can't save confidential to WASTE bskt.
55 D MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)
56 S:$D(XMCNT) XMCNT=XMCNT+1
57 Q
58MOVEIT(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;
59 I XMK D
60 . D COPYIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)
61 . D ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)
62 ; The message is not in the user's mailbox
63 E D PUTMSG(XMDUZ,XMKTO,$P(^XMB(3.7,XMDUZ,2,XMKTO,0),U),XMZ)
64 Q
65NTOGL(XMDUZ,XMK,XMKN,XMZ,XMCNT,XMKTO,XMKNTO) ;
66XNTOGL ;
67 ; If XMK>.5, then it's simple. Just toggle the 'new' flag.
68 ; If XMK<1, we know the message is not new, and we need to make it new.
69 ; Filter it, but if it filters to the WASTE basket put it in the IN.
70 ; Then make it new.
71 I '$G(XMK) D
72 . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
73 . S:XMK XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
74 I XMK<1 D
75 . I $D(^XMB(3.7,XMDUZ,15,"AF")) D
76 . . N XMZREC
77 . . S XMZREC=$G(^XMB(3.9,XMZ,0))
78 . . D FILTER^XMTDF(XMDUZ,XMZ,$P(XMZREC,U,1),$P(XMZREC,U,2),.XMKTO,.XMKNTO)
79 . . I XMKTO=1,XMK>1 S XMKTO=XMK,XMKNTO=XMKN Q
80 . . I XMKTO<1 S XMKTO=1,XMKNTO=$$EZBLD^DIALOG(37005) ; "IN"
81 . E I XMK>1 S XMKTO=XMK,XMKNTO=XMKN
82 . E S XMKTO=1,XMKNTO=$$EZBLD^DIALOG(37005) ; "IN"
83 . Q:XMK=XMKTO
84 . I XMK D MOVEIT(XMDUZ,XMK,XMZ,XMKTO,.XMCNT) Q
85 . D PUTMSG(XMDUZ,XMKTO,XMKNTO,XMZ)
86 E S XMKTO=XMK,XMKNTO=XMKN
87 I $D(XMCNT) D Q
88 . N XMFDA
89 . I $$NEW^XMXUTIL2(XMDUZ,XMKTO,XMZ) D
90 . . S XMFDA(3.702,XMZ_","_XMKTO_","_XMDUZ_",",3)="@" ; no longer new
91 . . S XMCNT(XMKTO,"DECR")=$G(XMCNT(XMKTO,"DECR"))+1
92 . E D
93 . . S XMFDA(3.702,XMZ_","_XMKTO_","_XMDUZ_",",3)="1" ; new
94 . . S XMCNT(XMKTO,"INCR")=$G(XMCNT(XMKTO,"INCR"))+1
95 . D FILE^DIE("","XMFDA")
96 . S XMCNT=XMCNT+1
97 I $$NEW^XMXUTIL2(XMDUZ,XMKTO,XMZ) D NONEW^XMXUTIL(XMDUZ,XMKTO,XMZ) Q
98 D MAKENEW^XMXUTIL(XMDUZ,XMKTO,XMZ)
99 Q
100TERM(XMDUZ,XMK,XMZ,XMCNT) ;
101XTERM ;
102 N XMIEN
103 S:'$G(XMK) XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
104 I XMDUZ'=DUZ,'$$DELETE^XMXSEC(XMDUZ,XMK,XMZ) Q
105 I XMK D
106 . D ZAPIT(XMDUZ,XMK,XMZ,.XMCNT)
107 . D WASTEIT(XMDUZ,XMK,XMZ)
108 S XMIEN=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
109 S:XMIEN ^XMB(3.9,XMZ,1,XMIEN,"D")=DT
110 S:$D(XMCNT) XMCNT=XMCNT+1
111 Q
112VAPOR(XMDUZ,XMK,XMZ,XMWHEN,XMCNT) ;
113XVAPOR ;
114 I '$G(XMK) S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,"")) Q:'XMK
115 I XMDUZ'=DUZ,'$$DELETE^XMXSEC(XMDUZ,XMK,XMZ) Q
116 S:$D(XMCNT) XMCNT=XMCNT+1
117 D KVAPOR^XMXUTIL(XMDUZ,XMK,XMZ,XMWHEN)
118 Q
119PUTMSG(XMDUZ,XMK,XMKN,XMZ) ; For internal MM use only.
120 ; Replaces SETSB^XMA1C, SET^XMS1, & part of MAIL^XMR0B
121 ; Put a msg in the Postmaster's (or anyone else's) basket.
122 ; The msg is NOT made new.
123 ; The basket has a specific name and number.
124 ; If the basket doesn't exist, create it.
125 ; XMK Basket number
126 ; XMKN Basket name
127 ; XMZ Msg number
128 N XMFDA,XMIEN,XMTRIES
129 Q:$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
130 I XMDUZ'=.5 D RESURECT(XMDUZ,XMZ)
131 I $D(^XMB(3.7,XMDUZ,2,XMK)) D
132 . S XMFDA(3.702,"+1,"_XMK_","_XMDUZ_",",.01)=XMZ
133 . S XMIEN(1)=XMZ
134 E D
135 . S XMFDA(3.701,"+1,"_XMDUZ_",",.01)=XMKN
136 . S XMFDA(3.702,"+2,+1,"_XMDUZ_",",.01)=XMZ
137 . S XMIEN(1)=XMK
138 . S XMIEN(2)=XMZ
139PTRY D UPDATE^DIE("S","XMFDA","XMIEN") Q:'$D(DIERR)
140 S XMTRIES=$G(XMTRIES)+1
141 I $D(^TMP("DIERR",$J,"E",110)) H 1 G PTRY ; Try again if can't lock
142 Q
143COPYIT(XMDUZ,XMK,XMZ,XMKTO,XMCNT) ;
144 Q:$D(^XMB(3.7,XMDUZ,2,XMKTO,1,XMZ)) ; Message already exists at destination
145 N XMFDA,XMKREC,XMIENS,XMIEN,XMTRIES
146 S XMKREC=^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
147 S XMIENS="+1,"_XMKTO_","_XMDUZ_","
148 S XMIEN(1)=XMZ
149 S XMFDA(3.702,XMIENS,.01)=XMZ
150 I XMKTO'=.5 D
151 . I $P(XMKREC,U,3) S XMFDA(3.702,XMIENS,3)=$P(XMKREC,U,3) ; new flag
152 . I '$P(XMKREC,U,7),$P(XMKREC,U,5) S XMFDA(3.702,XMIENS,5)=$P(XMKREC,U,5) ; vapor date
153 S:$P(XMKREC,U,4) XMFDA(3.702,XMIENS,4)=$P(XMKREC,U,4) ; date last accessed
154 S:$P(XMKREC,U,6) XMFDA(3.702,XMIENS,6)=$P(XMKREC,U,6) ; ntwk msg flag
155CTRY D UPDATE^DIE("S","XMFDA","XMIEN")
156 I '$D(DIERR) D Q
157 . I XMK=.5 D RESURECT(XMDUZ,XMZ) Q
158 . Q:'$G(XMFDA(3.702,XMIENS,3)) ; quit if not new
159 . I $D(XMCNT) S XMCNT(XMKTO,"INCR")=$G(XMCNT(XMKTO,"INCR"))+1 Q
160 . D INCRNEW^XMXUTIL(XMDUZ,XMKTO) ; Increment new counts
161 S XMTRIES=$G(XMTRIES)+1
162 I $D(^TMP("DIERR",$J,"E",110)) H 1 G CTRY ; Try again if can't lock
163 Q
164RESURECT(XMDUZ,XMZ) ; If msg was terminated, "unterminate" it.
165 N XMIEN
166 S XMIEN=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
167 K:$D(^XMB(3.9,XMZ,1,XMIEN,"D")) ^XMB(3.9,XMZ,1,XMIEN,"D")
168 Q
169ZAPIT(XMDUZ,XMK,XMZ,XMCNT) ;
170 I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D
171 . I $D(XMCNT) S XMCNT(XMK,"DECR")=$G(XMCNT(XMK,"DECR"))+1 Q
172 . D DECRNEW^XMXUTIL(XMDUZ,XMK)
173 N DA,DIK
174 S DA(2)=XMDUZ,DA(1)=XMK,DA=XMZ
175 S DIK="^XMB(3.7,"_XMDUZ_",2,"_XMK_",1,"
176 D ^DIK
177 Q
178WASTEIT(XMDUZ,XMK,XMZ) ;
179 Q:XMK=.5
180 Q:$D(^XMB(3.7,XMDUZ,2,.5,1,XMZ)) ; Already in wastebasket
181 N XMFDA,XMIENS,XMIEN,XMTRIES
182 S XMK=.5
183 D:'$D(^XMB(3.7,XMDUZ,2,.5,0)) MAKEBSKT^XMXBSKT(XMDUZ,.5,$$EZBLD^DIALOG(37004)) ; WASTE
184 S XMIENS="+1,"_XMK_","_XMDUZ_","
185 S XMIEN(1)=XMZ
186 S XMFDA(3.702,XMIENS,.01)=XMZ
187 S XMFDA(3.702,XMIENS,4)=$$NOW^XLFDT ; date/time last accessed
188WTRY D UPDATE^DIE("S","XMFDA","XMIEN") Q:'$D(DIERR)
189 S XMTRIES=$G(XMTRIES)+1
190 I $D(^TMP("DIERR",$J,"E",110)) H 1 G WTRY ; Try again if can't lock
191 Q
Note: See TracBrowser for help on using the repository browser.