LEXXMM ;ISL/KER - Convert Text to Mix Case (Misc) ;04/21/2014
;;2.0;General Lexicon Utilities;**80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^UTILITY($J) ICR 10011
;
; External References
; ^DIWP ICR 10011
;
; 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(.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 IEN S IEN=0 F S IEN=$O(^LEX(757.01,IEN)) Q:+IEN'>0 D
. N %,%1,X,DA S X=$P($G(^LEX(757.01,+IEN,0)),"^",1),DA=+($G(IEN)) Q:+DA'>0 Q:'$L(X)
. S %1=1 F %=1:1:$L(X)+1 D
. . S I=$E(X,%) I "~!@#$%&*()_+`-=[]{};'\:|,./?<> """[I D
. . . S I=$E(X,%1,%-1),%1=%+1 I $L(I)>0,$L(I)<31 D
. . . . N WD S WD=$$UP(I) S:$L(WD) ^LEX(757.01,"AEXC",WD,DA)=""
Q
PR(LEX,X) ; Parse Array LEX in X Length Strings (default 79)
N DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,LEXI,LEXLEN,LEXC,Z K ^UTILITY($J,"W") Q:'$D(LEX)
S LEXLEN=+($G(X)) S:+LEXLEN'>0 LEXLEN=79 S LEXC=+($G(LEX)) S:+($G(LEXC))'>0 LEXC=$O(LEX(" "),-1) Q:+LEXC'>0
S DIWL=1,DIWF="C"_+LEXLEN S LEXI=0 F S LEXI=$O(LEX(LEXI)) Q:+LEXI=0 S X=$G(LEX(LEXI)) D ^DIWP
K LEX S (LEXC,LEXI)=0 F S LEXI=$O(^UTILITY($J,"W",1,LEXI)) Q:+LEXI=0 D
. S LEX(LEXI)=$$TM($G(^UTILITY($J,"W",1,LEXI,0))," "),LEXC=LEXC+1
S:$L(LEXC) LEX=LEXC K ^UTILITY($J,"W")
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=" 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="'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
. 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,299)
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
LEXXMM ;ISL/KER - Convert Text to Mix Case (Misc) ;04/21/2014
+1 ;;2.0;General Lexicon Utilities;**80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^UTILITY($J) ICR 10011
+5 ;
+6 ; External References
+7 ; ^DIWP ICR 10011
+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(.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 IEN
SET IEN=0
FOR
SET IEN=$ORDER(^LEX(757.01,IEN))
IF +IEN'>0
QUIT
Begin DoDot:1
+2 NEW %,%1,X,DA
SET X=$PIECE($GET(^LEX(757.01,+IEN,0)),"^",1)
SET DA=+($GET(IEN))
IF +DA'>0
QUIT
IF '$LENGTH(X)
QUIT
+3 SET %1=1
FOR %=1:1:$LENGTH(X)+1
Begin DoDot:2
+4 SET I=$EXTRACT(X,%)
IF "~!@#$%&*()_+`-=[]{};'\:|,./?<> """[I
Begin DoDot:3
+5 SET I=$EXTRACT(X,%1,%-1)
SET %1=%+1
IF $LENGTH(I)>0
IF $LENGTH(I)<31
Begin DoDot:4
+6 NEW WD
SET WD=$$UP(I)
IF $LENGTH(WD)
SET ^LEX(757.01,"AEXC",WD,DA)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT
PR(LEX,X) ; Parse Array LEX in X Length Strings (default 79)
+1 NEW DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,LEXI,LEXLEN,LEXC,Z
KILL ^UTILITY($JOB,"W")
IF '$DATA(LEX)
QUIT
+2 SET LEXLEN=+($GET(X))
IF +LEXLEN'>0
SET LEXLEN=79
SET LEXC=+($GET(LEX))
IF +($GET(LEXC))'>0
SET LEXC=$ORDER(LEX(" "),-1)
IF +LEXC'>0
QUIT
+3 SET DIWL=1
SET DIWF="C"_+LEXLEN
SET LEXI=0
FOR
SET LEXI=$ORDER(LEX(LEXI))
IF +LEXI=0
QUIT
SET X=$GET(LEX(LEXI))
DO ^DIWP
+4 KILL LEX
SET (LEXC,LEXI)=0
FOR
SET LEXI=$ORDER(^UTILITY($JOB,"W",1,LEXI))
IF +LEXI=0
QUIT
Begin DoDot:1
+5 SET LEX(LEXI)=$$TM($GET(^UTILITY($JOB,"W",1,LEXI,0))," ")
SET LEXC=LEXC+1
End DoDot:1
+6 IF $LENGTH(LEXC)
SET LEX=LEXC
KILL ^UTILITY($JOB,"W")
+7 QUIT
+8 ;
+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=" A "
SET WITH=" a "
SET TXT=$$SWAP(TXT,SWAP,WITH)
+4 SET SWAP="Class a"
SET WITH="Clas A"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+5 SET SWAP="Type a"
SET WITH="Type A"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+6 SET SWAP="'S"
SET WITH="'s"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+7 SET SWAP="mg Diet"
SET WITH="MG Diet"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+8 SET SWAP="LO-Fat"
SET WITH="Lo-Fat"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+9 SET X=$GET(TXT)
+10 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)
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=" (Only)"
SET WITH=" (only)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
SET SWAP="(Only)"
SET WITH="(only)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+5 SET SWAP=" (Each)"
SET WITH=" (each)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
SET SWAP="(Each)"
SET WITH="(each)"
SET TXT=$$SWAP(TXT,SWAP,WITH)
+6 FOR PIE=1:1
IF '$LENGTH($PIECE(TXT,"&",PIE))
QUIT
Begin DoDot:1
+7 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
+8 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
+9 IF (C1+C2)'=1
SET X=$TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$EXTRACT(X,2,$LENGTH(X))
+10 NEW LOW
+11 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,299)
+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
