source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMTDL2.m@ 701

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

initial load of WorldVistAEHR

File size: 6.9 KB
Line 
1XMTDL2 ;ISC-SF/GMB-Deliver local mail to mailbox (cont.) ;04/17/2002 11:31
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Replaces ^XMADJF1B (ISC-WASH/CAP)
4 ; XMTO Recipient DUZ
5 ; XMZ Original XMZ
6 ; XMZSUBJ Msg subject
7 ; XMZFROM Who sent the original message
8 ; XMFROM Who sent the msg or reply, or who forwarded the msg
9 ; XMREPLY 0=msg is not a reply; 1=msg is a reply
10 ; XMK Basket number (or name) to deliver to (as specified by sender XMFROM)
11 ; XMDEL Delete Date (as specified by sender XMZFROM)
12 ; XMKCURR Basket the msg is currently in
13DELIVER(XMTO,XMZ,XMZSUBJ,XMZFROM,XMFROM,XMREPLY,XMK,XMDEL,XMZBSKT) ;
14 N XMKCURR,XMACT
15 I +XMTO'>0!'$D(^XMB(3.7,XMTO,2)) Q ; Do not deliver if invalid mailbox
16 S XMFROM=+$G(XMFROM),XMREPLY=+$G(XMREPLY),XMK=$G(XMK),XMDEL=+$G(XMDEL),XMZBSKT=$G(XMZBSKT)
17 I XMTO=.6,XMREPLY Q ; Do not deliver response to Shared,Mail
18 S XMKCURR=$O(^XMB(3.7,"M",XMZ,XMTO,0)) ; Get basket it is in
19 I XMKCURR D Q ; Already in a basket (ignore any basket sender may have specified)
20 . Q:'XMREPLY ; If this is a reply, continue, else it must be a forwarded msg, so quit.
21 . I XMKCURR=.5 D Q ; Msg is in waste basket
22 . . D CHEKBSKT(XMTO,.XMK,XMZSUBJ,XMZFROM,XMZBSKT,.XMACT) ; Where should it go?
23 . . Q:XMK=.5
24 . . D MOVENEW(XMFROM,XMTO,XMK,XMZ,.XMACT) ; Move msg and make it new.
25 . ; Msg is not in waste basket. Make the msg new.
26 . Q:$D(^XMB(3.7,XMTO,"N0",XMKCURR,XMZ)) ; Already new.
27 . D:XMFROM'=XMTO MAKENEW(XMTO,XMKCURR,XMZ)
28 ; Not yet in a basket.
29 ; Reinstated user may not see replies to old msgs which he doesn't already have.
30 I XMREPLY,$P(^XMB(3.7,XMTO,0),U,7) Q:$$SECRET($P(^(0),U,7),XMZ)
31 S:$G(XMK)="" XMK=0
32 I +XMK=XMK D
33 . D CHEKBSKT(XMTO,.XMK,XMZSUBJ,XMZFROM,XMZBSKT,.XMACT)
34 E D
35 . S XMK=$$NAMEBSKT(XMTO,XMK,"Y")
36 D ADDNEW($S(XMREPLY:XMFROM,1:XMZFROM),XMTO,XMK,XMZ,XMDEL,.XMACT,XMREPLY)
37 Q
38CHEKBSKT(XMTO,XMK,XMZSUBJ,XMZFROM,XMZBSKT,XMACT) ; Basket number (or no basket at all)
39 N XMREC
40 S XMREC=$G(^XMB(3.7,XMTO,16))
41 ; If the message hasn't been sent to a specific basket for this user
42 ; and the sender specified a delivery basket, and the recipient is
43 ; OK with that, then use the delivery basket.
44 ; Note: The IN basket is not considered a 'specific basket'.
45 I XMK<2,XMZBSKT'="","^^N^"'[(U_$P(XMREC,U,2)_U) S XMK=$$NAMEBSKT(XMTO,XMZBSKT,$P(XMREC,U,2)) Q:XMK
46 ; If the message hasn't been sent to a specific basket for this user
47 ; and active filters exist, and filtering is turned on,
48 ; then filter the message.
49 I XMK<2,$D(^XMB(3.7,XMTO,15,"AF")),$P(XMREC,U,1)="Y" D FILTER^XMTDF(XMTO,XMZ,XMZSUBJ,XMZFROM,.XMK,"",.XMACT) Q
50 ; The message was sent to a specific basket for this user.
51 I XMK Q:$D(^XMB(3.7,XMTO,2,XMK,0)) ; Quit if the basket XMK exists.
52 S XMK=1 ; Since the basket doesn't exist, force to the IN basket
53 Q:$D(^XMB(3.7,XMTO,2,XMK,0)) ; Quit if the IN basket exists.
54 D MAKEBSKT^XMXBSKT(XMTO,XMK,$$EZBLD^DIALOG(37005)) ; Create the "IN" basket
55 Q
56NAMEBSKT(XMTO,XMKN,XMZBOK) ; Basket name (not number)
57 N XMK
58 S XMK=$O(^XMB(3.7,XMTO,2,"B",XMKN,0))
59 S:'XMK XMK=$$FIND1^DIC(3.701,","_XMTO_",","X",$$LOW^XLFSTR(XMKN))
60 I XMK D Q XMK
61 . Q:XMZBOK'="S" ; 'YES' or 'EXISTING ONLY'
62 . S:$P(^XMB(3.7,XMTO,2,XMK,0),U,3)'="Y" XMK=0 ; 'SELECTED ONLY'
63 ; Basket not found
64 Q:XMZBOK'="Y" 0 ; quit if not 'YES'
65 I XMKN=$$EZBLD^DIALOG(37004) S XMK=.5 D MAKEBSKT^XMXBSKT(XMTO,XMK,XMKN) Q XMK ; "WASTE"
66 I XMKN=$$EZBLD^DIALOG(37005) S XMK=1 D MAKEBSKT^XMXBSKT(XMTO,XMK,XMKN) Q XMK ; "IN"
67 D MAKEBSKT^XMXBSKT(XMTO,.XMK,XMKN)
68 Q XMK
69ADDNEW(XMFROM,XMTO,XMK,XMZ,XMDEL,XMACT,XMREPLY) ;
70 N XMFDA,XMIENS,XMIEN,XMTRIES
71 S XMIENS="+1,"_XMK_","_XMTO_","
72 S XMIEN(1)=XMZ
73 S XMFDA(3.702,XMIENS,.01)=XMZ
74 I XMK'=.5 D
75 . I XMFROM'=XMTO D
76 . . I $G(XMACT("NONEW")),'$$RESP^XMXUTIL2(XMZ),$$ZREAD^XMXUTIL2(XMTO,XMZ)="" Q
77 . . S XMFDA(3.702,XMIENS,3)=1 ; new flag
78 . . D INCRNEW^XMXUTIL(XMTO,XMK) ; New counts
79 . I $G(XMACT("VDAYS")) D Q
80 . . S XMFDA(3.702,XMIENS,5)=$$FMADD^XLFDT(DT,XMACT("VDAYS")) ; vapor date
81 . . S XMFDA(3.702,XMIENS,7)=0 ; vapor date set by user
82 . I XMDEL S XMFDA(3.702,XMIENS,5)=XMDEL ; vapor date
83 ; Basket sequence number (XMKZ), and priority & new xrefs are handled by FM triggers.
84ATRY D UPDATE^DIE("S","XMFDA","XMIEN")
85 I '$D(DIERR) D Q
86 . Q:'$D(XMACT("FWD"))
87 . I 'XMREPLY,XMFROM'=XMTO D FORWARD(XMTO,XMZ,XMACT("FWD"))
88 S XMTRIES=$G(XMTRIES)+1
89 I $D(^TMP("DIERR",$J,"E",110)) H 1 G ATRY ; Try again if can't lock
90 Q
91MAKENEW(XMTO,XMK,XMZ) ;
92 ; We ignore any "vapor" date here because this is an existing msg
93 N XMFDA,XMREC
94 S XMREC=$G(^XMB(3.7,XMTO,2,XMK,1,XMZ,0))
95 I XMREC="" D Q:XMREC=""
96 . ; Message entry should have been there, but it wasn't. Add it.
97 . D FIXBSKT(XMTO,XMK,XMZ)
98 . S XMREC=$G(^XMB(3.7,XMTO,2,XMK,1,XMZ,0)) Q:XMREC'=""
99 . D ADDNEW(0,XMTO,XMK,XMZ,0)
100 S XMFDA(3.702,XMZ_","_XMK_","_XMTO_",",3)=1 ; new flag
101 ; Delete 'automatic delete date' if it was set by the system
102 ; (during IN BASKET PURGE).
103 S:$P(XMREC,U,7) XMFDA(3.702,XMZ_","_XMK_","_XMTO_",",5)="@"
104 L +^XMB(3.7,XMTO,2,XMK,1,XMZ,0):1 ; Lock message
105 ; Priority & new xrefs are handled by FM triggers.
106 D FILE^DIE("","XMFDA")
107 L -^XMB(3.7,XMTO,2,XMK,1,XMZ,0)
108 D INCRNEW^XMXUTIL(XMTO,XMK) ; New counts
109 Q
110SECRET(XMDATE,XMZ) ;
111 ; Don't need to check to see if the user already has the msg, because
112 ; at this point, we already know that he doesn't.
113 N XMCRE8
114 S XMCRE8=$P($G(^XMB(3.9,XMZ,.6)),U)
115 Q $S('XMCRE8:0,XMDATE>XMCRE8:1,1:0) ; 1 means user may NOT see the msg.
116MOVENEW(XMFROM,XMTO,XMK,XMZ,XMACT) ; Move msg from WASTE bskt and make new
117 N XMFDA,XMREC,XMIENS,XMIEN,XMTRIES
118 S XMREC=$G(^XMB(3.7,XMTO,2,.5,1,XMZ,0))
119 I XMREC="" D Q:XMREC=""
120 . ; Message entry should have been there, but it wasn't.
121 . D FIXBSKT(XMTO,.5,XMZ)
122 . S XMREC=$G(^XMB(3.7,XMTO,2,.5,1,XMZ,0)) Q:XMREC'=""
123 . D ADDNEW(XMFROM,XMTO,XMK,XMZ,0)
124 S XMIENS="+1,"_XMK_","_XMTO_","
125 S XMIEN(1)=XMZ
126 S XMFDA(3.702,XMIENS,.01)=XMZ
127 S:XMFROM'=XMTO XMFDA(3.702,XMIENS,3)=1 ; new flag
128 S:$P(XMREC,U,4) XMFDA(3.702,XMIENS,4)=$P(XMREC,U,4) ; date last accessed
129 ;I '$P(XMREC,U,7),$P(XMREC,U,5)>DT S XMFDA(3.702,XMIENS,5)=$P(XMREC,U,5) ; vapor date set by user, not system
130 I $G(XMACT("VDAYS")) D
131 . S XMFDA(3.702,XMIENS,5)=$$FMADD^XLFDT(DT,XMACT("VDAYS")) ; vapor date
132 . S XMFDA(3.702,XMIENS,7)=0 ; vapor date set by user
133MTRY D UPDATE^DIE("S","XMFDA","XMIEN")
134 I '$D(DIERR) D Q
135 . D:XMFROM'=XMTO INCRNEW^XMXUTIL(XMTO,XMK) ; Increment new counts
136 . N DA,DIK
137 . S DA(2)=XMTO,DA(1)=.5,DA=XMZ
138 . S DIK="^XMB(3.7,"_XMTO_",2,.5,1,"
139 . D ^DIK ; delete msg from waste bskt
140 S XMTRIES=$G(XMTRIES)+1
141 I $D(^TMP("DIERR",$J,"E",110)) H 1 G MTRY ; Try again if can't lock
142 Q
143FIXBSKT(XMTO,XMK,XMZ) ; Basket integrity check
144 N XMERROR ; (set in ^XMUT4)
145 L +^XMB(3.7,XMTO,2,XMK):1
146 K ^XMB(3.7,"M",XMZ,XMTO,XMK) ; This xref is wrong.
147 D BSKT^XMUT4(XMTO,XMK)
148 L -^XMB(3.7,XMTO,2,XMK)
149 Q
150FORWARD(XMTO,XMZ,XMFIEN) ;
151 ; XMFIEN IEN of the filter which activated.
152 N XMUPTR
153 S XMUPTR=+$O(^XMB(3.9,XMZ,1,"C",XMTO,0))
154 Q:$P($G(^XMB(3.9,XMZ,1,XMUPTR,0)),U,13)'="" ; already forwarded once.
155 N XMFDA
156 S XMFDA(3.91,XMUPTR_","_XMZ_",",15)=XMFIEN
157 D FILE^DIE("","XMFDA")
158 Q
Note: See TracBrowser for help on using the repository browser.