XMJBU ;ISC-SF/GMB-Basket utilities ;04/06/2002 08:56
;;8.0;MailMan;;Jun 28, 2002
; (ISC-WASH/CAP/THM)
SELBSKT(XMDUZ,XMPROMPT,XMLAYGO,XMDIC,XMK,XMKN) ; Select a basket (Replaces S^XMA1B)
; XMPROMPT (in) Verbage for prompt
; XMLAYGO (in) "L" - the user may create a new basket
; "" - the user may not create a new basket
; XMK (out) basket number (=^ if user up-arrows out)
; XMKN (out) basket name
N DIC,DINUM,DA,Y,X
I $G(XMLAYGO)["L" D
. ; Find the first vacant basket spot.
. F DINUM=2:1 Q:'$D(^XMB(3.7,XMDUZ,2,DINUM))
. ; Postmaster baskets numbered above 999 are reserved for message queues.
. I XMDUZ=.5,DINUM>999 S XMLAYGO=$TR(XMLAYGO,"L")
; Postmaster may not save a queued msg to his own basket. ***
S DIC="^XMB(3.7,"_XMDUZ_",2,"
S DA(1)=XMDUZ
S DIC(0)="AEQ"_$G(XMLAYGO)
I $G(XMPROMPT)'="" S DIC("A")=$S(+XMPROMPT=XMPROMPT:$$EZBLD^DIALOG(XMPROMPT),1:XMPROMPT)
; XMDIC("B")="@" means don't give a default
I $G(XMDIC("B"))'="@" D
. I $D(XMDIC("B")) S DIC("B")=XMDIC("B") Q
. I $$BMSGCT^XMXUTIL(XMDUZ,1) S DIC("B")=$$EZBLD^DIALOG(37005) Q ; IN
. W !!,$$EZBLD^DIALOG(34044,$$EZBLD^DIALOG(37005)) ; No messages in 'IN' basket.
S:$D(XMDIC("S")) DIC("S")=XMDIC("S")
S:$D(XMDIC("W")) DIC("W")=XMDIC("W")
D ^DIC I Y=-1 S XMK=U Q
S XMK=$P(Y,U,1)
S XMKN=$P(Y,U,2)
Q
CHKXMKN(X) ; Input transform for file 3.7 (3.701,.01 BASKET)
I X=+X,$D(^XMB(3.7,$G(XMDUZ,DUZ),2,X)) S X="`"_X Q
K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X
Q
NAMEBSKT(XMDUZ,XMK,XMKN) ; Rename an existing basket (Replaces REN^XMA11)
; XMK (in) basket number
; XMKN (in/out) basket name
N DIR,X,XMFDA,XMKX
I XMK'>1!(XMDUZ=.5&(XMK>999)) D Q
. W !,$$EZBLD^DIALOG(37201.1) ; The name of this basket may not be changed.
; *** I would rather use a ^DIE call, if I were sure that the user
; *** could not delete the basket or create a duplicate basket name.
S DIR("A")=$$EZBLD^DIALOG(34048) ; Enter a new basket name
S DIR("B")=XMKN
S DIR(0)="3.701,.01"
F D ^DIR Q:$D(DIRUT) D Q:$D(X)
. I X=XMKN D Q
. . W !,$C(7),$$EZBLD^DIALOG(34048.8) ; That's the same name.
. . K X
. S XMKX=$$FIND1^DIC(3.701,","_XMDUZ_",","X",X)
. I XMKX,XMKX'=XMK D Q
. . W !,$C(7),$$EZBLD^DIALOG(34048.9) ; You already have a basket by this name.
. . K X
. S XMKN=X
. S XMFDA(3.701,XMK_","_XMDUZ_",",.01)=XMKN
. D FILE^DIE("","XMFDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJBU 2428 printed Dec 13, 2024@02:11:49 Page 2
XMJBU ;ISC-SF/GMB-Basket utilities ;04/06/2002 08:56
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; (ISC-WASH/CAP/THM)
SELBSKT(XMDUZ,XMPROMPT,XMLAYGO,XMDIC,XMK,XMKN) ; Select a basket (Replaces S^XMA1B)
+1 ; XMPROMPT (in) Verbage for prompt
+2 ; XMLAYGO (in) "L" - the user may create a new basket
+3 ; "" - the user may not create a new basket
+4 ; XMK (out) basket number (=^ if user up-arrows out)
+5 ; XMKN (out) basket name
+6 NEW DIC,DINUM,DA,Y,X
+7 IF $GET(XMLAYGO)["L"
Begin DoDot:1
+8 ; Find the first vacant basket spot.
+9 FOR DINUM=2:1
if '$DATA(^XMB(3.7,XMDUZ,2,DINUM))
QUIT
+10 ; Postmaster baskets numbered above 999 are reserved for message queues.
+11 IF XMDUZ=.5
IF DINUM>999
SET XMLAYGO=$TRANSLATE(XMLAYGO,"L")
End DoDot:1
+12 ; Postmaster may not save a queued msg to his own basket. ***
+13 SET DIC="^XMB(3.7,"_XMDUZ_",2,"
+14 SET DA(1)=XMDUZ
+15 SET DIC(0)="AEQ"_$GET(XMLAYGO)
+16 IF $GET(XMPROMPT)'=""
SET DIC("A")=$SELECT(+XMPROMPT=XMPROMPT:$$EZBLD^DIALOG(XMPROMPT),1:XMPROMPT)
+17 ; XMDIC("B")="@" means don't give a default
+18 IF $GET(XMDIC("B"))'="@"
Begin DoDot:1
+19 IF $DATA(XMDIC("B"))
SET DIC("B")=XMDIC("B")
QUIT
+20 ; IN
IF $$BMSGCT^XMXUTIL(XMDUZ,1)
SET DIC("B")=$$EZBLD^DIALOG(37005)
QUIT
+21 ; No messages in 'IN' basket.
WRITE !!,$$EZBLD^DIALOG(34044,$$EZBLD^DIALOG(37005))
End DoDot:1
+22 if $DATA(XMDIC("S"))
SET DIC("S")=XMDIC("S")
+23 if $DATA(XMDIC("W"))
SET DIC("W")=XMDIC("W")
+24 DO ^DIC
IF Y=-1
SET XMK=U
QUIT
+25 SET XMK=$PIECE(Y,U,1)
+26 SET XMKN=$PIECE(Y,U,2)
+27 QUIT
CHKXMKN(X) ; Input transform for file 3.7 (3.701,.01 BASKET)
+1 IF X=+X
IF $DATA(^XMB(3.7,$GET(XMDUZ,DUZ),2,X))
SET X="`"_X
QUIT
+2 if X[""""!($ASCII(X)=45)
KILL X
IF $DATA(X)
if $LENGTH(X)>30!($LENGTH(X)<3)
KILL X
+3 QUIT
NAMEBSKT(XMDUZ,XMK,XMKN) ; Rename an existing basket (Replaces REN^XMA11)
+1 ; XMK (in) basket number
+2 ; XMKN (in/out) basket name
+3 NEW DIR,X,XMFDA,XMKX
+4 IF XMK'>1!(XMDUZ=.5&(XMK>999))
Begin DoDot:1
+5 ; The name of this basket may not be changed.
WRITE !,$$EZBLD^DIALOG(37201.1)
End DoDot:1
QUIT
+6 ; *** I would rather use a ^DIE call, if I were sure that the user
+7 ; *** could not delete the basket or create a duplicate basket name.
+8 ; Enter a new basket name
SET DIR("A")=$$EZBLD^DIALOG(34048)
+9 SET DIR("B")=XMKN
+10 SET DIR(0)="3.701,.01"
+11 FOR
DO ^DIR
if $DATA(DIRUT)
QUIT
Begin DoDot:1
+12 IF X=XMKN
Begin DoDot:2
+13 ; That's the same name.
WRITE !,$CHAR(7),$$EZBLD^DIALOG(34048.8)
+14 KILL X
End DoDot:2
QUIT
+15 SET XMKX=$$FIND1^DIC(3.701,","_XMDUZ_",","X",X)
+16 IF XMKX
IF XMKX'=XMK
Begin DoDot:2
+17 ; You already have a basket by this name.
WRITE !,$CHAR(7),$$EZBLD^DIALOG(34048.9)
+18 KILL X
End DoDot:2
QUIT
+19 SET XMKN=X
+20 SET XMFDA(3.701,XMK_","_XMDUZ_",",.01)=XMKN
+21 DO FILE^DIE("","XMFDA")
End DoDot:1
if $DATA(X)
QUIT
+22 QUIT
