XMXPARMB ;ISC-SF/GMB-Parameter check for XMXAPIB ;04/17/2002 14:12
;;8.0;MailMan;;Jun 28, 2002
CRE8MBOX(XMDUZ,XMDATE) ; Create a mailbox for a user
K XMERR,^TMP("XMERR",$J)
D CHKUSER^XMXPARM1(.XMDUZ,1)
I $D(XMDATE) S XMDATE=$$XMDATE("XMDATE",XMDATE)
Q
XMDATE(XMPARM,XMDATE) ;
N %DT,Y,X
S X=XMDATE ;,%DT(0)="-NOW"
S %DT="X"
D ^%DT
Q:Y>0 Y
N XMP
S XMP("PARAM","ID")=XMPARM
S XMP("PARAM","VALUE")=XMDATE
D ERRSET^XMXUTIL(39420,.XMP) ; Must be an exact date.
Q XMDATE
VA200(XMDUZ) ; Make sure DUZ exists
Q:$D(^VA(200,XMDUZ,0))
N XMP
S XMP("PARAM","ID")="XMDUZ"
S XMP("PARAM","VALUE")=XMDUZ,XMP(1)=XMDUZ
D ERRSET^XMXUTIL(39433,.XMP) ; User '|1|' not found.
Q
TERMMBOX(XMDUZ) ; Terminate a mailbox (delete all traces of user in MailMan)
K XMERR,^TMP("XMERR",$J)
D CHKUSER^XMXPARM1(.XMDUZ,1)
Q
MBOX(XMDUZ) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ^XMXPARM(.XMDUZ,.XMV)
Q
LISTBSKT(XMDUZ,XMFLAGS,XMAMT,XMSTART,XMPART,XMTROOT) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ^XMXPARM(.XMDUZ,.XMV)
I $D(XMFLAGS) D XMFLAG^XMXPARM("XMFLAGS",XMFLAGS,"BN")
I $D(XMAMT) D XMAMT("XMAMT",.XMAMT)
Q
LISTMSGS(XMDUZ,XMK,XMFLDS,XMFLAGS,XMAMT,XMSTART,XMF,XMTROOT) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ^XMXPARM(.XMDUZ,.XMV)
I $D(XMK) S:"^*^!^"'[(U_XMK_U) XMK=$$XMK^XMXPARM(XMDUZ,"XMK",XMK)
I $D(XMFLAGS) D XMFLAG^XMXPARM("XMFLAGS",XMFLAGS,"BCNP")
I $D(XMAMT) D XMAMT("XMAMT",.XMAMT)
Q
DELBSKT(XMDUZ,XMK,XMFLAGS) ;
D BSKT(.XMDUZ,.XMK)
I $D(XMFLAGS) D XMFLAG^XMXPARM("XMFLAGS",XMFLAGS,"D")
Q
BSKT(XMDUZ,XMK) ; Make sure basket exists
K XMERR,^TMP("XMERR",$J)
D XMDUZ^XMXPARM(.XMDUZ,.XMV)
S:$D(XMK) XMK=$$XMK^XMXPARM(XMDUZ,"XMK",XMK)
Q
CRE8BSKT(XMDUZ,XMKN) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ^XMXPARM(.XMDUZ,.XMV)
S XMKN=$$XMKN(XMDUZ,"XMKN",XMKN)
Q
NAMEBSKT(XMDUZ,XMK,XMKN) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ^XMXPARM(.XMDUZ,.XMV)
S XMK=$$XMK^XMXPARM(XMDUZ,"XMK",.XMK)
S XMKN=$$XMKN(XMDUZ,"XMKN",XMKN)
Q
XMKN(XMDUZ,XMPARM,XMKN,XMOKXST) ; Validate a prospective basket name
; XMKN prospective basket name
; XMOKXST is it OK if a basket with that name already exists? (0=no; 1=yes)
N XMOK
I '$G(XMOKXST) D Q:$D(XMERR) XMKN
. Q:'$$FIND1^DIC(3.701,","_XMDUZ_",","XQ",XMKN)
. N XMP
. S XMP("PARAM","ID")=XMPARM
. S XMP("PARAM","VALUE")=XMKN,XMP(1)=XMKN
. D ERRSET^XMXUTIL(39440,.XMP) ; Basket '|1|' already exists.
D VAL^DIE(3.701,"1,"_XMDUZ_",",.01,"",XMKN,.XMOK) Q:XMOK'=U XMKN
N XMP
S XMP("PARAM","ID")=XMPARM
S XMP("PARAM","VALUE")=XMKN,XMP(1)=2,XMP(2)=30
D ERRSET^XMXUTIL(39437,.XMP) ; Must be |1|-|2| characters, no ^.
Q XMKN
XMAMT(XMPARM,XMAMT) ;
Q:'$D(XMAMT)
Q:XMAMT=""
Q:XMAMT="*"
Q:XMAMT=+XMAMT&(XMAMT>0)
N XMP
S XMP("PARAM","ID")=XMPARM
S XMP("PARAM","VALUE")=XMAMT,XMP(1)=XMAMT
D ERRSET^XMXUTIL(39441,.XMP) ; Must be a positive number OR *.
Q
SERV(XMKN,XMZ) ;
K XMERR,^TMP("XMERR",$J)
D XMSERV(.XMKN)
D XMZ^XMXPARM(.XMZ)
Q
XMSERV(XMKN) ;
I $E(XMKN,1,2)'="S." D Q
. N XMP
. S XMP("PARAM","ID")="XMKN"
. S XMP("PARAM","VALUE")=XMKN,XMP(1)=XMKN
. D ERRSET^XMXUTIL(39442,.XMP) ; Server basket name must begin with 'S.'.
Q:$O(^DIC(19,"B",$E(XMKN,3,999),0))
N XMP
S XMP("PARAM","ID")="XMKN"
S XMP("PARAM","VALUE")=XMKN,XMP(1)=XMKN
D ERRSET^XMXUTIL(39443,.XMP) ; Server basket '|1|' not found. Name must be exact.
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXPARMB 3375 printed Apr 09, 2024@21:13:42 Page 2
XMXPARMB ;ISC-SF/GMB-Parameter check for XMXAPIB ;04/17/2002 14:12
+1 ;;8.0;MailMan;;Jun 28, 2002
CRE8MBOX(XMDUZ,XMDATE) ; Create a mailbox for a user
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO CHKUSER^XMXPARM1(.XMDUZ,1)
+3 IF $DATA(XMDATE)
SET XMDATE=$$XMDATE("XMDATE",XMDATE)
+4 QUIT
XMDATE(XMPARM,XMDATE) ;
+1 NEW %DT,Y,X
+2 ;,%DT(0)="-NOW"
SET X=XMDATE
+3 SET %DT="X"
+4 DO ^%DT
+5 if Y>0
QUIT Y
+6 NEW XMP
+7 SET XMP("PARAM","ID")=XMPARM
+8 SET XMP("PARAM","VALUE")=XMDATE
+9 ; Must be an exact date.
DO ERRSET^XMXUTIL(39420,.XMP)
+10 QUIT XMDATE
VA200(XMDUZ) ; Make sure DUZ exists
+1 if $DATA(^VA(200,XMDUZ,0))
QUIT
+2 NEW XMP
+3 SET XMP("PARAM","ID")="XMDUZ"
+4 SET XMP("PARAM","VALUE")=XMDUZ
SET XMP(1)=XMDUZ
+5 ; User '|1|' not found.
DO ERRSET^XMXUTIL(39433,.XMP)
+6 QUIT
TERMMBOX(XMDUZ) ; Terminate a mailbox (delete all traces of user in MailMan)
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO CHKUSER^XMXPARM1(.XMDUZ,1)
+3 QUIT
MBOX(XMDUZ) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ^XMXPARM(.XMDUZ,.XMV)
+3 QUIT
LISTBSKT(XMDUZ,XMFLAGS,XMAMT,XMSTART,XMPART,XMTROOT) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ^XMXPARM(.XMDUZ,.XMV)
+3 IF $DATA(XMFLAGS)
DO XMFLAG^XMXPARM("XMFLAGS",XMFLAGS,"BN")
+4 IF $DATA(XMAMT)
DO XMAMT("XMAMT",.XMAMT)
+5 QUIT
LISTMSGS(XMDUZ,XMK,XMFLDS,XMFLAGS,XMAMT,XMSTART,XMF,XMTROOT) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ^XMXPARM(.XMDUZ,.XMV)
+3 IF $DATA(XMK)
if "^*^!^"'[(U_XMK_U)
SET XMK=$$XMK^XMXPARM(XMDUZ,"XMK",XMK)
+4 IF $DATA(XMFLAGS)
DO XMFLAG^XMXPARM("XMFLAGS",XMFLAGS,"BCNP")
+5 IF $DATA(XMAMT)
DO XMAMT("XMAMT",.XMAMT)
+6 QUIT
DELBSKT(XMDUZ,XMK,XMFLAGS) ;
+1 DO BSKT(.XMDUZ,.XMK)
+2 IF $DATA(XMFLAGS)
DO XMFLAG^XMXPARM("XMFLAGS",XMFLAGS,"D")
+3 QUIT
BSKT(XMDUZ,XMK) ; Make sure basket exists
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ^XMXPARM(.XMDUZ,.XMV)
+3 if $DATA(XMK)
SET XMK=$$XMK^XMXPARM(XMDUZ,"XMK",XMK)
+4 QUIT
CRE8BSKT(XMDUZ,XMKN) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ^XMXPARM(.XMDUZ,.XMV)
+3 SET XMKN=$$XMKN(XMDUZ,"XMKN",XMKN)
+4 QUIT
NAMEBSKT(XMDUZ,XMK,XMKN) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ^XMXPARM(.XMDUZ,.XMV)
+3 SET XMK=$$XMK^XMXPARM(XMDUZ,"XMK",.XMK)
+4 SET XMKN=$$XMKN(XMDUZ,"XMKN",XMKN)
+5 QUIT
XMKN(XMDUZ,XMPARM,XMKN,XMOKXST) ; Validate a prospective basket name
+1 ; XMKN prospective basket name
+2 ; XMOKXST is it OK if a basket with that name already exists? (0=no; 1=yes)
+3 NEW XMOK
+4 IF '$GET(XMOKXST)
Begin DoDot:1
+5 if '$$FIND1^DIC(3.701,","_XMDUZ_",","XQ",XMKN)
QUIT
+6 NEW XMP
+7 SET XMP("PARAM","ID")=XMPARM
+8 SET XMP("PARAM","VALUE")=XMKN
SET XMP(1)=XMKN
+9 ; Basket '|1|' already exists.
DO ERRSET^XMXUTIL(39440,.XMP)
End DoDot:1
if $DATA(XMERR)
QUIT XMKN
+10 DO VAL^DIE(3.701,"1,"_XMDUZ_",",.01,"",XMKN,.XMOK)
if XMOK'=U
QUIT XMKN
+11 NEW XMP
+12 SET XMP("PARAM","ID")=XMPARM
+13 SET XMP("PARAM","VALUE")=XMKN
SET XMP(1)=2
SET XMP(2)=30
+14 ; Must be |1|-|2| characters, no ^.
DO ERRSET^XMXUTIL(39437,.XMP)
+15 QUIT XMKN
XMAMT(XMPARM,XMAMT) ;
+1 if '$DATA(XMAMT)
QUIT
+2 if XMAMT=""
QUIT
+3 if XMAMT="*"
QUIT
+4 if XMAMT=+XMAMT&(XMAMT>0)
QUIT
+5 NEW XMP
+6 SET XMP("PARAM","ID")=XMPARM
+7 SET XMP("PARAM","VALUE")=XMAMT
SET XMP(1)=XMAMT
+8 ; Must be a positive number OR *.
DO ERRSET^XMXUTIL(39441,.XMP)
+9 QUIT
SERV(XMKN,XMZ) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMSERV(.XMKN)
+3 DO XMZ^XMXPARM(.XMZ)
+4 QUIT
XMSERV(XMKN) ;
+1 IF $EXTRACT(XMKN,1,2)'="S."
Begin DoDot:1
+2 NEW XMP
+3 SET XMP("PARAM","ID")="XMKN"
+4 SET XMP("PARAM","VALUE")=XMKN
SET XMP(1)=XMKN
+5 ; Server basket name must begin with 'S.'.
DO ERRSET^XMXUTIL(39442,.XMP)
End DoDot:1
QUIT
+6 if $ORDER(^DIC(19,"B",$EXTRACT(XMKN,3,999),0))
QUIT
+7 NEW XMP
+8 SET XMP("PARAM","ID")="XMKN"
+9 SET XMP("PARAM","VALUE")=XMKN
SET XMP(1)=XMKN
+10 ; Server basket '|1|' not found. Name must be exact.
DO ERRSET^XMXUTIL(39443,.XMP)
+11 QUIT
