LEXXMM ;ISL/KER - Convert Text to Mix Case (Misc) ;05/23/2017
;;2.0;General Lexicon Utilities;**80,86,103**;Sep 23, 1996;Build 2
;
; Global Variables
; None
;
; External References
; None
;
; Local Variables NEWed or KILLed Elsewhere
; ALL,LOW checked but not used
;
EW(X) ; Exported Word
N WRD,CNT,IMC,EXP,IEN,WU,WM,ORG,SCR,TTL,WL S ORG=$G(X) Q:'$L(ORG) S (WRD,WU)=$$UP(ORG),WM=$$MX(ORG),WL=$$LO(ORG)
S TTL="Supplemental Word",SCR="SUP" D EW2 S TTL="Lowercase",SCR="LOW" D EW2 S TTL="Mixed Case",SCR="MIX" D EW2
S TTL="Uppercase",SCR="UPP" D EW2 S TTL="Special Case",SCR="SPC" D EW2
Q
EW2 ; Exported Word Indexed
Q:'$L($G(WRD)) N CNT,CT,EXP,I,IEN,IMC,MA,MIX,UPP
I $D(^LEX(757.01,"AWRD",WRD)) D Q
. N CNT,IMC S (CNT,IMC)=0 F S IMC=$O(^LEX(757.01,"AWRD",WRD,IMC)) Q:+IMC'>0 D
. . N IEN,EXP S EXP=$P($G(^LEX(757.01,+IMC,0)),"^",1) Q:'$L(EXP)
. . S IEN=0 F S IEN=$O(^LEX(757.01,"AWRD",WRD,IMC,IEN)) Q:+IEN'>0 D
. . . N CT,EXP,I,MA,MIX,UPP S EXP=$P($G(^LEX(757.01,+IEN,0)),"^",1) Q:'$L(EXP) S MIX=$$MIX^LEXXM(EXP),UPP=$$UP(EXP) D EW3
I $D(^LEX(757.01,"AEXC",WRD)) D
. Q:SCR="SUP" Q:SCR="LOW"&('$D(ALL))
. N CNT,IMC S (CNT,IMC)=0 F S IMC=$O(^LEX(757.01,"AEXC",WRD,IMC)) Q:+IMC'>0 D
. . N IEN,EXP,CT,EXP,I,MA,MIX,UPP S EXP=$P($G(^LEX(757.01,+IMC,0)),"^",1) Q:'$L(EXP)
. . Q:'$L(EXP) S IEN=IMC,MIX=$$MIX^LEXXM(EXP),UPP=$$UP(EXP) D EW3
N ALL
Q
EW3 ; Exported word is Special/Lower/Upper/Mixed case
Q:+IEN'>0 Q:'$L($G(TTL)) Q:'$L($G(WRD)) Q:'$L($G(SCR)) N OUT
I SCR="SUP",UPP'[$$UP(WRD),$D(^LEX(757.01,+IEN,5,"B",WRD)) S OUT=MIX D EW4
I SCR="LOW",UPP[$$UP(WRD),MIX[WL,MIX'[WU,MIX'[WM S OUT=MIX D EW4
I SCR="MIX",UPP[$$UP(WRD),MIX[WM,MIX'[WU,MIX'[WL S OUT=MIX D EW4
I SCR="UPP",UPP[$$UP(WRD),MIX[WU,MIX'[WM,MIX'[WL S OUT=MIX D EW4
I SCR="SPC",UPP[$$UP(WRD),MIX'[WU,MIX'[WM,MIX'[WL S OUT=MIX D EW4
Q
EW4 ; Exported Word Display
Q:+IEN'>0 Q:'$L($G(TTL)) Q:'$L($G(OUT))
N I,CT,OA S CT=0 S CNT=CNT+1 W:CNT=1 !!,TTL,! W !,IEN S OA(1)=OUT D PR^LEXU(.OA,70)
S I=0 F S I=$O(OA(I)) Q:+I'>0 I $L($G(OA(I))) S CT=CT+1 W:CT>1 ! W ?9,$G(OA(I))
Q
;
QWIC ; Create AEXC Index
N BEG,CHR,DA,END,IEN,TXT,WD,WRD
N IEN S IEN=0 F S IEN=$O(^LEX(757.01,IEN)) Q:+IEN'>0 D
. N BEG,END,TXT,DA S TXT=$P($G(^LEX(757.01,+IEN,0)),"^",1) Q:'$L(TXT)
. S DA=+($G(IEN)),BEG=1 F END=1:1:$L(TXT)+1 D
. . N CHR S CHR=$E(TXT,END) I "~!@#$%&*()_+`-=[]{};'\:|,./?<> """[CHR D
. . . N WRD S WRD=$E(TXT,BEG,(END-1)),BEG=END+1 I $L(WRD)>0,$L(WRD)<31 D
. . . . N WD S WD=$$UP(WRD) S:$L(WD) ^LEX(757.01,"AEXC",WD,DA)=""
Q
; Swap
SW1(X) ; Switch Text (before setting case)
N TXT,SWAP,WITH S TXT=$G(X) Q:'$L(TXT) TXT
S SWAP="I.E.",WITH="IE",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="E.G.",WITH="EG",TXT=$$SWAP(TXT,SWAP,WITH)
S X=TXT
Q X
SW2(X) ; Switch Text (after setting case)
N TXT,SWAP,WITH S TXT=$G(X) Q:'$L(TXT) TXT
S SWAP="(S)",WITH="(s)",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP=" (E)",WITH="(e)",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="(E)",WITH="(e)",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP=" A ",WITH=" a ",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="Class a",WITH="Clas A",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="Type a",WITH="Type A",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="'S",WITH="'s",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="mg Diet",WITH="MG Diet",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="LO-Fat",WITH="Lo-Fat",TXT=$$SWAP(TXT,SWAP,WITH)
S X=$G(TXT)
Q X
SW3(X) ; Switch Text (after assembling string)
N TXT,C1,C2,SWAP,WITH,PIE S TXT=$G(X) Q:'$L(TXT) TXT
S SWAP=" (S)",WITH="(s)",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="(S)",WITH="(s)",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP=" (E)",WITH="(e)",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="(E)",WITH="(e)",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="CR(e)St",WITH="CR(E)ST",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="CR(e),St",WITH="CR(E)ST",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP="'S",WITH="'s",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP=" (Only)",WITH=" (only)",TXT=$$SWAP(TXT,SWAP,WITH) S SWAP="(Only)",WITH="(only)",TXT=$$SWAP(TXT,SWAP,WITH)
S SWAP=" (Each)",WITH=" (each)",TXT=$$SWAP(TXT,SWAP,WITH) S SWAP="(Each)",WITH="(each)",TXT=$$SWAP(TXT,SWAP,WITH)
F PIE=1:1 Q:'$L($P(TXT,"&",PIE)) D
. N P1,P2 S P1=$P(TXT,"&",1,PIE) Q:'$L(P1) S P2=$P(TXT,"&",(PIE+1),$L(TXT,"&")) Q:'$L(P2) S:P1[" "&($E(P2,1)'=" ") TXT=$$TM(P1)_"&"_$$TM(P2)
S X=TXT Q:$D(LOW) X S C1=$E(X,1),C2=$E(X,2),C1=C1?1U,C2=C2?1U
S:(C1+C2)'=1 X=$TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,2,$L(X))
N LOW
Q X
SWAP(X,A,B) ; Swap text "A" for text "B" in text "X"
N TXT,SWAP,WITH S TXT=$G(X),SWAP=$G(A),WITH=$G(B) Q:'$L(TXT) TXT Q:'$L(SWAP) TXT Q:TXT'[SWAP TXT Q:SWAP=WITH TXT Q:WITH[SWAP TXT
F Q:TXT'[SWAP S (X,TXT)=$P(TXT,SWAP,1)_WITH_$P(TXT,SWAP,2,4000)
Q X
TM(X,Y) ; Trim Character Y - Default " "
S X=$G(X),Y=$G(Y) Q:$L(Y)&(X'[Y) X S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" " F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
Q X
;
; Case
IG(X) ; Ignore Case
N IN,XU,CHR,TMP S IN=$G(X),XU=$$UP(IN),CHR=$E(XU,1),TMP="TYPE "_XU,TMP=$$MIX^LEXXM(TMP),TMP=$E(TMP,6,$L(TMP)) Q:TMP=IN 1
Q 0
IL(X) ; Is Lowercase
Q:'$L($G(X)) 0 Q:$E($G(X),1)'?1A 0 N CH,I,WD S WD=$G(X),X=1 F I=1:1 S CH=$E(WD,I) Q:'$L(CH) S:CH?1U X=0 Q:'X
Q X
IU(X) ; Is Uppercase
Q:'$L($G(X)) 0 Q:$E($G(X),1)'?1A 0 N CH,I,WD S WD=$G(X),X=1 F I=1:1 S CH=$E(WD,I) Q:'$L(CH) S:CH?1L X=0 Q:'X
Q X
IM(X) ; Is Mixed Case
Q:'$L($G(X)) 0 Q:$E($G(X),1)'?1A 0 N CH,I,WD S WD=$G(X),X=1 F I=1:1 S CH=$E(WD,I) Q:'$L(CH) S:I=1&(CH'?1U) X=0 S:I>1&(CH?1U) X=0 Q:'X
Q X
IS(X) ; Is Special Case
Q:$L($G(X))'>1 0 Q:$E($G(X),1)'?1A 0 N CH,PC,WD,I S WD=$G(X),X=0 F I=2:1 S CH=$E(WD,I),PC=$E(WD,(I-1)) Q:'$L(CH) S:CH?1U&(PC?1L) X=1 Q:X>0
Q X
LO(X) ; Lower Case
Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
UP(X) ; Uppercase
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
MX(X) ; Mix Case Term
Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
MIX(X) ; Mixed Case Word
N IN,XU,CHR,TMP S IN=$G(X),XU=$$UP(IN),CHR=$E(XU,1),TMP="TYPE "_XU,TMP=$$MIX^LEXXM(TMP),TMP=$E(TMP,6,$L(TMP)) S X=TMP
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXXMM 6396 printed Dec 13, 2024@02:10:30 Page 2
LEXXMM ;ISL/KER - Convert Text to Mix Case (Misc) ;05/23/2017
+1 ;;2.0;General Lexicon Utilities;**80,86,103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; None
+8 ;
+9 ; Local Variables NEWed or KILLed Elsewhere
+10 ; ALL,LOW checked but not used
+11 ;
EW(X) ; Exported Word
+1 NEW WRD,CNT,IMC,EXP,IEN,WU,WM,ORG,SCR,TTL,WL
SET ORG=$GET(X)
if '$LENGTH(ORG)
QUIT
SET (WRD,WU)=$$UP(ORG)
SET WM=$$MX(ORG)
SET WL=$$LO(ORG)
+2 SET TTL="Supplemental Word"
SET SCR="SUP"
DO EW2
SET TTL="Lowercase"
SET SCR="LOW"
DO EW2
SET TTL="Mixed Case"
SET SCR="MIX"
DO EW2
+3 SET TTL="Uppercase"
SET SCR="UPP"
DO EW2
SET TTL="Special Case"
SET SCR="SPC"
DO EW2
+4 QUIT
EW2 ; Exported Word Indexed
+1 if '$LENGTH($GET(WRD))
QUIT
NEW CNT,CT,EXP,I,IEN,IMC,MA,MIX,UPP
+2 IF $DATA(^LEX(757.01,"AWRD",WRD))
Begin DoDot:1
+3 NEW CNT,IMC
SET (CNT,IMC)=0
FOR
SET IMC=$ORDER(^LEX(757.01,"AWRD",WRD,IMC))
if +IMC'>0
QUIT
Begin DoDot:2
+4 NEW IEN,EXP
SET EXP=$PIECE($GET(^LEX(757.01,+IMC,0)),"^",1)
if '$LENGTH(EXP)
QUIT
+5 SET IEN=0
FOR
SET IEN=$ORDER(^LEX(757.01,"AWRD",WRD,IMC,IEN))
if +IEN'>0
QUIT
Begin DoDot:3
+6 NEW CT,EXP,I,MA,MIX,UPP
SET EXP=$PIECE($GET(^LEX(757.01,+IEN,0)),"^",1)
if '$LENGTH(EXP)
QUIT
SET MIX=$$MIX^LEXXM(EXP)
SET UPP=$$UP(EXP)
DO EW3
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+7 IF $DATA(^LEX(757.01,"AEXC",WRD))
Begin DoDot:1
+8 if SCR="SUP"
QUIT
if SCR="LOW"&('$DATA(ALL))
QUIT
+9 NEW CNT,IMC
SET (CNT,IMC)=0
FOR
SET IMC=$ORDER(^LEX(757.01,"AEXC",WRD,IMC))
if +IMC'>0
QUIT
Begin DoDot:2
+10 NEW IEN,EXP,CT,EXP,I,MA,MIX,UPP
SET EXP=$PIECE($GET(^LEX(757.01,+IMC,0)),"^",1)
if '$LENGTH(EXP)
QUIT
+11 if '$LENGTH(EXP)
QUIT
SET IEN=IMC
SET MIX=$$MIX^LEXXM(EXP)
SET UPP=$$UP(EXP)
DO EW3
End DoDot:2
End DoDot:1
+12 NEW ALL
+13 QUIT
EW3 ; Exported word is Special/Lower/Upper/Mixed case
+1 if +IEN'>0
QUIT
if '$LENGTH($GET(TTL))
QUIT
if '$LENGTH($GET(WRD))
QUIT
if '$LENGTH($GET(SCR))
QUIT
NEW OUT
+2 IF SCR="SUP"
IF UPP'[$$UP(WRD)
IF $DATA(^LEX(757.01,+IEN,5,"B",WRD))
SET OUT=MIX
DO EW4
+3 IF SCR="LOW"
IF UPP[$$UP(WRD)
IF MIX[WL
IF MIX'[WU
IF MIX'[WM
SET OUT=MIX
DO EW4
+4 IF SCR="MIX"
IF UPP[$$UP(WRD)
IF MIX[WM
IF MIX'[WU
IF MIX'[WL
SET OUT=MIX
DO EW4
+5 IF SCR="UPP"
IF UPP[$$UP(WRD)
IF MIX[WU
IF MIX'[WM
IF MIX'[WL
SET OUT=MIX
DO EW4
+6 IF SCR="SPC"
IF UPP[$$UP(WRD)
IF MIX'[WU
IF MIX'[WM
IF MIX'[WL
SET OUT=MIX
DO EW4
+7 QUIT
EW4 ; Exported Word Display
+1 if +IEN'>0
QUIT
if '$LENGTH($GET(TTL))
QUIT
if '$LENGTH($GET(OUT))
QUIT
+2 NEW I,CT,OA
SET CT=0
SET CNT=CNT+1
if CNT=1
WRITE !!,TTL,!
WRITE !,IEN
SET OA(1)=OUT
DO PR^LEXU(.OA,70)
+3 SET I=0
FOR
SET I=$ORDER(OA(I))
if +I'>0
QUIT
IF $LENGTH($GET(OA(I)))
SET CT=CT+1
if CT>1
WRITE !
WRITE ?9,$GET(OA(I))
+4 QUIT
+5 ;
QWIC ; Create AEXC Index
+1 NEW BEG,CHR,DA,END,IEN,TXT,WD,WRD
+2 NEW IEN
SET IEN=0
FOR
SET IEN=$ORDER(^LEX(757.01,IEN))
if +IEN'>0
QUIT
Begin DoDot:1
+3 NEW BEG,END,TXT,DA
SET TXT=$PIECE($GET(^LEX(757.01,+IEN,0)),"^",1)
if '$LENGTH(TXT)
QUIT
+4 SET DA=+($GET(IEN))
SET BEG=1
FOR END=1:1:$LENGTH(TXT)+1
Begin DoDot:2
+5 NEW CHR
SET CHR=$EXTRACT(TXT,END)
IF "~!@#$%&*()_+`-=[]{};'\:|,./?<> """[CHR
Begin DoDot:3
+6 NEW WRD
SET WRD=$EXTRACT(TXT,BEG,(END-1))
SET BEG=END+1
IF $LENGTH(WRD)>0
IF $LENGTH(WRD)<31
Begin DoDot:4
+7 NEW WD
SET WD=$$UP(WRD)
if $LENGTH(WD)
SET ^LEX(757.01,"AEXC",WD,DA)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
+9 ; Swap
SW1(X) ; Switch Text (before setting case)
+1 NEW TXT,SWAP,WITH
SET TXT=$GET(X)
if '$LENGTH(TXT)
QUIT TXT
+2 SET SWAP="I.E."
SET WITH="IE"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+3 SET SWAP="E.G."
SET WITH="EG"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+4 SET X=TXT
+5 QUIT X
SW2(X) ; Switch Text (after setting case)
+1 NEW TXT,SWAP,WITH
SET TXT=$GET(X)
if '$LENGTH(TXT)
QUIT TXT
+2 SET SWAP="(S)"
SET WITH="(s)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+3 SET SWAP=" (E)"
SET WITH="(e)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+4 SET SWAP="(E)"
SET WITH="(e)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+5 SET SWAP=" A "
SET WITH=" a "
SET TXT=$$SWAP(TXT,SWAP,WITH)
+6 SET SWAP="Class a"
SET WITH="Clas A"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+7 SET SWAP="Type a"
SET WITH="Type A"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+8 SET SWAP="'S"
SET WITH="'s"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+9 SET SWAP="mg Diet"
SET WITH="MG Diet"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+10 SET SWAP="LO-Fat"
SET WITH="Lo-Fat"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+11 SET X=$GET(TXT)
+12 QUIT X
SW3(X) ; Switch Text (after assembling string)
+1 NEW TXT,C1,C2,SWAP,WITH,PIE
SET TXT=$GET(X)
if '$LENGTH(TXT)
QUIT TXT
+2 SET SWAP=" (S)"
SET WITH="(s)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+3 SET SWAP="(S)"
SET WITH="(s)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+4 SET SWAP=" (E)"
SET WITH="(e)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+5 SET SWAP="(E)"
SET WITH="(e)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+6 SET SWAP="CR(e)St"
SET WITH="CR(E)ST"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+7 SET SWAP="CR(e),St"
SET WITH="CR(E)ST"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+8 SET SWAP="'S"
SET WITH="'s"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+9 SET SWAP=" (Only)"
SET WITH=" (only)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
SET SWAP="(Only)"
SET WITH="(only)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+10 SET SWAP=" (Each)"
SET WITH=" (each)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
SET SWAP="(Each)"
SET WITH="(each)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+11 FOR PIE=1:1
if '$LENGTH($PIECE(TXT,"&",PIE))
QUIT
Begin DoDot:1
+12 NEW P1,P2
SET P1=$PIECE(TXT,"&",1,PIE)
if '$LENGTH(P1)
QUIT
SET P2=$PIECE(TXT,"&",(PIE+1),$LENGTH(TXT,"&"))
if '$LENGTH(P2)
QUIT
if P1[" "&($EXTRACT(P2,1)'=" ")
SET TXT=$$TM(P1)_"&"_$$TM(P2)
End DoDot:1
+13 SET X=TXT
if $DATA(LOW)
QUIT X
SET C1=$EXTRACT(X,1)
SET C2=$EXTRACT(X,2)
SET C1=C1?1U
SET C2=C2?1U
+14 if (C1+C2)'=1
SET X=$TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$EXTRACT(X,2,$LENGTH(X))
+15 NEW LOW
+16 QUIT X
SWAP(X,A,B) ; Swap text "A" for text "B" in text "X"
+1 NEW TXT,SWAP,WITH
SET TXT=$GET(X)
SET SWAP=$GET(A)
SET WITH=$GET(B)
if '$LENGTH(TXT)
QUIT TXT
if '$LENGTH(SWAP)
QUIT TXT
if TXT'[SWAP
QUIT TXT
if SWAP=WITH
QUIT TXT
if WITH[SWAP
QUIT TXT
+2 FOR
if TXT'[SWAP
QUIT
SET (X,TXT)=$PIECE(TXT,SWAP,1)_WITH_$PIECE(TXT,SWAP,2,4000)
+3 QUIT X
TM(X,Y) ; Trim Character Y - Default " "
+1 SET X=$GET(X)
SET Y=$GET(Y)
if $LENGTH(Y)&(X'[Y)
QUIT X
SET X=$GET(X)
if X=""
QUIT X
SET Y=$GET(Y)
if '$LENGTH(Y)
SET Y=" "
FOR
if $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 FOR
if $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+3 QUIT X
+4 ;
+5 ; Case
IG(X) ; Ignore Case
+1 NEW IN,XU,CHR,TMP
SET IN=$GET(X)
SET XU=$$UP(IN)
SET CHR=$EXTRACT(XU,1)
SET TMP="TYPE "_XU
SET TMP=$$MIX^LEXXM(TMP)
SET TMP=$EXTRACT(TMP,6,$LENGTH(TMP))
if TMP=IN
QUIT 1
+2 QUIT 0
IL(X) ; Is Lowercase
+1 if '$LENGTH($GET(X))
QUIT 0
if $EXTRACT($GET(X),1)'?1A
QUIT 0
NEW CH,I,WD
SET WD=$GET(X)
SET X=1
FOR I=1:1
SET CH=$EXTRACT(WD,I)
if '$LENGTH(CH)
QUIT
if CH?1U
SET X=0
if 'X
QUIT
+2 QUIT X
IU(X) ; Is Uppercase
+1 if '$LENGTH($GET(X))
QUIT 0
if $EXTRACT($GET(X),1)'?1A
QUIT 0
NEW CH,I,WD
SET WD=$GET(X)
SET X=1
FOR I=1:1
SET CH=$EXTRACT(WD,I)
if '$LENGTH(CH)
QUIT
if CH?1L
SET X=0
if 'X
QUIT
+2 QUIT X
IM(X) ; Is Mixed Case
+1 if '$LENGTH($GET(X))
QUIT 0
if $EXTRACT($GET(X),1)'?1A
QUIT 0
NEW CH,I,WD
SET WD=$GET(X)
SET X=1
FOR I=1:1
SET CH=$EXTRACT(WD,I)
if '$LENGTH(CH)
QUIT
if I=1&(CH'?1U)
SET X=0
if I>1&(CH?1U)
SET X=0
if 'X
QUIT
+2 QUIT X
IS(X) ; Is Special Case
+1 if $LENGTH($GET(X))'>1
QUIT 0
if $EXTRACT($GET(X),1)'?1A
QUIT 0
NEW CH,PC,WD,I
SET WD=$GET(X)
SET X=0
FOR I=2:1
SET CH=$EXTRACT(WD,I)
SET PC=$EXTRACT(WD,(I-1))
if '$LENGTH(CH)
QUIT
if CH?1U&(PC?1L)
SET X=1
if X>0
QUIT
+2 QUIT X
LO(X) ; Lower Case
+1 QUIT $TRANSLATE(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
UP(X) ; Uppercase
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
MX(X) ; Mix Case Term
+1 QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TRANSLATE($EXTRACT(X,2,$LENGTH(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
MIX(X) ; Mixed Case Word
+1 NEW IN,XU,CHR,TMP
SET IN=$GET(X)
SET XU=$$UP(IN)
SET CHR=$EXTRACT(XU,1)
SET TMP="TYPE "_XU
SET TMP=$$MIX^LEXXM(TMP)
SET TMP=$EXTRACT(TMP,6,$LENGTH(TMP))
SET X=TMP
+2 QUIT X
