| 1 | LEXAS6 ; ISL/FJF Look-up Check Input (TRIM,EXP,TP,SCH); 12/07/2006
|
|---|
| 2 | ;;2.0;LEXICON UTILITY;**41**;Sep 23, 1996;Build 34
|
|---|
| 3 | ;
|
|---|
| 4 | TRIM(LEXX) ; Trim string
|
|---|
| 5 | ;
|
|---|
| 6 | ; LEXOK Flag - string is OK
|
|---|
| 7 | ; LEXF Frequency
|
|---|
| 8 | ; LEXI Incremental counter
|
|---|
| 9 | ; LEXT Temporary string
|
|---|
| 10 | ; LEXX Return string
|
|---|
| 11 | ;
|
|---|
| 12 | N LEXI,LEXOK,LEXT,LEXF S LEXF=1,LEXOK=0,LEXT=LEXX
|
|---|
| 13 | F Q:$E(LEXX,1)'=" " S LEXX=$E(LEXX,2,$L(LEXX))
|
|---|
| 14 | F LEXI=$L(LEXX):-1:1 Q:LEXOK D Q:LEXOK
|
|---|
| 15 | . S LEXT=$E(LEXT,1,($L(LEXT)-1))
|
|---|
| 16 | . I $L(LEXT)<3 S LEXOK=1 Q
|
|---|
| 17 | . I $D(^LEX(757.01,"ASL",LEXT)) S LEXF=$O(^LEX(757.01,"ASL",LEXT,0)) I +(LEXF)>1 S LEXOK=1
|
|---|
| 18 | S LEXX=LEXT
|
|---|
| 19 | Q LEXX
|
|---|
| 20 | ;
|
|---|
| 21 | EXP3(LEXX) ; Expand string up to 3 characters
|
|---|
| 22 | N LEXT S LEXT=LEXX
|
|---|
| 23 | S LEXT=$$EXP(LEXT)
|
|---|
| 24 | I $L(LEXT)-$L(LEXX)'>3 S LEXX=LEXT
|
|---|
| 25 | Q LEXX
|
|---|
| 26 | EXP(LEXX) ; Expand string
|
|---|
| 27 | ;
|
|---|
| 28 | ; LEXF String found
|
|---|
| 29 | ; LEXC Control string
|
|---|
| 30 | ; LEXCK Check for string
|
|---|
| 31 | ; LEXI Character position
|
|---|
| 32 | ; LEXLTR Letter at character position
|
|---|
| 33 | ; LEXNT Altered tolken
|
|---|
| 34 | ; LEXOK Flag - 1 quit 0 keep checking
|
|---|
| 35 | ; LEXOKL Flag - 1 add letter 0 do not add letter
|
|---|
| 36 | ; LEXX Return expanded string
|
|---|
| 37 | ;
|
|---|
| 38 | Q:$D(^LEX(757.01,"AWRD",LEXX)) LEXX
|
|---|
| 39 | N LEXF,LEXC,LEXCK,LEXI,LEXLTR,LEXNT,LEXOK,LEXOKL
|
|---|
| 40 | S (LEXF,LEXC)=LEXX,LEXOK=0
|
|---|
| 41 | S LEXNT=$O(^LEX(757.01,"ASL",$$SCH(LEXF)))
|
|---|
| 42 | F LEXI=1:1:63 Q:LEXOK D Q:LEXOK!(LEXNT'[LEXC)
|
|---|
| 43 | . Q:LEXI'>$L(LEXC)
|
|---|
| 44 | . S LEXNT=$O(^LEX(757.01,"ASL",LEXNT)) Q:LEXNT=LEXF
|
|---|
| 45 | . S LEXLTR=$E(LEXNT,LEXI) Q:LEXLTR=""
|
|---|
| 46 | . S LEXOKL=1,LEXCK=$$SCH(LEXNT)
|
|---|
| 47 | . F S LEXCK=$O(^LEX(757.01,"ASL",LEXCK)) Q:LEXCK=""!('LEXOKL) D
|
|---|
| 48 | . . I $E(LEXCK,LEXI)'="",$E(LEXCK,LEXI)'=LEXLTR S LEXOKL=0 Q
|
|---|
| 49 | . . I LEXCK'[LEXC,$E(LEXCK,LEXI)'=LEXLTR S LEXCK="~~~~~~~~~~~" Q
|
|---|
| 50 | . S:LEXOKL LEXF=LEXF_LEXLTR S:'LEXOKL LEXOK=1
|
|---|
| 51 | . S:$D(^LEX(757.01,"AWRD",LEXF)) LEXOK=1
|
|---|
| 52 | S LEXX=LEXF Q LEXX
|
|---|
| 53 | ;
|
|---|
| 54 | TP(LEXX) ; Transposed letters
|
|---|
| 55 | ;
|
|---|
| 56 | ; LEXF Tolken found
|
|---|
| 57 | ; LEXO Original tolken
|
|---|
| 58 | ; LEXN Concatenated tolken
|
|---|
| 59 | ; LEXT Temporary tolken
|
|---|
| 60 | ; LEXI Character position
|
|---|
| 61 | ; LEXX Return string
|
|---|
| 62 | ;
|
|---|
| 63 | N LEXO,LEXN,LEXI,LEXF,LEXT S (LEXF,LEXN)="",LEXO=LEXX
|
|---|
| 64 | F LEXI=2:1:$L(LEXX) Q:LEXF'="" D Q:LEXF'=""
|
|---|
| 65 | . S LEXN=$E(LEXX,1,(LEXI-1))_$E(LEXX,(LEXI+1))_$E(LEXX,LEXI)_$E(LEXX,(LEXI+2),$L(LEXX))
|
|---|
| 66 | . I $D(^LEX(757.01,"ASL",LEXN)) S LEXF=LEXN
|
|---|
| 67 | . S LEXT=$$ONE^LEXAS2(LEXN)
|
|---|
| 68 | . I $L(LEXT)=$L(LEXN),$D(^LEX(757.01,"ASL",LEXT)) S LEXF=LEXT
|
|---|
| 69 | S:LEXF'="" LEXX=LEXF
|
|---|
| 70 | S:LEXF="" LEXX=LEXO
|
|---|
| 71 | Q LEXX
|
|---|
| 72 | SCH(LEXX) ; Create $O variable
|
|---|
| 73 | ;
|
|---|
| 74 | ; LEXX Return $O variable
|
|---|
| 75 | ;
|
|---|
| 76 | S LEXX=$E(LEXX,1,($L(LEXX)-1))_$C($A($E(LEXX,$L(LEXX)))-1)_"~"
|
|---|
| 77 | Q LEXX
|
|---|
