[613] | 1 | LEXNDX4 ; ISL Set/kill indexes (Part 4) Link ; 09-23-96
|
---|
| 2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
|
---|
| 3 | ;
|
---|
| 4 | LINK ; Link a Keyword to an expression
|
---|
| 5 | I $D(^LEX(757.05,DA,1,"B",1)) Q
|
---|
| 6 | W !,"LINK" S X=LEXBY D PTX^LEXTOLKN
|
---|
| 7 | I ^TMP("LEXTKN",$J,0)>0 S (LEXLINK,LEXKEY)="",LEXKEY=$O(^TMP("LEXTKN",$J,1,LEXKEY))
|
---|
| 8 | S LEXREC=0 F S LEXREC=$O(^LEX(757.01,"AWRD",LEXKEY,LEXREC)) Q:+LEXREC=0!(LEXLINK[U) D
|
---|
| 9 | . I ^TMP("LEXTKN",$J,0)=1 S LEXASK=1
|
---|
| 10 | . I ^TMP("LEXTKN",$J,0)>1 S LEXASK=1 D
|
---|
| 11 | . . F LEXA=2:1:^TMP("LEXTKN",$J,0) D
|
---|
| 12 | . . . S LEXAKEY="",LEXAKEY=$O(^TMP("LEXTKN",$J,LEXA,LEXAKEY))
|
---|
| 13 | . . . S LEXSRC=$$UP^XLFSTR(^LEX(757.01,LEXREC,0))
|
---|
| 14 | . . . I LEXSRC'[$E(LEXAKEY,1,4) S LEXASK=0
|
---|
| 15 | . S LEXLINK="" I LEXASK D
|
---|
| 16 | . . I $D(^LEX(757.05,DA,1,"B",LEXREC)) Q
|
---|
| 17 | MOK . . ; Prompt to Map/Link a keyword to an expression
|
---|
| 18 | . . W !!,"Map ",^LEX(757.01,LEXREC,0),!,"To ",LEXREP,!,"OK" S %=1 D YN^DICN S LEXLINK=% I %=-1 W ! S LEXLINK=U Q
|
---|
| 19 | . . I '% W !!,"By answering ""Yes"", an index reference will be made to link the",!,"term to the key word ",LEXREP G MOK
|
---|
| 20 | . I +LEXLINK=1 D
|
---|
| 21 | . . N LEXYPE,LEXT S ^LEX(757.05,"ALINK",DA,LEXREC)=""
|
---|
| 22 | . . S LEXYPE=+($P($G(^LEX(757.01,LEXREC,1)),U,2))
|
---|
| 23 | . . S LEXT=+($P($G(^LEX(757.011,LEXYPE,0)),U,2))
|
---|
| 24 | . . S:+LEXT>0 ^LEX(757.01,"AWRD",LEXREP,LEXREC,"LINKED")="" W !
|
---|
| 25 | . . I $D(^LEX(757.05,DA,1,0)) D
|
---|
| 26 | . . . S LEXSREC=0 F S LEXSREC=$O(^LEX(757.05,DA,1,LEXSREC)) Q:+LEXSREC=0 D
|
---|
| 27 | . . . . S ^LEX(757.05,DA,1,"B",^LEX(757.05,DA,1,LEXSREC,0),LEXSREC)=""
|
---|
| 28 | . . . I '$D(^LEX(757.05,DA,1,"B",LEXREC)) D
|
---|
| 29 | . . . . S LEXSREC=0 F S LEXSREC=$O(^LEX(757.05,DA,1,LEXSREC)) Q:+LEXSREC=0 S LEXLNK=LEXSREC+1
|
---|
| 30 | . . . . K LEXSREC S ^LEX(757.05,DA,1,LEXLNK,0)=LEXREC
|
---|
| 31 | . . . . S ^LEX(757.05,DA,1,"B",LEXREC,LEXLNK)="",$P(^LEX(757.05,DA,1,0),U,4)=$P(^LEX(757.05,DA,1,0),U,4)+1
|
---|
| 32 | . . . . S $P(^LEX(757.05,DA,1,0),U,3)=LEXLNK K LEXLNK
|
---|
| 33 | . . I '$D(^LEX(757.05,DA,1,0)) S ^LEX(757.05,DA,1,1,0)=LEXREC,^LEX(757.05,DA,1,"B",LEXREC,1)="",^LEX(757.05,DA,1,0)="^757.53P^1^1"
|
---|
| 34 | D VERIFY K ^TMP("LEXTKN",$J),^TMP("LEXTKN",$J,0),LEXSRC,LEXKEY,LEXA,LEXAKEY,LEXREC,LEXASK,LEXLINK
|
---|
| 35 | Q
|
---|
| 36 | VERIFY ; Display linkages made for user verification
|
---|
| 37 | Q:'$D(DA)
|
---|
| 38 | I '$D(^LEX(757.05,DA,1,0)) W !,"No Word Linkages Created",! Q
|
---|
| 39 | W !!,$P(^LEX(757.05,DA,0),"^",1)," has been linked to: ",!
|
---|
| 40 | N LEXSREC S LEXSREC=0
|
---|
| 41 | F S LEXSREC=$O(^LEX(757.05,DA,1,LEXSREC)) Q:+LEXSREC=0 D
|
---|
| 42 | . W !,?4,$E(^LEX(757.01,^LEX(757.05,DA,1,LEXSREC,0),0),1,75)
|
---|
| 43 | W ! I +$$OK D K LEXSREC,LEXLNK Q
|
---|
| 44 | . S LEXSREC=0 F S LEXSREC=$O(^LEX(757.05,DA,1,LEXSREC)) Q:+LEXSREC=0 S LEXLNK=LEXSREC+1
|
---|
| 45 | . K LEXSREC S ^LEX(757.05,DA,1,LEXLNK,0)=1,^LEX(757.05,DA,1,"B",1,LEXLNK)=""
|
---|
| 46 | . S $P(^LEX(757.05,DA,1,0),U,4)=$P(^LEX(757.05,DA,1,0),U,4)+1
|
---|
| 47 | . S $P(^LEX(757.05,DA,1,0),U,3)=LEXLNK K LEXLNK
|
---|
| 48 | D UNLINK
|
---|
| 49 | Q
|
---|
| 50 | OK(LEXOK) ; Get user response
|
---|
| 51 | OK1 ; Prompt "Is this correct"
|
---|
| 52 | W !,"Is this correct" S %=1 D YN^DICN
|
---|
| 53 | I %=-1!(%=2) K %,%Y Q 0
|
---|
| 54 | I %=1 K %,%Y Q 1
|
---|
| 55 | I '% D G OK1
|
---|
| 56 | . W !,"By confirming the word linkages displayed above, a look-up"
|
---|
| 57 | . W !,"conducted on ",$P(^LEX(757.05,DA,0),"^",1)
|
---|
| 58 | . W " will retrieve the linked terms."
|
---|
| 59 | Q 0
|
---|
| 60 | RELINK ; Relink Keywords to expressions
|
---|
| 61 | Q:'$D(DA) Q:'$D(^LEX(757.05,DA,1,1,0))
|
---|
| 62 | D SUB N LEXMC,LEXCTR,LEXSREC,LEXERM S (LEXCTR,LEXSREC)=0,LEXERM=$P(^LEX(757.05,DA,0),"^",1)
|
---|
| 63 | F S LEXSREC=$O(^LEX(757.05,DA,1,LEXSREC)) Q:+LEXSREC=0 D
|
---|
| 64 | . S LEXCTR=LEXCTR+1
|
---|
| 65 | . S ^LEX(757.05,DA,1,0)="^757.53P^"_LEXCTR_"^"_LEXCTR
|
---|
| 66 | . S ^LEX(757.05,DA,1,"B",^LEX(757.05,DA,1,LEXSREC,0),LEXSREC)=""
|
---|
| 67 | . I ^LEX(757.05,DA,1,LEXSREC,0)'=1 D
|
---|
| 68 | . . S LEXMC=^LEX(757.05,DA,1,LEXSREC,0)
|
---|
| 69 | . . N LEXYPE,LEXT S LEXYPE=+($P($G(^LEX(757.01,LEXMC,1)),U,2))
|
---|
| 70 | . . S LEXT=+($P($G(^LEX(757.011,LEXYPE,0)),U,2))
|
---|
| 71 | . . I +LEXT>0 D
|
---|
| 72 | . . . S ^LEX(757.01,"AWRD",LEXERM,LEXMC,"LINKED")=""
|
---|
| 73 | . . . N X S X=LEXERM D SSF^LEXNDX6
|
---|
| 74 | . . S ^LEX(757.05,"ALINK",DA,LEXMC)=""
|
---|
| 75 | K LEXSREC,LEXERM
|
---|
| 76 | Q
|
---|
| 77 | UNLINK ; Unlink a Keyword from an expression
|
---|
| 78 | Q:'$D(^LEX(757.05,DA,1,0)) N LEXMC,LEXLNK
|
---|
| 79 | S LEXMC=0 F S LEXMC=$O(^LEX(757.05,DA,1,"B",LEXMC)) Q:+LEXMC=0 D
|
---|
| 80 | . S LEXLNK=0 F S LEXLNK=$O(^LEX(757.05,DA,1,"B",LEXMC,LEXLNK)) Q:+LEXLNK=0 D
|
---|
| 81 | . . S LEXWRD=$P(^LEX(757.05,DA,0),U,1)
|
---|
| 82 | . . K ^LEX(757.01,"AWRD",LEXWRD,LEXMC,"LINKED")
|
---|
| 83 | . . N X S X=LEXWRD D KSF^LEXNDX6
|
---|
| 84 | . . K ^LEX(757.05,"ALINK",DA,LEXMC)
|
---|
| 85 | . . I $D(X),X=0 K ^LEX(757.05,DA,1,LEXLNK,0),^LEX(757.05,DA,1,"B",LEXMC,LEXLNK),^LEX(757.05,DA,1,0)
|
---|
| 86 | K LEXLNK,LEXMC
|
---|
| 87 | Q
|
---|
| 88 | SUB ; Index linked words in sub-file before UNLINK and RELINK
|
---|
| 89 | Q:'$D(DA) I $D(^LEX(757.05,DA,1,1,0)) N LEXSREC,LEXMC S LEXSREC=0 F S LEXSREC=$O(^LEX(757.05,DA,1,LEXSREC)) Q:+LEXSREC=0 S ^LEX(757.05,DA,1,"B",^LEX(757.05,DA,1,LEXSREC,0),LEXSREC)=""
|
---|
| 90 | Q
|
---|