Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXNDX1

LEXNDX1.m

Go to the documentation of this file.
  1. LEXNDX1 ;ISL/KER - Set/kill indexes (Part 1) ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**80,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^LEX(757.011) N/A
  1. ; ^TMP("LEXSTOP") SACC 2.3.2.5.1
  1. ; ^TMP("LEXTKN") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; $$UP^XLFSTR ICR 10103
  1. ; HOME^%ZIS ICR 10086
  1. ; ^%ZTLOAD ICR 10063
  1. ;
  1. S ; Set Expression file (#757.01) word index node AWRD
  1. Q:'$D(X)!('$D(DA)) Q:$D(DIC)#2=0 Q:'$D(@(DIC_DA_",0)")) Q:'$D(@(DIC_DA_",1)"))
  1. Q:+($P(@(DIC_DA_",1)"),U,1))'>0 N LEXIDX,LEXDEA,LEXTTYP,LEXJ,LEXI,LEXTYPE,LEXT
  1. S LEXTYPE=+X Q:LEXTYPE'>0 S LEXT=$P($G(^LEX(757.011,LEXTYPE,0)),"^",2) Q:+LEXT=0
  1. S LEXTYPE=$P($G(^LEX(757.011,LEXTYPE,0)),"^",1) D:LEXTYPE["DELETED" U
  1. S X=@(DIC_DA_",0)") S:X'="" ^LEX(757.01,"B",$$UP^XLFSTR($E(X,1,63)),DA)=""
  1. S LEXDEA=$$DEA(DA),LEXTTYP=$P($G(^LEX(757.01,DA,1)),U,2) Q:+($G(LEXDEA))>0 Q:LEXTTYP=8
  1. S LEXEX=$P(^LEX(757,$P(^LEX(757.01,DA,1),U,1),0),U,1),LEXIDX=""
  1. D PTX^LEXTOKN I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 S LEXI="",LEXJ=0 D
  1. . F S LEXJ=$O(^TMP("LEXTKN",$J,LEXJ)) Q:+LEXJ'>0 D
  1. . . S LEXI=$O(^TMP("LEXTKN",$J,LEXJ,"")) Q:'$L(LEXI)
  1. . . I '$D(^LEX(757.01,"AWRD",LEXI,LEXEX)) D
  1. . . . S:'$D(^LEX(757.01,DA,4,"B",LEXI)) ^LEX(757.01,"AWRD",LEXI,LEXEX,DA)=""
  1. D L K LEXIDX,LEXEX,LEXI,LEXTYPE,LEXT,LEXJ,^TMP("LEXTKN",$J,0),^TMP("LEXTKN",$J) Q
  1. ;
  1. K ; Kill Expression file (#757.01) word index node AWRD
  1. Q:'$D(X)!('$D(DA)) D U
  1. Q:'$D(^LEX(757.01,DA,0)) Q:+($P(^LEX(757.01,DA,1),U,1))=0
  1. N LEXTYPE,LEXT S LEXTYPE=+X Q:LEXTYPE'>0
  1. S LEXT=$P($G(^LEX(757.011,LEXTYPE,0)),"^",2) Q:+LEXT=0
  1. N LEXIDX,LEXJ,LEXI S X=^LEX(757.01,DA,0),LEXIDX=""
  1. D PTX^LEXTOKN I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 S LEXI="",LEXJ=0 D
  1. . F S LEXJ=$O(^TMP("LEXTKN",$J,LEXJ)) Q:+LEXJ'>0 D
  1. . . N LEXI,LEXEX S LEXI=$O(^TMP("LEXTKN",$J,LEXJ,"")) Q:'$L(LEXI)
  1. . . S LEXEX=$P(^LEX(757,$P(^LEX(757.01,DA,1),U,1),0),U,1)
  1. . . K ^LEX(757.01,"AWRD",LEXI,DA)
  1. . . K ^LEX(757.01,"AWRD",LEXI,LEXEX,DA)
  1. K LEXIDX,LEXTYPE,LEXI,LEXJ,^TMP("LEXTKN",$J,0),^TMP("LEXTKN",$J) Q
  1. L ; Link words
  1. N DIC,LEXDEXP D KILL^LEXNDX2 S LEXDEXP=DA
  1. ; For Subsets
  1. I $D(^LEX(757.21,"B",LEXDEXP)) D
  1. . S DA=0 F S DA=$O(^LEX(757.21,"B",LEXDEXP,DA)) Q:+DA=0 D
  1. . . N X S X=$P(^LEX(757.21,DA,0),U,2) Q:+X<1 D SS^LEXNDX2
  1. ; For Replacement Words
  1. I $D(^LEX(757.05,"AEXP",LEXDEXP)) D
  1. . S DA=0 F S DA=$O(^LEX(757.05,"AEXP",LEXDEXP,DA)) Q:+DA=0 D
  1. . . N X,LEXMC S X=$P(^LEX(757.05,DA,0),U,1) Q:X=""
  1. . . S LEXMC=$P($G(^LEX(757.01,LEXDEXP,1)),U,1) Q:+LEXMC'>0
  1. . . S ^LEX(757.01,"AWRD",X,LEXDEXP,"LINKED")=""
  1. S DA=LEXDEXP
  1. Q
  1. U ; Unlink words
  1. N DIC,LEXDEXP D KILL^LEXNDX2 S LEXDEXP=DA
  1. ; For Subsets
  1. I $D(^LEX(757.21,"B",LEXDEXP)) D
  1. . S DA=0 F S DA=$O(^LEX(757.21,"B",LEXDEXP,DA)) Q:+DA=0 D
  1. . . N X S X=$P(^LEX(757.21,DA,0),U,2) Q:+X<1 D SK^LEXNDX2
  1. ; For Replacement Words
  1. I $D(^LEX(757.05,"AEXP",LEXDEXP)) D
  1. . S DA=0 F S DA=$O(^LEX(757.05,"AEXP",LEXDEXP,DA)) Q:+DA=0 D
  1. . . N X,LEXMC S X=$P(^LEX(757.05,DA,0),U,1) Q:X=""
  1. . . S LEXMC=$P($G(^LEX(757.01,LEXDEXP,1)),U,1) Q:+LEXMC'>0
  1. . . K ^LEX(757.01,"AWRD",X,LEXDEXP,"LINKED")
  1. S DA=LEXDEXP
  1. Q
  1. REIDXMC ; Re-Index Expression file word index AWRD
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. N LEXIDX,LEXREIX,DA,X S DA=0,X="",(LEXREIX,LEXIDX)="" K ^TMP("LEXSTOP","REIDXMC")
  1. F S DA=$O(^LEX(757.01,DA)) Q:+DA=0!($D(^TMP("LEXSTOP","REIDXMC"))) D
  1. . S X=$P(^LEX(757.01,DA,1),U,2) D S
  1. K ^TMP("LEXSTOP","REIDXMC"),LEXIDX,DA,X
  1. Q
  1. RMC ; Re-Index Expression file word index AWRD (Task Manager)
  1. S ZTRTN="REIDXMC^LEXNDX1"
  1. S ZTDESC="Re-Indexing Major Concept Words in ""AWRD"" index"
  1. 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"
  1. K ZTDTH,ZTDESC,ZTIO,ZTRTN
  1. Q
  1. RALL ; Re-Index entire file (needs DIC)
  1. S DIK=$G(DIC) Q:DIK="" Q:'$D(@(DIK_"0)"))
  1. S ZTREQ="@",(ZTSAVE("ZTREQ"),ZTSAVE("DIK"))="",ZTRTN="IXALL^DIK"
  1. S ZTDESC="Re-Indexing "_DIK
  1. S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS
  1. K ZTDTH,ZTDESC,ZTIO,ZTRTN,ZTREQ,ZTSAVE
  1. Q
  1. DEA(X) ; Expression/Concept Deactive
  1. N LEXA,LEXEA,LEXEIEN,LEXMA,LEXMIEN,LEXN S LEXEIEN=+($G(X)),LEXN=$G(^LEX(757.01,+LEXEIEN,1))
  1. S LEXEA=+($P(LEXN,"^",5)),LEXMIEN=+LEXN,LEXN=+($P(LEXN,"^",2)) Q:LEXN=1&(LEXEA>0) 1 Q:LEXN=1&(LEXEA'>0) 0
  1. S LEXMIEN=+($G(^LEX(757,+LEXMIEN,0))),LEXMA=+($P($G(^LEX(757.01,+LEXMIEN,1)),"^",5)) Q:(LEXEA+LEXMA)>0 1
  1. Q 0