Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXXMM

LEXXMM.m

Go to the documentation of this file. 
  1. LEXXMM ;ISL/KER - Convert Text to Mix Case (Misc) ;04/21/2014
  1.  ;;2.0;General Lexicon Utilities;**80**;Sep 23, 1996;Build 10
  1.  ;               
  1.  ; Global Variables
  1.  ;    ^UTILITY($J)        ICR  10011
  1.  ;               
  1.  ; External References
  1.  ;    ^DIWP               ICR  10011
  1.  ;               
  1.  ; Local Variables NEWed or KILLed Elsewhere
  1.  ;     ALL,LOW checked but not used
  1.  ;                 
  1. EW(X) ; Exported Word
  1.  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)
  1.  S TTL="Supplemental Word",SCR="SUP" D EW2 S TTL="Lowercase",SCR="LOW" D EW2 S TTL="Mixed Case",SCR="MIX" D EW2
  1.  S TTL="Uppercase",SCR="UPP" D EW2 S TTL="Special Case",SCR="SPC" D EW2
  1.  Q
  1. EW2 ;   Exported Word Indexed
  1.  Q:'$L($G(WRD))  N CNT,CT,EXP,I,IEN,IMC,MA,MIX,UPP
  1.  I $D(^LEX(757.01,"AWRD",WRD)) D  Q
  1.  . N CNT,IMC S (CNT,IMC)=0 F  S IMC=$O(^LEX(757.01,"AWRD",WRD,IMC)) Q:+IMC'>0  D
  1.  . . N IEN,EXP S EXP=$P($G(^LEX(757.01,+IMC,0)),"^",1) Q:'$L(EXP)
  1.  . . S IEN=0 F  S IEN=$O(^LEX(757.01,"AWRD",WRD,IMC,IEN)) Q:+IEN'>0  D
  1.  . . . 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
  1.  I $D(^LEX(757.01,"AEXC",WRD)) D
  1.  . Q:SCR="SUP"  Q:SCR="LOW"&('$D(ALL))
  1.  . N CNT,IMC S (CNT,IMC)=0 F  S IMC=$O(^LEX(757.01,"AEXC",WRD,IMC)) Q:+IMC'>0  D
  1.  . . N IEN,EXP,CT,EXP,I,MA,MIX,UPP S EXP=$P($G(^LEX(757.01,+IMC,0)),"^",1) Q:'$L(EXP)
  1.  . . Q:'$L(EXP)  S IEN=IMC,MIX=$$MIX^LEXXM(EXP),UPP=$$UP(EXP) D EW3
  1.  N ALL
  1.  Q
  1. EW3 ;   Exported word is Special/Lower/Upper/Mixed case
  1.  Q:+IEN'>0  Q:'$L($G(TTL))  Q:'$L($G(WRD))  Q:'$L($G(SCR))  N OUT
  1.  I SCR="SUP",UPP'[$$UP(WRD),$D(^LEX(757.01,+IEN,5,"B",WRD)) S OUT=MIX D EW4
  1.  I SCR="LOW",UPP[$$UP(WRD),MIX[WL,MIX'[WU,MIX'[WM S OUT=MIX D EW4
  1.  I SCR="MIX",UPP[$$UP(WRD),MIX[WM,MIX'[WU,MIX'[WL S OUT=MIX D EW4
  1.  I SCR="UPP",UPP[$$UP(WRD),MIX[WU,MIX'[WM,MIX'[WL S OUT=MIX D EW4
  1.  I SCR="SPC",UPP[$$UP(WRD),MIX'[WU,MIX'[WM,MIX'[WL S OUT=MIX D EW4
  1.  Q
  1. EW4 ;   Exported Word Display
  1.  Q:+IEN'>0  Q:'$L($G(TTL))  Q:'$L($G(OUT))
  1.  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)
  1.  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))
  1.  Q
  1.  ;                 
  1. QWIC ; Create AEXC Index
  1.  N IEN S IEN=0 F  S IEN=$O(^LEX(757.01,IEN)) Q:+IEN'>0  D
  1.  . N %,%1,X,DA S X=$P($G(^LEX(757.01,+IEN,0)),"^",1),DA=+($G(IEN)) Q:+DA'>0  Q:'$L(X)
  1.  . S %1=1 F %=1:1:$L(X)+1 D
  1.  . . S I=$E(X,%) I "~!@#$%&*()_+`-=[]{};'\:|,./?<> """[I D
  1.  . . . S I=$E(X,%1,%-1),%1=%+1 I $L(I)>0,$L(I)<31 D
  1.  . . . . N WD S WD=$$UP(I) S:$L(WD) ^LEX(757.01,"AEXC",WD,DA)=""
  1.  Q
  1. PR(LEX,X) ; Parse Array LEX in X Length Strings (default 79)
  1.  N DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,LEXI,LEXLEN,LEXC,Z K ^UTILITY($J,"W") Q:'$D(LEX)
  1.  S LEXLEN=+($G(X)) S:+LEXLEN'>0 LEXLEN=79 S LEXC=+($G(LEX)) S:+($G(LEXC))'>0 LEXC=$O(LEX(" "),-1) Q:+LEXC'>0
  1.  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
  1.  K LEX S (LEXC,LEXI)=0 F  S LEXI=$O(^UTILITY($J,"W",1,LEXI)) Q:+LEXI=0  D
  1.  . S LEX(LEXI)=$$TM($G(^UTILITY($J,"W",1,LEXI,0))," "),LEXC=LEXC+1
  1.  S:$L(LEXC) LEX=LEXC K ^UTILITY($J,"W")
  1.  Q
  1.  ;                 
  1.  ; Swap
  1. SW1(X) ;   Switch Text (before setting case)
  1.  N TXT,SWAP,WITH S TXT=$G(X) Q:'$L(TXT) TXT
  1.  S SWAP="I.E.",WITH="IE",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S SWAP="E.G.",WITH="EG",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S X=TXT
  1.  Q X
  1. SW2(X) ;   Switch Text (after setting case)
  1.  N TXT,SWAP,WITH S TXT=$G(X) Q:'$L(TXT) TXT
  1.  S SWAP="(S)",WITH="(s)",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S SWAP=" A ",WITH=" a ",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S SWAP="Class a",WITH="Clas A",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S SWAP="Type a",WITH="Type A",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S SWAP="'S",WITH="'s",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S SWAP="mg Diet",WITH="MG Diet",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S SWAP="LO-Fat",WITH="Lo-Fat",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S X=$G(TXT)
  1.  Q X
  1. SW3(X) ;   Switch Text (after assembling string)
  1.  N TXT,C1,C2,SWAP,WITH,PIE S TXT=$G(X) Q:'$L(TXT) TXT
  1.  S SWAP=" (S)",WITH="(s)",TXT=$$SWAP(TXT,SWAP,WITH) S SWAP="(S)",WITH="(s)",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S SWAP="'S",WITH="'s",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S SWAP=" (Only)",WITH=" (only)",TXT=$$SWAP(TXT,SWAP,WITH) S SWAP="(Only)",WITH="(only)",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  S SWAP=" (Each)",WITH=" (each)",TXT=$$SWAP(TXT,SWAP,WITH) S SWAP="(Each)",WITH="(each)",TXT=$$SWAP(TXT,SWAP,WITH)
  1.  F PIE=1:1 Q:'$L($P(TXT,"&",PIE))  D
  1.  . 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)
  1.  S X=TXT Q:$D(LOW) X  S C1=$E(X,1),C2=$E(X,2),C1=C1?1U,C2=C2?1U
  1.  S:(C1+C2)'=1 X=$TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,2,$L(X))
  1.  N LOW
  1.  Q X
  1. SWAP(X,A,B) ;   Swap text "A" for text "B" in text "X"
  1.  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
  1.  F  Q:TXT'[SWAP  S (X,TXT)=$P(TXT,SWAP,1)_WITH_$P(TXT,SWAP,2,299)
  1.  Q X
  1. TM(X,Y) ; Trim Character Y - Default " "
  1.  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))
  1.  F  Q:$E(X,$L(X))'=Y  S X=$E(X,1,($L(X)-1))
  1.  Q X
  1.  ;                 
  1.  ; Case
  1. IG(X) ;   Ignore Case
  1.  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
  1.  Q 0
  1. IL(X) ;   Is Lowercase
  1.  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
  1.  Q X
  1. IU(X) ;   Is Uppercase
  1.  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
  1.  Q X
  1. IM(X) ;   Is Mixed Case
  1.  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
  1.  Q X
  1. IS(X) ;   Is Special Case
  1.  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
  1.  Q X
  1. LO(X) ;   Lower Case
  1.  Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
  1. UP(X) ;   Uppercase
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. MX(X) ;   Mix Case Term
  1.  Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
  1. MIX(X) ;   Mixed Case Word
  1.  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
  1.  Q X