source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXNDX6.m@ 771

Last change on this file since 771 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1LEXNDX6 ; ISL Set/kill indexes (Misc) ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4SRA ; Set Shortcut index
5 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
6 ;
7KRA ; Kill Shortcut index
8 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
9 ;
10SSF ; Set String Frequency
11 Q:'$L($G(X))
12 N LEXIDX,LEXE S LEXIDX="",LEXE=X,X=$$UP^XLFSTR(X) D PTX^LEXTOLKN
13 I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D
14 . N LEXNT,LEXT,LEXW,LEXI,LEXP,LEXS S LEXI=""
15 . F LEXI=1:1:^TMP("LEXTKN",$J,0) D
16 . . S LEXW=$O(^TMP("LEXTKN",$J,LEXI,""))
17 . . I $L(LEXW) F LEXP=1:1:$L(LEXW) D
18 . . . S LEXS=$E(LEXW,1,LEXP),LEXT=0
19 . . . I $D(^LEX(757.01,"ASL",LEXS)) D
20 . . . . S LEXT=$O(^LEX(757.01,"ASL",LEXS,0))
21 . . . S LEXNT=LEXT+1,^LEX(757.01,"ASL",LEXS,LEXNT)=""
22 . . . K ^LEX(757.01,"ASL",LEXS,LEXT)
23 S X=LEXE K ^TMP("LEXTKN",$J)
24 Q
25 ;
26KSF ; Kill String Frequency
27 Q:'$L($G(X))
28 N LEXIDX,LEXE S LEXIDX="",LEXE=X,X=$$UP^XLFSTR(X) D PTX^LEXTOLKN
29 I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D
30 . N LEXNT,LEXT,LEXW,LEXI,LEXP,LEXS S LEXI=""
31 . F LEXI=1:1:^TMP("LEXTKN",$J,0) D
32 . . S LEXW=$O(^TMP("LEXTKN",$J,LEXI,""))
33 . . I $L(LEXW) F LEXP=1:1:$L(LEXW) D
34 . . . S LEXS=$E(LEXW,1,LEXP),LEXT=0
35 . . . I $D(^LEX(757.01,"ASL",LEXS)) D
36 . . . . S LEXT=$O(^LEX(757.01,"ASL",LEXS,0))
37 . . . S LEXNT=LEXT-1
38 . . . S:LEXNT>0 ^LEX(757.01,"ASL",LEXS,LEXNT)=""
39 . . . K:LEXNT'>0 ^LEX(757.01,"ASL",LEXS,LEXNT)
40 . . . K ^LEX(757.01,"ASL",LEXS,LEXT)
41 S X=LEXE K ^TMP("LEXTKN",$J)
42 Q
43SSUP ;
44 N LEXX,LEXDA1,LEXDA,LEXMC
45 S LEXX=$G(X) Q:'$L(LEXX) S LEXDA1=+($G(DA(1)))
46 Q:LEXDA1=0 S LEXDA=+($G(DA)) Q:LEXDA=0
47 S LEXMC=$$MC(LEXDA1) Q:LEXMC=0
48 S ^LEX(757.01,"AWRD",LEXX,LEXDA1,LEXMC,LEXDA)=""
49 ;S ^LEX(757.01,"AWRD",LEXX,LEXMC,LEXDA1,LEXDA)=""
50 Q
51KSUP ;
52 N LEXX,LEXDA1,LEXDA,LEXMC
53 S LEXX=$G(X) Q:'$L(LEXX) S LEXDA1=+($G(DA(1))) Q:LEXDA1=0 S LEXDA=+($G(DA)) Q:LEXDA=0
54 S LEXMC=$$MC(LEXDA1) Q:LEXMC=0
55 K ^LEX(757.01,"AWRD",LEXX,LEXDA1,LEXMC,LEXDA)
56 ;K ^LEX(757.01,"AWRD",LEXX,LEXMC,LEXDA1,LEXDA)
57 Q
58MC(X) ; Major Concept IEN
59 N LEXX S LEXX=+($G(X)) Q:LEXX=0 0
60 S LEXX=+($G(^LEX(757.01,LEXX,1))) Q:LEXX=0 0
61 S LEXX=+($G(^LEX(757,LEXX,0))) Q:LEXX=0 0
62 S X=LEXX Q X
Note: See TracBrowser for help on using the repository browser.