Routine: LEXXM5

LEXXM5 ;ISL/KER - Convert Text to Mix Case (5) ;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

T5 ; 5 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,3),TRL=$E(XU,4,5) I +NUM=NUM,((TRL="TH")!(TRL="ST")!(TRL="RD")) S Y=$$LO(XU) Q:$L($G(Y))

 S:$E(XU,1)?1U&($E(XU,5)?1N) Y=XU Q:$L($G(Y))  S:$E(XU,1)?1N&($E(XU,5)?1U) Y=XU Q:$L($G(Y))

 S:XU="TRALI"&(UIN["TRANSFUSION-RELATED ACUTE LUNG INJURY"!(USE["TRANSFUSION-RELATED ACUTE LUNG INJURY")) Y=XU Q:$L($G(Y))

 S:XU="TRALI"&(UIN["TRANSFUSION RELATED ACUTE LUNG INJURY"!(USE["TRANSFUSION RELATED ACUTE LUNG INJURY")) Y=XU Q:$L($G(Y))

 S:XU="THREE"&($G(UIN)["DIMENSION") Y=$$MX(XU) Q:$L($G(Y))

 S:XU="FIFTH"&($E($G(NXT),1,7)["DISEASE") Y=$$MX(XU) Q:$L($G(Y))

 S:XU="SIXTH"&($E($G(NXT),1,7)["DISEASE") Y=$$MX(XU) Q:$L($G(Y))

 S:XU="AREAS"&($G(PRE)["MORE") Y=$$LO(XU) Q:$L($G(Y))

 ;   Special Case

 S:X="CVIBI" Y="CviBI" S:X="DNASE" Y="DNase" S:X="ECORI" Y="EcoRI" Q:$L($G(Y))

 S:X="GROEL" Y="GroEL" S:X="HAEII" Y="HaeII" S:X="HBSAG" Y="HBsAg" Q:$L($G(Y))

 S:X="HINFI" Y="HinfI" S:X="HNRNP" Y="hnRNP" S:X="HPAII" Y="HpaII" Q:$L($G(Y))

 S:X="HPGRF" Y="hpGRF" S:X="MBOII" Y="MboII" S:X="MELEU" Y="MeLeu" Q:$L($G(Y))

 S:X="MEPHE" Y="MePhe" S:X="MEPRO" Y="MePro" S:X="NEUAC" Y="NeuAc" Q:$L($G(Y))

 S:X="PTHRP" Y="PTHrP" S:X="RNASE" Y="RNase" S:X="SALGI" Y="SalGI" Q:$L($G(Y))

 S:X="SNRNP" Y="snRNP" Q:$L($G(Y))

 ;   Lower Case

 I "EQUAL"=XU&($E(USE,($L(USE)-12),$L(USE))["THAN OR") S Y=$$LO(X) Q

 I "^ABOVE^AFTER^BELOW^COULD^FIFTH^FIRST^FORTH^FOUND^GIVEN^HOURS"[("^"_XU_"^") S Y=$$LO(X) Q

 I "^LOWER^MAJOR^OFTEN^OTHER^OUTER^RIGHT^SITES^SIXTH^THERE^THESE"[("^"_XU_"^") S Y=$$LO(X) Q

 I "^THIRD^THREE^UPPER^USING^WHERE^WHICH^WOULD"[("^"_XU_"^") S Y=$$LO(X) Q

 ;   Mixed Case

 I "^APRIL^ARBOR^BARRE^BEACH^BLACK^BLUFF^BRONX^CLOUD^CREEK^DIEGO"[("^"_XU_"^") S Y=$$MX(X) Q

 I "^DRIVE^FALLS^FARGO^GOISE^GRAND^HAVEN^HILLS^HINES^JUNCT^LINDA"[("^"_XU_"^") S Y=$$MX(X) Q

 I "^LOUIS^LYONS^MARCH^MEADE^MIAMI^MILES^NORTH^OMAHA^PASSO^PERRY"[("^"_XU_"^") S Y=$$MX(X) Q

 I "^PINES^PITTS^POINT^PUGET^RIVER^RIVER^SAINT^SALEM^SIOUX^SOUND"[("^"_XU_"^") S Y=$$MX(X) Q

 I "^SOUTH^TAMPA^TEXAS^TOGUS^TOMAH^VEGAS^WALLA^WAYNE^WHITE"[("^"_XU_"^") S Y=$$MX(X) Q

 ;   Uppercase

 I "^1003F^1004F^1006F^1007F^1031C^2000F^2001F^2002F^2003F^2004F"[("^"_XU_"^") S Y=XU Q

 I "^ALLA1^AREDS^BRCA1^BRCA2^BRDCL^C1251^CCAAT^CCHIT^CCND1^CD117"[("^"_XU_"^") S Y=XU Q

 I "^COPD1^CTLSO^CTLSO^DDIT3^DOPAC^DPDPE^EPSDT^EPSDT^EPTFE^ERRB2"[("^"_XU_"^") S Y=XU Q

 I "^EWSR1^HBSAG^HCPCS^HGSIL^HKAFO^HKAFO^HNPCC^IGFBP^JAZF1^JJAZ1"[("^"_XU_"^") S Y=XU Q

 I "^KAPPA^LGSIL^MELAS^MERRF^MERRF^MYH11^NSAID^NADPH^NIDDM^NKHHC^NR4A3^PACAP"[("^"_XU_"^") S Y=XU Q

 I "^PDGFB^PPROM^PUPPP^QSART^RBF56^RUNX1^SAECG^SAIDS^SEWHO^SPECT^SPECT"[("^"_XU_"^") S Y=XU Q

 I "^STAAR^SUNCT^T1MIC^TCF12^THKAO^TKHAO^XVIII^XXIII^ZPACK"[("^"_XU_"^") S Y=XU 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[HLEXXM5   4015     printed  Mar 13, 2025@21:14:57                                                                                                                                                                                                      Page 2

LEXXM5    ;ISL/KER - Convert Text to Mix Case (5) ;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      ;

T5        ; 5 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,3)

           SET TRL=$EXTRACT(XU,4,5)

           IF +NUM=NUM

               IF ((TRL="TH")!(TRL="ST")!(TRL="RD"))

                   SET Y=$$LO(XU)

                   if $LENGTH($GET(Y))

                       QUIT

 +5        if $EXTRACT(XU,1)?1U&($EXTRACT(XU,5)?1N)

               SET Y=XU

           if $LENGTH($GET(Y))

               QUIT

           if $EXTRACT(XU,1)?1N&($EXTRACT(XU,5)?1U)

               SET Y=XU

           if $LENGTH($GET(Y))

               QUIT

 +6        if XU="TRALI"&(UIN["TRANSFUSION-RELATED ACUTE LUNG INJURY"!(USE["TRANSFUSION-RELATED ACUTE LUNG INJURY"))

               SET Y=XU

           if $LENGTH($GET(Y))

               QUIT

 +7        if XU="TRALI"&(UIN["TRANSFUSION RELATED ACUTE LUNG INJURY"!(USE["TRANSFUSION RELATED ACUTE LUNG INJURY"))

               SET Y=XU

           if $LENGTH($GET(Y))

               QUIT

 +8        if XU="THREE"&($GET(UIN)["DIMENSION")

               SET Y=$$MX(XU)

           if $LENGTH($GET(Y))

               QUIT

 +9        if XU="FIFTH"&($EXTRACT($GET(NXT),1,7)["DISEASE")

               SET Y=$$MX(XU)

           if $LENGTH($GET(Y))

               QUIT

 +10       if XU="SIXTH"&($EXTRACT($GET(NXT),1,7)["DISEASE")

               SET Y=$$MX(XU)

           if $LENGTH($GET(Y))

               QUIT

 +11       if XU="AREAS"&($GET(PRE)["MORE")

               SET Y=$$LO(XU)

           if $LENGTH($GET(Y))

               QUIT

 +12      ;   Special Case

 +13       if X="CVIBI"

               SET Y="CviBI"

           if X="DNASE"

               SET Y="DNase"

           if X="ECORI"

               SET Y="EcoRI"

           if $LENGTH($GET(Y))

               QUIT

 +14       if X="GROEL"

               SET Y="GroEL"

           if X="HAEII"

               SET Y="HaeII"

           if X="HBSAG"

               SET Y="HBsAg"

           if $LENGTH($GET(Y))

               QUIT

 +15       if X="HINFI"

               SET Y="HinfI"

           if X="HNRNP"

               SET Y="hnRNP"

           if X="HPAII"

               SET Y="HpaII"

           if $LENGTH($GET(Y))

               QUIT

 +16       if X="HPGRF"

               SET Y="hpGRF"

           if X="MBOII"

               SET Y="MboII"

           if X="MELEU"

               SET Y="MeLeu"

           if $LENGTH($GET(Y))

               QUIT

 +17       if X="MEPHE"

               SET Y="MePhe"

           if X="MEPRO"

               SET Y="MePro"

           if X="NEUAC"

               SET Y="NeuAc"

           if $LENGTH($GET(Y))

               QUIT

 +18       if X="PTHRP"

               SET Y="PTHrP"

           if X="RNASE"

               SET Y="RNase"

           if X="SALGI"

               SET Y="SalGI"

           if $LENGTH($GET(Y))

               QUIT

 +19       if X="SNRNP"

               SET Y="snRNP"

           if $LENGTH($GET(Y))

               QUIT

 +20      ;   Lower Case

 +21       IF "EQUAL"=XU&($EXTRACT(USE,($LENGTH(USE)-12),$LENGTH(USE))["THAN OR")

               SET Y=$$LO(X)

               QUIT

 +22       IF "^ABOVE^AFTER^BELOW^COULD^FIFTH^FIRST^FORTH^FOUND^GIVEN^HOURS"[("^"_XU_"^")

               SET Y=$$LO(X)

               QUIT

 +23       IF "^LOWER^MAJOR^OFTEN^OTHER^OUTER^RIGHT^SITES^SIXTH^THERE^THESE"[("^"_XU_"^")

               SET Y=$$LO(X)

               QUIT

 +24       IF "^THIRD^THREE^UPPER^USING^WHERE^WHICH^WOULD"[("^"_XU_"^")

               SET Y=$$LO(X)

               QUIT

 +25      ;   Mixed Case

 +26       IF "^APRIL^ARBOR^BARRE^BEACH^BLACK^BLUFF^BRONX^CLOUD^CREEK^DIEGO"[("^"_XU_"^")

               SET Y=$$MX(X)

               QUIT

 +27       IF "^DRIVE^FALLS^FARGO^GOISE^GRAND^HAVEN^HILLS^HINES^JUNCT^LINDA"[("^"_XU_"^")

               SET Y=$$MX(X)

               QUIT

 +28       IF "^LOUIS^LYONS^MARCH^MEADE^MIAMI^MILES^NORTH^OMAHA^PASSO^PERRY"[("^"_XU_"^")

               SET Y=$$MX(X)

               QUIT

 +29       IF "^PINES^PITTS^POINT^PUGET^RIVER^RIVER^SAINT^SALEM^SIOUX^SOUND"[("^"_XU_"^")

               SET Y=$$MX(X)

               QUIT

 +30       IF "^SOUTH^TAMPA^TEXAS^TOGUS^TOMAH^VEGAS^WALLA^WAYNE^WHITE"[("^"_XU_"^")

               SET Y=$$MX(X)

               QUIT

 +31      ;   Uppercase

 +32       IF "^1003F^1004F^1006F^1007F^1031C^2000F^2001F^2002F^2003F^2004F"[("^"_XU_"^")

               SET Y=XU

               QUIT

 +33       IF "^ALLA1^AREDS^BRCA1^BRCA2^BRDCL^C1251^CCAAT^CCHIT^CCND1^CD117"[("^"_XU_"^")

               SET Y=XU

               QUIT

 +34       IF "^COPD1^CTLSO^CTLSO^DDIT3^DOPAC^DPDPE^EPSDT^EPSDT^EPTFE^ERRB2"[("^"_XU_"^")

               SET Y=XU

               QUIT

 +35       IF "^EWSR1^HBSAG^HCPCS^HGSIL^HKAFO^HKAFO^HNPCC^IGFBP^JAZF1^JJAZ1"[("^"_XU_"^")

               SET Y=XU

               QUIT

 +36       IF "^KAPPA^LGSIL^MELAS^MERRF^MERRF^MYH11^NSAID^NADPH^NIDDM^NKHHC^NR4A3^PACAP"[("^"_XU_"^")

               SET Y=XU

               QUIT

 +37       IF "^PDGFB^PPROM^PUPPP^QSART^RBF56^RUNX1^SAECG^SAIDS^SEWHO^SPECT^SPECT"[("^"_XU_"^")

               SET Y=XU

               QUIT

 +38       IF "^STAAR^SUNCT^T1MIC^TCF12^THKAO^TKHAO^XVIII^XXIII^ZPACK"[("^"_XU_"^")

               SET Y=XU

               QUIT

 +39       QUIT

 +40      ;

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

LEXXM5.m