BMXTRS.m

BMXTRS ; IHS/OIT/HMW - UPPERCASE-LOWERCASE ;

 ;;4.0;BMX;;JUN 28, 2010

 ;

T(X) ;EP

 ;---> Translate word to mixed case.

 ;

 N BMXWORD,I

 I '$D(X) Q ""

 I X="^" Q X

 I X=" " Q X

 ;-----> REMOVE LEADING INAPPROPRIATE CHARACTERS IF PRESENT.

 F  Q:$E(X)'?1P  S X=$E(X,2,99)

 ;-----> CHANGE FIRST LETTER TO UPPERCASE:

 S BMXWORD=$E(X)

 I $E(BMXWORD)?1L S BMXWORD=$C($A($E(BMXWORD))-32)

 ;-----> DO NEXT CHARACTER

 F I=2:1:$L(X) D CHAR

 ;-----> REMOVE TRAILING SPACE OR QUOTE.

 F  Q:""" "'[$E(BMXWORD,$L(BMXWORD))  D

 .S BMXWORD=$E(BMXWORD,1,($L(BMXWORD)-1))

 ;-----> RESET X EQUAL TO RESULT

EOJ ;

 Q BMXWORD

 ;

CHAR ;

 ;-----> IF THE CHARACTER IS UPPERCASE AND PREVIOUS CHARACTER IS NOT

 ;-----> PUNCTUATION (EXCEPT FOR AN APOSTROPHY) OR A SPACE,

 ;-----> THEN CHANGE CHARACTER TO LOWERCASE:

 I ($E(X,I)?1U)&(($E(X,I-1)'?1P)!($E(X,I-1)="'")) D  Q

 .S BMXWORD=BMXWORD_$C($A($E(X,I))+32)

 ;

 ;-----> IF THE CHARACTER IS LOWERCASE AND PREVIOUS CHARACTER IS

 ;-----> PUNCTUATION (BUT NOT AN APOSTROPHY) OR A SPACE, THEN CHANGE

 ;-----> CHARACTER TO UPPERCASE:

 I $E(X,I)?1L,$E(X,I-1)?1P,$E(X,I-1)'="'" D  Q

 .S BMXWORD=BMXWORD_$C($A($E(X,I))-32)

 ;

 ;-----> ADD CHARACTER TO BMXWORD STRING WITHOUT MODIFICATION.

 ;-----> "\" PLACED BEFORE A LETTER FORCES IT TO BE UPPERCASE;

 ;-----> HERE REMOVE ANY "\"'s.

 I $E(X,I)'="\" S BMXWORD=BMXWORD_$E(X,I)

 Q

BMXTRS    ; IHS/OIT/HMW - UPPERCASE-LOWERCASE ;

 +1       ;;4.0;BMX;;JUN 28, 2010

 +2       ;

T(X)      ;EP

 +1       ;---> Translate word to mixed case.

 +2       ;

 +3        NEW BMXWORD,I

 +4        IF '$DATA(X)

               QUIT ""

 +5        IF X="^"

               QUIT X

 +6        IF X=" "

               QUIT X

 +7       ;-----> REMOVE LEADING INAPPROPRIATE CHARACTERS IF PRESENT.

 +8        FOR 

               IF $EXTRACT(X)'?1P

                   QUIT 

               SET X=$EXTRACT(X,2,99)

 +9       ;-----> CHANGE FIRST LETTER TO UPPERCASE:

 +10       SET BMXWORD=$EXTRACT(X)

 +11       IF $EXTRACT(BMXWORD)?1L

               SET BMXWORD=$CHAR($ASCII($EXTRACT(BMXWORD))-32)

 +12      ;-----> DO NEXT CHARACTER

 +13       FOR I=2:1:$LENGTH(X)

               DO CHAR

 +14      ;-----> REMOVE TRAILING SPACE OR QUOTE.

 +15       FOR 

               IF """ "'[$EXTRACT(BMXWORD,$LENGTH(BMXWORD))

                   QUIT 

               Begin DoDot:1

 +16               SET BMXWORD=$EXTRACT(BMXWORD,1,($LENGTH(BMXWORD)-1))

               End DoDot:1

 +17      ;-----> RESET X EQUAL TO RESULT

EOJ       ;

 +1        QUIT BMXWORD

 +2       ;

CHAR      ;

 +1       ;-----> IF THE CHARACTER IS UPPERCASE AND PREVIOUS CHARACTER IS NOT

 +2       ;-----> PUNCTUATION (EXCEPT FOR AN APOSTROPHY) OR A SPACE,

 +3       ;-----> THEN CHANGE CHARACTER TO LOWERCASE:

 +4        IF ($EXTRACT(X,I)?1U)&(($EXTRACT(X,I-1)'?1P)!($EXTRACT(X,I-1)="'"))

               Begin DoDot:1

 +5                SET BMXWORD=BMXWORD_$CHAR($ASCII($EXTRACT(X,I))+32)

               End DoDot:1

               QUIT 

 +6       ;

 +7       ;-----> IF THE CHARACTER IS LOWERCASE AND PREVIOUS CHARACTER IS

 +8       ;-----> PUNCTUATION (BUT NOT AN APOSTROPHY) OR A SPACE, THEN CHANGE

 +9       ;-----> CHARACTER TO UPPERCASE:

 +10       IF $EXTRACT(X,I)?1L

               IF $EXTRACT(X,I-1)?1P

                   IF $EXTRACT(X,I-1)'="'"

                       Begin DoDot:1

 +11                       SET BMXWORD=BMXWORD_$CHAR($ASCII($EXTRACT(X,I))-32)

                       End DoDot:1

                       QUIT 

 +12      ;

 +13      ;-----> ADD CHARACTER TO BMXWORD STRING WITHOUT MODIFICATION.

 +14      ;-----> "\" PLACED BEFORE A LETTER FORCES IT TO BE UPPERCASE;

 +15      ;-----> HERE REMOVE ANY "\"'s.

 +16       IF $EXTRACT(X,I)'="\"

               SET BMXWORD=BMXWORD_$EXTRACT(X,I)

 +17       QUIT