| [613] | 1 | LEXAS ; ISL Look-up Check Input ; 09-23-96
|
|---|
| 2 | ;;2.0;LEXICON UTILITY;**4**;Sep 23, 1996;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | SPL(LEXX) ; Check word
|
|---|
| 5 | S LEXX=$G(LEXX) Q:LEXX="" LEXX
|
|---|
| 6 | Q:$L(LEXX)<6&(LEXX["/") LEXX ; PCH 4 - Quit if LEXX=XX/XX
|
|---|
| 7 | N LEXFQ,LEXFQT,LEXT S LEXFQ=0,LEXFQT=""
|
|---|
| 8 | S LEXT=$$DBL^LEXAS4(LEXX) D COMP(LEXX,LEXT)
|
|---|
| 9 | S LEXT=$$REM^LEXAS4(LEXX) D COMP(LEXX,LEXT)
|
|---|
| 10 | S LEXT=$$LC^LEXAS7(LEXX) D COMP(LEXX,LEXT)
|
|---|
| 11 | S LEXT=$$TP^LEXAS6(LEXX) D COMP(LEXX,LEXT)
|
|---|
| 12 | S LEXT=$$ONE^LEXAS2(LEXX) D COMP(LEXX,LEXT)
|
|---|
| 13 | S LEXT=$$SHIFT^LEXAS3(LEXX) D COMP(LEXX,LEXT)
|
|---|
| 14 | S LEXT=$$SPLIT^LEXAS5(LEXX) D COMP(LEXX,LEXT)
|
|---|
| 15 | S LEXT=$$TRIM^LEXAS6(LEXX) D COMP(LEXX,LEXT)
|
|---|
| 16 | S LEXT=$$TC^LEXAS7(LEXX) D COMP(LEXX,LEXT)
|
|---|
| 17 | S:LEXFQT'="" LEXX=LEXFQT
|
|---|
| 18 | Q LEXX
|
|---|
| 19 | COMP(LEXKN,LEXF) ; Compare words
|
|---|
| 20 | Q:'$L($G(LEXF)) N LEXOTKN,LEXCLEN,LEXLEN,LEXI,LEXC,LEXDIF
|
|---|
| 21 | S LEXOTKN=LEXF,LEXCLEN=$L(LEXKN)+$L(LEXF) S:LEXF["^" LEXCLEN=LEXCLEN-1 S LEXC=0
|
|---|
| 22 | S:LEXF'["^"&(+($$W(LEXF))) LEXC=1
|
|---|
| 23 | S:LEXF["^" LEXF=$TR(LEXF,"^"," ")
|
|---|
| 24 | S:$L(LEXKN)>$L(LEXF) LEXLEN=$L(LEXKN)-$L(LEXF) S:$L(LEXF)>$L(LEXKN) LEXLEN=$L(LEXF)-$L(LEXKN)
|
|---|
| 25 | S:$L(LEXF)=$L(LEXKN) LEXLEN=0 S LEXCLEN=LEXCLEN-LEXLEN
|
|---|
| 26 | I LEXKN'=LEXF D
|
|---|
| 27 | . I LEXOTKN'["^" S LEXC=LEXC+$$CNT(LEXKN,LEXF)
|
|---|
| 28 | . I LEXOTKN["^" D
|
|---|
| 29 | . . S LEXC=LEXC+$$CNT($P(LEXOTKN,"^",2),$E(LEXKN,(($L(LEXKN)-$L($P(LEXOTKN,"^",2)))+1),$L(LEXKN)))
|
|---|
| 30 | . . S LEXC=LEXC+($$CNT($P(LEXOTKN,"^",1),$E(LEXKN,1,$L($P(LEXOTKN,"^",1)))))
|
|---|
| 31 | N LEXMUL S LEXMUL=LEXCLEN*LEXC
|
|---|
| 32 | I LEXOTKN'["^",$D(^LEX(757.01,"AWRD",LEXOTKN)) S LEXMUL=LEXMUL*2
|
|---|
| 33 | I LEXOTKN["^",$D(^LEX(757.01,"AWRD",$P(LEXOTKN,"^",2))) S LEXMUL=LEXMUL*2
|
|---|
| 34 | S LEXMUL=0 I LEXC>0,LEXCLEN>0 S LEXMUL=LEXCLEN/LEXC
|
|---|
| 35 | S LEXDIF=0 S:LEXMUL'=0 LEXDIF=LEXCLEN+LEXC
|
|---|
| 36 | I LEXDIF>LEXFQ S LEXFQ=LEXDIF,LEXFQT=LEXOTKN
|
|---|
| 37 | Q
|
|---|
| 38 | CNT(LEXX,LEXY) ; Count characters
|
|---|
| 39 | N LEXC,LEXL,LEXI,LEXU S LEXC=0
|
|---|
| 40 | F LEXI=1:1:$L(LEXY) D
|
|---|
| 41 | . S LEXL=$E(LEXY,LEXI) Q:$D(LEXU(LEXL)) S:$E(LEXX,LEXI)=$E(LEXY,LEXI) LEXC=LEXC+1
|
|---|
| 42 | . I $L(LEXY)<$L(LEXX) S:$E(LEXX,(LEXI+1))=$E(LEXY,LEXI) LEXC=LEXC+1
|
|---|
| 43 | . I $L(LEXY)>$L(LEXX) S:$E(LEXX,(LEXI-1))=$E(LEXY,LEXI) LEXC=LEXC+1
|
|---|
| 44 | . S LEXU(LEXL)=""
|
|---|
| 45 | K LEXU S LEXX=LEXC Q LEXX
|
|---|
| 46 | Q
|
|---|
| 47 | W(LEXX) ; Is LEXX a word
|
|---|
| 48 | Q:'$L($G(LEXX)) 0
|
|---|
| 49 | I $D(^LEX(757.01,"AWRD",LEXX)) Q 1
|
|---|
| 50 | Q 0
|
|---|
