source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXAS.m@ 1261

Last change on this file since 1261 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1LEXAS ; ISL Look-up Check Input ; 09-23-96
2 ;;2.0;LEXICON UTILITY;**4**;Sep 23, 1996;Build 1
3 ;
4SPL(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
19COMP(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
38CNT(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
47W(LEXX) ; Is LEXX a word
48 Q:'$L($G(LEXX)) 0
49 I $D(^LEX(757.01,"AWRD",LEXX)) Q 1
50 Q 0
Note: See TracBrowser for help on using the repository browser.