| 1 | XMXBSKT ;ISC-SF/GMB-Basket APIs ;03/25/2003 14:55
|
---|
| 2 | ;;8.0;MailMan;**16**;Jun 28, 2002
|
---|
| 3 | CRE8BSKT(XMDUZ,XMKN,XMK) ; Routine creates basket, given name, and
|
---|
| 4 | ; returns basket number.
|
---|
| 5 | K XMERR,^TMP("XMERR",$J)
|
---|
| 6 | I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q
|
---|
| 7 | I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
|
---|
| 8 | S XMK=$$FIND1^DIC(3.701,","_XMDUZ_",","X",XMKN)
|
---|
| 9 | I XMK D Q
|
---|
| 10 | .; (It might be better if used an index which was the upper case of
|
---|
| 11 | .; the basket name, and if we checked for upper case of XMKN)
|
---|
| 12 | . D ERRSET^XMXUTIL(37201.3,XMKN) ; Basket '_XMKN_' already exists.
|
---|
| 13 | I XMDUZ=.5 D Q:$G(XMERR)
|
---|
| 14 | . N I,XMK
|
---|
| 15 | . S XMK=.99
|
---|
| 16 | . F I=1:1 S XMK=$O(^XMB(3.7,.5,2,XMK)) Q:XMK>999!'XMK
|
---|
| 17 | . Q:I<999
|
---|
| 18 | . D ERRSET^XMXUTIL(38113.1) ; Postmaster may not have more than 999 baskets. (>999=Network msg queues)
|
---|
| 19 | ;D VAL^DIE(3.701,"1,"_XMDUZ_",",.01,"H",XMKN) ; validate the name
|
---|
| 20 | D MAKEBSKT(XMDUZ,.XMK,XMKN)
|
---|
| 21 | Q
|
---|
| 22 | MAKEBSKT(XMDUZ,XMK,XMKN) ; Create a basket (For internal MM use only)
|
---|
| 23 | ; If you give it an XMK, it'll put it there,
|
---|
| 24 | ; else, it'll find a vacant XMK.
|
---|
| 25 | N XMFDA,XMIEN,XMTRIES
|
---|
| 26 | I 'XMK F XMK=2:1 Q:'$D(^XMB(3.7,XMDUZ,2,XMK)) ; Find 1st vacant bskt #
|
---|
| 27 | S XMFDA(3.701,"+1,"_XMDUZ_",",.01)=XMKN
|
---|
| 28 | S XMIEN(1)=XMK
|
---|
| 29 | MTRY D UPDATE^DIE("S","XMFDA","XMIEN") Q:'$D(DIERR)
|
---|
| 30 | S XMTRIES=$G(XMTRIES)+1
|
---|
| 31 | I $D(^TMP("DIERR",$J,"E",110)) H 1 G MTRY ; Try again if can't lock
|
---|
| 32 | Q
|
---|
| 33 | DELBSKT(XMDUZ,XMK,XMFLAGS) ;
|
---|
| 34 | ; XMK Basket IEN
|
---|
| 35 | N XMNEW
|
---|
| 36 | K XMERR,^TMP("XMERR",$J)
|
---|
| 37 | I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q
|
---|
| 38 | I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
|
---|
| 39 | I XMK'>1 D Q
|
---|
| 40 | . D ERRSET^XMXUTIL(37215.2,$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)) ; The '_IN/WASTE_' basket may not be deleted.
|
---|
| 41 | I $G(XMFLAGS)'["D",$$BMSGCT^XMXUTIL(XMDUZ,XMK)>0 D Q
|
---|
| 42 | . 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.
|
---|
| 43 | S XMNEW=$$BNMSGCT^XMXUTIL(XMDUZ,XMK)
|
---|
| 44 | L +^XMB(3.7,XMDUZ):1
|
---|
| 45 | S:XMNEW $P(^(0),U,6)=$P(^XMB(3.7,XMDUZ,0),U,6)-XMNEW
|
---|
| 46 | N XMFDA
|
---|
| 47 | S XMFDA(3.701,XMK_","_XMDUZ_",",.01)="@"
|
---|
| 48 | D FILE^DIE("","XMFDA")
|
---|
| 49 | L -^XMB(3.7,XMDUZ)
|
---|
| 50 | Q
|
---|
| 51 | LISTBSKT(XMDUZ,XMFLAGS,XMAMT,XMSTART,XMPART,XMTROOT) ;
|
---|
| 52 | N XMORDER,XMI,XMCNT,XMK,XMKREC,XMSCREEN,XMFMFLAG
|
---|
| 53 | I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
|
---|
| 54 | I $D(XMTROOT),XMTROOT'="" D
|
---|
| 55 | . K @$$CREF^DILF(XMTROOT)
|
---|
| 56 | . S XMTROOT=$$OREF^DILF(XMTROOT)_"""XMLIST"","
|
---|
| 57 | E D
|
---|
| 58 | . K ^TMP("XMLIST",$J)
|
---|
| 59 | . S XMTROOT="^TMP(""XMLIST"",$J,"
|
---|
| 60 | I $G(XMFLAGS)["N" S XMSCREEN="I $P(^(0),U,2)" ; Only baskets w/new msgs
|
---|
| 61 | E S XMSCREEN=""
|
---|
| 62 | S XMFMFLAG="I"
|
---|
| 63 | I $G(XMFLAGS)["B" S XMFMFLAG=XMFMFLAG_"B"
|
---|
| 64 | D LIST^DIC(3.701,","_XMDUZ_",","",XMFMFLAG,.XMAMT,.XMSTART,.XMPART,"",XMSCREEN)
|
---|
| 65 | S @(XMTROOT_"0)")=^TMP("DILIST",$J,0)
|
---|
| 66 | S XMORDER=$S($G(XMFLAGS)["B":-1,1:1)
|
---|
| 67 | S XMCNT=0,XMI=""
|
---|
| 68 | F S XMI=$O(^TMP("DILIST",$J,2,XMI),XMORDER) Q:'XMI S XMK=^(XMI) D
|
---|
| 69 | . S XMCNT=XMCNT+1
|
---|
| 70 | . S XMKREC=^XMB(3.7,XMDUZ,2,XMK,0)
|
---|
| 71 | . 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
|
---|
| 72 | . I '$G(XMAMT) S @(XMTROOT_"""BSKT"",$$UP^XLFSTR($P(XMKREC,U,1)),"_XMCNT_")")=""
|
---|
| 73 | K ^TMP("DILIST",$J)
|
---|
| 74 | Q
|
---|
| 75 | NAMEBSKT(XMDUZ,XMK,XMKN) ;
|
---|
| 76 | ; XMK Basket IEN
|
---|
| 77 | ; XMKN New basket name
|
---|
| 78 | K XMERR,^TMP("XMERR",$J)
|
---|
| 79 | I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q
|
---|
| 80 | I XMDUZ'=DUZ,'$$WPRIV^XMXSEC Q
|
---|
| 81 | I XMK'>1!(XMDUZ=.5&(XMK>999)) D Q
|
---|
| 82 | . D ERRSET^XMXUTIL(37201.2,$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)) ; The '_x_' basket name may not be changed.
|
---|
| 83 | N XMFDA
|
---|
| 84 | S XMFDA(3.701,XMK_","_XMDUZ_",",.01)=XMKN
|
---|
| 85 | D FILE^DIE("","XMFDA")
|
---|
| 86 | Q
|
---|
| 87 | QBSKT(XMDUZ,XMK,XMMSG) ; Message counts for a mail basket
|
---|
| 88 | N XMKREC
|
---|
| 89 | K XMERR,^TMP("XMERR",$J)
|
---|
| 90 | S XMMSG=""
|
---|
| 91 | I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
|
---|
| 92 | S XMKREC=^XMB(3.7,XMDUZ,2,XMK,0)
|
---|
| 93 | 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
|
---|
| 94 | Q
|
---|
| 95 | RSEQBSKT(XMDUZ,XMK,XMMSG) ; Resequence message numbers
|
---|
| 96 | ; XMZ - Unique message number
|
---|
| 97 | ; XMK - basket number
|
---|
| 98 | ; XMKZ - Message number in basket
|
---|
| 99 | ; XMKZCNT - Number of messages in basket
|
---|
| 100 | N XMKZCNT,XMERROR ; (XMERROR is set in XMUT4)
|
---|
| 101 | K XMERR,^TMP("XMERR",$J)
|
---|
| 102 | S XMMSG=""
|
---|
| 103 | ;I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q ; Shouldn't need special privileges.
|
---|
| 104 | I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
|
---|
| 105 | D BSKT^XMUT4(XMDUZ,XMK) ; Basket integrity check
|
---|
| 106 | D RSEQ(XMDUZ,XMK,.XMKZCNT) ; resequence
|
---|
| 107 | S XMMSG=$$EZBLD^DIALOG(37212.9,XMKZCNT) ; Resequenced from 1 to _XMKZCNT.
|
---|
| 108 | Q
|
---|
| 109 | RSEQ(XMDUZ,XMK,XMKZNEW) ; Internal MailMan entry point to resequence a basket
|
---|
| 110 | ; *** IN create date/xmz SEQUENCE ***
|
---|
| 111 | N XMKZ,XMZ,XMFDA,XMCRE8DT
|
---|
| 112 | K ^TMP("XM",$J,"RSEQ")
|
---|
| 113 | S XMZ=0
|
---|
| 114 | 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)=""
|
---|
| 115 | S XMKZNEW=0,(XMCRE8DT,XMZ)=""
|
---|
| 116 | F S XMCRE8DT=$O(^TMP("XM",$J,"RSEQ",XMCRE8DT)) Q:XMCRE8DT="" D Q:$D(XMERR)
|
---|
| 117 | . F S XMZ=$O(^TMP("XM",$J,"RSEQ",XMCRE8DT,XMZ)) Q:'XMZ D Q:$D(XMERR)
|
---|
| 118 | . . S XMKZ=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2) Q:'XMKZ
|
---|
| 119 | . . S XMKZNEW=XMKZNEW+1
|
---|
| 120 | . . Q:XMKZ=XMKZNEW
|
---|
| 121 | . . S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",2)=XMKZNEW
|
---|
| 122 | . . 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.
|
---|
| 123 | K ^TMP("XM",$J,"RSEQ")
|
---|
| 124 | Q:$D(XMERR)
|
---|
| 125 | S:+$P($G(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)'=XMKZNEW $P(^(0),U,4)=XMKZNEW
|
---|
| 126 | Q
|
---|
| 127 | XRSEQ(XMDUZ,XMK,XMKZNEW) ; Internal MailMan entry point to resequence a basket
|
---|
| 128 | ; *** IN XMKZ SEQUENCE ***
|
---|
| 129 | N XMKZ,XMZ,XMFDA
|
---|
| 130 | S (XMKZ,XMKZNEW)=0
|
---|
| 131 | F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ'>0 D Q:$D(XMERR)
|
---|
| 132 | . I XMKZ'>XMKZNEW S XMKZNEW=XMKZ-1
|
---|
| 133 | . S XMZ=0
|
---|
| 134 | . F S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,XMZ)) Q:XMZ'>0 D Q:$D(XMERR)
|
---|
| 135 | . . S XMKZNEW=XMKZNEW+1
|
---|
| 136 | . . Q:XMKZ=XMKZNEW
|
---|
| 137 | . . S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",2)=XMKZNEW
|
---|
| 138 | . . 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.
|
---|
| 139 | Q:$D(XMERR)
|
---|
| 140 | S:+$P($G(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)'=XMKZNEW $P(^(0),U,4)=XMKZNEW
|
---|
| 141 | Q
|
---|
| 142 | FLTRBSKT(XMDUZ,XMK,XMMSG) ; Filter a basket
|
---|
| 143 | ; XMZ - Unique message number
|
---|
| 144 | ; XMK - basket number
|
---|
| 145 | K XMERR,^TMP("XMERR",$J)
|
---|
| 146 | S XMMSG=""
|
---|
| 147 | I XMDUZ=.6,'$$POSTPRIV^XMXSEC Q
|
---|
| 148 | I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
|
---|
| 149 | I XMK'=.5,'$D(^XMB(3.7,XMDUZ,15,"AF")) D Q
|
---|
| 150 | . D ERRSET^XMXUTIL($S(XMDUZ=DUZ:37204.1,1:37204.2),XMV("NAME")) ; You have / x has no message filters defined.
|
---|
| 151 | I XMDUZ=.5,XMK>1000 D Q
|
---|
| 152 | . D ERRSET^XMXUTIL(37251) ; You may not do this with messages in the transmit queues.
|
---|
| 153 | N XMZ,XMKN
|
---|
| 154 | S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
|
---|
| 155 | S XMZ=0
|
---|
| 156 | F S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,XMZ)) Q:XMZ'>0 D FLTR^XMXMSGS2(XMDUZ,XMK,XMKN,XMZ)
|
---|
| 157 | S XMMSG=$$EZBLD^DIALOG(34306.2) ; Basket filtered.
|
---|
| 158 | Q
|
---|