XMXPARM1 ;ISC-SF/GMB-Parameter check (cont.) ;04/19/2002 12:14
;;8.0;MailMan;**36**;Jun 28, 2002;Build 1
CHKUSER(XMDUZ,XMNOMBOX) ; Ascertain/verify user's DUZ, and make sure authorized to use MailMan
; XMNOMBOX Is it possible that this user does not have a mailbox?
; 0=no (default); 1=yes
N XMSCREEN,XMUSER,XMADDR
S XMADDR=XMDUZ
S XMADDR=$$UP^XLFSTR(XMADDR)
;S:'$G(XMNOMBOX) XMSCREEN="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))" ; User must have an access code & mailbox
I '$G(XMNOMBOX),'$$USERTYPE^XUSAP(XMDUZ,"APPLICATION PROXY") S XMSCREEN="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))" ; User must have an access code & mailbox
; "B^BB^C^D" = name^alias^initial^nickname
S XMDUZ=$$FIND1^DIC(200,"","O",$S(+XMADDR=XMADDR:"`"_XMADDR,1:XMADDR),"B^BB^C^D",.XMSCREEN)
Q:XMDUZ
S XMDUZ=XMADDR
D ERRSET^XMXUTIL($S($D(DIERR):39432,1:39433),XMDUZ) ; User '|1|' ambiguous / not found.
Q
XMATTACH(XMATTACH) ; Validate attachments
Q
XMBN(XMBN) ; Check bulletin name
I $G(XMBN)="" D ERRSET^XMXUTIL(39430) Q ; Bulletin name must be supplied.
Q:$D(^XMB(3.6,"B",XMBN))
D ERRSET^XMXUTIL(39431,XMBN) ; Bulletin '|1|' not found.
Q
XMBODY(XMBODY,XMOPTNL) ; Check the body of the message (just make sure there is a body)
I $G(XMBODY)="" D Q
. I '$G(XMOPTNL) D ERRSET^XMXUTIL(39405) ;Message must have a body.
I $E(XMBODY,1,6)="XMBODY" D Q
. D ERRSET^XMXUTIL(39406) ;Message body may not be called XMBODY.
I $D(@XMBODY)'>9 D Q
. D ERRSET^XMXUTIL(39407,XMBODY) ;Message body '|1|' has no data.
Q
XMCODE(XMPARM,XMCODE,XMSET) ;
Q:XMSET[(U_XMCODE_U)
N XMP
S XMP("PARAM","ID")=XMPARM
S XMP("PARAM","VALUE")=XMCODE
;S XMP("PARAM","FILE")=3.901,XMP("PARAM","FIELD")=1.8
S XMP(1)=XMSET
D ERRSET^XMXUTIL(39438,.XMP) ; Must be one of |1|.
Q
XMHINT(XMHINT) ; Validate a scramble hint
I $G(XMHINT)="" Q
;I $G(XMHINT)="" D ERRSET^XMXUTIL(39436) Q ; Scramble hint must be supplied
;D CHK^DIE(3.9,1.8,"H",XMHINT)
I $L(XMHINT)>0,$L(XMHINT)<41,XMHINT'[U Q
N XMP
S XMP("PARAM","ID")="XMINSTR(""SCR HINT"")"
S XMP("PARAM","VALUE")=XMHINT
;S XMP("PARAM","FILE")=3.901,XMP("PARAM","FIELD")=1.8
S XMP(1)=1,XMP(2)=40
D ERRSET^XMXUTIL(39437,.XMP) ; Must be |1|-|2| characters, no ^.
Q
XMKEY(XMKEY) ; Validate a scramble key
I $G(XMKEY)="" D ERRSET^XMXUTIL(39435) Q ; Scramble key must be supplied.
;D CHK^DIE(3.9,1.85,"H",XMKEY)
I $L(XMKEY)>2,$L(XMKEY)<21 Q
N XMP
S XMP("PARAM","ID")="XMINSTR(""SCR KEY"")"
S XMP("PARAM","VALUE")=XMKEY
;S XMP("PARAM","FILE")=3.9,XMP("PARAM","FIELD")=1.85
S XMP(1)=3,XMP(2)=20
D ERRSET^XMXUTIL(39434,.XMP) ; Must be |1|-|2| characters.
Q
XMKZ(XMK,XMKZ) ;
I $G(XMKZ),$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q
N XMP S XMP(1)=XMKZ,XMP(2)=XMK
D ERRSET^XMXUTIL(34351,.XMP) ; message not found in basket
Q
XMKZA(XMKZA) ; Check the message numbers (just make sure there is at least one)
Q:$D(XMKZA)
D ERRSET^XMXUTIL(39418) ;No message numbers.
Q
XMROOT(XMPARM,XMROOT) ; Validate root
Q
XMSTRIP(XMSTRIP) ; Validate a message strip string
I $L(XMSTRIP)>0,$L(XMSTRIP)<21 Q
N XMP
S XMP("PARAM","ID")="XMINSTR(""STRIP"")"
S XMP("PARAM","VALUE")=XMSTRIP
S XMP(1)=1,XMP(2)=20
D ERRSET^XMXUTIL(39434,.XMP) ; Must be |1|-|2| characters.
Q
XMTO(XMTO,XMOPTNL) ; Check the addressees (just make sure there is at least one)
Q:$D(XMTO)
I $G(XMOPTNL),$$GOTADDR^XMXADDR Q
D ERRSET^XMXUTIL(39408) ;No recipients
Q
XMXPARM1 ;ISC-SF/GMB-Parameter check (cont.) ;04/19/2002 12:14
+1 ;;8.0;MailMan;**36**;Jun 28, 2002;Build 1
CHKUSER(XMDUZ,XMNOMBOX) ; Ascertain/verify user's DUZ, and make sure authorized to use MailMan
+1 ; XMNOMBOX Is it possible that this user does not have a mailbox?
+2 ; 0=no (default); 1=yes
+3 NEW XMSCREEN,XMUSER,XMADDR
+4 SET XMADDR=XMDUZ
+5 SET XMADDR=$$UP^XLFSTR(XMADDR)
+6 ;S:'$G(XMNOMBOX) XMSCREEN="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))" ; User must have an access code & mailbox
+7 ; User must have an access code & mailbox
IF '$GET(XMNOMBOX)
IF '$$USERTYPE^XUSAP(XMDUZ,"APPLICATION PROXY")
SET XMSCREEN="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))"
+8 ; "B^BB^C^D" = name^alias^initial^nickname
+9 SET XMDUZ=$$FIND1^DIC(200,"","O",$SELECT(+XMADDR=XMADDR:"`"_XMADDR,1:XMADDR),"B^BB^C^D",.XMSCREEN)
+10 IF XMDUZ
QUIT
+11 SET XMDUZ=XMADDR
+12 ; User '|1|' ambiguous / not found.
DO ERRSET^XMXUTIL($SELECT($DATA(DIERR):39432,1:39433),XMDUZ)
+13 QUIT
XMATTACH(XMATTACH) ; Validate attachments
+1 QUIT
XMBN(XMBN) ; Check bulletin name
+1 ; Bulletin name must be supplied.
IF $GET(XMBN)=""
DO ERRSET^XMXUTIL(39430)
QUIT
+2 IF $DATA(^XMB(3.6,"B",XMBN))
QUIT
+3 ; Bulletin '|1|' not found.
DO ERRSET^XMXUTIL(39431,XMBN)
+4 QUIT
XMBODY(XMBODY,XMOPTNL) ; Check the body of the message (just make sure there is a body)
+1 IF $GET(XMBODY)=""
Begin DoDot:1
+2 ;Message must have a body.
IF '$GET(XMOPTNL)
DO ERRSET^XMXUTIL(39405)
End DoDot:1
QUIT
+3 IF $EXTRACT(XMBODY,1,6)="XMBODY"
Begin DoDot:1
+4 ;Message body may not be called XMBODY.
DO ERRSET^XMXUTIL(39406)
End DoDot:1
QUIT
+5 IF $DATA(@XMBODY)'>9
Begin DoDot:1
+6 ;Message body '|1|' has no data.
DO ERRSET^XMXUTIL(39407,XMBODY)
End DoDot:1
QUIT
+7 QUIT
XMCODE(XMPARM,XMCODE,XMSET) ;
+1 IF XMSET[(U_XMCODE_U)
QUIT
+2 NEW XMP
+3 SET XMP("PARAM","ID")=XMPARM
+4 SET XMP("PARAM","VALUE")=XMCODE
+5 ;S XMP("PARAM","FILE")=3.901,XMP("PARAM","FIELD")=1.8
+6 SET XMP(1)=XMSET
+7 ; Must be one of |1|.
DO ERRSET^XMXUTIL(39438,.XMP)
+8 QUIT
XMHINT(XMHINT) ; Validate a scramble hint
+1 IF $GET(XMHINT)=""
QUIT
+2 ;I $G(XMHINT)="" D ERRSET^XMXUTIL(39436) Q ; Scramble hint must be supplied
+3 ;D CHK^DIE(3.9,1.8,"H",XMHINT)
+4 IF $LENGTH(XMHINT)>0
IF $LENGTH(XMHINT)<41
IF XMHINT'[U
QUIT
+5 NEW XMP
+6 SET XMP("PARAM","ID")="XMINSTR(""SCR HINT"")"
+7 SET XMP("PARAM","VALUE")=XMHINT
+8 ;S XMP("PARAM","FILE")=3.901,XMP("PARAM","FIELD")=1.8
+9 SET XMP(1)=1
SET XMP(2)=40
+10 ; Must be |1|-|2| characters, no ^.
DO ERRSET^XMXUTIL(39437,.XMP)
+11 QUIT
XMKEY(XMKEY) ; Validate a scramble key
+1 ; Scramble key must be supplied.
IF $GET(XMKEY)=""
DO ERRSET^XMXUTIL(39435)
QUIT
+2 ;D CHK^DIE(3.9,1.85,"H",XMKEY)
+3 IF $LENGTH(XMKEY)>2
IF $LENGTH(XMKEY)<21
QUIT
+4 NEW XMP
+5 SET XMP("PARAM","ID")="XMINSTR(""SCR KEY"")"
+6 SET XMP("PARAM","VALUE")=XMKEY
+7 ;S XMP("PARAM","FILE")=3.9,XMP("PARAM","FIELD")=1.85
+8 SET XMP(1)=3
SET XMP(2)=20
+9 ; Must be |1|-|2| characters.
DO ERRSET^XMXUTIL(39434,.XMP)
+10 QUIT
XMKZ(XMK,XMKZ) ;
+1 IF $GET(XMKZ)
IF $DATA(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ))
QUIT
+2 NEW XMP
SET XMP(1)=XMKZ
SET XMP(2)=XMK
+3 ; message not found in basket
DO ERRSET^XMXUTIL(34351,.XMP)
+4 QUIT
XMKZA(XMKZA) ; Check the message numbers (just make sure there is at least one)
+1 IF $DATA(XMKZA)
QUIT
+2 ;No message numbers.
DO ERRSET^XMXUTIL(39418)
+3 QUIT
XMROOT(XMPARM,XMROOT) ; Validate root
+1 QUIT
XMSTRIP(XMSTRIP) ; Validate a message strip string
+1 IF $LENGTH(XMSTRIP)>0
IF $LENGTH(XMSTRIP)<21
QUIT
+2 NEW XMP
+3 SET XMP("PARAM","ID")="XMINSTR(""STRIP"")"
+4 SET XMP("PARAM","VALUE")=XMSTRIP
+5 SET XMP(1)=1
SET XMP(2)=20
+6 ; Must be |1|-|2| characters.
DO ERRSET^XMXUTIL(39434,.XMP)
+7 QUIT
XMTO(XMTO,XMOPTNL) ; Check the addressees (just make sure there is at least one)
+1 IF $DATA(XMTO)
QUIT
+2 IF $GET(XMOPTNL)
IF $$GOTADDR^XMXADDR
QUIT
+3 ;No recipients
DO ERRSET^XMXUTIL(39408)
+4 QUIT
