XMGAPI0 ;(WASH ISC)/CAP-Validate/Get Subject APIs ;04/17/2002 08:56
;;8.0;MailMan;;Jun 28, 2002
; Entry points (DBIA 1142):
; $$SUBCHK - Validate a proposed message subject
; $$SUBGET - Retrieve the subject of a message
ENT(Y,Z) ;Check Input Subject
;Param1=String
;Param2=Silent Flag
N A S A=""
I $L(Y)>65 S A=1,%="Entered SUBJECT too long, "_$L($E(Y,66,999))_" characters longer than 65." S Y=$E(Y,1,250) G S:Z Q "3-"_%_U_$E(Y,1,65)
;
I Y[U S Y=$$ENCODEUP^XMCU1(Y)
;
;REMOVE LEADING BLANKS
B I Y?1" ".E S Y=$E(Y,2,99) G B
;
;REMOVE TRAILING BLANKS
E I $E(Y,$L(Y))=" " S Y=$E(Y,1,$L(Y)-1) G E
;
G U:Y'?.E1C.E I 'Z Q "5-Subject cannot contain control characters.^"_Y
F X=1:1 I $E(Y,X)?1C S Y=$E(Y,1,X-1)_$E(Y,X+1,99) Q:Y'?.E1C.E S X=X-1
W $C(7),!,"Control characters removed ("""_Y_""" is Subject accepted).",!
;
U I Y="" Q ""
I Y="?" S A=1,%="Enter a Message Subject, between 3 & 65 characters long or '^' to exit." G S:Z Q "4-"_%_U_Y
I $L(Y)<3 S A=1,%="SUBJECT must be at least 3 characters long." G S:Z Q "1-"_%_U_Y
I Y?1"R"2N.N S A=1,%="Subject names of this format (1""R""1.N) are RESERVED" G S:Z Q "2-"_%_U_Y
Q Q A_U_Y
S W !,$C(7),%,!
G Q
SUBGET(X) ;Return Subject of a Message (""=Error, Else returns Subject)
S X=$P($G(^XMB(3.9,X,0)),U) I X="" Q ""
Q $$DECODEUP^XMCU1(X)
SUBCHK(X,Z) ;Check Subject (""=Error, Else returns Subject)
;Param1=String
;Param2=Silent Flag (0=Silent, 1=Verbose)
N Y S Y=X
Q $$ENT(X,Z)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMGAPI0 1488 printed Dec 13, 2024@02:11:37 Page 2
XMGAPI0 ;(WASH ISC)/CAP-Validate/Get Subject APIs ;04/17/2002 08:56
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points (DBIA 1142):
+3 ; $$SUBCHK - Validate a proposed message subject
+4 ; $$SUBGET - Retrieve the subject of a message
ENT(Y,Z) ;Check Input Subject
+1 ;Param1=String
+2 ;Param2=Silent Flag
+3 NEW A
SET A=""
+4 IF $LENGTH(Y)>65
SET A=1
SET %="Entered SUBJECT too long, "_$LENGTH($EXTRACT(Y,66,999))_" characters longer than 65."
SET Y=$EXTRACT(Y,1,250)
if Z
GOTO S
QUIT "3-"_%_U_$EXTRACT(Y,1,65)
+5 ;
+6 IF Y[U
SET Y=$$ENCODEUP^XMCU1(Y)
+7 ;
+8 ;REMOVE LEADING BLANKS
B IF Y?1" ".E
SET Y=$EXTRACT(Y,2,99)
GOTO B
+1 ;
+2 ;REMOVE TRAILING BLANKS
E IF $EXTRACT(Y,$LENGTH(Y))=" "
SET Y=$EXTRACT(Y,1,$LENGTH(Y)-1)
GOTO E
+1 ;
+2 if Y'?.E1C.E
GOTO U
IF 'Z
QUIT "5-Subject cannot contain control characters.^"_Y
+3 FOR X=1:1
IF $EXTRACT(Y,X)?1C
SET Y=$EXTRACT(Y,1,X-1)_$EXTRACT(Y,X+1,99)
if Y'?.E1C.E
QUIT
SET X=X-1
+4 WRITE $CHAR(7),!,"Control characters removed ("""_Y_""" is Subject accepted).",!
+5 ;
U IF Y=""
QUIT ""
+1 IF Y="?"
SET A=1
SET %="Enter a Message Subject, between 3 & 65 characters long or '^' to exit."
if Z
GOTO S
QUIT "4-"_%_U_Y
+2 IF $LENGTH(Y)<3
SET A=1
SET %="SUBJECT must be at least 3 characters long."
if Z
GOTO S
QUIT "1-"_%_U_Y
+3 IF Y?1"R"2N.N
SET A=1
SET %="Subject names of this format (1""R""1.N) are RESERVED"
if Z
GOTO S
QUIT "2-"_%_U_Y
Q QUIT A_U_Y
S WRITE !,$CHAR(7),%,!
+1 GOTO Q
SUBGET(X) ;Return Subject of a Message (""=Error, Else returns Subject)
+1 SET X=$PIECE($GET(^XMB(3.9,X,0)),U)
IF X=""
QUIT ""
+2 QUIT $$DECODEUP^XMCU1(X)
SUBCHK(X,Z) ;Check Subject (""=Error, Else returns Subject)
+1 ;Param1=String
+2 ;Param2=Silent Flag (0=Silent, 1=Verbose)
+3 NEW Y
SET Y=X
+4 QUIT $$ENT(X,Z)
