LEXNDX6 ;ISL/KER - Set/kill indexes (Misc) ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^LEX(757.4) N/A
; ^TMP("LEXTKN") SACC 2.3.2.5.1
;
; External References
; $$UP^XLFSTR ICR 10103
;
SRA ; Set Shortcut index
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
KRA ; Kill Shortcut index
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
;
SSF ; Set String Frequency
Q:'$L($G(X)) N LEXIDX,LEXE
S LEXIDX="",LEXE=X,X=$$UP^XLFSTR(X) D PTX^LEXTOKN
I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D
. N LEXNT,LEXT,LEXW,LEXI,LEXP,LEXS S LEXI=""
. S LEXI=0 F S LEXI=$O(^TMP("LEXTKN",$J,LEXI)) Q:+LEXI'>0 D
. . S LEXW=$O(^TMP("LEXTKN",$J,LEXI,"")) Q:'$L(LEXW)
. . F LEXP=1:1:$L(LEXW) D
. . . S LEXS=$E(LEXW,1,LEXP)
. . . ; Re-indexing All Entries of the file
. . . I $D(DICNT)!($D(DIKDASV))!($D(DIKSAVE)) D Q
. . . . S LEXT=0 I $D(^LEX(757.01,"ASL",LEXS)) D
. . . . . S LEXT=$O(^LEX(757.01,"ASL",LEXS,0))
. . . . S LEXNT=LEXT+1 Q:LEXNT'>0
. . . . K ^LEX(757.01,"ASL",LEXS)
. . . . S ^LEX(757.01,"ASL",LEXS,LEXNT)=""
. . . ; Re-indexing One Entry of the file
. . . S LEXNT=$$FRE(LEXS) Q:LEXNT'>0
. . . K ^LEX(757.01,"ASL",LEXS)
. . . S ^LEX(757.01,"ASL",LEXS,LEXNT)=""
S X=LEXE K ^TMP("LEXTKN",$J) N DICNT,DIKDASV,DIKSAVE
Q
KSF ; Kill String Frequency
Q:'$L($G(X)) N LEXIDX,LEXE
S LEXIDX="",LEXE=X,X=$$UP^XLFSTR(X) D PTX^LEXTOKN
I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D
. N LEXNT,LEXT,LEXW,LEXI,LEXP,LEXS S LEXI=""
. S LEXI=0 F S LEXI=$O(^TMP("LEXTKN",$J,LEXI)) Q:+LEXI'>0 D
. . S LEXW=$O(^TMP("LEXTKN",$J,LEXI,""))
. . I $L(LEXW) F LEXP=1:1:$L(LEXW) D
. . . S LEXS=$E(LEXW,1,LEXP),LEXT=0
. . . I $D(^LEX(757.01,"ASL",LEXS)) D
. . . . S LEXT=$O(^LEX(757.01,"ASL",LEXS,0))
. . . S LEXNT=LEXT-1
. . . I LEXNT'>0 K ^LEX(757.01,"ASL",LEXS) Q
. . . K ^LEX(757.01,"ASL",LEXS)
. . . S ^LEX(757.01,"ASL",LEXS,LEXNT)=""
. . .
S X=LEXE K ^TMP("LEXTKN",$J)
Q
FRE(X) ; Frequency Counter of String
N LEXC,LEXTK,LEXTKN,LEXO,LEXT,LEXS,LEXP
S (LEXC,LEXTK)=$$UP^XLFSTR($G(X)),LEXT=0 Q:'$L(LEXTK) 0
S:$L(LEXTK)>1 LEXO=$E(LEXTK,1,($L(LEXTK)-1))_$C(($A($E(LEXTK,$L(LEXTK)))-1))_"~"
S:$L(LEXTK)=1 LEXO=$C(($A(LEXTK)-1))_"~"
F S LEXO=$O(^LEX(757.01,"AWRD",LEXO)) Q:'$L(LEXO) Q:$E(LEXO,1,$L(LEXC))'=LEXC D
. N LEXM S LEXM=0 F S LEXM=$O(^LEX(757.01,"AWRD",LEXO,LEXM)) Q:+LEXM'>0 D
. . N LEXE S LEXE=0 F S LEXE=$O(^LEX(757.01,"AWRD",LEXO,LEXM,LEXE)) Q:+LEXE'>0 D
. . . S LEXT=LEXT+1
S X=LEXT
Q X
;
SSUP ; Set Supplemental Words
N LEXX,LEXDA1,LEXDA,LEXMC
S LEXX=$G(X) Q:'$L(LEXX) S LEXDA1=+($G(DA(1)))
Q:LEXDA1=0 S LEXDA=+($G(DA)) Q:LEXDA=0
S LEXMC=$$MC(LEXDA1) Q:LEXMC=0
S ^LEX(757.01,"AWRD",$$UP^XLFSTR(LEXX),LEXDA1,LEXMC,LEXDA)=""
Q
KSUP ; Kill Supplemental Words
N LEXX,LEXDA1,LEXDA,LEXMC
S LEXX=$G(X) Q:'$L(LEXX) S LEXDA1=+($G(DA(1))) Q:LEXDA1=0 S LEXDA=+($G(DA)) Q:LEXDA=0
S LEXMC=$$MC(LEXDA1) Q:LEXMC=0
K ^LEX(757.01,"AWRD",LEXX,LEXDA1,LEXMC,LEXDA)
K ^LEX(757.01,"AWRD",$$UP^XLFSTR(LEXX),LEXDA1,LEXMC,LEXDA)
Q
;
; Miscellaneous
MC(X) ; Major Concept IEN
N LEXX S LEXX=+($G(X)) Q:LEXX=0 0
S LEXX=+($G(^LEX(757.01,LEXX,1))) Q:LEXX=0 0
S LEXX=+($G(^LEX(757,LEXX,0))) Q:LEXX=0 0
S X=LEXX Q X
LEXNDX6 ;ISL/KER - Set/kill indexes (Misc) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^LEX(757.4) N/A
+5 ; ^TMP("LEXTKN") SACC 2.3.2.5.1
+6 ;
+7 ; External References
+8 ; $$UP^XLFSTR ICR 10103
+9 ;
SRA ; Set Shortcut index
+1 IF '$DATA(X)!('$DATA(DA))!('$DATA(DA(1)))
QUIT
NEW LEXKW
SET LEXKW=$PIECE($GET(^LEX(757.4,DA(1),1,DA,0)),U,1)
IF $LENGTH(LEXKW)
SET ^LEX(757.4,"ARA",$EXTRACT($$UP^XLFSTR(LEXKW),1,63),X,DA(1),DA)=""
QUIT
KRA ; Kill Shortcut index
+1 IF '$DATA(X)!('$DATA(DA))!('$DATA(DA(1)))
QUIT
NEW LEXKW
SET LEXKW=$PIECE($GET(^LEX(757.4,DA(1),1,DA,0)),U,1)
IF $LENGTH(LEXKW)
KILL ^LEX(757.4,"ARA",$EXTRACT($$UP^XLFSTR(LEXKW),1,63),X,DA(1),DA)
QUIT
+2 ;
SSF ; Set String Frequency
+1 IF '$LENGTH($GET(X))
QUIT
NEW LEXIDX,LEXE
+2 SET LEXIDX=""
SET LEXE=X
SET X=$$UP^XLFSTR(X)
DO PTX^LEXTOKN
+3 IF $DATA(^TMP("LEXTKN",$JOB,0))
IF ^TMP("LEXTKN",$JOB,0)>0
Begin DoDot:1
+4 NEW LEXNT,LEXT,LEXW,LEXI,LEXP,LEXS
SET LEXI=""
+5 SET LEXI=0
FOR
SET LEXI=$ORDER(^TMP("LEXTKN",$JOB,LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:2
+6 SET LEXW=$ORDER(^TMP("LEXTKN",$JOB,LEXI,""))
IF '$LENGTH(LEXW)
QUIT
+7 FOR LEXP=1:1:$LENGTH(LEXW)
Begin DoDot:3
+8 SET LEXS=$EXTRACT(LEXW,1,LEXP)
+9 ; Re-indexing All Entries of the file
+10 IF $DATA(DICNT)!($DATA(DIKDASV))!($DATA(DIKSAVE))
Begin DoDot:4
+11 SET LEXT=0
IF $DATA(^LEX(757.01,"ASL",LEXS))
Begin DoDot:5
+12 SET LEXT=$ORDER(^LEX(757.01,"ASL",LEXS,0))
End DoDot:5
+13 SET LEXNT=LEXT+1
IF LEXNT'>0
QUIT
+14 KILL ^LEX(757.01,"ASL",LEXS)
+15 SET ^LEX(757.01,"ASL",LEXS,LEXNT)=""
End DoDot:4
QUIT
+16 ; Re-indexing One Entry of the file
+17 SET LEXNT=$$FRE(LEXS)
IF LEXNT'>0
QUIT
+18 KILL ^LEX(757.01,"ASL",LEXS)
+19 SET ^LEX(757.01,"ASL",LEXS,LEXNT)=""
End DoDot:3
End DoDot:2
End DoDot:1
+20 SET X=LEXE
KILL ^TMP("LEXTKN",$JOB)
NEW DICNT,DIKDASV,DIKSAVE
+21 QUIT
KSF ; Kill String Frequency
+1 IF '$LENGTH($GET(X))
QUIT
NEW LEXIDX,LEXE
+2 SET LEXIDX=""
SET LEXE=X
SET X=$$UP^XLFSTR(X)
DO PTX^LEXTOKN
+3 IF $DATA(^TMP("LEXTKN",$JOB,0))
IF ^TMP("LEXTKN",$JOB,0)>0
Begin DoDot:1
+4 NEW LEXNT,LEXT,LEXW,LEXI,LEXP,LEXS
SET LEXI=""
+5 SET LEXI=0
FOR
SET LEXI=$ORDER(^TMP("LEXTKN",$JOB,LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:2
+6 SET LEXW=$ORDER(^TMP("LEXTKN",$JOB,LEXI,""))
+7 IF $LENGTH(LEXW)
FOR LEXP=1:1:$LENGTH(LEXW)
Begin DoDot:3
+8 SET LEXS=$EXTRACT(LEXW,1,LEXP)
SET LEXT=0
+9 IF $DATA(^LEX(757.01,"ASL",LEXS))
Begin DoDot:4
+10 SET LEXT=$ORDER(^LEX(757.01,"ASL",LEXS,0))
End DoDot:4
+11 SET LEXNT=LEXT-1
+12 IF LEXNT'>0
KILL ^LEX(757.01,"ASL",LEXS)
QUIT
+13 KILL ^LEX(757.01,"ASL",LEXS)
+14 SET ^LEX(757.01,"ASL",LEXS,LEXNT)=""
+15 End DoDot:3
End DoDot:2
End DoDot:1
+16 SET X=LEXE
KILL ^TMP("LEXTKN",$JOB)
+17 QUIT
FRE(X) ; Frequency Counter of String
+1 NEW LEXC,LEXTK,LEXTKN,LEXO,LEXT,LEXS,LEXP
+2 SET (LEXC,LEXTK)=$$UP^XLFSTR($GET(X))
SET LEXT=0
IF '$LENGTH(LEXTK)
QUIT 0
+3 IF $LENGTH(LEXTK)>1
SET LEXO=$EXTRACT(LEXTK,1,($LENGTH(LEXTK)-1))_$CHAR(($ASCII($EXTRACT(LEXTK,$LENGTH(LEXTK)))-1))_"~"
+4 IF $LENGTH(LEXTK)=1
SET LEXO=$CHAR(($ASCII(LEXTK)-1))_"~"
+5 FOR
SET LEXO=$ORDER(^LEX(757.01,"AWRD",LEXO))
IF '$LENGTH(LEXO)
QUIT
IF $EXTRACT(LEXO,1,$LENGTH(LEXC))'=LEXC
QUIT
Begin DoDot:1
+6 NEW LEXM
SET LEXM=0
FOR
SET LEXM=$ORDER(^LEX(757.01,"AWRD",LEXO,LEXM))
IF +LEXM'>0
QUIT
Begin DoDot:2
+7 NEW LEXE
SET LEXE=0
FOR
SET LEXE=$ORDER(^LEX(757.01,"AWRD",LEXO,LEXM,LEXE))
IF +LEXE'>0
QUIT
Begin DoDot:3
+8 SET LEXT=LEXT+1
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET X=LEXT
+10 QUIT X
+11 ;
SSUP ; Set Supplemental Words
+1 NEW LEXX,LEXDA1,LEXDA,LEXMC
+2 SET LEXX=$GET(X)
IF '$LENGTH(LEXX)
QUIT
SET LEXDA1=+($GET(DA(1)))
+3 IF LEXDA1=0
QUIT
SET LEXDA=+($GET(DA))
IF LEXDA=0
QUIT
+4 SET LEXMC=$$MC(LEXDA1)
IF LEXMC=0
QUIT
+5 SET ^LEX(757.01,"AWRD",$$UP^XLFSTR(LEXX),LEXDA1,LEXMC,LEXDA)=""
+6 QUIT
KSUP ; Kill Supplemental Words
+1 NEW LEXX,LEXDA1,LEXDA,LEXMC
+2 SET LEXX=$GET(X)
IF '$LENGTH(LEXX)
QUIT
SET LEXDA1=+($GET(DA(1)))
IF LEXDA1=0
QUIT
SET LEXDA=+($GET(DA))
IF LEXDA=0
QUIT
+3 SET LEXMC=$$MC(LEXDA1)
IF LEXMC=0
QUIT
+4 KILL ^LEX(757.01,"AWRD",LEXX,LEXDA1,LEXMC,LEXDA)
+5 KILL ^LEX(757.01,"AWRD",$$UP^XLFSTR(LEXX),LEXDA1,LEXMC,LEXDA)
+6 QUIT
+7 ;
+8 ; Miscellaneous
MC(X) ; Major Concept IEN
+1 NEW LEXX
SET LEXX=+($GET(X))
IF LEXX=0
QUIT 0
+2 SET LEXX=+($GET(^LEX(757.01,LEXX,1)))
IF LEXX=0
QUIT 0
+3 SET LEXX=+($GET(^LEX(757,LEXX,0)))
IF LEXX=0
QUIT 0
+4 SET X=LEXX
QUIT X
