source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJBU.m@ 1261

Last change on this file since 1261 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1XMJBU ;ISC-SF/GMB-Basket utilities ;04/06/2002 08:56
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; (ISC-WASH/CAP/THM)
4SELBSKT(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
32CHKXMKN(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
36NAMEBSKT(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
Note: See TracBrowser for help on using the repository browser.