Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMTDF

XMTDF.m

Go to the documentation of this file. 
  1. XMTDF ;ISC-SF/GMB-Filter message: multiple conditions ;04/15/2003  12:45
  1.  ;;8.0;MailMan;**18**;Jun 28, 2002
  1.  ; XMF("SUBJ")  Subject contains this string
  1.  ; XMF("FROM")  Message is from this person
  1.  ; XMF("TO")    Message is to this person
  1. FILTER(XMDUZ,XMZ,XMZSUBJ,XMZFROM,XMK,XMKN,XMACT) ; figures out which basket to save to
  1.  ; the message should be put in.
  1.  ; Defaults: the "IN" basket.
  1.  ; If basket doesn't exist, it creates the basket.
  1.  ; Returns:
  1.  ; XMK  basket number
  1.  ; XMKN basket name
  1.  ; Optionally, if specified by user:
  1.  ; XMACT("VDAYS") set vaporize date to this many days from today.
  1.  ; XMACT("NONEW") don't make this message new.
  1.  ; XMACT("FWD")   forward this message
  1.  N XMORDER,XMIEN,XMFREC
  1.  K XMK,XMKN
  1.  S (XMORDER,XMIEN)=0
  1.  F  S XMORDER=$O(^XMB(3.7,XMDUZ,15,"AF",XMORDER)) Q:'XMORDER  D  Q:$D(XMKN)
  1.  . F  S XMIEN=$O(^XMB(3.7,XMDUZ,15,"AF",XMORDER,XMIEN)) Q:'XMIEN  D  Q:$D(XMKN)
  1.  . . N XMF
  1.  . . S XMFREC=$G(^XMB(3.7,XMDUZ,15,XMIEN,0))
  1.  . . S:$P(XMFREC,U,5)]"" XMF("SUBJ")=$P(XMFREC,U,5)
  1.  . . S:$P(XMFREC,U,6)]"" XMF("FROM")=$P(XMFREC,U,6)
  1.  . . S:$P(XMFREC,U,7)]"" XMF("TO")=$P(XMFREC,U,7)
  1.  . . S:$$GOODMSG(XMZ,XMZSUBJ,XMZFROM,.XMF) XMKN=$P(XMFREC,U,3)
  1.  I '$D(XMKN) D  Q
  1.  . S XMK=1,XMKN=$$EZBLD^DIALOG(37005)   ; Default to "IN" basket
  1.  . D:'$D(^XMB(3.7,XMDUZ,2,XMK,0)) MAKEBSKT^XMXBSKT(XMDUZ,XMK,XMKN)
  1.  S XMK=$O(^XMB(3.7,XMDUZ,2,"B",XMKN,0))
  1.  I $P(XMFREC,U,8) S XMACT("VDAYS")=$P(XMFREC,U,8)
  1.  I $P(XMFREC,U,9)="N" S XMACT("NONEW")=1
  1.  I $D(^XMB(3.7,XMDUZ,15,XMIEN,1,"B")),$$OKFWD(XMZ) S XMACT("FWD")=XMIEN
  1.  Q:XMK
  1.  I XMKN=$$EZBLD^DIALOG(37004) S XMK=.5 D MAKEBSKT^XMXBSKT(XMDUZ,XMK,XMKN) Q  ; "WASTE"
  1.  D MAKEBSKT^XMXBSKT(XMDUZ,.XMK,XMKN)
  1.  Q
  1. GOODMSG(XMZ,XMZSUBJ,XMZFROM,XMF) ;
  1.  ; This function is a copy of $$GOODMSG^XMJMFB, but with fewer
  1.  ; conditions to match on.
  1.  N XMNOGOOD
  1.  I $D(XMF("SUBJ")),$$UP^XLFSTR(XMZSUBJ)'[XMF("SUBJ") Q 0
  1.  I $D(XMF("FROM")) D  Q:XMNOGOOD 0
  1.  . I XMF("FROM")=+XMF("FROM"),XMF("FROM")=XMZFROM S XMNOGOOD=0 Q
  1.  . S XMNOGOOD=1
  1.  . Q:XMF("FROM")'["@"
  1.  . S XMZFROM=$$UP^XLFSTR(XMZFROM)
  1.  . Q:$P(XMZFROM,"@")'[$P(XMF("FROM"),"@")
  1.  . Q:$P(XMZFROM,"@",2)'[$P(XMF("FROM"),"@",2)
  1.  . S XMNOGOOD=0
  1.  I $D(XMF("TO")) D  Q:XMNOGOOD 0
  1.  . I $D(^XMB(3.9,XMZ,6,"B",XMF("TO"))) S XMNOGOOD=0 Q
  1.  . 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
  1.  . S XMNOGOOD=1
  1.  . Q:XMF("TO")'["@"
  1.  . N XMTOX,XMTO
  1.  . S XMTO=""
  1.  . F  S XMTO=$O(^XMB(3.9,XMZ,6,"B",XMTO)) Q:XMTO=""  D  Q:'XMNOGOOD
  1.  . . Q:XMTO'["@"
  1.  . . S XMTOX=$$UP^XLFSTR(XMTO)
  1.  . . Q:$P(XMTOX,"@")'[$P(XMF("TO"),"@")
  1.  . . Q:$P(XMTOX,"@",2)'[$P(XMF("TO"),"@",2)
  1.  . . S XMNOGOOD=0
  1.  Q 1
  1. BASKET(X) ; Input Transform for file 3.7, subfile 3.715, field 2 BASKET
  1.  N DIC,Y,DA
  1.  S DA(1)=$G(XMDUZ,DUZ)
  1.  S DIC="^XMB(3.7,"_DA(1)_",2,"
  1.  S DIC("P")=3.701
  1.  S DIC(0)="EQL"
  1.  D ^DIC
  1.  I $P(Y,U)=1 K X Q  ; May not filter to the IN basket
  1.  I Y>0 S X=$P(Y,U,2) Q
  1.  K X
  1.  Q
  1. BSKTHELP ; Executable Help for file 3.7, subfile 3.715, field 2 BASKET
  1.  N DIC,Y
  1.  Q:"??"'[X
  1.  S DIC("S")="I X'="""_$$EZBLD^DIALOG(37005)_"""" ; IN
  1.  S DIC="^XMB(3.7,"_$G(XMDUZ,DUZ)_",2,"
  1.  S DIC(0)="EQL"
  1.  D ^DIC
  1.  Q
  1. FROM(X) ; Input Transform for file 3.7, subfile 3.715, field 5 FROM
  1.  S X=$$UP^XLFSTR(X)
  1.  I X["@" K:$L(X)<2!($L(X)>45) X Q
  1.  N DIC,Y
  1.  S DIC="^VA(200,",DIC(0)="MNE"
  1.  D ^DIC
  1.  I Y=-1 K X Q
  1.  S X=+Y
  1.  Q
  1. TO(X) ; Input Transform for file 3.7, subfile 3.715, field 6 ADDRESSED TO
  1.  I X["@" D  Q
  1.  . S X=$$UP^XLFSTR(X)
  1.  . K:$L(X)<2!($L(X)>55) X
  1.  I $E(X,1,2)="G."!($E(X,1,2)="g.") D  Q
  1.  . ; See GETPERS^XMJMF2 for another way to do the lookup.  The difference
  1.  . ; is that the other way does not let unauthorized senders pick groups
  1.  . ; which have authorized senders.
  1.  . S X=$E(X,3,99)
  1.  . N DIC,Y
  1.  . ; Screen:  Group is public OR user is organizer
  1.  . ;          OR group is unrestricted and user is member
  1.  . 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)"
  1.  . S DIC="^XMB(3.8,"
  1.  . S DIC(0)="MEZ"
  1.  . D ^DIC
  1.  . I Y=-1 K X Q
  1.  . S X="G."_$P(Y,U,2)_$S($P(Y(0),U,6):$$EZBLD^DIALOG(39135),1:"") ; " [Private Mail Group]"
  1.  S X=$$UP^XLFSTR(X)
  1.  N DIC,Y
  1.  S DIC="^VA(200,",DIC(0)="MNE"
  1.  D ^DIC
  1.  I Y=-1 K X Q
  1.  S X=$P(Y,U,2)
  1.  Q
  1. FWDTO(XMADDR,XMIA) ; Input Transform for file 3.7, subfile 3.715,
  1.  ; subfile 3.7159, field .01 FORWARD TO
  1.  N DO ; to keep FileMan from exploding (that's D-oh)
  1.  N XMERROR,XMRESTR,XMINSTR,XMFULL,XMFWDADD
  1.  S XMINSTR("ADDR FLAGS")="X" ; do not create ^TMP(, just check.
  1.  D ADDRESS^XMXADDR(DUZ,XMADDR,.XMFULL,.XMERROR)
  1.  I $D(XMERROR) K XMADDR Q
  1.  S XMADDR=XMFULL
  1.  Q
  1. DELFWDTO(XMUSER,XMFILTER,XMIEN,XMFWD,XMERROR) ; Delete a user's invalid FORWARD TO address.
  1.  N XMPARM,XMINSTR,XMFDA
  1.  S XMFDA(3.7159,XMIEN_","_XMFILTER_","_XMUSER_",",.01)="@"
  1.  D FILE^DIE("","XMFDA")
  1.  S XMINSTR("FROM")=.5
  1.  S XMPARM(1)=XMFWD,XMPARM(3)=XMERROR
  1.  S XMPARM(2)=$P(^XMB(3.7,XMUSER,15,XMFILTER,0),U,1) ; filter name
  1.  D TASKBULL^XMXBULL(.5,"XM FILTER FWD ADDRESS DELETE",.XMPARM,"",XMUSER,.XMINSTR)
  1.  Q
  1. OKFWD(XMZ) ; Is it OK to automatically forward this message?
  1.  N XMZREC
  1.  S XMZREC=$G(^XMB(3.9,XMZ,0))
  1.  Q:$$CLOSED^XMXSEC(XMZREC) 0
  1.  Q:$$CONFID^XMXSEC(XMZREC) 0
  1.  Q 1