LEXXM1.m

LEXXM1 ;ISL/KER - Convert Text to Mix Case (1) ;04/21/2014

 ;;2.0;General Lexicon Utilities;**80**;Sep 23, 1996;Build 10

 ;               

 ; Global Variables

 ;    None

 ;               

 ; External References

 ;    None

 ;               

T1 ; 1 Character

 N XU,CHR,PRE,LEXPRE,UIN,NXT S PRE=$G(LEXPRE),UIN=$G(UIN),NXT=$G(LEXNXT) S XU=$$UP(X),CHR=$E(XU,1)

 S:XU="W"&(($G(UIN)["W/WO")!($G(UIN)["W/")) Y=$$LO(XU) Q:$L($G(Y))

 ;   Special Case "A"

 S Y="" I XU="A",$E(NXT,1,7)["SINGLE" S Y=$$LO(XU) Q

 I $D(UIN),"^A^"[("^"_XU_"^"),(" "_UIN_" ")[(" "_XU_" ") D  Q:$L($G(Y))

 . N UP S Y=XU Q:UIN[" A OR V "  Q:UIN[" T AND A "  Q:UIN[" A & E"  Q:UIN[" A OR B"  Q:UIN["O>HM< A"  S UP=$$UPA(XU,PRE,UIN) S:+UP'>0 Y=$$LO(XU)

 ;   Special Case W/O

 I "^O^W^"[("^"_XU_"^")&(UIN["W/O") S Y=$$LO(XU) Q

 I "^G^"[("^"_XU_"^")&(+($G(PRE))>0) S Y=$$LO(XU) Q

 ;   Uppercase

 I "^B^C^D^E^F^G^H^I^J^K^L^M^N^O^P^Q^R^S^T^U^V^X^Y^Z^"[("^"_XU_"^") S Y=XU Q

 Q

 ;            

UPA(X,Y,Z) ; Check if "A" is Uppercase A

 N CHR,FIR,OK,PRE,UP,W,XU

 S XU=$G(X),PRE=$G(Y),UIN=$G(Z),FIR=$A($E(PRE,1))

 S OK=1 Q:UIN[" A OR V " 1  Q:UIN[" T and A " 1  Q:UIN[" A & E" 1  Q:UIN[" A OR B" 1  Q:UIN["O>HM< A" 1  Q:PRE="&" 1

 S OK=0 I FIR<66 F W="ACETYLGLUCOSAMINIDASE","ACETYLHEXOSAMINIDASE","ACTIONS","ACTIVIN","ACYLCOENZYME","AKIYAMI","ALDOLASE","AMINOPEPTIDASE" S:PRE=W OK=1

 Q:OK=1 1  I FIR<66 F W="AMPHOTERICIN","AMYLOID","ANOPHELES","ANTI","ANTIBODY","ANTIGEN","APHTHOVIRUS","APOLIPOPROTEIN","APOLIPOPROTEINS","ARYLSULFATASE" S:PRE=W OK=1

 Q:OK=1 1  I FIR<68 F W="ATTRIBUTE","ATTRIBUTES","AUXIN","AZURE","BACITRACIN","BIOVAR","BISPHENOL","BOTULINIUM","BOTULINUM","CARBOMYCIN","CARBOXYPEPTIDASE" S:PRE=W OK=1

 Q:OK=1 1  I FIR>66,FIR<68 F W="CARMOISINE","CAROTID","CATEGORY","CHROMOGRANIN","CHYMOTRYPSIN","CICLOSPORIN","CLASS","CLINIC","CLUSTER","COBALAMIN","COENZYME" S:PRE=W OK=1

 Q:OK=1 1  I FIR>66,FIR<70 F W="COMPOUND","CON","CONCANAVALIN","CORONARY","COXSACKIE","COXSACKIEVIRUS","CYCLOSPORIN","DIPEPTIDASE","DNASE","DOUBLE","ENTEROTOXIN" S:PRE=W OK=1

 Q:OK=1 1  I FIR>68,FIR<72 F W="ENZYMES","EQUIZOLE","FEEDS","FIBRINOPEPTIDE","FIBRINOPEPTIDES","FORMULA","GALACTOSIDASE","GELATINASE","GENUS","GLYCOPHORIN","GP" S:PRE=W OK=1

 Q:OK=1 1  I FIR>70,FIR<73 F W="GRADE","GRANZYME","GROUP","HAEMOGLOBIN","HAEMOPHILIA","HB","HEMOGLOBIN","HEMOPHILIA","HEP","HEPATITIS","HEXOSAMINIDASE","HLA","HPFH" S:PRE=W OK=1

 Q:OK=1 1  I FIR>71,FIR<74 F W="HYPERVITAMINOSIS","HYPOGLYCIN","HYPOVITAMINOSIS","I","II","III","IMMUNOGLOBULIN","INDEX","INFLUENZA","INFLUENZAE","INFLUENZAVIRUS" S:PRE=W OK=1

 Q:OK=1 1  I FIR>72,FIR<78 F W="INHIBIN","IV","JEC","LANTADENE","LASALOCID","LEFT","LEPROMIN","LEUKOTRIENE","LEVEL","LIPOPROTEIN","LOCUS","MED","MENINGITIDIS" S:PRE=W OK=1

 Q:OK=1 1  I FIR>76,FIR<80 F W="MENINGITIS","MEPRIN","MOENOMYCIN","MORQUIO","NEOVITAMIN","NEUROKININ","NUTRITION","OLEOVITAMIN","OLIGOPEPTIDASE","ORBITAL","OXIDASE" S:PRE=W OK=1

 Q:OK=1 1  I FIR>79,FIR<81 F W="PADIMATE","PARATYPHI","PARATYPHOID","PEPSIN","PHOSPHOLIPASE","POLYSACCHARIDE","PRECURSORS","PROTEIN","PROTEINASE","PROTEINS" S:PRE=W OK=1

 Q:OK=1 1  I FIR>79,FIR<84 F W="PROTOVERATRINE","PUMILIOTOXIN","RASTELLI","RH","RHINITIS","RIGHT","RUTTER","SCILLAREN","SCYTALIDOPEPSIN","SEROTYPE","SOLVENT" S:PRE=W OK=1

 Q:OK=1 1  I FIR>82,FIR<85 F W="SOMATOMEDIN","SPECIES","STAGE","STREPTOGRISIN","SUBGROUP","SUBSCALE","SUBUNIT","SULFATASE","SULFATE","SULPHATASE","T","TARIFF" S:PRE=W OK=1

 Q:OK=1 1  I FIR>83,FIR<91 F W="TOXIN","TRIPLE","TYPE","TYPING","ULTRAVIOLET","VALUES","VENOMBIN","VIRUS","VITAMIN","WEAK" S:PRE=W OK=1

 S X=OK

 Q X

 ;                    

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")

LEXXM1    ;ISL/KER - Convert Text to Mix Case (1) ;04/21/2014

 +1       ;;2.0;General Lexicon Utilities;**80**;Sep 23, 1996;Build 10

 +2       ;               

 +3       ; Global Variables

 +4       ;    None

 +5       ;               

 +6       ; External References

 +7       ;    None

 +8       ;               

T1        ; 1 Character

 +1        NEW XU,CHR,PRE,LEXPRE,UIN,NXT

           SET PRE=$GET(LEXPRE)

           SET UIN=$GET(UIN)

           SET NXT=$GET(LEXNXT)

           SET XU=$$UP(X)

           SET CHR=$EXTRACT(XU,1)

 +2        IF XU="W"&(($GET(UIN)["W/WO")!($GET(UIN)["W/"))

               SET Y=$$LO(XU)

           IF $LENGTH($GET(Y))

               QUIT 

 +3       ;   Special Case "A"

 +4        SET Y=""

           IF XU="A"

               IF $EXTRACT(NXT,1,7)["SINGLE"

                   SET Y=$$LO(XU)

                   QUIT 

 +5        IF $DATA(UIN)

               IF "^A^"[("^"_XU_"^")

                   IF (" "_UIN_" ")[(" "_XU_" ")

                       Begin DoDot:1

 +6                        NEW UP

                           SET Y=XU

                           IF UIN[" A OR V "

                               QUIT 

                           IF UIN[" T AND A "

                               QUIT 

                           IF UIN[" A & E"

                               QUIT 

                           IF UIN[" A OR B"

                               QUIT 

                           IF UIN["O>HM< A"

                               QUIT 

                           SET UP=$$UPA(XU,PRE,UIN)

                           IF +UP'>0

                               SET Y=$$LO(XU)

                       End DoDot:1

                       IF $LENGTH($GET(Y))

                           QUIT 

 +7       ;   Special Case W/O

 +8        IF "^O^W^"[("^"_XU_"^")&(UIN["W/O")

               SET Y=$$LO(XU)

               QUIT 

 +9        IF "^G^"[("^"_XU_"^")&(+($GET(PRE))>0)

               SET Y=$$LO(XU)

               QUIT 

 +10      ;   Uppercase

 +11       IF "^B^C^D^E^F^G^H^I^J^K^L^M^N^O^P^Q^R^S^T^U^V^X^Y^Z^"[("^"_XU_"^")

               SET Y=XU

               QUIT 

 +12       QUIT 

 +13      ;            

UPA(X,Y,Z) ; Check if "A" is Uppercase A

 +1        NEW CHR,FIR,OK,PRE,UP,W,XU

 +2        SET XU=$GET(X)

           SET PRE=$GET(Y)

           SET UIN=$GET(Z)

           SET FIR=$ASCII($EXTRACT(PRE,1))

 +3        SET OK=1

           IF UIN[" A OR V "

               QUIT 1

           IF UIN[" T and A "

               QUIT 1

           IF UIN[" A & E"

               QUIT 1

           IF UIN[" A OR B"

               QUIT 1

           IF UIN["O>HM< A"

               QUIT 1

           IF PRE="&"

               QUIT 1

 +4        SET OK=0

           IF FIR<66

               FOR W="ACETYLGLUCOSAMINIDASE","ACETYLHEXOSAMINIDASE","ACTIONS","ACTIVIN","ACYLCOENZYME","AKIYAMI","ALDOLASE","AMINOPEPTIDASE"

                   IF PRE=W

                       SET OK=1

 +5        IF OK=1

               QUIT 1

           IF FIR<66

               FOR W="AMPHOTERICIN","AMYLOID","ANOPHELES","ANTI","ANTIBODY","ANTIGEN","APHTHOVIRUS","APOLIPOPROTEIN","APOLIPOPROTEINS","ARYLSULFATASE"

                   IF PRE=W

                       SET OK=1

 +6        IF OK=1

               QUIT 1

           IF FIR<68

               FOR W="ATTRIBUTE","ATTRIBUTES","AUXIN","AZURE","BACITRACIN","BIOVAR","BISPHENOL","BOTULINIUM","BOTULINUM","CARBOMYCIN","CARBOXYPEPTIDASE"

                   IF PRE=W

                       SET OK=1

 +7        IF OK=1

               QUIT 1

           IF FIR>66

               IF FIR<68

                   FOR W="CARMOISINE","CAROTID","CATEGORY","CHROMOGRANIN","CHYMOTRYPSIN","CICLOSPORIN","CLASS","CLINIC","CLUSTER","COBALAMIN","COENZYME"

                       IF PRE=W

                           SET OK=1

 +8        IF OK=1

               QUIT 1

           IF FIR>66

               IF FIR<70

                   FOR W="COMPOUND","CON","CONCANAVALIN","CORONARY","COXSACKIE","COXSACKIEVIRUS","CYCLOSPORIN","DIPEPTIDASE","DNASE","DOUBLE","ENTEROTOXIN"

                       IF PRE=W

                           SET OK=1

 +9        IF OK=1

               QUIT 1

           IF FIR>68

               IF FIR<72

                   FOR W="ENZYMES","EQUIZOLE","FEEDS","FIBRINOPEPTIDE","FIBRINOPEPTIDES","FORMULA","GALACTOSIDASE","GELATINASE","GENUS","GLYCOPHORIN","GP"

                       IF PRE=W

                           SET OK=1

 +10       IF OK=1

               QUIT 1

           IF FIR>70

               IF FIR<73

                   FOR W="GRADE","GRANZYME","GROUP","HAEMOGLOBIN","HAEMOPHILIA","HB","HEMOGLOBIN","HEMOPHILIA","HEP","HEPATITIS","HEXOSAMINIDASE","HLA","HPFH"

                       IF PRE=W

                           SET OK=1

 +11       IF OK=1

               QUIT 1

           IF FIR>71

               IF FIR<74

                   FOR W="HYPERVITAMINOSIS","HYPOGLYCIN","HYPOVITAMINOSIS","I","II","III","IMMUNOGLOBULIN","INDEX","INFLUENZA","INFLUENZAE","INFLUENZAVIRUS"

                       IF PRE=W

                           SET OK=1

 +12       IF OK=1

               QUIT 1

           IF FIR>72

               IF FIR<78

                   FOR W="INHIBIN","IV","JEC","LANTADENE","LASALOCID","LEFT","LEPROMIN","LEUKOTRIENE","LEVEL","LIPOPROTEIN","LOCUS","MED","MENINGITIDIS"

                       IF PRE=W

                           SET OK=1

 +13       IF OK=1

               QUIT 1

           IF FIR>76

               IF FIR<80

                   FOR W="MENINGITIS","MEPRIN","MOENOMYCIN","MORQUIO","NEOVITAMIN","NEUROKININ","NUTRITION","OLEOVITAMIN","OLIGOPEPTIDASE","ORBITAL","OXIDASE"

                       IF PRE=W

                           SET OK=1

 +14       IF OK=1

               QUIT 1

           IF FIR>79

               IF FIR<81

                   FOR W="PADIMATE","PARATYPHI","PARATYPHOID","PEPSIN","PHOSPHOLIPASE","POLYSACCHARIDE","PRECURSORS","PROTEIN","PROTEINASE","PROTEINS"

                       IF PRE=W

                           SET OK=1

 +15       IF OK=1

               QUIT 1

           IF FIR>79

               IF FIR<84

                   FOR W="PROTOVERATRINE","PUMILIOTOXIN","RASTELLI","RH","RHINITIS","RIGHT","RUTTER","SCILLAREN","SCYTALIDOPEPSIN","SEROTYPE","SOLVENT"

                       IF PRE=W

                           SET OK=1

 +16       IF OK=1

               QUIT 1

           IF FIR>82

               IF FIR<85

                   FOR W="SOMATOMEDIN","SPECIES","STAGE","STREPTOGRISIN","SUBGROUP","SUBSCALE","SUBUNIT","SULFATASE","SULFATE","SULPHATASE","T","TARIFF"

                       IF PRE=W

                           SET OK=1

 +17       IF OK=1

               QUIT 1

           IF FIR>83

               IF FIR<91

                   FOR W="TOXIN","TRIPLE","TYPE","TYPING","ULTRAVIOLET","VALUES","VENOMBIN","VIRUS","VITAMIN","WEAK"

                       IF PRE=W

                           SET OK=1

 +18       SET X=OK

 +19       QUIT X

 +20      ;                    

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")