source: FOIAVistA/trunk/r/MAILMAN-XM/XMTDF.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1XMTDF ;ISC-SF/GMB-Filter message: multiple conditions ;04/15/2003 12:45
2 ;;8.0;MailMan;**18**;Jun 28, 2002
3 ; XMF("SUBJ") Subject contains this string
4 ; XMF("FROM") Message is from this person
5 ; XMF("TO") Message is to this person
6FILTER(XMDUZ,XMZ,XMZSUBJ,XMZFROM,XMK,XMKN,XMACT) ; figures out which basket to save to
7 ; the message should be put in.
8 ; Defaults: the "IN" basket.
9 ; If basket doesn't exist, it creates the basket.
10 ; Returns:
11 ; XMK basket number
12 ; XMKN basket name
13 ; Optionally, if specified by user:
14 ; XMACT("VDAYS") set vaporize date to this many days from today.
15 ; XMACT("NONEW") don't make this message new.
16 ; XMACT("FWD") forward this message
17 N XMORDER,XMIEN,XMFREC
18 K XMK,XMKN
19 S (XMORDER,XMIEN)=0
20 F S XMORDER=$O(^XMB(3.7,XMDUZ,15,"AF",XMORDER)) Q:'XMORDER D Q:$D(XMKN)
21 . F S XMIEN=$O(^XMB(3.7,XMDUZ,15,"AF",XMORDER,XMIEN)) Q:'XMIEN D Q:$D(XMKN)
22 . . N XMF
23 . . S XMFREC=$G(^XMB(3.7,XMDUZ,15,XMIEN,0))
24 . . S:$P(XMFREC,U,5)]"" XMF("SUBJ")=$P(XMFREC,U,5)
25 . . S:$P(XMFREC,U,6)]"" XMF("FROM")=$P(XMFREC,U,6)
26 . . S:$P(XMFREC,U,7)]"" XMF("TO")=$P(XMFREC,U,7)
27 . . S:$$GOODMSG(XMZ,XMZSUBJ,XMZFROM,.XMF) XMKN=$P(XMFREC,U,3)
28 I '$D(XMKN) D Q
29 . S XMK=1,XMKN=$$EZBLD^DIALOG(37005) ; Default to "IN" basket
30 . D:'$D(^XMB(3.7,XMDUZ,2,XMK,0)) MAKEBSKT^XMXBSKT(XMDUZ,XMK,XMKN)
31 S XMK=$O(^XMB(3.7,XMDUZ,2,"B",XMKN,0))
32 I $P(XMFREC,U,8) S XMACT("VDAYS")=$P(XMFREC,U,8)
33 I $P(XMFREC,U,9)="N" S XMACT("NONEW")=1
34 I $D(^XMB(3.7,XMDUZ,15,XMIEN,1,"B")),$$OKFWD(XMZ) S XMACT("FWD")=XMIEN
35 Q:XMK
36 I XMKN=$$EZBLD^DIALOG(37004) S XMK=.5 D MAKEBSKT^XMXBSKT(XMDUZ,XMK,XMKN) Q ; "WASTE"
37 D MAKEBSKT^XMXBSKT(XMDUZ,.XMK,XMKN)
38 Q
39GOODMSG(XMZ,XMZSUBJ,XMZFROM,XMF) ;
40 ; This function is a copy of $$GOODMSG^XMJMFB, but with fewer
41 ; conditions to match on.
42 N XMNOGOOD
43 I $D(XMF("SUBJ")),$$UP^XLFSTR(XMZSUBJ)'[XMF("SUBJ") Q 0
44 I $D(XMF("FROM")) D Q:XMNOGOOD 0
45 . I XMF("FROM")=+XMF("FROM"),XMF("FROM")=XMZFROM S XMNOGOOD=0 Q
46 . S XMNOGOOD=1
47 . Q:XMF("FROM")'["@"
48 . S XMZFROM=$$UP^XLFSTR(XMZFROM)
49 . Q:$P(XMZFROM,"@")'[$P(XMF("FROM"),"@")
50 . Q:$P(XMZFROM,"@",2)'[$P(XMF("FROM"),"@",2)
51 . S XMNOGOOD=0
52 I $D(XMF("TO")) D Q:XMNOGOOD 0
53 . I $D(^XMB(3.9,XMZ,6,"B",XMF("TO"))) S XMNOGOOD=0 Q
54 . I $L(XMF("TO"))>30,$D(^XMB(3.9,XMZ,6,"B",$E(XMF("TO"),1,30))),XMF("TO")=$P($G(^XMB(3.9,XMZ,6,+$O(^XMB(3.9,XMZ,6,"B",$E(XMF("TO"),1,30),0)),0)),U,1) S XMNOGOOD=0 Q
55 . S XMNOGOOD=1
56 . Q:XMF("TO")'["@"
57 . N XMTOX,XMTO
58 . S XMTO=""
59 . F S XMTO=$O(^XMB(3.9,XMZ,6,"B",XMTO)) Q:XMTO="" D Q:'XMNOGOOD
60 . . Q:XMTO'["@"
61 . . S XMTOX=$$UP^XLFSTR(XMTO)
62 . . Q:$P(XMTOX,"@")'[$P(XMF("TO"),"@")
63 . . Q:$P(XMTOX,"@",2)'[$P(XMF("TO"),"@",2)
64 . . S XMNOGOOD=0
65 Q 1
66BASKET(X) ; Input Transform for file 3.7, subfile 3.715, field 2 BASKET
67 N DIC,Y,DA
68 S DA(1)=$G(XMDUZ,DUZ)
69 S DIC="^XMB(3.7,"_DA(1)_",2,"
70 S DIC("P")=3.701
71 S DIC(0)="EQL"
72 D ^DIC
73 I $P(Y,U)=1 K X Q ; May not filter to the IN basket
74 I Y>0 S X=$P(Y,U,2) Q
75 K X
76 Q
77BSKTHELP ; Executable Help for file 3.7, subfile 3.715, field 2 BASKET
78 N DIC,Y
79 Q:"??"'[X
80 S DIC("S")="I X'="""_$$EZBLD^DIALOG(37005)_"""" ; IN
81 S DIC="^XMB(3.7,"_$G(XMDUZ,DUZ)_",2,"
82 S DIC(0)="EQL"
83 D ^DIC
84 Q
85FROM(X) ; Input Transform for file 3.7, subfile 3.715, field 5 FROM
86 S X=$$UP^XLFSTR(X)
87 I X["@" K:$L(X)<2!($L(X)>45) X Q
88 N DIC,Y
89 S DIC="^VA(200,",DIC(0)="MNE"
90 D ^DIC
91 I Y=-1 K X Q
92 S X=+Y
93 Q
94TO(X) ; Input Transform for file 3.7, subfile 3.715, field 6 ADDRESSED TO
95 I X["@" D Q
96 . S X=$$UP^XLFSTR(X)
97 . K:$L(X)<2!($L(X)>55) X
98 I $E(X,1,2)="G."!($E(X,1,2)="g.") D Q
99 . ; See GETPERS^XMJMF2 for another way to do the lookup. The difference
100 . ; is that the other way does not let unauthorized senders pick groups
101 . ; which have authorized senders.
102 . S X=$E(X,3,99)
103 . N DIC,Y
104 . ; Screen: Group is public OR user is organizer
105 . ; OR group is unrestricted and user is member
106 . S DIC("S")="N XMR S XMR=^(0) I $S($P(XMR,U,2)=""PU"":1,$P($G(^XMB(3.8,+Y,3),.5),U)=$G(XMDUZ,DUZ):1,+$P(XMR,U,6):0,$D(^XMB(3.8,+Y,1,""B"",$G(XMDUZ,DUZ))):1,1:0)"
107 . S DIC="^XMB(3.8,"
108 . S DIC(0)="MEZ"
109 . D ^DIC
110 . I Y=-1 K X Q
111 . S X="G."_$P(Y,U,2)_$S($P(Y(0),U,6):$$EZBLD^DIALOG(39135),1:"") ; " [Private Mail Group]"
112 S X=$$UP^XLFSTR(X)
113 N DIC,Y
114 S DIC="^VA(200,",DIC(0)="MNE"
115 D ^DIC
116 I Y=-1 K X Q
117 S X=$P(Y,U,2)
118 Q
119FWDTO(XMADDR,XMIA) ; Input Transform for file 3.7, subfile 3.715,
120 ; subfile 3.7159, field .01 FORWARD TO
121 N DO ; to keep FileMan from exploding (that's D-oh)
122 N XMERROR,XMRESTR,XMINSTR,XMFULL,XMFWDADD
123 S XMINSTR("ADDR FLAGS")="X" ; do not create ^TMP(, just check.
124 D ADDRESS^XMXADDR(DUZ,XMADDR,.XMFULL,.XMERROR)
125 I $D(XMERROR) K XMADDR Q
126 S XMADDR=XMFULL
127 Q
128DELFWDTO(XMUSER,XMFILTER,XMIEN,XMFWD,XMERROR) ; Delete a user's invalid FORWARD TO address.
129 N XMPARM,XMINSTR,XMFDA
130 S XMFDA(3.7159,XMIEN_","_XMFILTER_","_XMUSER_",",.01)="@"
131 D FILE^DIE("","XMFDA")
132 S XMINSTR("FROM")=.5
133 S XMPARM(1)=XMFWD,XMPARM(3)=XMERROR
134 S XMPARM(2)=$P(^XMB(3.7,XMUSER,15,XMFILTER,0),U,1) ; filter name
135 D TASKBULL^XMXBULL(.5,"XM FILTER FWD ADDRESS DELETE",.XMPARM,"",XMUSER,.XMINSTR)
136 Q
137OKFWD(XMZ) ; Is it OK to automatically forward this message?
138 N XMZREC
139 S XMZREC=$G(^XMB(3.9,XMZ,0))
140 Q:$$CLOSED^XMXSEC(XMZREC) 0
141 Q:$$CONFID^XMXSEC(XMZREC) 0
142 Q 1
Note: See TracBrowser for help on using the repository browser.