VistA-WorldVistAEHR/r/LEXICON_UTILITY-LEX-GMPT/LEXNDX3.m

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