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

XMJBU.m

Go to the documentation of this file.
  1. XMJBU ;ISC-SF/GMB-Basket utilities ;04/06/2002 08:56
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. ; (ISC-WASH/CAP/THM)
  1. SELBSKT(XMDUZ,XMPROMPT,XMLAYGO,XMDIC,XMK,XMKN) ; Select a basket (Replaces S^XMA1B)
  1. ; XMPROMPT (in) Verbage for prompt
  1. ; XMLAYGO (in) "L" - the user may create a new basket
  1. ; "" - the user may not create a new basket
  1. ; XMK (out) basket number (=^ if user up-arrows out)
  1. ; XMKN (out) basket name
  1. N DIC,DINUM,DA,Y,X
  1. I $G(XMLAYGO)["L" D
  1. . ; Find the first vacant basket spot.
  1. . F DINUM=2:1 Q:'$D(^XMB(3.7,XMDUZ,2,DINUM))
  1. . ; Postmaster baskets numbered above 999 are reserved for message queues.
  1. . I XMDUZ=.5,DINUM>999 S XMLAYGO=$TR(XMLAYGO,"L")
  1. ; Postmaster may not save a queued msg to his own basket. ***
  1. S DIC="^XMB(3.7,"_XMDUZ_",2,"
  1. S DA(1)=XMDUZ
  1. S DIC(0)="AEQ"_$G(XMLAYGO)
  1. I $G(XMPROMPT)'="" S DIC("A")=$S(+XMPROMPT=XMPROMPT:$$EZBLD^DIALOG(XMPROMPT),1:XMPROMPT)
  1. ; XMDIC("B")="@" means don't give a default
  1. I $G(XMDIC("B"))'="@" D
  1. . I $D(XMDIC("B")) S DIC("B")=XMDIC("B") Q
  1. . I $$BMSGCT^XMXUTIL(XMDUZ,1) S DIC("B")=$$EZBLD^DIALOG(37005) Q ; IN
  1. . W !!,$$EZBLD^DIALOG(34044,$$EZBLD^DIALOG(37005)) ; No messages in 'IN' basket.
  1. S:$D(XMDIC("S")) DIC("S")=XMDIC("S")
  1. S:$D(XMDIC("W")) DIC("W")=XMDIC("W")
  1. D ^DIC I Y=-1 S XMK=U Q
  1. S XMK=$P(Y,U,1)
  1. S XMKN=$P(Y,U,2)
  1. Q
  1. CHKXMKN(X) ; Input transform for file 3.7 (3.701,.01 BASKET)
  1. I X=+X,$D(^XMB(3.7,$G(XMDUZ,DUZ),2,X)) S X="`"_X Q
  1. K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X
  1. Q
  1. NAMEBSKT(XMDUZ,XMK,XMKN) ; Rename an existing basket (Replaces REN^XMA11)
  1. ; XMK (in) basket number
  1. ; XMKN (in/out) basket name
  1. N DIR,X,XMFDA,XMKX
  1. I XMK'>1!(XMDUZ=.5&(XMK>999)) D Q
  1. . W !,$$EZBLD^DIALOG(37201.1) ; The name of this basket may not be changed.
  1. ; *** I would rather use a ^DIE call, if I were sure that the user
  1. ; *** could not delete the basket or create a duplicate basket name.
  1. S DIR("A")=$$EZBLD^DIALOG(34048) ; Enter a new basket name
  1. S DIR("B")=XMKN
  1. S DIR(0)="3.701,.01"
  1. F D ^DIR Q:$D(DIRUT) D Q:$D(X)
  1. . I X=XMKN D Q
  1. . . W !,$C(7),$$EZBLD^DIALOG(34048.8) ; That's the same name.
  1. . . K X
  1. . S XMKX=$$FIND1^DIC(3.701,","_XMDUZ_",","X",X)
  1. . I XMKX,XMKX'=XMK D Q
  1. . . W !,$C(7),$$EZBLD^DIALOG(34048.9) ; You already have a basket by this name.
  1. . . K X
  1. . S XMKN=X
  1. . S XMFDA(3.701,XMK_","_XMDUZ_",",.01)=XMKN
  1. . D FILE^DIE("","XMFDA")
  1. Q