source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXAM.m@ 1310

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

initial load of FOIAVistA 6/30/08 version
File size: 4.0 KB
Line 
1LEXAM ; ISL Look-up Misc (Setup/Parse) ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996
3 ;
4SETUP(LEXSUB) ; Set up search variables
5 I '$L($G(LEXSUB)) D Q
6 . S LEX("ERR",0)=+($G(LEX("ERR",0)))+1
7 . S LEX("ERR",LEX("ERR",0))="Default Vocabulary missing or invalid"
8 S ^TMP("LEXSCH",$J,"VOC",0)=LEXSUB
9 I '$D(^LEXT(757.2,"AA",^TMP("LEXSCH",$J,"VOC",0))) D Q
10 . S LEX("ERR",0)=+($G(LEX("ERR",0)))+1
11 . S LEX("ERR",LEX("ERR",0))="Default Vocabulary missing or invalid"
12 N LEXSUBS S LEXSUBS=$O(^LEXT(757.2,"AA",^TMP("LEXSCH",$J,"VOC",0),0))
13 S ^TMP("LEXSCH",$J,"IDX",0)="A"_^TMP("LEXSCH",$J,"VOC",0)
14 I $D(^LEXT(757.2,LEXSUBS,1)) D
15 . S ^TMP("LEXSCH",$J,"GBL",0)=^LEXT(757.2,LEXSUBS,1)
16 . S ^TMP("LEXSCH",$J,"FLN",0)=+($P(^TMP("LEXSCH",$J,"GBL",0),"(",2))
17 . I +^TMP("LEXSCH",$J,"FLN",0)=0!('$D(^DD(+^TMP("LEXSCH",$J,"FLN",0)))) D Q
18 . . S LEX("ERR",0)=+($G(LEX("ERR",0)))+1
19 . . S LEX("ERR",LEX("ERR",0))="File Number missing or invalid"
20 . I '$D(^DIC(^TMP("LEXSCH",$J,"FLN",0),0,"GL")) D Q
21 . . S LEX("ERR",0)=+($G(LEX("ERR",0)))+1
22 . . S LEX("ERR",LEX("ERR",0))="Global Location missing or invalid"
23 . I $G(^DIC(^TMP("LEXSCH",$J,"FLN",0),0,"GL"))'=^TMP("LEXSCH",$J,"GBL",0) D Q
24 . . S LEX("ERR",0)=+($G(LEX("ERR",0)))+1
25 . . S LEX("ERR",LEX("ERR",0))="Global Location missing or invalid"
26 . I $D(^TMP("LEXFND",$J)) D
27 . . N LEXI,LEXE S LEXI=-999999999,^TMP("LEXSCH",$J,"EXM",0)=""
28 . . F S LEXI=$O(^TMP("LEXFND",$J,LEXI)) Q:LEXI=0!(^TMP("LEXSCH",$J,"EXM",0)'="") D
29 . . . S ^TMP("LEXSCH",$J,"EXM",0)=$O(^TMP("LEXFND",$J,LEXI,0)) S:+(^TMP("LEXSCH",$J,"EXM",0))=0 ^TMP("LEXSCH",$J,"EXM",0)=""
30 Q
31 ;
32 ; Entry D TOLKEN^LEXAM("USER INPUT")
33 ; Returns LEXTKN(#)=TOLKEN LIST
34 ;
35 ; LEXFOC( Array by frequency of occurance
36 ; LEXTKN( Array by frequency
37 ; LEXTKNS( Array by input
38 ;
39 ; LEXLOOK Flag for PTX^LEXTOLKN indicating parse for look-up
40 ; LEXI Incremental counter
41 ; LEXF Frequency of occurance
42 ; LEXKEY Key for spell check
43 ; LEXK Tolken
44 ; LEXKF Tolken found
45 ; LEXNK Next tolken
46 ;
47TOLKEN(LEXX) ; Return list of tolkens in ascending order of usage
48 Q:'$L($G(LEXX)) D PARSE,ORD K ^TMP("LEXTKN",$J) Q
49PARSE ; Parse user input into tolkens
50 K ^TMP("LEXTKN",$J) N X,LEXLOOK S X=LEXX,LEXLOOK="" D PTX^LEXTOLKN Q
51ORD ; tolken list in frequency order
52 Q:'$D(^TMP("LEXTKN",$J,0)) K LEXFOC,LEXTKN N LEXKEY,LEXI,LEXF,LEXK,LEXCT
53 ; Get possible key
54 S (LEXCT,LEXI)=0 F S LEXI=$O(^TMP("LEXTKN",$J,LEXI)) Q:+LEXI=0 D
55 . S LEXK=$O(^TMP("LEXTKN",$J,LEXI,""))
56 . I $D(^LEX(757.01,"ASL",LEXK)) S LEXF=$O(^LEX(757.01,"ASL",LEXK,0)),LEXKEY(LEXF)=LEXK
57 I $D(LEXKEY) N LEXKF S LEXKF=$O(LEXKEY(0)),LEXKF=LEXKEY(LEXKF) K LEXKEY S LEXKEY=LEXKF
58 S:'$D(LEXKEY) LEXKEY=""
59 ; Order by frequency
60 S (LEXCT,LEXI)=0 F S LEXI=$O(^TMP("LEXTKN",$J,LEXI)) Q:+LEXI=0 D
61 . S LEXK=$O(^TMP("LEXTKN",$J,LEXI,""))
62 . I $D(^LEX(757.01,"ASL",LEXK)) D
63 . . N LEXNK S LEXNK=$$EXP^LEXAS6(LEXK)
64 . . I $D(^LEX(757.01,"ASL",LEXNK)),LEXNK[LEXK,$L(LEXNK)>$L(LEXK) S LEXK=LEXNK
65 . . S LEXCT=LEXCT+1,LEXF=$O(^LEX(757.01,"ASL",LEXK,0))
66 . . S LEXTKNS(LEXCT)=LEXK,LEXFOC(LEXF,LEXK)=""
67 . . S LEXTKNS(0)=LEXCT
68 . I '$D(^LEX(757.01,"ASL",LEXK)),$D(^LEX(757.01,"AWRD",LEXK)) D FRQ(LEXK) Q
69 . I '$D(^LEX(757.01,"ASL",LEXK)),'$D(^LEX(757.01,"AWRD",LEXK)) D
70 . . S LEXK=$$SPL^LEXAS(LEXK)
71 . . I LEXK["^" D Q
72 . . . N LEXF,LEXT S LEXF=$P(LEXK,"^",1),LEXT=$P(LEXK,"^",2)
73 . . . D FRQ(LEXF),FRQ(LEXT)
74 . . D FRQ(LEXK)
75 K ^TMP("LEXTKN",$J) Q:'$D(LEXFOC) S LEXI=-999999999,LEXF=0
76 F S LEXI=$O(LEXFOC(LEXI)) Q:+LEXI=0 D
77 . S LEXK="" F S LEXK=$O(LEXFOC(LEXI,LEXK)) Q:LEXK="" D
78 . . S LEXF=LEXF+1,LEXTKN(LEXF)=LEXK K LEXFOC(LEXI,LEXK)
79 S:LEXF>0 LEXTKN(0)=LEXF
80 Q
81FRQ(LEXK) ; Frequency
82 I $D(^LEX(757.01,"ASL",LEXK)) D
83 . S LEXCT=LEXCT+1,LEXF=$O(^LEX(757.01,"ASL",LEXK,0))
84 . S LEXTKNS(LEXCT)=LEXK,LEXFOC(LEXF,LEXK)=""
85 . S LEXTKNS(0)=LEXCT
86 I '$D(^LEX(757.01,"ASL",LEXK)),$D(^LEX(757.01,"AWRD",LEXK)) D
87 . S LEXCT=LEXCT+1 N LEXC,LEXI S (LEXC,LEXI)=0
88 . F S LEXI=$O(^LEX(757.01,"AWRD",LEXK,LEXI)) Q:+LEXI=0 S LEXC=LEXC+1
89 . S LEXF=LEXC,LEXTKNS(LEXCT)=LEXK,LEXFOC(LEXF,LEXK)=""
90 . S LEXTKNS(0)=LEXCT
91 Q
Note: See TracBrowser for help on using the repository browser.