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

LEXNDX6.m

Go to the documentation of this file.
  1. LEXNDX6 ;ISL/KER - Set/kill indexes (Misc) ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**80,86,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^LEX(757.4) N/A
  1. ; ^TMP("LEXTKN") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; $$UP^XLFSTR ICR 10103
  1. ;
  1. ; NEWed/KILLed by FileMan
  1. ; DA
  1. ;
  1. SRA ; Set Shortcut index
  1. Q:'$D(X)!('$D(DA))!('$D(DA(1))) N LEXKW S LEXKW=$P($G(^LEX(757.4,DA(1),1,DA,0)),U,1) S:$L(LEXKW) ^LEX(757.4,"ARA",$E($$UP^XLFSTR(LEXKW),1,63),X,DA(1),DA)="" Q
  1. KRA ; Kill Shortcut index
  1. Q:'$D(X)!('$D(DA))!('$D(DA(1))) N LEXKW S LEXKW=$P($G(^LEX(757.4,DA(1),1,DA,0)),U,1) K:$L(LEXKW) ^LEX(757.4,"ARA",$E($$UP^XLFSTR(LEXKW),1,63),X,DA(1),DA) Q
  1. ;
  1. SSF ; Set String Frequency
  1. Q:'$L($G(X)) N LEXIDX,LEXE
  1. S LEXIDX="",LEXE=X,X=$$UP^XLFSTR(X) D PTX^LEXTOKN
  1. I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D
  1. . N LEXNT,LEXT,LEXW,LEXI,LEXP,LEXS S LEXI=""
  1. . S LEXI=0 F S LEXI=$O(^TMP("LEXTKN",$J,LEXI)) Q:+LEXI'>0 D
  1. . . S LEXW=$O(^TMP("LEXTKN",$J,LEXI,"")) Q:'$L(LEXW)
  1. . . F LEXP=1:1:$L(LEXW) D
  1. . . . S LEXS=$E(LEXW,1,LEXP)
  1. . . . ; Re-indexing All Entries of the file
  1. . . . S LEXT=0 I $D(^LEX(757.01,"ASL",LEXS)) D
  1. . . . . S LEXT=$O(^LEX(757.01,"ASL",LEXS,0))
  1. . . . S LEXNT=LEXT+1 Q:LEXNT'>0
  1. . . . K ^LEX(757.01,"ASL",LEXS)
  1. . . . S ^LEX(757.01,"ASL",LEXS,LEXNT)=""
  1. S X=LEXE K ^TMP("LEXTKN",$J) N DICNT,DIKDASV,DIKSAVE K LEXRECAL
  1. Q
  1. KSF ; Kill String Frequency
  1. Q:'$L($G(X)) N LEXIDX,LEXE
  1. S LEXIDX="",LEXE=X,X=$$UP^XLFSTR(X) D PTX^LEXTOKN
  1. I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D
  1. . N LEXNT,LEXT,LEXW,LEXI,LEXP,LEXS S LEXI=""
  1. . S LEXI=0 F S LEXI=$O(^TMP("LEXTKN",$J,LEXI)) Q:+LEXI'>0 D
  1. . . S LEXW=$O(^TMP("LEXTKN",$J,LEXI,""))
  1. . . I $L(LEXW) F LEXP=1:1:$L(LEXW) D
  1. . . . S LEXS=$E(LEXW,1,LEXP),LEXT=0
  1. . . . I $D(^LEX(757.01,"ASL",LEXS)) D
  1. . . . . S LEXT=$O(^LEX(757.01,"ASL",LEXS,0))
  1. . . . S LEXNT=LEXT-1
  1. . . . I LEXNT'>0 K ^LEX(757.01,"ASL",LEXS) Q
  1. . . . K ^LEX(757.01,"ASL",LEXS)
  1. . . . S ^LEX(757.01,"ASL",LEXS,LEXNT)=""
  1. . . .
  1. S X=LEXE K ^TMP("LEXTKN",$J)
  1. Q
  1. FRE(X) ; Frequency Counter of String
  1. N LEX,LEXA,LEXE,LEXIT,LEXM,LEXN,LEXO,LEXOUT,LEXP,LEXRT,LEXRT2,LEXS,LEXT,LEXTKN
  1. S LEXS=$$UP^XLFSTR($G(X)) Q:'$L(LEXS) 0 S LEXRT="" S:$D(^LEX(757.01,"AWRD")) LEXRT="^LEX(757.01,""AWRD"","
  1. Q:'$L(LEXRT) 0 S (LEXA,LEXN,LEXT)=0
  1. S:$L(LEXS)>1 LEXO=$E(LEXS,1,($L(LEXS)-1))_$C(($A($E(LEXS,$L(LEXS)))-1))_"~"
  1. S:$L(LEXS)=1 LEXO=$C(($A(LEXS)-1))_"~" S LEXIT=0
  1. F S LEXO=$O(@(LEXRT_""""_LEXO_""")")) D Q:LEXIT>0
  1. . S:'$L(LEXO) LEXIT=1 S:$E(LEXO,1,$L(LEXS))'=LEXS LEXIT=1
  1. . Q:LEXIT>0 N LEXM S LEXM=0 F S LEXM=$O(@(LEXRT_""""_LEXO_""","_LEXM_")")) Q:+LEXM'>0 D
  1. . . N LEXE,LEXRT2 S LEXE=0,LEXRT2=LEXRT_""""_LEXO_""","_LEXM_","
  1. . . F S LEXE=$O(@(LEXRT2_LEXE_")")) Q:+LEXE'>0 S LEXT=LEXT+1,LEXA=LEXA+1
  1. I $TR(LEXS,".","")?1N.N,$L(LEXS,".")'>2 I +LEXS=LEXS D
  1. . N LEXFC S LEXFC=$E(LEXS,1) S:$E(LEXS,1)?1N LEXO=LEXS-.000000001
  1. . S:$E(LEXS,1)="." LEXO=.000000001 S LEXIT=0
  1. . F S LEXO=$O(@(LEXRT_+LEXO_")")) D Q:LEXIT>0 Q:'$L(LEXO)
  1. . . S:LEXFC?1N&($E(LEXO,1)'?1N) LEXIT=1
  1. . . S:LEXFC?1P&($E(LEXO,1)'?1P) LEXIT=1 Q:LEXIT>0
  1. . . Q:'$L(LEXO) Q:$E(LEXO,1,$L(LEXS))'=LEXS N LEXM S LEXM=0
  1. . . F S LEXM=$O(@(LEXRT_+LEXO_","_LEXM_")")) Q:+LEXM'>0 D
  1. . . . N LEXE,LEXRT2 S LEXE=0,LEXRT2=LEXRT_+LEXO_","_LEXM_","
  1. . . . F S LEXE=$O(@(LEXRT2_LEXE_")")) Q:+LEXE'>0 S LEXT=LEXT+1,LEXN=LEXN+1
  1. S X=LEXT
  1. Q X
  1. ;
  1. SSUP ; Set Supplemental Words
  1. N LEXX,LEXDA1,LEXDA,LEXMC,LEXDEA,LEXTTYP
  1. S LEXX=$G(X) Q:'$L(LEXX) S LEXDA1=+($G(DA(1)))
  1. S LEXDEA=$$DEA(LEXDA1),LEXTTYP=$P($G(^LEX(757.01,+LEXDA1,1)),"^",2)
  1. Q:+LEXDEA>0 Q:+LEXTTYP=8
  1. Q:LEXDA1=0 S LEXDA=+($G(DA)) Q:LEXDA=0
  1. S LEXMC=$$MC(LEXDA1) Q:LEXMC=0
  1. S ^LEX(757.01,"AWRD",$$UP^XLFSTR(LEXX),LEXDA1,LEXMC,LEXDA)=""
  1. Q
  1. KSUP ; Kill Supplemental Words
  1. N LEXX,LEXDA1,LEXDA,LEXMC,LEXDEA,LEXTTYP
  1. S LEXX=$G(X) Q:'$L(LEXX) S LEXDA1=+($G(DA(1))) Q:LEXDA1=0 S LEXDA=+($G(DA)) Q:LEXDA=0
  1. S LEXMC=$$MC(LEXDA1) Q:LEXMC=0
  1. K ^LEX(757.01,"AWRD",LEXX,LEXDA1,LEXMC,LEXDA)
  1. K ^LEX(757.01,"AWRD",$$UP^XLFSTR(LEXX),LEXDA1,LEXMC,LEXDA)
  1. Q
  1. ;
  1. ; Miscellaneous
  1. MC(X) ; Major Concept IEN
  1. N LEXX S LEXX=+($G(X)) Q:LEXX=0 0
  1. S LEXX=+($G(^LEX(757.01,LEXX,1))) Q:LEXX=0 0
  1. S LEXX=+($G(^LEX(757,LEXX,0))) Q:LEXX=0 0
  1. S X=LEXX Q X
  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