60 lines
2.6 KiB
Mathematica
60 lines
2.6 KiB
Mathematica
|
LEXNDX3 ; ISL Set/kill indexes (Part 3) Link ; 09-23-96
|
||
|
|
;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
|
||
|
|
;
|
||
|
|
S ; Set indexes for file 757.05
|
||
|
|
Q:('$D(DA))!('$D(X))
|
||
|
|
S DIC="^LEX(757.05,"
|
||
|
|
N LEXREP,LEXBY,LEXOLDX,LEXEXCL,LEXCTR,LEXREC
|
||
|
|
S LEXOLDX=X I X="R" D SREP Q
|
||
|
|
S LEXREP=$P(@(DIC_DA_",0)"),U,1),LEXBY=$P(@(DIC_DA_",0)"),U,2)
|
||
|
|
Q:LEXREP=""!(LEXBY="")
|
||
|
|
I X="N" D UNLINK^LEXNDX4 Q
|
||
|
|
I X="L",$D(^LEX(757.05,DA,1,1,0)) D RELINK^LEXNDX4 Q
|
||
|
|
D EXCL^LEXNDX5 I 'LEXEXCL S LEXOLDX="L" D LINK^LEXNDX4
|
||
|
|
I LEXEXCL,'$D(^LEX(757.01,"AWRD",LEXREP)) D ANYWAY^LEXNDX5 I 'LEXEXCL S LEXOLDX="L" D LINK^LEXNDX4
|
||
|
|
S:LEXEXCL LEXOLDX="R" S X=LEXOLDX,$P(^LEX(757.05,DA,0),U,3)=X
|
||
|
|
K LEXREP,LEXBY,LEXOLDX,LEXEXCL,LEXCTR,LEXREC
|
||
|
|
Q
|
||
|
|
SREP ; Set indexes for Replacement Words
|
||
|
|
N LEXEX,LEXRE S LEXEX=$P(^LEX(757.05,DA,0),U,2),LEXRE=$P(^LEX(757.05,DA,0),U,1) I LEXEX=""!(LEXRE="") K LEXRE,LEXEX Q
|
||
|
|
I $D(^LEX(757.01,"B",LEXEX)) D
|
||
|
|
. S LEXEXR=$O(^LEX(757.01,"B",LEXEX,0))
|
||
|
|
. I +LEXEXR>0,$D(^LEX(757.01,LEXEXR)),+(^LEX(757,+(^LEX(757.01,LEXEXR,1)),0))'=LEXEXR D
|
||
|
|
. . S X=LEXEX
|
||
|
|
. . 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
|
||
|
|
. . . S LEXI=$O(^TMP("LEXTKN",$J,LEXJ,"")) I '$D(^LEX(757.01,"AWRD",LEXI,LEXEXR)) D
|
||
|
|
. . . . N LEXYPE,LEXT S LEXYPE=+($P($G(^LEX(757.01,LEXEXR,1)),U,2)) Q:LEXYPE'>0
|
||
|
|
. . . . S LEXT=+($P($G(^LEX(757.011,LEXYPE,0)),"^",2)) Q:LEXT=0
|
||
|
|
. . . . S ^LEX(757.01,"AWRD",LEXI,LEXEXR,"LINKED")=""
|
||
|
|
. . K LEXI,LEXJ,^TMP("LEXTKN",$J,0),^TMP("LEXTKN",$J)
|
||
|
|
K LEXRE,LEXEX,LEXEXR
|
||
|
|
Q
|
||
|
|
K ; Kill indexes for file 757.05
|
||
|
|
Q:$D(DIC)#2=0!('$D(DA))!('$D(X))
|
||
|
|
N LEXREP,LEXBY,LEXOLDX
|
||
|
|
S LEXOLDX=X I X="R" D KREP Q
|
||
|
|
S LEXREP=$P(@(DIC_DA_",0)"),U,1),LEXBY=$P(@(DIC_DA_",0)"),U,2)
|
||
|
|
D UNLINK^LEXNDX4
|
||
|
|
K LEXREP,LEXBY,LEXOLDX
|
||
|
|
Q
|
||
|
|
KREP ; Kill indexes for Replacement Words
|
||
|
|
N LEXEX,LEXRE S LEXEX=$P(^LEX(757.05,DA,0),U,2),LEXRE=$P(^LEX(757.05,DA,0),U,1) I LEXEX=""!(LEXRE="") K LEXRE,LEXEX Q
|
||
|
|
I $D(^LEX(757.01,"B",LEXEX)) D
|
||
|
|
. S LEXEXR=$O(^LEX(757.01,"B",LEXEX,0))
|
||
|
|
. I +LEXEXR>0,$D(^LEX(757.01,LEXEXR)),+(^LEX(757,+(^LEX(757.01,LEXEXR,1)),0))'=LEXEXR D
|
||
|
|
. . S X=LEXEX
|
||
|
|
. . 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
|
||
|
|
. . . S LEXI=$O(^TMP("LEXTKN",$J,LEXJ,"")) I $D(^LEX(757.01,"AWRD",LEXI,LEXEXR)) D
|
||
|
|
. . . . K ^LEX(757.01,"AWRD",LEXI,LEXEXR,"LINKED")
|
||
|
|
. . K LEXI,LEXJ,^TMP("LEXTKN",$J,0),^TMP("LEXTKN",$J)
|
||
|
|
K LEXRE,LEXEX,LEXEXR
|
||
|
|
Q
|
||
|
|
RE ; Reindex (Kill/Set) Replacement Words
|
||
|
|
N LEXDA,LEXDIC S LEXDA=0,LEXDIC="^LEX(757.05,"
|
||
|
|
F S LEXDA=$O(^LEX(757.05,LEXDA)) Q:+LEXDA=0 D
|
||
|
|
. S DA=LEXDA,DIC=LEXDIC D KILL^LEXNDX2 S DA=LEXDA,DIC=LEXDIC D SET^LEXNDX2
|
||
|
|
K LEXDA,LEXDIC,DA,DIC
|
||
|
|
Q
|