| 1 | BMXTRS ; IHS/OIT/HMW - UPPERCASE-LOWERCASE ;
|
|---|
| 2 | ;;2.1;BMX;;Jul 26, 2009
|
|---|
| 3 | ;
|
|---|
| 4 | T(X) ;EP
|
|---|
| 5 | ;---> Translate word to mixed case.
|
|---|
| 6 | ;
|
|---|
| 7 | N BMXWORD,I
|
|---|
| 8 | I '$D(X) Q ""
|
|---|
| 9 | I X="^" Q X
|
|---|
| 10 | I X=" " Q X
|
|---|
| 11 | ;-----> REMOVE LEADING INAPPROPRIATE CHARACTERS IF PRESENT.
|
|---|
| 12 | F Q:$E(X)'?1P S X=$E(X,2,99)
|
|---|
| 13 | ;-----> CHANGE FIRST LETTER TO UPPERCASE:
|
|---|
| 14 | S BMXWORD=$E(X)
|
|---|
| 15 | I $E(BMXWORD)?1L S BMXWORD=$C($A($E(BMXWORD))-32)
|
|---|
| 16 | ;-----> DO NEXT CHARACTER
|
|---|
| 17 | F I=2:1:$L(X) D CHAR
|
|---|
| 18 | ;-----> REMOVE TRAILING SPACE OR QUOTE.
|
|---|
| 19 | F Q:""" "'[$E(BMXWORD,$L(BMXWORD)) D
|
|---|
| 20 | .S BMXWORD=$E(BMXWORD,1,($L(BMXWORD)-1))
|
|---|
| 21 | ;-----> RESET X EQUAL TO RESULT
|
|---|
| 22 | EOJ ;
|
|---|
| 23 | Q BMXWORD
|
|---|
| 24 | ;
|
|---|
| 25 | CHAR ;
|
|---|
| 26 | ;-----> IF THE CHARACTER IS UPPERCASE AND PREVIOUS CHARACTER IS NOT
|
|---|
| 27 | ;-----> PUNCTUATION (EXCEPT FOR AN APOSTROPHY) OR A SPACE,
|
|---|
| 28 | ;-----> THEN CHANGE CHARACTER TO LOWERCASE:
|
|---|
| 29 | I ($E(X,I)?1U)&(($E(X,I-1)'?1P)!($E(X,I-1)="'")) D Q
|
|---|
| 30 | .S BMXWORD=BMXWORD_$C($A($E(X,I))+32)
|
|---|
| 31 | ;
|
|---|
| 32 | ;-----> IF THE CHARACTER IS LOWERCASE AND PREVIOUS CHARACTER IS
|
|---|
| 33 | ;-----> PUNCTUATION (BUT NOT AN APOSTROPHY) OR A SPACE, THEN CHANGE
|
|---|
| 34 | ;-----> CHARACTER TO UPPERCASE:
|
|---|
| 35 | I $E(X,I)?1L,$E(X,I-1)?1P,$E(X,I-1)'="'" D Q
|
|---|
| 36 | .S BMXWORD=BMXWORD_$C($A($E(X,I))-32)
|
|---|
| 37 | ;
|
|---|
| 38 | ;-----> ADD CHARACTER TO BMXWORD STRING WITHOUT MODIFICATION.
|
|---|
| 39 | ;-----> "\" PLACED BEFORE A LETTER FORCES IT TO BE UPPERCASE;
|
|---|
| 40 | ;-----> HERE REMOVE ANY "\"'s.
|
|---|
| 41 | I $E(X,I)'="\" S BMXWORD=BMXWORD_$E(X,I)
|
|---|
| 42 | Q
|
|---|
