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

XMXBSKT.m

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