- XMXPARM1 ;ISC-SF/GMB-Parameter check (cont.) ;04/19/2002 12:14
- ;;8.0;MailMan;**36**;Jun 28, 2002
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXPARM1 3437 printed Feb 18, 2025@23:40:29 Page 2
- XMXPARM1 ;ISC-SF/GMB-Parameter check (cont.) ;04/19/2002 12:14
- +1 ;;8.0;MailMan;**36**;Jun 28, 2002
- 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