LEXXM6.m

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 ---LEXXM6   8229     printed  Feb 18, 2025@23:36:32                                                                                                                                                                                                      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