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