source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXAS3.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1LEXAS3 ; ISL Look-up Check Input (SHIFT) ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996
3 ;
4SHIFT(LEXX) ; Letters are shifted out of position
5 ;
6 ; LEXORG( Array of characters in the ORiGinal string
7 ; LEXORD( Array of characters in the $O variable
8 ; LEXE $E string
9 ; LEXL Length
10 ; LEXD Flag - Difference of strings
11 ; LEXOK Flag - Shifted string is ok to use
12 ; LEXO $O variable
13 ; LEXI Incremental counter
14 ; LEXX Returned value
15 ;
16 ;
17 Q:$L(LEXX)<5 LEXX
18 N LEXT,LEXE,LEXL,LEXO,LEXOK,LEXORG,LEXORD
19 S LEXT=LEXX,LEXOK=0
20 F LEXL=1:1:3 D SHF Q:LEXOK S LEXT=$E(LEXT,1,($L(LEXT)-1))
21 K LEXORG,LEXORD
22 S LEXX=LEXT
23 Q LEXX
24 ;
25SHF ; Shift letters in arrays
26 K LEXORG D ORG(LEXT)
27 S LEXE=$E(LEXT,1,2),LEXO=$$SCH^LEXAS6(LEXE)
28 F S LEXO=$O(^LEX(757.01,"AWRD",LEXO)) Q:LEXO=""!(LEXO'[LEXE)!(LEXOK) D Q:LEXOK
29 . Q:$L(LEXO)<$L(LEXT)!($L(LEXO)>($L(LEXT)+1))
30 . N LEXD D ORD(LEXO) S LEXD=$$COMP
31 . I LEXD S LEXOK=0 Q
32 . I 'LEXD S LEXT=LEXO,LEXOK=1 Q
33 Q
34 ;
35ORG(LEXX) ; Original tolken
36 K LEXORG N LEXI
37 F LEXI=1:1:$L(LEXX) D
38 . I $D(LEXORG($E(LEXX,LEXI))) D Q
39 . . S LEXORG($E(LEXX,LEXI))=LEXORG($E(LEXX,LEXI))+1
40 . S LEXORG($E(LEXX,LEXI))=1
41 Q
42ORD(LEXO) ; Ordered tolken
43 K LEXORD N LEXI
44 F LEXI=1:1:$L(LEXO) D
45 . I $D(LEXORD($E(LEXO,LEXI))) D Q
46 . . S LEXORD($E(LEXO,LEXI))=LEXORD($E(LEXO,LEXI))+1
47 . S LEXORD($E(LEXO,LEXI))=1
48 Q
49COMP(LEXX) ; Compare Original to Ordered
50 N LEXI,LEXD S LEXI="",LEXD=1
51 F S LEXI=$O(LEXORG(LEXI)) Q:LEXI="" D Q:'LEXD
52 . I '$D(LEXORD(LEXI)) S LEXD=0 Q
53 . I LEXORG(LEXI)>LEXORD(LEXI) S LEXD=0
54 I LEXD=0 K LEXORD Q 1
55 S LEXI="",LEXD=1
56 F S LEXI=$O(LEXORD(LEXI)) Q:LEXI="" D Q:'LEXD
57 . ;I '$D(LEXORG(LEXI)) Q
58 . I LEXORD(LEXI)>($G(LEXORG(LEXI))+1) S LEXD=0
59 I LEXD=0 K LEXORD Q 1
60 K LEXORD Q 0
Note: See TracBrowser for help on using the repository browser.