source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMTDT.m@ 1154

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

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1XMTDT ;ISC-SF/GMB-Deliver later'd msgs & delete inactive msgs ;04/15/2003 12:48
2 ;;8.0;MailMan;**18**;Jun 28, 2002
3 ; Replaces ^XMADJ999,LATER^XMAD2 (ISC-WASH/CAP)
4GO ;
5 N XMWAIT
6 I $D(ZTQUEUED) S ZTREQ="@"
7 L +^XMBPOST("POST_Tickler"):1 E Q
8 I $D(ZTQUEUED) S %=$$PSET^%ZTLOAD(ZTSK)
9 F Q:$P($G(^XMB(1,1,0)),U,16) D
10 . D LATERNEW
11 . D LATERFWD
12 . D PURGEOLD
13 . D FILTRFWD
14 . S XMWAIT=$$TSTAMP^XMXUTIL1 ; Why can't we just H 60?
15 . F D Q:$$TSTAMP^XMXUTIL1-XMWAIT>60
16 . . H XMHANG
17 L -^XMBPOST("POST_Tickler")
18 I $D(ZTQUEUED) D PCLEAR^%ZTLOAD(ZTSK)
19 Q
20LATERNEW ; This routine takes care of 'new'ing messages which the user
21 ; had previously 'later'ed for himself.
22 N XMNOW,XMLATER,DIK,XMDUZ,XMZ,DA,XMZREC,XMINACT
23 S XMNOW=$$NOW^XLFDT
24 S XMLATER=0
25 F S XMLATER=$O(^XMB(3.73,"AB",XMLATER)) Q:XMLATER'>0!(XMLATER>XMNOW) D
26 . S DIK="^XMB(3.73,"
27 . S XMDUZ=0
28 . F S XMDUZ=$O(^XMB(3.73,"AB",XMLATER,XMDUZ)) Q:'XMDUZ D
29 . . S XMINACT=$S($P($G(^VA(200,XMDUZ,0)),U,3)="":1,$P($G(^(.1)),U,2)="":1,$P($G(^(201)),U)="":1,1:0) ; user is inactive if no access code, or verify code, or primary menu
30 . . S XMZ=0
31 . . F S XMZ=$O(^XMB(3.73,"AB",XMLATER,XMDUZ,XMZ)) Q:'XMZ D
32 . . . S DA=$O(^XMB(3.73,"AB",XMLATER,XMDUZ,XMZ,0)) Q:'DA
33 . . . I '$D(^XMB(3.73,DA,0)) D Q ; *** This should not be necessary
34 . . . . K ^XMB(3.73,"AB",XMLATER,XMDUZ,XMZ,DA)
35 . . . . K ^XMB(3.73,"AC",XMZ,XMDUZ,DA)
36 . . . . K ^XMB(3.73,"C",XMDUZ,DA)
37 . . . D ^DIK
38 . . . Q:XMINACT
39 . . . S XMZREC=$G(^XMB(3.9,XMZ,0)) Q:XMZREC=""
40 . . . D RESURECT^XMXMSGS2(XMDUZ,XMZ)
41 . . . D DELIVER^XMTDL2(XMDUZ,XMZ,$P(XMZREC,U,1),$P(XMZREC,U,2),0,1)
42 Q
43LATERFWD ; This routine takes care of forwarding messages which a user
44 ; had previously scheduled for 'later' delivery to other users.
45 N XMDUZ,XMNOW,XMLATER,DIK,XMIEN,XMZ,DA,XMREC,XMV,XMINSTR,XMTO,XMPRIVAT
46 K XMERR,^TMP("XMERR",$J)
47 S XMPRIVAT=$$EZBLD^DIALOG(39135) ; " [Private Mail Group]"
48 S XMINSTR("FWD BY XMDUZ")=""
49 S XMNOW=$$NOW^XLFDT
50 S XMLATER=0
51 F S XMLATER=$O(^XMB(3.9,"AL",XMLATER)) Q:XMLATER'>0!(XMLATER>XMNOW) D
52 . S XMZ=0
53 . F S XMZ=$O(^XMB(3.9,"AL",XMLATER,XMZ)) Q:'XMZ D
54 . . S DA(1)=XMZ
55 . . S DIK="^XMB(3.9,"_DA(1)_",7,"
56 . . S XMIEN=0
57 . . F S XMIEN=$O(^XMB(3.9,"AL",XMLATER,XMZ,XMIEN)) Q:'XMIEN D
58 . . . S XMREC=$G(^XMB(3.9,XMZ,7,XMIEN,0))
59 . . . I XMREC="" K ^XMB(3.9,"AL",XMLATER,XMZ,XMIEN) Q
60 . . . S XMDUZ=$P(XMREC,U,3)
61 . . . S XMTO=$P(XMREC,U,1)
62 . . . I XMTO[XMPRIVAT S XMTO=$P(XMTO,XMPRIVAT,1) ; " [Private Mail Group]" (set in ^XMXADDRG)
63 . . . I $P(XMREC,U,2)'="" S XMTO=$P(XMREC,U,2)_":"_XMTO
64 . . . D INIT^XMXADDR
65 . . . D CHKADDR^XMXADDR(XMDUZ,XMTO) K:$D(XMERR) XMERR,^TMP("XMERR",$J)
66 . . . S XMINSTR("FWD BY")=$P(XMREC,U,4)
67 . . . D:$D(^TMP("XMY",$J)) FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
68 . . . D CLEANUP^XMXADDR
69 . . . S DA=XMIEN
70 . . . D ^DIK
71 Q
72PURGEOLD ; This routine deletes msgs marked for automatic deletion,
73 ; whether marked by the user, or marked by the 'in basket purge'
74 ; because they hadn't been accessed for a certain number of days.
75 ; Replaces ^XMAI0 (ISC-WASH/CAP/RJ)
76 ; XMDDATE Message delete date
77 N XMDDATE,XMDUZ,XMK,XMZ,XMNOW
78 S XMNOW=$$NOW^XLFDT
79 S (XMDDATE,XMDUZ,XMK,XMZ)=""
80 F S XMDDATE=$O(^XMB(3.7,"AC",XMDDATE)) Q:XMDDATE=""!(XMDDATE>XMNOW) D
81 . F S XMDUZ=$O(^XMB(3.7,"AC",XMDDATE,XMDUZ)) Q:XMDUZ="" D
82 . . F S XMK=$O(^XMB(3.7,"AC",XMDDATE,XMDUZ,XMK)) Q:XMK="" D
83 . . . F S XMZ=$O(^XMB(3.7,"AC",XMDDATE,XMDUZ,XMK,XMZ)) Q:XMZ="" D
84 . . . . I $D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
85 . . . . K ^XMB(3.7,"AC",XMDDATE,XMDUZ,XMK,XMZ)
86 Q
87FILTRFWD ; This routine forwards messages for a user when a filter
88 ; with 'forward to' recipients has activated during message delivery.
89 N XMDUZ,XMUPTR,XMZ,XMREC,XMV,XMINSTR,XMTO,XMPRIVAT,XMFIEN,XMFWDIEN
90 S XMPRIVAT=$$EZBLD^DIALOG(39135) ; " [Private Mail Group]"
91 S XMINSTR("FWD BY XMDUZ")="F"
92 S XMFIEN=0
93 F S XMFIEN=$O(^XMB(3.9,"AF",XMFIEN)) Q:'XMFIEN D
94 . S XMZ=0
95 . F S XMZ=$O(^XMB(3.9,"AF",XMFIEN,XMZ)) Q:'XMZ D
96 . . S XMUPTR=0
97 . . F S XMUPTR=$O(^XMB(3.9,"AF",XMFIEN,XMZ,XMUPTR)) Q:'XMUPTR D
98 . . . S XMREC=$G(^XMB(3.9,XMZ,1,XMUPTR,0))
99 . . . S XMDUZ=$P(XMREC,U,1)
100 . . . I XMREC=""!'XMDUZ!($P(XMREC,U,13)'=XMFIEN) K ^XMB(3.9,"AF",XMFIEN,XMZ,XMUPTR) Q
101 . . . S XMFWDIEN=0
102 . . . D INIT^XMXADDR
103 . . . F S XMFWDIEN=$O(^XMB(3.7,XMDUZ,15,XMFIEN,1,XMFWDIEN)) Q:'XMFWDIEN S XMREC=$G(^(XMFWDIEN,0)) D
104 . . . . S XMTO=$P(XMREC,U,1) Q:XMTO=""
105 . . . . N XMERROR,XMFULL,XMFWDADD
106 . . . . I XMTO[XMPRIVAT S XMTO=$P(XMTO,XMPRIVAT,1) ; " [Private Mail Group]" (set in ^XMXADDRG)
107 . . . . ;I $P(XMREC,U,2)'="" S XMTO=$P(XMREC,U,2)_":"_XMTO
108 . . . . D ADDRESS^XMXADDR(XMDUZ,XMTO,.XMFULL,.XMERROR) Q:'$D(XMERROR)
109 . . . . D DELFWDTO^XMTDF(XMDUZ,XMFIEN,XMFWDIEN,XMTO,$$GETERR^XMXADDR4)
110 . . . S XMINSTR("FWD BY")=$$NAME^XMXUTIL(XMDUZ)
111 . . . D:$D(^TMP("XMY",$J)) FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
112 . . . D CLEANUP^XMXADDR
113 . . . N XMFDA
114 . . . S XMFDA(3.91,XMUPTR_","_XMZ_",",15)=0 ; filter forward completed
115 . . . D FILE^DIE("","XMFDA")
116 Q
Note: See TracBrowser for help on using the repository browser.