LEXXM6 ;ISL/KER - Convert Text to Mix Case (6+) ;12/19/2014
;;2.0;General Lexicon Utilities;**80,86**;Sep 23, 1996;Build 1
;
; Global Variables
; None
;
; External References
; None
;
; Local Variables NEWed or KILLed Elsewhere
; LEXNXT,LEXPRE,LEXUSE Newed in LEXXM
; Y set and returned to LEXXM
;
T6 ; 6 Characters
N XU,CHR,NUM,TRL,PRE,UIN,NXT,USE,P1,P2 S PRE=$G(LEXPRE),NXT=$G(LEXNXT),USE=$G(LEXUSE),UIN=$G(UIN),XU=$$UP(X),CHR=$E(XU,1)
; Exceptions
S P1=$E(XU,1,($L(XU)-2)),P2=$E(XU,($L(XU)-1),$L(XU)) I "^CC^ML^GM^"[("^"_P2_"^"),$E(P1,$L(P1))?1N S Y=$$LO(XU) Q
S NUM=$E(XU,1,4),TRL=$E(XU,5,6) I +NUM=NUM,((TRL="TH")!(TRL="ST")!(TRL="RD")!(TRL="ND")) S Y=$$LO(XU) Q:$L($G(Y))
I "SNOMED"=XU S Y=XU Q
I "STATED"=XU&(PRE="SO") S Y=$$LO(X) Q
I "^DEVICE^"[("^"_XU_"^")&($L(PRE)>5) S Y=$$MX(X) Q
S:$E(XU,1)?1U&($E(XU,6)?1N) Y=XU Q:$L($G(Y)) S:$E(XU,1)?1N Y=XU Q:$L($G(Y))
; Special Case
S:X="DESGLY" Y="desGly" S:X="ECORII" Y="EcoRII" S:X="GALNAC" Y="GalNAc" Q:$L($G(Y))
S:X="GLCNAC" Y="GlcNAc" S:X="GTPASE" Y="GTPase" S:X="LEFORT" Y="LeFort" Q:$L($G(Y))
S:X="MURNAC" Y="MurNAc" S:X="PTDINS" Y="PtdIns" S:X="STYLTI" Y="StyLTI" Q:$L($G(Y))
S:X="UVRABC" Y="uvrABC" S:X="PDGOLD" Y="PdGold" S:X="IOGOLD" Y="IoGold" Q:$L($G(Y))
S:X="ATPASE" Y="ATPase" Q:$L($G(Y))
; Lower Case
I "^BEFORE^CLOSED^CYCLIC^DEGREE^DEVICE^DURING^EFFECT^"[("^"_XU_"^") S Y=$$LO(X) Q
I "^EXCEPT^FACTOR^FILING^FOURTH^HEMPAS^HAVING^INSIDE^ITSELF^"[("^"_XU_"^") S Y=$$LO(X) Q
I "^LENGTH^MOLDED^RETURN^SECOND^SINGLE^WITHIN^"[("^"_XU_"^") S Y=$$LO(X) Q
; Mixed Case
I "^ANGLES^AUGUST^BATTLE^BILOXI^BONHAM^BOSTON^BUTLER^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^CASTLE^CLINIC^DALLAS^DAYTON^DENVER^DUBLIN^DURHAM^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^FRESNO^HEALTH^HGHLND^HOWARD^HUDSON^ISLAND^JERSEY^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^KANSAS^LESSER^LITTLE^MANILA^MARION^MARLIN^MOINES^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^ORANGE^POPLAR^POPLAR^RETURN^SPRING^TACOMA^TEMPLE^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^TOPEKA^TUCSON^VALLEY^WILKES^"[("^"_XU_"^") S Y=$$MX(X) Q
; Uppercase
I "^ADAMTS^BICROS^C1251C^COL1A1^DMEPOS^FOX01A^FOXO1A^PEPPTS"[("^"_XU_"^") S Y=XU Q
Q
;
T7 ; 7 Characters
N XU,CHR,NUM,TRL,PRE,UIN,NXT,USE,P1,P2 S PRE=$G(LEXPRE),NXT=$G(LEXNXT),USE=$G(LEXUSE),UIN=$G(UIN),XU=$$UP(X),CHR=$E(XU,1)
; Exceptions
S P1=$E(XU,1,($L(XU)-2)),P2=$E(XU,($L(XU)-1),$L(XU)) I "^CC^ML^GM^"[("^"_P2_"^"),$E(P1,$L(P1))?1N S Y=$$LO(XU) Q
S NUM=$E(XU,1,5),TRL=$E(XU,6,7) I +NUM=NUM,((TRL="TH")!(TRL="ST")!(TRL="RD")!(TRL="ND")) S Y=$$LO(XU) Q:$L($G(Y))
S:$E(XU,1)?1U&($E(XU,7)?1N) Y=XU Q:$L($G(Y)) S:$E(XU,1)?1N Y=XU Q:$L($G(Y))
; Lower Case
I "GREATER"=XU&($E(NXT,1,4)="THAN") S Y=$$LO(X) Q
I "GREATER"=XU&(PRE="OR") S Y=$$LO(X) Q
I "^EFFECTS^BETWEEN^ONESELF^HERSELF^HIMSELF^OUTSIDE^"[("^"_XU_"^") S Y=$$LO(X) Q
I "^THEREOF^ANOTHER^THEREBY^WITHOUT^MENTION^THROUGH^"[("^"_XU_"^") S Y=$$LO(X) Q
; Mixed Case
I "^APHAKIA^APHAKIC^ALTOONA^ANTONIO^ATLANTA^AUGUSTA^BATAVIA^BECKLEY^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^BEDFORD^BUFFALO^CENTRAL^CHICAGO^EASTERN^FLORIDA^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^GEORGIA^GREATER^HAMPTON^HOUSTON^JACKSON^JANUARY^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^LEBANON^LINCOLN^MADISON^MEMPHIS^OCTOBER^ORLEANS^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^PATIENT^PHOENIX^SAGINAW^SEATTLE^SPOKANE^SPRINGS^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^WESTERN^WICHITA^"[("^"_XU_"^") S Y=$$MX(X) Q
; Uppercase
I "^ASPSCR1^CBFA2T1^CMVIGIV^S30R060^S30R080^S30R100^"[("^"_XU_"^") S Y=XU Q
Q
;
T8 ; 8 Characters
N XU,CHR,NUM,TRL,PRE,UIN,NXT,USE,P1,P2 S PRE=$G(LEXPRE),NXT=$G(LEXNXT),USE=$G(LEXUSE),UIN=$G(UIN),XU=$$UP(X),CHR=$E(XU,1)
; Exceptions
S P1=$E(XU,1,($L(XU)-2)),P2=$E(XU,($L(XU)-1),$L(XU)) I "^CC^ML^GM^"[("^"_P2_"^"),$E(P1,$L(P1))?1N S Y=$$LO(XU) Q
S NUM=$E(XU,1,6),TRL=$E(XU,7,8) I +NUM=NUM,((TRL="TH")!(TRL="ST")!(TRL="RD")!(TRL="ND")) S Y=$$LO(XU) Q:$L($G(Y))
S:$E(XU,1)?1U&($E(XU,8)?1N) Y=XU Q:$L($G(Y)) S:$E(XU,1)?1N Y=XU Q:$L($G(Y))
; Lower Case
I XU="MULTIPLE",$E(NXT,1,5)="SITES" S Y=$$LO(X) Q
I XU="MULTIPLE",$E(NXT,1,18)["AND UNSPECIFIED" S Y=$$LO(X) Q
I "^ALTHOUGH^INJURING^INCLUDES^ADDITION^EXCLUDES^"[("^"_XU_"^") S Y=$$LO(X) Q
; Mixed Case
I "^BROCKTON^BROOKLYN^CHEYENNE^COLUMBIA^COLUMBUS^DANVILLE^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^DECEMBER^FAYETTVL^FEBRUARY^HARRISON^HIGHLAND^HONOLULU^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^JUNCTION^MARTINEZ^MARYLAND^MONTROSE^MOUNTAIN^MOUNTIAN^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^MUSKOGEE^NEBRASKA^NORTHERN^OKLAHOMA^PORTLAND^PRESCOTT^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^RICHMOND^ROSEBURG^SHERIDAN^SOUTHERN^SYRACUSE^TUSKEGEE^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^VETERANS^"[("^"_XU_"^") S Y=$$MX(X) Q
; Uppercase
I "^PD3S111L^PD3S111P^"[("^"_XU_"^") S Y=XU Q
Q
;
T9 ; 9 Characters
N XU,CHR,NUM,TRL,PRE,UIN,NXT,P1,P2 S PRE=$G(LEXPRE),NXT=$G(LEXNXT),UIN=$G(UIN),XU=$$UP(X),CHR=$E(XU,1)
; Exceptions
S P1=$E(XU,1,($L(XU)-2)),P2=$E(XU,($L(XU)-1),$L(XU)) I "^CC^ML^GM^"[("^"_P2_"^"),$E(P1,$L(P1))?1N S Y=$$LO(XU) Q
S NUM=$E(XU,1,7),TRL=$E(XU,8,9) I +NUM=NUM,((TRL="TH")!(TRL="ST")!(TRL="RD")!(TRL="ND")) S Y=$$LO(XU) Q:$L($G(Y))
S:$E(XU,1)?1U&($E(XU,9)?1N) Y=XU Q:$L($G(Y)) S:$E(XU,1)?1N Y=XU Q:$L($G(Y))
S:XU="MILLIGRAM"&(($G(UIN)[" PER ")&($G(UIN)[" MILLI")) Y="mg" Q:$L($G(Y))
; Lower Case
I "^OTHERWISE^SPECIFIED^INCLUDING^ELSEWHERE^INVOLVING^EXCLUDING^"[("^"_XU_"^") S Y=$$LO(X) Q
; Mixed Case
I "^ASHEVILLE^BALTIMORE^CLEVELAND^FRANCISCO^KERRVILLE^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^KNOXVILLE^LEXINGTON^LIVERMORE^MILWAUKEE^NASHVILLE^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^NEWINGTON^NORTHPORT^SALISBURY^SEPTEMBER^SEPULVEDA^"[("^"_XU_"^") S Y=$$MX(X) Q
Q
;
TM ; Long Words
T10 ; 10 Characters
N XU,CHR,NUM,TRL,PRE,UIN,NXT,USE S PRE=$G(LEXPRE),NXT=$G(LEXNXT),USE=$G(LEXUSE),UIN=$G(UIN),XU=$$UP(X),CHR=$E(XU,1)
; Exceptions
S NUM=$E(XU,1,($L(XU)-2)),TRL=$E(XU,($L(XU)-1),$L(XU))
I +NUM=NUM,((TRL="TH")!(TRL="ST")!(TRL="RD")!(TRL="ND")) S Y=$$LO(XU) Q:$L($G(Y))
S:$E(XU,1)?1U&($E(XU,$L(XU))?1N) Y=XU Q:$L($G(Y)) S:$E(XU,1)?1N Y=XU Q:$L($G(Y))
; Special Case
S:X="GDPMANNOSE" Y="GDPmannose" S:X="UDPGLUCOSE" Y="UDPglucose" Q:$L($G(Y))
; Lower Case
I XU="COMPLICATED",$E(NXT,1,2)="BY" S Y=$$LO(X) Q
I "^CONDITIONS^ADDITIONAL^CLASSIFIED^"[("^"_XU_"^") S Y=$$LO(X) Q
; Mixed Case
I "^BIRMINGHAM^CALIFORNIA^CHARLESTON^CINCINNATI^CLARKSBURG^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^HEALTHCARE^HUNTINGTON^LOUISVILLE^MANCHESTER^MONTGOMERY^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^PITTSBURGH^PROVIDENCE^SHREVEPORT^TUSCALOOSA^UNIVERSITY^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^WASHINGTON^WILMINGTON^"[("^"_XU_"^") S Y=$$MX(X) Q
T11 ; 11 Characters
N XU,CHR S XU=$$UP(X),CHR=$E(XU,1)
; Exceptions
S:$E(XU,1)?1U&($E(XU,$L(XU))?1N) Y=XU Q:$L($G(Y)) S:$E(XU,1)?1N&($E(XU,$L(XU))?1U) Y=XU Q:$L($G(Y))
; Lower Case
I "^UNSPECIFIED^"[("^"_XU_"^") S Y=$$LO(X) Q
; Mixed Case
I "^CANANDAIGUA^CHILLICOTHE^COATESVILLE^CONNECTICUT^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^GAINESVILLE^LEAVENWORTH^MARTINSBURG^MINNEAPOLIS^"[("^"_XU_"^") S Y=$$MX(X) Q
I "^NORTHAMPTON^"[("^"_XU_"^") S Y=$$MX(X) Q
T12 ; 12 Characters or Greater
N XU,CHR S XU=$$UP(X),CHR=$E(XU,1)
; Exceptions
S:$E(XU,1)?1U&($E(XU,$L(XU))?1N) Y=XU Q:$L($G(Y)) S:$E(XU,1)?1N&($E(XU,$L(XU))?1U) Y=XU Q:$L($G(Y))
; Mixed Case
I "^INDIANAPOLIS^MURFREESBORO^PHILADELPHIA^"[("^"_XU_"^") S Y=$$MX(X) Q
Q
;
LO(X) ; Lower Case
Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
UP(X) ; Uppercase
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
MX(X) ; Mix Case
Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
LD(X) ; Leading Character
Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,2,$L(X))
TRIM(X) ; Trim Spaces
S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
n LEXNXT,LEXPRE,LEXUSE,Y
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXXM6 8229 printed Apr 09, 2024@21:13:59 Page 2
LEXXM6 ;ISL/KER - Convert Text to Mix Case (6+) ;12/19/2014
+1 ;;2.0;General Lexicon Utilities;**80,86**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; None
+8 ;
+9 ; Local Variables NEWed or KILLed Elsewhere
+10 ; LEXNXT,LEXPRE,LEXUSE Newed in LEXXM
+11 ; Y set and returned to LEXXM
+12 ;
T6 ; 6 Characters
+1 NEW XU,CHR,NUM,TRL,PRE,UIN,NXT,USE,P1,P2
SET PRE=$GET(LEXPRE)
SET NXT=$GET(LEXNXT)
SET USE=$GET(LEXUSE)
SET UIN=$GET(UIN)
SET XU=$$UP(X)
SET CHR=$EXTRACT(XU,1)
+2 ; Exceptions
+3 SET P1=$EXTRACT(XU,1,($LENGTH(XU)-2))
SET P2=$EXTRACT(XU,($LENGTH(XU)-1),$LENGTH(XU))
IF "^CC^ML^GM^"[("^"_P2_"^")
IF $EXTRACT(P1,$LENGTH(P1))?1N
SET Y=$$LO(XU)
QUIT
+4 SET NUM=$EXTRACT(XU,1,4)
SET TRL=$EXTRACT(XU,5,6)
IF +NUM=NUM
IF ((TRL="TH")!(TRL="ST")!(TRL="RD")!(TRL="ND"))
SET Y=$$LO(XU)
if $LENGTH($GET(Y))
QUIT
+5 IF "SNOMED"=XU
SET Y=XU
QUIT
+6 IF "STATED"=XU&(PRE="SO")
SET Y=$$LO(X)
QUIT
+7 IF "^DEVICE^"[("^"_XU_"^")&($LENGTH(PRE)>5)
SET Y=$$MX(X)
QUIT
+8 if $EXTRACT(XU,1)?1U&($EXTRACT(XU,6)?1N)
SET Y=XU
if $LENGTH($GET(Y))
QUIT
if $EXTRACT(XU,1)?1N
SET Y=XU
if $LENGTH($GET(Y))
QUIT
+9 ; Special Case
+10 if X="DESGLY"
SET Y="desGly"
if X="ECORII"
SET Y="EcoRII"
if X="GALNAC"
SET Y="GalNAc"
if $LENGTH($GET(Y))
QUIT
+11 if X="GLCNAC"
SET Y="GlcNAc"
if X="GTPASE"
SET Y="GTPase"
if X="LEFORT"
SET Y="LeFort"
if $LENGTH($GET(Y))
QUIT
+12 if X="MURNAC"
SET Y="MurNAc"
if X="PTDINS"
SET Y="PtdIns"
if X="STYLTI"
SET Y="StyLTI"
if $LENGTH($GET(Y))
QUIT
+13 if X="UVRABC"
SET Y="uvrABC"
if X="PDGOLD"
SET Y="PdGold"
if X="IOGOLD"
SET Y="IoGold"
if $LENGTH($GET(Y))
QUIT
+14 if X="ATPASE"
SET Y="ATPase"
if $LENGTH($GET(Y))
QUIT
+15 ; Lower Case
+16 IF "^BEFORE^CLOSED^CYCLIC^DEGREE^DEVICE^DURING^EFFECT^"[("^"_XU_"^")
SET Y=$$LO(X)
QUIT
+17 IF "^EXCEPT^FACTOR^FILING^FOURTH^HEMPAS^HAVING^INSIDE^ITSELF^"[("^"_XU_"^")
SET Y=$$LO(X)
QUIT
+18 IF "^LENGTH^MOLDED^RETURN^SECOND^SINGLE^WITHIN^"[("^"_XU_"^")
SET Y=$$LO(X)
QUIT
+19 ; Mixed Case
+20 IF "^ANGLES^AUGUST^BATTLE^BILOXI^BONHAM^BOSTON^BUTLER^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+21 IF "^CASTLE^CLINIC^DALLAS^DAYTON^DENVER^DUBLIN^DURHAM^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+22 IF "^FRESNO^HEALTH^HGHLND^HOWARD^HUDSON^ISLAND^JERSEY^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+23 IF "^KANSAS^LESSER^LITTLE^MANILA^MARION^MARLIN^MOINES^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+24 IF "^ORANGE^POPLAR^POPLAR^RETURN^SPRING^TACOMA^TEMPLE^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+25 IF "^TOPEKA^TUCSON^VALLEY^WILKES^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+26 ; Uppercase
+27 IF "^ADAMTS^BICROS^C1251C^COL1A1^DMEPOS^FOX01A^FOXO1A^PEPPTS"[("^"_XU_"^")
SET Y=XU
QUIT
+28 QUIT
+29 ;
T7 ; 7 Characters
+1 NEW XU,CHR,NUM,TRL,PRE,UIN,NXT,USE,P1,P2
SET PRE=$GET(LEXPRE)
SET NXT=$GET(LEXNXT)
SET USE=$GET(LEXUSE)
SET UIN=$GET(UIN)
SET XU=$$UP(X)
SET CHR=$EXTRACT(XU,1)
+2 ; Exceptions
+3 SET P1=$EXTRACT(XU,1,($LENGTH(XU)-2))
SET P2=$EXTRACT(XU,($LENGTH(XU)-1),$LENGTH(XU))
IF "^CC^ML^GM^"[("^"_P2_"^")
IF $EXTRACT(P1,$LENGTH(P1))?1N
SET Y=$$LO(XU)
QUIT
+4 SET NUM=$EXTRACT(XU,1,5)
SET TRL=$EXTRACT(XU,6,7)
IF +NUM=NUM
IF ((TRL="TH")!(TRL="ST")!(TRL="RD")!(TRL="ND"))
SET Y=$$LO(XU)
if $LENGTH($GET(Y))
QUIT
+5 if $EXTRACT(XU,1)?1U&($EXTRACT(XU,7)?1N)
SET Y=XU
if $LENGTH($GET(Y))
QUIT
if $EXTRACT(XU,1)?1N
SET Y=XU
if $LENGTH($GET(Y))
QUIT
+6 ; Lower Case
+7 IF "GREATER"=XU&($EXTRACT(NXT,1,4)="THAN")
SET Y=$$LO(X)
QUIT
+8 IF "GREATER"=XU&(PRE="OR")
SET Y=$$LO(X)
QUIT
+9 IF "^EFFECTS^BETWEEN^ONESELF^HERSELF^HIMSELF^OUTSIDE^"[("^"_XU_"^")
SET Y=$$LO(X)
QUIT
+10 IF "^THEREOF^ANOTHER^THEREBY^WITHOUT^MENTION^THROUGH^"[("^"_XU_"^")
SET Y=$$LO(X)
QUIT
+11 ; Mixed Case
+12 IF "^APHAKIA^APHAKIC^ALTOONA^ANTONIO^ATLANTA^AUGUSTA^BATAVIA^BECKLEY^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+13 IF "^BEDFORD^BUFFALO^CENTRAL^CHICAGO^EASTERN^FLORIDA^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+14 IF "^GEORGIA^GREATER^HAMPTON^HOUSTON^JACKSON^JANUARY^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+15 IF "^LEBANON^LINCOLN^MADISON^MEMPHIS^OCTOBER^ORLEANS^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+16 IF "^PATIENT^PHOENIX^SAGINAW^SEATTLE^SPOKANE^SPRINGS^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+17 IF "^WESTERN^WICHITA^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+18 ; Uppercase
+19 IF "^ASPSCR1^CBFA2T1^CMVIGIV^S30R060^S30R080^S30R100^"[("^"_XU_"^")
SET Y=XU
QUIT
+20 QUIT
+21 ;
T8 ; 8 Characters
+1 NEW XU,CHR,NUM,TRL,PRE,UIN,NXT,USE,P1,P2
SET PRE=$GET(LEXPRE)
SET NXT=$GET(LEXNXT)
SET USE=$GET(LEXUSE)
SET UIN=$GET(UIN)
SET XU=$$UP(X)
SET CHR=$EXTRACT(XU,1)
+2 ; Exceptions
+3 SET P1=$EXTRACT(XU,1,($LENGTH(XU)-2))
SET P2=$EXTRACT(XU,($LENGTH(XU)-1),$LENGTH(XU))
IF "^CC^ML^GM^"[("^"_P2_"^")
IF $EXTRACT(P1,$LENGTH(P1))?1N
SET Y=$$LO(XU)
QUIT
+4 SET NUM=$EXTRACT(XU,1,6)
SET TRL=$EXTRACT(XU,7,8)
IF +NUM=NUM
IF ((TRL="TH")!(TRL="ST")!(TRL="RD")!(TRL="ND"))
SET Y=$$LO(XU)
if $LENGTH($GET(Y))
QUIT
+5 if $EXTRACT(XU,1)?1U&($EXTRACT(XU,8)?1N)
SET Y=XU
if $LENGTH($GET(Y))
QUIT
if $EXTRACT(XU,1)?1N
SET Y=XU
if $LENGTH($GET(Y))
QUIT
+6 ; Lower Case
+7 IF XU="MULTIPLE"
IF $EXTRACT(NXT,1,5)="SITES"
SET Y=$$LO(X)
QUIT
+8 IF XU="MULTIPLE"
IF $EXTRACT(NXT,1,18)["AND UNSPECIFIED"
SET Y=$$LO(X)
QUIT
+9 IF "^ALTHOUGH^INJURING^INCLUDES^ADDITION^EXCLUDES^"[("^"_XU_"^")
SET Y=$$LO(X)
QUIT
+10 ; Mixed Case
+11 IF "^BROCKTON^BROOKLYN^CHEYENNE^COLUMBIA^COLUMBUS^DANVILLE^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+12 IF "^DECEMBER^FAYETTVL^FEBRUARY^HARRISON^HIGHLAND^HONOLULU^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+13 IF "^JUNCTION^MARTINEZ^MARYLAND^MONTROSE^MOUNTAIN^MOUNTIAN^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+14 IF "^MUSKOGEE^NEBRASKA^NORTHERN^OKLAHOMA^PORTLAND^PRESCOTT^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+15 IF "^RICHMOND^ROSEBURG^SHERIDAN^SOUTHERN^SYRACUSE^TUSKEGEE^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+16 IF "^VETERANS^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+17 ; Uppercase
+18 IF "^PD3S111L^PD3S111P^"[("^"_XU_"^")
SET Y=XU
QUIT
+19 QUIT
+20 ;
T9 ; 9 Characters
+1 NEW XU,CHR,NUM,TRL,PRE,UIN,NXT,P1,P2
SET PRE=$GET(LEXPRE)
SET NXT=$GET(LEXNXT)
SET UIN=$GET(UIN)
SET XU=$$UP(X)
SET CHR=$EXTRACT(XU,1)
+2 ; Exceptions
+3 SET P1=$EXTRACT(XU,1,($LENGTH(XU)-2))
SET P2=$EXTRACT(XU,($LENGTH(XU)-1),$LENGTH(XU))
IF "^CC^ML^GM^"[("^"_P2_"^")
IF $EXTRACT(P1,$LENGTH(P1))?1N
SET Y=$$LO(XU)
QUIT
+4 SET NUM=$EXTRACT(XU,1,7)
SET TRL=$EXTRACT(XU,8,9)
IF +NUM=NUM
IF ((TRL="TH")!(TRL="ST")!(TRL="RD")!(TRL="ND"))
SET Y=$$LO(XU)
if $LENGTH($GET(Y))
QUIT
+5 if $EXTRACT(XU,1)?1U&($EXTRACT(XU,9)?1N)
SET Y=XU
if $LENGTH($GET(Y))
QUIT
if $EXTRACT(XU,1)?1N
SET Y=XU
if $LENGTH($GET(Y))
QUIT
+6 if XU="MILLIGRAM"&(($GET(UIN)[" PER ")&($GET(UIN)[" MILLI"))
SET Y="mg"
if $LENGTH($GET(Y))
QUIT
+7 ; Lower Case
+8 IF "^OTHERWISE^SPECIFIED^INCLUDING^ELSEWHERE^INVOLVING^EXCLUDING^"[("^"_XU_"^")
SET Y=$$LO(X)
QUIT
+9 ; Mixed Case
+10 IF "^ASHEVILLE^BALTIMORE^CLEVELAND^FRANCISCO^KERRVILLE^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+11 IF "^KNOXVILLE^LEXINGTON^LIVERMORE^MILWAUKEE^NASHVILLE^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+12 IF "^NEWINGTON^NORTHPORT^SALISBURY^SEPTEMBER^SEPULVEDA^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+13 QUIT
+14 ;
TM ; Long Words
T10 ; 10 Characters
+1 NEW XU,CHR,NUM,TRL,PRE,UIN,NXT,USE
SET PRE=$GET(LEXPRE)
SET NXT=$GET(LEXNXT)
SET USE=$GET(LEXUSE)
SET UIN=$GET(UIN)
SET XU=$$UP(X)
SET CHR=$EXTRACT(XU,1)
+2 ; Exceptions
+3 SET NUM=$EXTRACT(XU,1,($LENGTH(XU)-2))
SET TRL=$EXTRACT(XU,($LENGTH(XU)-1),$LENGTH(XU))
+4 IF +NUM=NUM
IF ((TRL="TH")!(TRL="ST")!(TRL="RD")!(TRL="ND"))
SET Y=$$LO(XU)
if $LENGTH($GET(Y))
QUIT
+5 if $EXTRACT(XU,1)?1U&($EXTRACT(XU,$LENGTH(XU))?1N)
SET Y=XU
if $LENGTH($GET(Y))
QUIT
if $EXTRACT(XU,1)?1N
SET Y=XU
if $LENGTH($GET(Y))
QUIT
+6 ; Special Case
+7 if X="GDPMANNOSE"
SET Y="GDPmannose"
if X="UDPGLUCOSE"
SET Y="UDPglucose"
if $LENGTH($GET(Y))
QUIT
+8 ; Lower Case
+9 IF XU="COMPLICATED"
IF $EXTRACT(NXT,1,2)="BY"
SET Y=$$LO(X)
QUIT
+10 IF "^CONDITIONS^ADDITIONAL^CLASSIFIED^"[("^"_XU_"^")
SET Y=$$LO(X)
QUIT
+11 ; Mixed Case
+12 IF "^BIRMINGHAM^CALIFORNIA^CHARLESTON^CINCINNATI^CLARKSBURG^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+13 IF "^HEALTHCARE^HUNTINGTON^LOUISVILLE^MANCHESTER^MONTGOMERY^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+14 IF "^PITTSBURGH^PROVIDENCE^SHREVEPORT^TUSCALOOSA^UNIVERSITY^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+15 IF "^WASHINGTON^WILMINGTON^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
T11 ; 11 Characters
+1 NEW XU,CHR
SET XU=$$UP(X)
SET CHR=$EXTRACT(XU,1)
+2 ; Exceptions
+3 if $EXTRACT(XU,1)?1U&($EXTRACT(XU,$LENGTH(XU))?1N)
SET Y=XU
if $LENGTH($GET(Y))
QUIT
if $EXTRACT(XU,1)?1N&($EXTRACT(XU,$LENGTH(XU))?1U)
SET Y=XU
if $LENGTH($GET(Y))
QUIT
+4 ; Lower Case
+5 IF "^UNSPECIFIED^"[("^"_XU_"^")
SET Y=$$LO(X)
QUIT
+6 ; Mixed Case
+7 IF "^CANANDAIGUA^CHILLICOTHE^COATESVILLE^CONNECTICUT^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+8 IF "^GAINESVILLE^LEAVENWORTH^MARTINSBURG^MINNEAPOLIS^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+9 IF "^NORTHAMPTON^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
T12 ; 12 Characters or Greater
+1 NEW XU,CHR
SET XU=$$UP(X)
SET CHR=$EXTRACT(XU,1)
+2 ; Exceptions
+3 if $EXTRACT(XU,1)?1U&($EXTRACT(XU,$LENGTH(XU))?1N)
SET Y=XU
if $LENGTH($GET(Y))
QUIT
if $EXTRACT(XU,1)?1N&($EXTRACT(XU,$LENGTH(XU))?1U)
SET Y=XU
if $LENGTH($GET(Y))
QUIT
+4 ; Mixed Case
+5 IF "^INDIANAPOLIS^MURFREESBORO^PHILADELPHIA^"[("^"_XU_"^")
SET Y=$$MX(X)
QUIT
+6 QUIT
+7 ;
LO(X) ; Lower Case
+1 QUIT $TRANSLATE(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
UP(X) ; Uppercase
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
MX(X) ; Mix Case
+1 QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TRANSLATE($EXTRACT(X,2,$LENGTH(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
LD(X) ; Leading Character
+1 QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$EXTRACT(X,2,$LENGTH(X))
TRIM(X) ; Trim Spaces
+1 SET X=$GET(X)
FOR
if $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 FOR
if $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+3 NEW LEXNXT,LEXPRE,LEXUSE,Y
+4 QUIT X
