XMGAPI0.m

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 ---XMGAPI0   1488     printed  Apr 09, 2024@21:13:10                                                                                                                                                                                                     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)