LEXNDX3 ;ISL/KER - Set/kill indexes (Part 3) Link ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Global Variables
; ^LEX(757.011) N/A
; ^TMP("LEXTKN") SACC 2.3.2.5.1
;
; External References
; None
;
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^LEXTOKN
. . I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 S LEXI="",LEXJ=0 D
. . . F S LEXJ=$O(^TMP("LEXTKN",$J,LEXJ)) Q:+LEXJ'>0 D
. . . . S LEXI=$O(^TMP("LEXTKN",$J,LEXJ,"")) Q:'$L(LEXI) 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^LEXTOKN
. . I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 S LEXI="",LEXJ=0 D
. . . F S LEXJ=$O(^TMP("LEXTKN",$J,LEXJ)) Q:+LEXJ'>0 D
. . . . S LEXI=$O(^TMP("LEXTKN",$J,LEXJ,"")) Q:'$L(LEXI)
. . . . I $D(^LEX(757.01,"AWRD",LEXI,LEXEXR)) 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXNDX3 2997 printed Dec 13, 2024@02:08:15 Page 2
LEXNDX3 ;ISL/KER - Set/kill indexes (Part 3) Link ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^LEX(757.011) N/A
+5 ; ^TMP("LEXTKN") SACC 2.3.2.5.1
+6 ;
+7 ; External References
+8 ; None
+9 ;
S ; Set indexes for file 757.05
+1 if ('$DATA(DA))!('$DATA(X))
QUIT
+2 SET DIC="^LEX(757.05,"
+3 NEW LEXREP,LEXBY,LEXOLDX,LEXEXCL,LEXCTR,LEXREC
+4 SET LEXOLDX=X
IF X="R"
DO SREP
QUIT
+5 SET LEXREP=$PIECE(@(DIC_DA_",0)"),U,1)
SET LEXBY=$PIECE(@(DIC_DA_",0)"),U,2)
+6 if LEXREP=""!(LEXBY="")
QUIT
+7 IF X="N"
DO UNLINK^LEXNDX4
QUIT
+8 IF X="L"
IF $DATA(^LEX(757.05,DA,1,1,0))
DO RELINK^LEXNDX4
QUIT
+9 DO EXCL^LEXNDX5
IF 'LEXEXCL
SET LEXOLDX="L"
DO LINK^LEXNDX4
+10 IF LEXEXCL
IF '$DATA(^LEX(757.01,"AWRD",LEXREP))
DO ANYWAY^LEXNDX5
IF 'LEXEXCL
SET LEXOLDX="L"
DO LINK^LEXNDX4
+11 if LEXEXCL
SET LEXOLDX="R"
SET X=LEXOLDX
SET $PIECE(^LEX(757.05,DA,0),U,3)=X
+12 KILL LEXREP,LEXBY,LEXOLDX,LEXEXCL,LEXCTR,LEXREC
+13 QUIT
SREP ; Set indexes for Replacement Words
+1 NEW LEXEX,LEXRE
SET LEXEX=$PIECE(^LEX(757.05,DA,0),U,2)
SET LEXRE=$PIECE(^LEX(757.05,DA,0),U,1)
IF LEXEX=""!(LEXRE="")
KILL LEXRE,LEXEX
QUIT
+2 IF $DATA(^LEX(757.01,"B",LEXEX))
Begin DoDot:1
+3 SET LEXEXR=$ORDER(^LEX(757.01,"B",LEXEX,0))
+4 IF +LEXEXR>0
IF $DATA(^LEX(757.01,LEXEXR))
IF +(^LEX(757,+(^LEX(757.01,LEXEXR,1)),0))'=LEXEXR
Begin DoDot:2
+5 SET X=LEXEX
DO PTX^LEXTOKN
+6 IF $DATA(^TMP("LEXTKN",$JOB,0))
IF ^TMP("LEXTKN",$JOB,0)>0
SET LEXI=""
SET LEXJ=0
Begin DoDot:3
+7 FOR
SET LEXJ=$ORDER(^TMP("LEXTKN",$JOB,LEXJ))
if +LEXJ'>0
QUIT
Begin DoDot:4
+8 SET LEXI=$ORDER(^TMP("LEXTKN",$JOB,LEXJ,""))
if '$LENGTH(LEXI)
QUIT
IF '$DATA(^LEX(757.01,"AWRD",LEXI,LEXEXR))
Begin DoDot:5
+9 NEW LEXYPE,LEXT
SET LEXYPE=+($PIECE($GET(^LEX(757.01,LEXEXR,1)),U,2))
if LEXYPE'>0
QUIT
+10 SET LEXT=+($PIECE($GET(^LEX(757.011,LEXYPE,0)),"^",2))
if LEXT=0
QUIT
+11 SET ^LEX(757.01,"AWRD",LEXI,LEXEXR,"LINKED")=""
End DoDot:5
End DoDot:4
End DoDot:3
+12 KILL LEXI,LEXJ,^TMP("LEXTKN",$JOB,0),^TMP("LEXTKN",$JOB)
End DoDot:2
End DoDot:1
+13 KILL LEXRE,LEXEX,LEXEXR
+14 QUIT
K ; Kill indexes for file 757.05
+1 if $DATA(DIC)#2=0!('$DATA(DA))!('$DATA(X))
QUIT
+2 NEW LEXREP,LEXBY,LEXOLDX
+3 SET LEXOLDX=X
IF X="R"
DO KREP
QUIT
+4 SET LEXREP=$PIECE(@(DIC_DA_",0)"),U,1)
SET LEXBY=$PIECE(@(DIC_DA_",0)"),U,2)
+5 DO UNLINK^LEXNDX4
+6 KILL LEXREP,LEXBY,LEXOLDX
+7 QUIT
KREP ; Kill indexes for Replacement Words
+1 NEW LEXEX,LEXRE
SET LEXEX=$PIECE(^LEX(757.05,DA,0),U,2)
SET LEXRE=$PIECE(^LEX(757.05,DA,0),U,1)
IF LEXEX=""!(LEXRE="")
KILL LEXRE,LEXEX
QUIT
+2 IF $DATA(^LEX(757.01,"B",LEXEX))
Begin DoDot:1
+3 SET LEXEXR=$ORDER(^LEX(757.01,"B",LEXEX,0))
+4 IF +LEXEXR>0
IF $DATA(^LEX(757.01,LEXEXR))
IF +(^LEX(757,+(^LEX(757.01,LEXEXR,1)),0))'=LEXEXR
Begin DoDot:2
+5 SET X=LEXEX
DO PTX^LEXTOKN
+6 IF $DATA(^TMP("LEXTKN",$JOB,0))
IF ^TMP("LEXTKN",$JOB,0)>0
SET LEXI=""
SET LEXJ=0
Begin DoDot:3
+7 FOR
SET LEXJ=$ORDER(^TMP("LEXTKN",$JOB,LEXJ))
if +LEXJ'>0
QUIT
Begin DoDot:4
+8 SET LEXI=$ORDER(^TMP("LEXTKN",$JOB,LEXJ,""))
if '$LENGTH(LEXI)
QUIT
+9 IF $DATA(^LEX(757.01,"AWRD",LEXI,LEXEXR))
KILL ^LEX(757.01,"AWRD",LEXI,LEXEXR,"LINKED")
End DoDot:4
End DoDot:3
+10 KILL LEXI,LEXJ,^TMP("LEXTKN",$JOB,0),^TMP("LEXTKN",$JOB)
End DoDot:2
End DoDot:1
+11 KILL LEXRE,LEXEX,LEXEXR
+12 QUIT
RE ; Reindex (Kill/Set) Replacement Words
+1 NEW LEXDA,LEXDIC
SET LEXDA=0
SET LEXDIC="^LEX(757.05,"
+2 FOR
SET LEXDA=$ORDER(^LEX(757.05,LEXDA))
if +LEXDA=0
QUIT
Begin DoDot:1
+3 SET DA=LEXDA
SET DIC=LEXDIC
DO KILL^LEXNDX2
SET DA=LEXDA
SET DIC=LEXDIC
DO SET^LEXNDX2
End DoDot:1
+4 KILL LEXDA,LEXDIC,DA,DIC
+5 QUIT
