source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXNDX1.m@ 1800

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

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1LEXNDX1 ; ISL Set/kill indexes (Part 1) ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4S ; Set Expression file (#757.01) word index node AWRD
5 Q:'$D(X)!('$D(DA)) Q:$D(DIC)#2=0
6 Q:'$D(@(DIC_DA_",0)")) Q:'$D(@(DIC_DA_",1)")) Q:+($P(@(DIC_DA_",1)"),U,1))=0
7 N LEXIDX,LEXJ,LEXI,LEXTYPE,LEXT S LEXTYPE=+X Q:LEXTYPE'>0
8 S LEXT=$P($G(^LEX(757.011,LEXTYPE,0)),"^",2) Q:+LEXT=0
9 S LEXTYPE=$P($G(^LEX(757.011,LEXTYPE,0)),"^",1) D:LEXTYPE["DELETED" U
10 S X=@(DIC_DA_",0)") S:X'="" ^LEX(757.01,"B",$$UP^XLFSTR($E(X,1,63)),DA)=""
11 S LEXEX=$P(^LEX(757,$P(^LEX(757.01,DA,1),U,1),0),U,1),LEXIDX=""
12 D PTX^LEXTOLKN
13 I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 S LEXI="" F LEXJ=1:1:^TMP("LEXTKN",$J,0) D
14 . S LEXI=$O(^TMP("LEXTKN",$J,LEXJ,""))
15 . I '$D(^LEX(757.01,"AWRD",LEXI,LEXEX)) D
16 . . S:'$D(^LEX(757.01,DA,4,"B",LEXI)) ^LEX(757.01,"AWRD",LEXI,LEXEX,DA)=""
17 D L K LEXIDX,LEXEX,LEXI,LEXTYPE,LEXT,LEXJ,^TMP("LEXTKN",$J,0),^TMP("LEXTKN",$J) Q
18 ;
19K ; Kill Expression file (#757.01) word index node AWRD
20 Q:'$D(X)!('$D(DA)) D U
21 Q:'$D(^LEX(757.01,DA,0)) Q:+($P(^LEX(757.01,DA,1),U,1))=0
22 N LEXTYPE,LEXT S LEXTYPE=+X Q:LEXTYPE'>0
23 S LEXT=$P($G(^LEX(757.011,LEXTYPE,0)),"^",2) Q:+LEXT=0
24 N LEXIDX,LEXJ,LEXI S X=^LEX(757.01,DA,0),LEXIDX=""
25 D PTX^LEXTOLKN I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 S LEXI="" F LEXJ=1:1:^TMP("LEXTKN",$J,0) D
26 . S LEXI=$O(^TMP("LEXTKN",$J,LEXJ,""))
27 . K ^LEX(757.01,"AWRD",LEXI,DA)
28 K LEXIDX,LEXTYPE,LEXI,LEXJ,^TMP("LEXTKN",$J,0),^TMP("LEXTKN",$J) Q
29L ; Link words
30 N DIC,LEXDEXP D KILL^LEXNDX2 S LEXDEXP=DA
31 ; For Subsets
32 I $D(^LEX(757.21,"B",LEXDEXP)) D
33 . S DA=0 F S DA=$O(^LEX(757.21,"B",LEXDEXP,DA)) Q:+DA=0 D
34 . . N X S X=$P(^LEX(757.21,DA,0),U,2) Q:+X<1 D SS^LEXNDX2
35 ; For Replacement Words
36 I $D(^LEX(757.05,"AEXP",LEXDEXP)) D
37 . S DA=0 F S DA=$O(^LEX(757.05,"AEXP",LEXDEXP,DA)) Q:+DA=0 D
38 . . N X,LEXMC S X=$P(^LEX(757.05,DA,0),U,1) Q:X=""
39 . . S LEXMC=$P($G(^LEX(757.01,LEXDEXP,1)),U,1) Q:+LEXMC'>0
40 . . S ^LEX(757.01,"AWRD",X,LEXDEXP,"LINKED")=""
41 S DA=LEXDEXP
42 Q
43U ; Unlink words
44 N DIC,LEXDEXP D KILL^LEXNDX2 S LEXDEXP=DA
45 ; For Subsets
46 I $D(^LEX(757.21,"B",LEXDEXP)) D
47 . S DA=0 F S DA=$O(^LEX(757.21,"B",LEXDEXP,DA)) Q:+DA=0 D
48 . . N X S X=$P(^LEX(757.21,DA,0),U,2) Q:+X<1 D SK^LEXNDX2
49 ; For Replacement Words
50 I $D(^LEX(757.05,"AEXP",LEXDEXP)) D
51 . S DA=0 F S DA=$O(^LEX(757.05,"AEXP",LEXDEXP,DA)) Q:+DA=0 D
52 . . N X,LEXMC S X=$P(^LEX(757.05,DA,0),U,1) Q:X=""
53 . . S LEXMC=$P($G(^LEX(757.01,LEXDEXP,1)),U,1) Q:+LEXMC'>0
54 . . K ^LEX(757.01,"AWRD",X,LEXDEXP,"LINKED")
55 S DA=LEXDEXP
56 Q
57REIDXMC ; Re-Index Expression file word index AWRD
58 S:$D(ZTQUEUED) ZTREQ="@"
59 N LEXIDX,LEXREIX,DA,X S DA=0,X="",(LEXREIX,LEXIDX)="" K ^TMP("LEXSTOP","REIDXMC")
60 F S DA=$O(^LEX(757.01,DA)) Q:+DA=0!($D(^TMP("LEXSTOP","REIDXMC"))) D
61 . S X=$P(^LEX(757.01,DA,1),U,2) D S
62 K ^TMP("LEXSTOP","REIDXMC"),LEXIDX,DA,X
63 Q
64RMC ; Re-Index Expression file word index AWRD (Task Manager)
65 S ZTRTN="REIDXMC^LEXNDX1"
66 S ZTDESC="Re-Indexing Major Concept Words in ""AWRD"" index"
67 S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS W:$D(ZTSK) !!,"Re-Indexing Major Concept Words in ""AWRD"" index" W:'$D(ZTSK) !!,"Task to re-index Major Concept not created"
68 K ZTDTH,ZTDESC,ZTIO,ZTRTN
69 Q
70RALL ; Re-Index entire file (needs DIC)
71 S DIK=$G(DIC) Q:DIK="" Q:'$D(@(DIK_"0)"))
72 S ZTREQ="@",(ZTSAVE("ZTREQ"),ZTSAVE("DIK"))="",ZTRTN="IXALL^DIK"
73 S ZTDESC="Re-Indexing "_DIK
74 S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS
75 K ZTDTH,ZTDESC,ZTIO,ZTRTN,ZTREQ,ZTSAVE
76 Q
Note: See TracBrowser for help on using the repository browser.