- 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 Mar 13, 2025@21:15 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
