LEXNDX6 ; ISL Set/kill indexes (Misc) ; 09-23-96 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1 ; 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^LEXTOLKN I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D . N LEXNT,LEXT,LEXW,LEXI,LEXP,LEXS S LEXI="" . F LEXI=1:1:^TMP("LEXTKN",$J,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,^LEX(757.01,"ASL",LEXS,LEXNT)="" . . . K ^LEX(757.01,"ASL",LEXS,LEXT) S X=LEXE K ^TMP("LEXTKN",$J) Q ; KSF ; Kill String Frequency Q:'$L($G(X)) N LEXIDX,LEXE S LEXIDX="",LEXE=X,X=$$UP^XLFSTR(X) D PTX^LEXTOLKN I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D . N LEXNT,LEXT,LEXW,LEXI,LEXP,LEXS S LEXI="" . F LEXI=1:1:^TMP("LEXTKN",$J,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 . . . S:LEXNT>0 ^LEX(757.01,"ASL",LEXS,LEXNT)="" . . . K:LEXNT'>0 ^LEX(757.01,"ASL",LEXS,LEXNT) . . . K ^LEX(757.01,"ASL",LEXS,LEXT) S X=LEXE K ^TMP("LEXTKN",$J) Q SSUP ; 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",LEXX,LEXDA1,LEXMC,LEXDA)="" ;S ^LEX(757.01,"AWRD",LEXX,LEXMC,LEXDA1,LEXDA)="" Q KSUP ; 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",LEXX,LEXMC,LEXDA1,LEXDA) Q 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