| 1 | XMJBU ;ISC-SF/GMB-Basket utilities ;04/06/2002 08:56
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; (ISC-WASH/CAP/THM)
|
|---|
| 4 | SELBSKT(XMDUZ,XMPROMPT,XMLAYGO,XMDIC,XMK,XMKN) ; Select a basket (Replaces S^XMA1B)
|
|---|
| 5 | ; XMPROMPT (in) Verbage for prompt
|
|---|
| 6 | ; XMLAYGO (in) "L" - the user may create a new basket
|
|---|
| 7 | ; "" - the user may not create a new basket
|
|---|
| 8 | ; XMK (out) basket number (=^ if user up-arrows out)
|
|---|
| 9 | ; XMKN (out) basket name
|
|---|
| 10 | N DIC,DINUM,DA,Y,X
|
|---|
| 11 | I $G(XMLAYGO)["L" D
|
|---|
| 12 | . ; Find the first vacant basket spot.
|
|---|
| 13 | . F DINUM=2:1 Q:'$D(^XMB(3.7,XMDUZ,2,DINUM))
|
|---|
| 14 | . ; Postmaster baskets numbered above 999 are reserved for message queues.
|
|---|
| 15 | . I XMDUZ=.5,DINUM>999 S XMLAYGO=$TR(XMLAYGO,"L")
|
|---|
| 16 | ; Postmaster may not save a queued msg to his own basket. ***
|
|---|
| 17 | S DIC="^XMB(3.7,"_XMDUZ_",2,"
|
|---|
| 18 | S DA(1)=XMDUZ
|
|---|
| 19 | S DIC(0)="AEQ"_$G(XMLAYGO)
|
|---|
| 20 | I $G(XMPROMPT)'="" S DIC("A")=$S(+XMPROMPT=XMPROMPT:$$EZBLD^DIALOG(XMPROMPT),1:XMPROMPT)
|
|---|
| 21 | ; XMDIC("B")="@" means don't give a default
|
|---|
| 22 | I $G(XMDIC("B"))'="@" D
|
|---|
| 23 | . I $D(XMDIC("B")) S DIC("B")=XMDIC("B") Q
|
|---|
| 24 | . I $$BMSGCT^XMXUTIL(XMDUZ,1) S DIC("B")=$$EZBLD^DIALOG(37005) Q ; IN
|
|---|
| 25 | . W !!,$$EZBLD^DIALOG(34044,$$EZBLD^DIALOG(37005)) ; No messages in 'IN' basket.
|
|---|
| 26 | S:$D(XMDIC("S")) DIC("S")=XMDIC("S")
|
|---|
| 27 | S:$D(XMDIC("W")) DIC("W")=XMDIC("W")
|
|---|
| 28 | D ^DIC I Y=-1 S XMK=U Q
|
|---|
| 29 | S XMK=$P(Y,U,1)
|
|---|
| 30 | S XMKN=$P(Y,U,2)
|
|---|
| 31 | Q
|
|---|
| 32 | CHKXMKN(X) ; Input transform for file 3.7 (3.701,.01 BASKET)
|
|---|
| 33 | I X=+X,$D(^XMB(3.7,$G(XMDUZ,DUZ),2,X)) S X="`"_X Q
|
|---|
| 34 | K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X
|
|---|
| 35 | Q
|
|---|
| 36 | NAMEBSKT(XMDUZ,XMK,XMKN) ; Rename an existing basket (Replaces REN^XMA11)
|
|---|
| 37 | ; XMK (in) basket number
|
|---|
| 38 | ; XMKN (in/out) basket name
|
|---|
| 39 | N DIR,X,XMFDA,XMKX
|
|---|
| 40 | I XMK'>1!(XMDUZ=.5&(XMK>999)) D Q
|
|---|
| 41 | . W !,$$EZBLD^DIALOG(37201.1) ; The name of this basket may not be changed.
|
|---|
| 42 | ; *** I would rather use a ^DIE call, if I were sure that the user
|
|---|
| 43 | ; *** could not delete the basket or create a duplicate basket name.
|
|---|
| 44 | S DIR("A")=$$EZBLD^DIALOG(34048) ; Enter a new basket name
|
|---|
| 45 | S DIR("B")=XMKN
|
|---|
| 46 | S DIR(0)="3.701,.01"
|
|---|
| 47 | F D ^DIR Q:$D(DIRUT) D Q:$D(X)
|
|---|
| 48 | . I X=XMKN D Q
|
|---|
| 49 | . . W !,$C(7),$$EZBLD^DIALOG(34048.8) ; That's the same name.
|
|---|
| 50 | . . K X
|
|---|
| 51 | . S XMKX=$$FIND1^DIC(3.701,","_XMDUZ_",","X",X)
|
|---|
| 52 | . I XMKX,XMKX'=XMK D Q
|
|---|
| 53 | . . W !,$C(7),$$EZBLD^DIALOG(34048.9) ; You already have a basket by this name.
|
|---|
| 54 | . . K X
|
|---|
| 55 | . S XMKN=X
|
|---|
| 56 | . S XMFDA(3.701,XMK_","_XMDUZ_",",.01)=XMKN
|
|---|
| 57 | . D FILE^DIE("","XMFDA")
|
|---|
| 58 | Q
|
|---|
