source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMXPARMB.m@ 691

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1XMXPARMB ;ISC-SF/GMB-Parameter check for XMXAPIB ;04/17/2002 14:12
2 ;;8.0;MailMan;;Jun 28, 2002
3CRE8MBOX(XMDUZ,XMDATE) ; Create a mailbox for a user
4 K XMERR,^TMP("XMERR",$J)
5 D CHKUSER^XMXPARM1(.XMDUZ,1)
6 I $D(XMDATE) S XMDATE=$$XMDATE("XMDATE",XMDATE)
7 Q
8XMDATE(XMPARM,XMDATE) ;
9 N %DT,Y,X
10 S X=XMDATE ;,%DT(0)="-NOW"
11 S %DT="X"
12 D ^%DT
13 Q:Y>0 Y
14 N XMP
15 S XMP("PARAM","ID")=XMPARM
16 S XMP("PARAM","VALUE")=XMDATE
17 D ERRSET^XMXUTIL(39420,.XMP) ; Must be an exact date.
18 Q XMDATE
19VA200(XMDUZ) ; Make sure DUZ exists
20 Q:$D(^VA(200,XMDUZ,0))
21 N XMP
22 S XMP("PARAM","ID")="XMDUZ"
23 S XMP("PARAM","VALUE")=XMDUZ,XMP(1)=XMDUZ
24 D ERRSET^XMXUTIL(39433,.XMP) ; User '|1|' not found.
25 Q
26TERMMBOX(XMDUZ) ; Terminate a mailbox (delete all traces of user in MailMan)
27 K XMERR,^TMP("XMERR",$J)
28 D CHKUSER^XMXPARM1(.XMDUZ,1)
29 Q
30MBOX(XMDUZ) ;
31 K XMERR,^TMP("XMERR",$J)
32 D XMDUZ^XMXPARM(.XMDUZ,.XMV)
33 Q
34LISTBSKT(XMDUZ,XMFLAGS,XMAMT,XMSTART,XMPART,XMTROOT) ;
35 K XMERR,^TMP("XMERR",$J)
36 D XMDUZ^XMXPARM(.XMDUZ,.XMV)
37 I $D(XMFLAGS) D XMFLAG^XMXPARM("XMFLAGS",XMFLAGS,"BN")
38 I $D(XMAMT) D XMAMT("XMAMT",.XMAMT)
39 Q
40LISTMSGS(XMDUZ,XMK,XMFLDS,XMFLAGS,XMAMT,XMSTART,XMF,XMTROOT) ;
41 K XMERR,^TMP("XMERR",$J)
42 D XMDUZ^XMXPARM(.XMDUZ,.XMV)
43 I $D(XMK) S:"^*^!^"'[(U_XMK_U) XMK=$$XMK^XMXPARM(XMDUZ,"XMK",XMK)
44 I $D(XMFLAGS) D XMFLAG^XMXPARM("XMFLAGS",XMFLAGS,"BCNP")
45 I $D(XMAMT) D XMAMT("XMAMT",.XMAMT)
46 Q
47DELBSKT(XMDUZ,XMK,XMFLAGS) ;
48 D BSKT(.XMDUZ,.XMK)
49 I $D(XMFLAGS) D XMFLAG^XMXPARM("XMFLAGS",XMFLAGS,"D")
50 Q
51BSKT(XMDUZ,XMK) ; Make sure basket exists
52 K XMERR,^TMP("XMERR",$J)
53 D XMDUZ^XMXPARM(.XMDUZ,.XMV)
54 S:$D(XMK) XMK=$$XMK^XMXPARM(XMDUZ,"XMK",XMK)
55 Q
56CRE8BSKT(XMDUZ,XMKN) ;
57 K XMERR,^TMP("XMERR",$J)
58 D XMDUZ^XMXPARM(.XMDUZ,.XMV)
59 S XMKN=$$XMKN(XMDUZ,"XMKN",XMKN)
60 Q
61NAMEBSKT(XMDUZ,XMK,XMKN) ;
62 K XMERR,^TMP("XMERR",$J)
63 D XMDUZ^XMXPARM(.XMDUZ,.XMV)
64 S XMK=$$XMK^XMXPARM(XMDUZ,"XMK",.XMK)
65 S XMKN=$$XMKN(XMDUZ,"XMKN",XMKN)
66 Q
67XMKN(XMDUZ,XMPARM,XMKN,XMOKXST) ; Validate a prospective basket name
68 ; XMKN prospective basket name
69 ; XMOKXST is it OK if a basket with that name already exists? (0=no; 1=yes)
70 N XMOK
71 I '$G(XMOKXST) D Q:$D(XMERR) XMKN
72 . Q:'$$FIND1^DIC(3.701,","_XMDUZ_",","XQ",XMKN)
73 . N XMP
74 . S XMP("PARAM","ID")=XMPARM
75 . S XMP("PARAM","VALUE")=XMKN,XMP(1)=XMKN
76 . D ERRSET^XMXUTIL(39440,.XMP) ; Basket '|1|' already exists.
77 D VAL^DIE(3.701,"1,"_XMDUZ_",",.01,"",XMKN,.XMOK) Q:XMOK'=U XMKN
78 N XMP
79 S XMP("PARAM","ID")=XMPARM
80 S XMP("PARAM","VALUE")=XMKN,XMP(1)=2,XMP(2)=30
81 D ERRSET^XMXUTIL(39437,.XMP) ; Must be |1|-|2| characters, no ^.
82 Q XMKN
83XMAMT(XMPARM,XMAMT) ;
84 Q:'$D(XMAMT)
85 Q:XMAMT=""
86 Q:XMAMT="*"
87 Q:XMAMT=+XMAMT&(XMAMT>0)
88 N XMP
89 S XMP("PARAM","ID")=XMPARM
90 S XMP("PARAM","VALUE")=XMAMT,XMP(1)=XMAMT
91 D ERRSET^XMXUTIL(39441,.XMP) ; Must be a positive number OR *.
92 Q
93SERV(XMKN,XMZ) ;
94 K XMERR,^TMP("XMERR",$J)
95 D XMSERV(.XMKN)
96 D XMZ^XMXPARM(.XMZ)
97 Q
98XMSERV(XMKN) ;
99 I $E(XMKN,1,2)'="S." D Q
100 . N XMP
101 . S XMP("PARAM","ID")="XMKN"
102 . S XMP("PARAM","VALUE")=XMKN,XMP(1)=XMKN
103 . D ERRSET^XMXUTIL(39442,.XMP) ; Server basket name must begin with 'S.'.
104 Q:$O(^DIC(19,"B",$E(XMKN,3,999),0))
105 N XMP
106 S XMP("PARAM","ID")="XMKN"
107 S XMP("PARAM","VALUE")=XMKN,XMP(1)=XMKN
108 D ERRSET^XMXUTIL(39443,.XMP) ; Server basket '|1|' not found. Name must be exact.
109 Q
Note: See TracBrowser for help on using the repository browser.