- BITRS ;IHS/CMI/MWR - TRANSFORM X INTO REQD CASE; MAY 10, 2010
- ;;8.5;IMMUNIZATION;;SEP 01,2011
- ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
- ;; UTILITY: TRANSFORMS X INTO MIXED CASE OR UPPERCASE.
- ;
- ;
- ;----------
- T(X) ;EP
- ;---> Translate word to mixed case.
- ;
- Q:"^ "[$G(X) X
- N BIWORD,I
- ;
- ;---> Remove leading inappropriate characters if present.
- F Q:$E(X)'?1P S X=$E(X,2,99)
- ;
- ;---> Change first letter to uppercase.
- S BIWORD=$E(X)
- I BIWORD?1L S BIWORD=$C($A($E(BIWORD))-32)
- ;
- ;---> Do following characters.
- F I=2:1:$L(X) D CHAR
- ;
- ;
- ;---> Remove trailing space or quote.
- ;F Q:""" "'[$E(BIWORD,$L(BIWORD)) S BIWORD=$E(BIWORD,1,($L(BIWORD)-1))
- ;---> CodeChange for v7.1 - IHS/CMI/MWR 12/01/2000:
- ;---> Next line, handle word with leading space.
- F Q:(""" "'[$E(BIWORD,$L(BIWORD)))!($L(BIWORD)=0) D
- .S BIWORD=$E(BIWORD,1,($L(BIWORD)-1))
- ;
- ;
- Q BIWORD
- ;
- ;
- ;----------
- CHAR ;EP
- ;---> If this 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 BIWORD=BIWORD_$C($A($E(X,I))+32)
- ;
- ;
- ;---> If this 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 BIWORD=BIWORD_$C($A($E(X,I))-32) Q
- ;
- ;
- ;---> Add character to BIWORD string without modification.
- ;---> "\" placed before a letter forces it to be uppercase;
- ;---> HERE REMOVE ANY "\"'s.
- I $E(X,I)'="\" S BIWORD=BIWORD_$E(X,I)
- Q
- ;
- ;
- ;----------
- UP(X) ;EP
- ;---> Translate any lowercase letters to uppercase.
- ;---> Leave all other characters untouched.
- ;
- Q:"^ "[$G(X) X
- N BICHAR,BIWORD,I S BIWORD=""
- ;
- F I=1:1:$L(X) D S BIWORD=BIWORD_BICHAR
- .S BICHAR=$E(X,I)
- .Q:(($A(BICHAR)<97)!($A(BICHAR)>122))
- .S BICHAR=$C($A(BICHAR)-32)
- ;
- Q BIWORD
- ;
- ;
- ;----------
- LOW(X) ;EP
- ;---> Translate any uppercase letters to lowercase.
- ;---> Leave all other characters untouched.
- ;
- Q:"^ "[$G(X) X
- N BICHAR,BIWORD,I S BIWORD=""
- ;
- F I=1:1:$L(X) D S BIWORD=BIWORD_BICHAR
- .S BICHAR=$E(X,I)
- .Q:(($A(BICHAR)<65)!($A(BICHAR)>90))
- .S BICHAR=$C($A(BICHAR)+32)
- ;
- Q BIWORD
- BITRS ;IHS/CMI/MWR - TRANSFORM X INTO REQD CASE; MAY 10, 2010
- +1 ;;8.5;IMMUNIZATION;;SEP 01,2011
- +2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
- +3 ;; UTILITY: TRANSFORMS X INTO MIXED CASE OR UPPERCASE.
- +4 ;
- +5 ;
- +6 ;----------
- T(X) ;EP
- +1 ;---> Translate word to mixed case.
- +2 ;
- +3 IF "^ "[$GET(X)
- QUIT X
- +4 NEW BIWORD,I
- +5 ;
- +6 ;---> Remove leading inappropriate characters if present.
- +7 FOR
- IF $EXTRACT(X)'?1P
- QUIT
- SET X=$EXTRACT(X,2,99)
- +8 ;
- +9 ;---> Change first letter to uppercase.
- +10 SET BIWORD=$EXTRACT(X)
- +11 IF BIWORD?1L
- SET BIWORD=$CHAR($ASCII($EXTRACT(BIWORD))-32)
- +12 ;
- +13 ;---> Do following characters.
- +14 FOR I=2:1:$LENGTH(X)
- DO CHAR
- +15 ;
- +16 ;
- +17 ;---> Remove trailing space or quote.
- +18 ;F Q:""" "'[$E(BIWORD,$L(BIWORD)) S BIWORD=$E(BIWORD,1,($L(BIWORD)-1))
- +19 ;---> CodeChange for v7.1 - IHS/CMI/MWR 12/01/2000:
- +20 ;---> Next line, handle word with leading space.
- +21 FOR
- IF (""" "'[$EXTRACT(BIWORD,$LENGTH(BIWORD)))!($LENGTH(BIWORD)=0)
- QUIT
- Begin DoDot:1
- +22 SET BIWORD=$EXTRACT(BIWORD,1,($LENGTH(BIWORD)-1))
- End DoDot:1
- +23 ;
- +24 ;
- +25 QUIT BIWORD
- +26 ;
- +27 ;
- +28 ;----------
- CHAR ;EP
- +1 ;---> If this character is uppercase and previous character is
- +2 ;---> not punctuation (except for an apostrophy) or a space,
- +3 ;---> then change character to lowercase.
- +4 ;
- +5 IF ($EXTRACT(X,I)?1U)&(($EXTRACT(X,I-1)'?1P)!($EXTRACT(X,I-1)="'"))
- Begin DoDot:1
- +6 SET BIWORD=BIWORD_$CHAR($ASCII($EXTRACT(X,I))+32)
- End DoDot:1
- QUIT
- +7 ;
- +8 ;
- +9 ;---> If this character is lowercase and previous character is
- +10 ;---> punctuation (but not an apostrophy) or a space, then change
- +11 ;---> character to uppercase.
- +12 ;
- +13 IF $EXTRACT(X,I)?1L
- IF $EXTRACT(X,I-1)?1P
- IF $EXTRACT(X,I-1)'="'"
- Begin DoDot:1
- +14 SET BIWORD=BIWORD_$CHAR($ASCII($EXTRACT(X,I))-32)
- QUIT
- End DoDot:1
- QUIT
- +15 ;
- +16 ;
- +17 ;---> Add character to BIWORD string without modification.
- +18 ;---> "\" placed before a letter forces it to be uppercase;
- +19 ;---> HERE REMOVE ANY "\"'s.
- +20 IF $EXTRACT(X,I)'="\"
- SET BIWORD=BIWORD_$EXTRACT(X,I)
- +21 QUIT
- +22 ;
- +23 ;
- +24 ;----------
- UP(X) ;EP
- +1 ;---> Translate any lowercase letters to uppercase.
- +2 ;---> Leave all other characters untouched.
- +3 ;
- +4 IF "^ "[$GET(X)
- QUIT X
- +5 NEW BICHAR,BIWORD,I
- SET BIWORD=""
- +6 ;
- +7 FOR I=1:1:$LENGTH(X)
- Begin DoDot:1
- +8 SET BICHAR=$EXTRACT(X,I)
- +9 IF (($ASCII(BICHAR)<97)!($ASCII(BICHAR)>122))
- QUIT
- +10 SET BICHAR=$CHAR($ASCII(BICHAR)-32)
- End DoDot:1
- SET BIWORD=BIWORD_BICHAR
- +11 ;
- +12 QUIT BIWORD
- +13 ;
- +14 ;
- +15 ;----------
- LOW(X) ;EP
- +1 ;---> Translate any uppercase letters to lowercase.
- +2 ;---> Leave all other characters untouched.
- +3 ;
- +4 IF "^ "[$GET(X)
- QUIT X
- +5 NEW BICHAR,BIWORD,I
- SET BIWORD=""
- +6 ;
- +7 FOR I=1:1:$LENGTH(X)
- Begin DoDot:1
- +8 SET BICHAR=$EXTRACT(X,I)
- +9 IF (($ASCII(BICHAR)<65)!($ASCII(BICHAR)>90))
- QUIT
- +10 SET BICHAR=$CHAR($ASCII(BICHAR)+32)
- End DoDot:1
- SET BIWORD=BIWORD_BICHAR
- +11 ;
- +12 QUIT BIWORD
