- 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 Feb 18, 2025@23:40:30 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