| [613] | 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
 | 
|---|