XMXBSKT ;ISC-SF/GMB-Basket APIs ;03/25/2003 14:55
;;8.0;MailMan;**16**;Jun 28, 2002
CRE8BSKT(XMDUZ,XMKN,XMK) ; Routine creates basket, given name, and
; returns basket number.
K XMERR,^TMP("XMERR",$J)
I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q
I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
S XMK=$$FIND1^DIC(3.701,","_XMDUZ_",","X",XMKN)
I XMK D Q
.; (It might be better if used an index which was the upper case of
.; the basket name, and if we checked for upper case of XMKN)
. D ERRSET^XMXUTIL(37201.3,XMKN) ; Basket '_XMKN_' already exists.
I XMDUZ=.5 D Q:$G(XMERR)
. N I,XMK
. S XMK=.99
. F I=1:1 S XMK=$O(^XMB(3.7,.5,2,XMK)) Q:XMK>999!'XMK
. Q:I<999
. D ERRSET^XMXUTIL(38113.1) ; Postmaster may not have more than 999 baskets. (>999=Network msg queues)
;D VAL^DIE(3.701,"1,"_XMDUZ_",",.01,"H",XMKN) ; validate the name
D MAKEBSKT(XMDUZ,.XMK,XMKN)
Q
MAKEBSKT(XMDUZ,XMK,XMKN) ; Create a basket (For internal MM use only)
; If you give it an XMK, it'll put it there,
; else, it'll find a vacant XMK.
N XMFDA,XMIEN,XMTRIES
I 'XMK F XMK=2:1 Q:'$D(^XMB(3.7,XMDUZ,2,XMK)) ; Find 1st vacant bskt #
S XMFDA(3.701,"+1,"_XMDUZ_",",.01)=XMKN
S XMIEN(1)=XMK
MTRY D UPDATE^DIE("S","XMFDA","XMIEN") Q:'$D(DIERR)
S XMTRIES=$G(XMTRIES)+1
I $D(^TMP("DIERR",$J,"E",110)) H 1 G MTRY ; Try again if can't lock
Q
DELBSKT(XMDUZ,XMK,XMFLAGS) ;
; XMK Basket IEN
N XMNEW
K XMERR,^TMP("XMERR",$J)
I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q
I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
I XMK'>1 D Q
. D ERRSET^XMXUTIL(37215.2,$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)) ; The '_IN/WASTE_' basket may not be deleted.
I $G(XMFLAGS)'["D",$$BMSGCT^XMXUTIL(XMDUZ,XMK)>0 D Q
. D ERRSET^XMXUTIL(37215.4,$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)) ; The '_x_' basket may not be deleted, because it still has messages in it.
S XMNEW=$$BNMSGCT^XMXUTIL(XMDUZ,XMK)
L +^XMB(3.7,XMDUZ):1
S:XMNEW $P(^(0),U,6)=$P(^XMB(3.7,XMDUZ,0),U,6)-XMNEW
N XMFDA
S XMFDA(3.701,XMK_","_XMDUZ_",",.01)="@"
D FILE^DIE("","XMFDA")
L -^XMB(3.7,XMDUZ)
Q
LISTBSKT(XMDUZ,XMFLAGS,XMAMT,XMSTART,XMPART,XMTROOT) ;
N XMORDER,XMI,XMCNT,XMK,XMKREC,XMSCREEN,XMFMFLAG
I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
I $D(XMTROOT),XMTROOT'="" D
. K @$$CREF^DILF(XMTROOT)
. S XMTROOT=$$OREF^DILF(XMTROOT)_"""XMLIST"","
E D
. K ^TMP("XMLIST",$J)
. S XMTROOT="^TMP(""XMLIST"",$J,"
I $G(XMFLAGS)["N" S XMSCREEN="I $P(^(0),U,2)" ; Only baskets w/new msgs
E S XMSCREEN=""
S XMFMFLAG="I"
I $G(XMFLAGS)["B" S XMFMFLAG=XMFMFLAG_"B"
D LIST^DIC(3.701,","_XMDUZ_",","",XMFMFLAG,.XMAMT,.XMSTART,.XMPART,"",XMSCREEN)
S @(XMTROOT_"0)")=^TMP("DILIST",$J,0)
S XMORDER=$S($G(XMFLAGS)["B":-1,1:1)
S XMCNT=0,XMI=""
F S XMI=$O(^TMP("DILIST",$J,2,XMI),XMORDER) Q:'XMI S XMK=^(XMI) D
. S XMCNT=XMCNT+1
. S XMKREC=^XMB(3.7,XMDUZ,2,XMK,0)
. S @(XMTROOT_XMCNT_")")=XMK_U_$P(XMKREC,U,1)_U_$$BMSGCT^XMXUTIL(XMDUZ,XMK)_U_+$P(XMKREC,U,2) ; basket ien^basket name^# msgs^# new msgs
. I '$G(XMAMT) S @(XMTROOT_"""BSKT"",$$UP^XLFSTR($P(XMKREC,U,1)),"_XMCNT_")")=""
K ^TMP("DILIST",$J)
Q
NAMEBSKT(XMDUZ,XMK,XMKN) ;
; XMK Basket IEN
; XMKN New basket name
K XMERR,^TMP("XMERR",$J)
I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q
I XMDUZ'=DUZ,'$$WPRIV^XMXSEC Q
I XMK'>1!(XMDUZ=.5&(XMK>999)) D Q
. D ERRSET^XMXUTIL(37201.2,$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)) ; The '_x_' basket name may not be changed.
N XMFDA
S XMFDA(3.701,XMK_","_XMDUZ_",",.01)=XMKN
D FILE^DIE("","XMFDA")
Q
QBSKT(XMDUZ,XMK,XMMSG) ; Message counts for a mail basket
N XMKREC
K XMERR,^TMP("XMERR",$J)
S XMMSG=""
I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
S XMKREC=^XMB(3.7,XMDUZ,2,XMK,0)
S XMMSG=XMK_U_$P(XMKREC,U,1)_U_$$BMSGCT^XMXUTIL(XMDUZ,XMK)_U_+$P(XMKREC,U,2) ; basket ien^basket name^# msgs^# new msgs
Q
RSEQBSKT(XMDUZ,XMK,XMMSG) ; Resequence message numbers
; XMZ - Unique message number
; XMK - basket number
; XMKZ - Message number in basket
; XMKZCNT - Number of messages in basket
N XMKZCNT,XMERROR ; (XMERROR is set in XMUT4)
K XMERR,^TMP("XMERR",$J)
S XMMSG=""
;I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q ; Shouldn't need special privileges.
I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
D BSKT^XMUT4(XMDUZ,XMK) ; Basket integrity check
D RSEQ(XMDUZ,XMK,.XMKZCNT) ; resequence
S XMMSG=$$EZBLD^DIALOG(37212.9,XMKZCNT) ; Resequenced from 1 to _XMKZCNT.
Q
RSEQ(XMDUZ,XMK,XMKZNEW) ; Internal MailMan entry point to resequence a basket
; *** IN create date/xmz SEQUENCE ***
N XMKZ,XMZ,XMFDA,XMCRE8DT
K ^TMP("XM",$J,"RSEQ")
S XMZ=0
F S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,XMZ)) Q:XMZ'>0 S ^TMP("XM",$J,"RSEQ",+$P($G(^XMB(3.9,XMZ,.6)),U),XMZ)=""
S XMKZNEW=0,(XMCRE8DT,XMZ)=""
F S XMCRE8DT=$O(^TMP("XM",$J,"RSEQ",XMCRE8DT)) Q:XMCRE8DT="" D Q:$D(XMERR)
. F S XMZ=$O(^TMP("XM",$J,"RSEQ",XMCRE8DT,XMZ)) Q:'XMZ D Q:$D(XMERR)
. . S XMKZ=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2) Q:'XMKZ
. . S XMKZNEW=XMKZNEW+1
. . Q:XMKZ=XMKZNEW
. . S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",2)=XMKZNEW
. . D FILE^DIE("","XMFDA") I $D(DIERR) D ERRSET^XMXUTIL(37212.8,$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)) ; Error resequencing the '_x_' basket.
K ^TMP("XM",$J,"RSEQ")
Q:$D(XMERR)
S:+$P($G(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)'=XMKZNEW $P(^(0),U,4)=XMKZNEW
Q
XRSEQ(XMDUZ,XMK,XMKZNEW) ; Internal MailMan entry point to resequence a basket
; *** IN XMKZ SEQUENCE ***
N XMKZ,XMZ,XMFDA
S (XMKZ,XMKZNEW)=0
F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ'>0 D Q:$D(XMERR)
. I XMKZ'>XMKZNEW S XMKZNEW=XMKZ-1
. S XMZ=0
. F S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,XMZ)) Q:XMZ'>0 D Q:$D(XMERR)
. . S XMKZNEW=XMKZNEW+1
. . Q:XMKZ=XMKZNEW
. . S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",2)=XMKZNEW
. . D FILE^DIE("","XMFDA") I $D(DIERR) D ERRSET^XMXUTIL(37212.8,$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)) ; Error resequencing the '_x_' basket.
Q:$D(XMERR)
S:+$P($G(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)'=XMKZNEW $P(^(0),U,4)=XMKZNEW
Q
FLTRBSKT(XMDUZ,XMK,XMMSG) ; Filter a basket
; XMZ - Unique message number
; XMK - basket number
K XMERR,^TMP("XMERR",$J)
S XMMSG=""
I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q
I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
I XMK'=.5,'$D(^XMB(3.7,XMDUZ,15,"AF")) D Q
. D ERRSET^XMXUTIL($S(XMDUZ=DUZ:37204.1,1:37204.2),XMV("NAME")) ; You have / x has no message filters defined.
I XMDUZ=.5,XMK>1000 D Q
. D ERRSET^XMXUTIL(37251) ; You may not do this with messages in the transmit queues.
N XMZ,XMKN
S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
S XMZ=0
F S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,XMZ)) Q:XMZ'>0 D FLTR^XMXMSGS2(XMDUZ,XMK,XMKN,XMZ)
S XMMSG=$$EZBLD^DIALOG(34306.2) ; Basket filtered.
Q
XMXBSKT ;ISC-SF/GMB-Basket APIs ;03/25/2003 14:55
+1 ;;8.0;MailMan;**16**;Jun 28, 2002
CRE8BSKT(XMDUZ,XMKN,XMK) ; Routine creates basket, given name, and
+1 ; returns basket number.
+2 KILL XMERR,^TMP("XMERR",$JOB)
+3 IF XMDUZ=.6
IF '$$POSTPRIV^XMXSEC
QUIT
+4 IF XMDUZ'=DUZ
IF '$$RPRIV^XMXSEC
QUIT
+5 SET XMK=$$FIND1^DIC(3.701,","_XMDUZ_",","X",XMKN)
+6 IF XMK
Begin DoDot:1
+7 ; (It might be better if used an index which was the upper case of
+8 ; the basket name, and if we checked for upper case of XMKN)
+9 ; Basket '_XMKN_' already exists.
DO ERRSET^XMXUTIL(37201.3,XMKN)
End DoDot:1
QUIT
+10 IF XMDUZ=.5
Begin DoDot:1
+11 NEW I,XMK
+12 SET XMK=.99
+13 FOR I=1:1
SET XMK=$ORDER(^XMB(3.7,.5,2,XMK))
IF XMK>999!'XMK
QUIT
+14 IF I<999
QUIT
+15 ; Postmaster may not have more than 999 baskets. (>999=Network msg queues)
DO ERRSET^XMXUTIL(38113.1)
End DoDot:1
IF $GET(XMERR)
QUIT
+16 ;D VAL^DIE(3.701,"1,"_XMDUZ_",",.01,"H",XMKN) ; validate the name
+17 DO MAKEBSKT(XMDUZ,.XMK,XMKN)
+18 QUIT
MAKEBSKT(XMDUZ,XMK,XMKN) ; Create a basket (For internal MM use only)
+1 ; If you give it an XMK, it'll put it there,
+2 ; else, it'll find a vacant XMK.
+3 NEW XMFDA,XMIEN,XMTRIES
+4 ; Find 1st vacant bskt #
IF 'XMK
FOR XMK=2:1
IF '$DATA(^XMB(3.7,XMDUZ,2,XMK))
QUIT
+5 SET XMFDA(3.701,"+1,"_XMDUZ_",",.01)=XMKN
+6 SET XMIEN(1)=XMK
MTRY DO UPDATE^DIE("S","XMFDA","XMIEN")
IF '$DATA(DIERR)
QUIT
+1 SET XMTRIES=$GET(XMTRIES)+1
+2 ; Try again if can't lock
IF $DATA(^TMP("DIERR",$JOB,"E",110))
HANG 1
GOTO MTRY
+3 QUIT
DELBSKT(XMDUZ,XMK,XMFLAGS) ;
+1 ; XMK Basket IEN
+2 NEW XMNEW
+3 KILL XMERR,^TMP("XMERR",$JOB)
+4 IF XMDUZ=.6
IF '$$POSTPRIV^XMXSEC
QUIT
+5 IF XMDUZ'=DUZ
IF '$$RPRIV^XMXSEC
QUIT
+6 IF XMK'>1
Begin DoDot:1
+7 ; The '_IN/WASTE_' basket may not be deleted.
DO ERRSET^XMXUTIL(37215.2,$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1))
End DoDot:1
QUIT
+8 IF $GET(XMFLAGS)'["D"
IF $$BMSGCT^XMXUTIL(XMDUZ,XMK)>0
Begin DoDot:1
+9 ; The '_x_' basket may not be deleted, because it still has messages in it.
DO ERRSET^XMXUTIL(37215.4,$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1))
End DoDot:1
QUIT
+10 SET XMNEW=$$BNMSGCT^XMXUTIL(XMDUZ,XMK)
+11 LOCK +^XMB(3.7,XMDUZ):1
+12 IF XMNEW
SET $PIECE(^(0),U,6)=$PIECE(^XMB(3.7,XMDUZ,0),U,6)-XMNEW
+13 NEW XMFDA
+14 SET XMFDA(3.701,XMK_","_XMDUZ_",",.01)="@"
+15 DO FILE^DIE("","XMFDA")
+16 LOCK -^XMB(3.7,XMDUZ)
+17 QUIT
LISTBSKT(XMDUZ,XMFLAGS,XMAMT,XMSTART,XMPART,XMTROOT) ;
+1 NEW XMORDER,XMI,XMCNT,XMK,XMKREC,XMSCREEN,XMFMFLAG
+2 IF XMDUZ'=DUZ
IF '$$RPRIV^XMXSEC
QUIT
+3 IF $DATA(XMTROOT)
IF XMTROOT'=""
Begin DoDot:1
+4 KILL @$$CREF^DILF(XMTROOT)
+5 SET XMTROOT=$$OREF^DILF(XMTROOT)_"""XMLIST"","
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 KILL ^TMP("XMLIST",$JOB)
+8 SET XMTROOT="^TMP(""XMLIST"",$J,"
End DoDot:1
+9 ; Only baskets w/new msgs
IF $GET(XMFLAGS)["N"
SET XMSCREEN="I $P(^(0),U,2)"
+10 IF '$TEST
SET XMSCREEN=""
+11 SET XMFMFLAG="I"
+12 IF $GET(XMFLAGS)["B"
SET XMFMFLAG=XMFMFLAG_"B"
+13 DO LIST^DIC(3.701,","_XMDUZ_",","",XMFMFLAG,.XMAMT,.XMSTART,.XMPART,"",XMSCREEN)
+14 SET @(XMTROOT_"0)")=^TMP("DILIST",$JOB,0)
+15 SET XMORDER=$SELECT($GET(XMFLAGS)["B":-1,1:1)
+16 SET XMCNT=0
SET XMI=""
+17 FOR
SET XMI=$ORDER(^TMP("DILIST",$JOB,2,XMI),XMORDER)
IF 'XMI
QUIT
SET XMK=^(XMI)
Begin DoDot:1
+18 SET XMCNT=XMCNT+1
+19 SET XMKREC=^XMB(3.7,XMDUZ,2,XMK,0)
+20 ; basket ien^basket name^# msgs^# new msgs
SET @(XMTROOT_XMCNT_")")=XMK_U_$PIECE(XMKREC,U,1)_U_$$BMSGCT^XMXUTIL(XMDUZ,XMK)_U_+$PIECE(XMKREC,U,2)
+21 IF '$GET(XMAMT)
SET @(XMTROOT_"""BSKT"",$$UP^XLFSTR($P(XMKREC,U,1)),"_XMCNT_")")=""
End DoDot:1
+22 KILL ^TMP("DILIST",$JOB)
+23 QUIT
NAMEBSKT(XMDUZ,XMK,XMKN) ;
+1 ; XMK Basket IEN
+2 ; XMKN New basket name
+3 KILL XMERR,^TMP("XMERR",$JOB)
+4 IF XMDUZ=.6
IF '$$POSTPRIV^XMXSEC
QUIT
+5 IF XMDUZ'=DUZ
IF '$$WPRIV^XMXSEC
QUIT
+6 IF XMK'>1!(XMDUZ=.5&(XMK>999))
Begin DoDot:1
+7 ; The '_x_' basket name may not be changed.
DO ERRSET^XMXUTIL(37201.2,$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1))
End DoDot:1
QUIT
+8 NEW XMFDA
+9 SET XMFDA(3.701,XMK_","_XMDUZ_",",.01)=XMKN
+10 DO FILE^DIE("","XMFDA")
+11 QUIT
QBSKT(XMDUZ,XMK,XMMSG) ; Message counts for a mail basket
+1 NEW XMKREC
+2 KILL XMERR,^TMP("XMERR",$JOB)
+3 SET XMMSG=""
+4 IF XMDUZ'=DUZ
IF '$$RPRIV^XMXSEC
QUIT
+5 SET XMKREC=^XMB(3.7,XMDUZ,2,XMK,0)
+6 ; basket ien^basket name^# msgs^# new msgs
SET XMMSG=XMK_U_$PIECE(XMKREC,U,1)_U_$$BMSGCT^XMXUTIL(XMDUZ,XMK)_U_+$PIECE(XMKREC,U,2)
+7 QUIT
RSEQBSKT(XMDUZ,XMK,XMMSG) ; Resequence message numbers
+1 ; XMZ - Unique message number
+2 ; XMK - basket number
+3 ; XMKZ - Message number in basket
+4 ; XMKZCNT - Number of messages in basket
+5 ; (XMERROR is set in XMUT4)
NEW XMKZCNT,XMERROR
+6 KILL XMERR,^TMP("XMERR",$JOB)
+7 SET XMMSG=""
+8 ;I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q ; Shouldn't need special privileges.
+9 IF XMDUZ'=DUZ
IF '$$RPRIV^XMXSEC
QUIT
+10 ; Basket integrity check
DO BSKT^XMUT4(XMDUZ,XMK)
+11 ; resequence
DO RSEQ(XMDUZ,XMK,.XMKZCNT)
+12 ; Resequenced from 1 to _XMKZCNT.
SET XMMSG=$$EZBLD^DIALOG(37212.9,XMKZCNT)
+13 QUIT
RSEQ(XMDUZ,XMK,XMKZNEW) ; Internal MailMan entry point to resequence a basket
+1 ; *** IN create date/xmz SEQUENCE ***
+2 NEW XMKZ,XMZ,XMFDA,XMCRE8DT
+3 KILL ^TMP("XM",$JOB,"RSEQ")
+4 SET XMZ=0
+5 FOR
SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,XMZ))
IF XMZ'>0
QUIT
SET ^TMP("XM",$JOB,"RSEQ",+$PIECE($GET(^XMB(3.9,XMZ,.6)),U),XMZ)=""
+6 SET XMKZNEW=0
SET (XMCRE8DT,XMZ)=""
+7 FOR
SET XMCRE8DT=$ORDER(^TMP("XM",$JOB,"RSEQ",XMCRE8DT))
IF XMCRE8DT=""
QUIT
Begin DoDot:1
+8 FOR
SET XMZ=$ORDER(^TMP("XM",$JOB,"RSEQ",XMCRE8DT,XMZ))
IF 'XMZ
QUIT
Begin DoDot:2
+9 SET XMKZ=$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
IF 'XMKZ
QUIT
+10 SET XMKZNEW=XMKZNEW+1
+11 IF XMKZ=XMKZNEW
QUIT
+12 SET XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",2)=XMKZNEW
+13 ; Error resequencing the '_x_' basket.
DO FILE^DIE("","XMFDA")
IF $DATA(DIERR)
DO ERRSET^XMXUTIL(37212.8,$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1))
End DoDot:2
IF $DATA(XMERR)
QUIT
End DoDot:1
IF $DATA(XMERR)
QUIT
+14 KILL ^TMP("XM",$JOB,"RSEQ")
+15 IF $DATA(XMERR)
QUIT
+16 IF +$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)'=XMKZNEW
SET $PIECE(^(0),U,4)=XMKZNEW
+17 QUIT
XRSEQ(XMDUZ,XMK,XMKZNEW) ; Internal MailMan entry point to resequence a basket
+1 ; *** IN XMKZ SEQUENCE ***
+2 NEW XMKZ,XMZ,XMFDA
+3 SET (XMKZ,XMKZNEW)=0
+4 FOR
SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ))
IF XMKZ'>0
QUIT
Begin DoDot:1
+5 IF XMKZ'>XMKZNEW
SET XMKZNEW=XMKZ-1
+6 SET XMZ=0
+7 FOR
SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,XMZ))
IF XMZ'>0
QUIT
Begin DoDot:2
+8 SET XMKZNEW=XMKZNEW+1
+9 IF XMKZ=XMKZNEW
QUIT
+10 SET XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",2)=XMKZNEW
+11 ; Error resequencing the '_x_' basket.
DO FILE^DIE("","XMFDA")
IF $DATA(DIERR)
DO ERRSET^XMXUTIL(37212.8,$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1))
End DoDot:2
IF $DATA(XMERR)
QUIT
End DoDot:1
IF $DATA(XMERR)
QUIT
+12 IF $DATA(XMERR)
QUIT
+13 IF +$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)'=XMKZNEW
SET $PIECE(^(0),U,4)=XMKZNEW
+14 QUIT
FLTRBSKT(XMDUZ,XMK,XMMSG) ; Filter a basket
+1 ; XMZ - Unique message number
+2 ; XMK - basket number
+3 KILL XMERR,^TMP("XMERR",$JOB)
+4 SET XMMSG=""
+5 IF XMDUZ=.6
IF '$$POSTPRIV^XMXSEC
QUIT
+6 IF XMDUZ'=DUZ
IF '$$RPRIV^XMXSEC
QUIT
+7 IF XMK'=.5
IF '$DATA(^XMB(3.7,XMDUZ,15,"AF"))
Begin DoDot:1
+8 ; You have / x has no message filters defined.
DO ERRSET^XMXUTIL($SELECT(XMDUZ=DUZ:37204.1,1:37204.2),XMV("NAME"))
End DoDot:1
QUIT
+9 IF XMDUZ=.5
IF XMK>1000
Begin DoDot:1
+10 ; You may not do this with messages in the transmit queues.
DO ERRSET^XMXUTIL(37251)
End DoDot:1
QUIT
+11 NEW XMZ,XMKN
+12 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
+13 SET XMZ=0
+14 FOR
SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,XMZ))
IF XMZ'>0
QUIT
DO FLTR^XMXMSGS2(XMDUZ,XMK,XMKN,XMZ)
+15 ; Basket filtered.
SET XMMSG=$$EZBLD^DIALOG(34306.2)
+16 QUIT
