- LEXNDX3 ;ISL/KER - Set/kill indexes (Part 3) Link ;04/21/2014
- ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
- ;
- ; 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
- LEXNDX3 ;ISL/KER - Set/kill indexes (Part 3) Link ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
- +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
