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
