| 1 | LEXEDF2 ; ISL Edit/Display a Definition (Part 2)   ; 09-23-96
 | 
|---|
| 2 |  ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | EXP(LEXX) ; Select an expression
 | 
|---|
| 5 |  N Y,LEXS,LEXC,LEXMC,LEXE,LEXI,LEXME S Y=LEXX,(LEXS,LEXC)=0
 | 
|---|
| 6 |  S LEXMC=$P($G(^LEX(757.01,+Y,1)),U,1),LEXME=$P(^LEX(757,LEXMC,0),U,1)
 | 
|---|
| 7 |  S ^TMP("LEXE",$J,0)=1,^TMP("LEXE",$J,1)=LEXME,(LEXI,LEXE)=0
 | 
|---|
| 8 |  F  S LEXI=$O(^LEX(757.01,"AMC",LEXMC,LEXI)) Q:+LEXI=0  D
 | 
|---|
| 9 |  . I +($P($G(^LEX(757.01,LEXI,1)),U,2))>1,+($P($G(^LEX(757.01,LEXI,1)),U,2))<4 D
 | 
|---|
| 10 |  . . S ^TMP("LEXE",$J,0)=^TMP("LEXE",$J,0)+1
 | 
|---|
| 11 |  . . S ^TMP("LEXE",$J,^TMP("LEXE",$J,0))=LEXI
 | 
|---|
| 12 |  W ! W $S(^TMP("LEXE",$J,0)>1:"",1:"Only "),^TMP("LEXE",$J,0)
 | 
|---|
| 13 |  W $S(^TMP("LEXE",$J,0)>1:" expressions were ",1:" expression was ")
 | 
|---|
| 14 |  W "found representing the selected concept:"
 | 
|---|
| 15 |  W:^TMP("LEXE",$J,0)=1 !
 | 
|---|
| 16 |  I $D(^TMP("LEXE",$J,0)),^TMP("LEXE",$J,0)>1 D
 | 
|---|
| 17 | MULTI . ; Multiple expression found
 | 
|---|
| 18 |  . K LEXE
 | 
|---|
| 19 |  . F LEXC=1:1:^TMP("LEXE",$J,0) Q:((LEXS>0)&(LEXS<LEXC+1))  D
 | 
|---|
| 20 |  . . W:LEXC#5=1 ! W !,$J(LEXC,4),": "
 | 
|---|
| 21 |  . . N LEXTY S LEXTY=$$TYPE(^TMP("LEXE",$J,LEXC)) W LEXTY
 | 
|---|
| 22 |  . . W $E(^LEX(757.01,^TMP("LEXE",$J,LEXC),0),1,64)
 | 
|---|
| 23 |  . . W:LEXC#5=0 ! S:LEXC#5=0 LEXS=$$SEL
 | 
|---|
| 24 |  . . I LEXS>0&(LEXS<LEXC+1) S LEXE=^TMP("LEXE",$J,LEXS) Q
 | 
|---|
| 25 |  . I LEXC#5'=0,+LEXS=0 D
 | 
|---|
| 26 |  . . W ! S LEXS=$$SEL
 | 
|---|
| 27 |  . . I LEXS>0&(LEXS<LEXC+1) S LEXE=^TMP("LEXE",$J,LEXS)
 | 
|---|
| 28 |  I $D(^TMP("LEXE",$J,0)),^TMP("LEXE",$J,0)=1 D
 | 
|---|
| 29 | ONE . ; One expression found
 | 
|---|
| 30 |  . K LEXE N LEXTY
 | 
|---|
| 31 |  . S LEXTY=$$TYPE(^TMP("LEXE",$J,1)) W LEXTY
 | 
|---|
| 32 |  . W $E(^LEX(757.01,^TMP("LEXE",$J,1),0),1,69)
 | 
|---|
| 33 |  . W !," OK" S %=1 D YN^DICN D:'% EXPHLP G:'% ONE
 | 
|---|
| 34 |  . S:%=1 LEXE=^TMP("LEXE",$J,1) S:%=-1!(%=2) LEXE="" K %,%Y
 | 
|---|
| 35 |  S:'$D(LEXE) LEXE=0 K ^TMP("LEXE",$J),LEXC,LEXS,LEXMC
 | 
|---|
| 36 |  S LEXX=LEXE Q LEXX
 | 
|---|
| 37 | SEL(X) ; Select expression
 | 
|---|
| 38 |  N Y,DTOUT,DUOUT,DIRUT,DIROUT S DIR("A")="Select 1-"_LEXC_":  "
 | 
|---|
| 39 |  S DIR("?")="Answer must be from 1 to "_LEXC_", or <Return> to continue"
 | 
|---|
| 40 |  S DIR("??")="^D EXPHLP^LEXEDF2"
 | 
|---|
| 41 |  S DIR(0)="NAO^1:"_LEXC_":0" D ^DIR S:$D(DTOUT)!(X[U) X=U K DIR Q X
 | 
|---|
| 42 | EXPHLP ; Selection help
 | 
|---|
| 43 |  W !!,"There are several types of expressions "
 | 
|---|
| 44 |  W "which can represent a concept:"
 | 
|---|
| 45 |  W !!,"    Major Concept"
 | 
|---|
| 46 |  W !,"    Synonym of the Concept"
 | 
|---|
| 47 |  W !,"    Lexical Variant of the Concept"
 | 
|---|
| 48 |  W !,"    Lexical Variant of a Synonym of the Concept"
 | 
|---|
| 49 |  I $D(^TMP("LEXE",$J,0)),^TMP("LEXE",$J,0)>1 D
 | 
|---|
| 50 |  . W !!,"You may edit any of these forms of expressions.",!
 | 
|---|
| 51 |  . N LEXST,LEXI S:LEXC#5<1 LEXST=1
 | 
|---|
| 52 |  . S:LEXC#5>0 LEXST=(((LEXC\5)*5)+1)
 | 
|---|
| 53 |  . F LEXI=LEXST:1:LEXC D
 | 
|---|
| 54 |  . . W !,$J(LEXI,4),": "
 | 
|---|
| 55 |  . . N LEXTY S LEXTY=$$TYPE(^TMP("LEXE",$J,LEXI)) W LEXTY
 | 
|---|
| 56 |  . . W $E(^LEX(757.01,^TMP("LEXE",$J,LEXI),0),1,64)
 | 
|---|
| 57 |  I $D(^TMP("LEXE",$J,0)),^TMP("LEXE",$J,0)=1 D
 | 
|---|
| 58 |  . W !!,"In this case, there are no Synonyms or "
 | 
|---|
| 59 |  . W "Lexical Variants to select from,"
 | 
|---|
| 60 |  . W !,"you can only edit the Concept",!
 | 
|---|
| 61 |  Q
 | 
|---|
| 62 | TYPE(LEXX) ; Expression type
 | 
|---|
| 63 |  S LEXX=$P(^LEX(757.01,LEXX,1),U,2)
 | 
|---|
| 64 |  S:LEXX=1 LEXX="Concept  - " S:LEXX=2 LEXX="Synonym  - " S:LEXX=3 LEXX="Variant  - "
 | 
|---|
| 65 |  S:LEXX=991 LEXX="Related  - " S:LEXX=992 LEXX="Modified - " S:LEXX'["-" LEXX="Other    - "
 | 
|---|
| 66 |  Q LEXX
 | 
|---|
| 67 | SNAP(LEXX) ; Picture of definition before edit
 | 
|---|
| 68 |  Q:+($G(LEXX))'>2  S LEXX=+LEXX
 | 
|---|
| 69 |  S:'$D(LEXAID) LEXAID="SNAP" K LEX(LEXAID)
 | 
|---|
| 70 |  I '$D(^LEX(757.01,LEXX,3,0)) K LEXAID Q
 | 
|---|
| 71 |  N LEXC,LEXL S (LEXC,LEXL)=0
 | 
|---|
| 72 |  S:$D(^LEX(757.01,LEXX,3,0)) LEX(LEXAID)=^LEX(757.01,LEXX,3,0)
 | 
|---|
| 73 |  F  S LEXC=$O(^LEX(757.01,LEXX,3,LEXC)) Q:+LEXC=0  D
 | 
|---|
| 74 |  . S LEXL=LEXL+1,LEX(LEXAID,LEXL)=^LEX(757.01,LEXX,3,LEXC,0)
 | 
|---|
| 75 |  S:+LEXL>0 LEX(LEXAID,0)=LEXL K LEXAID
 | 
|---|
| 76 |  Q
 | 
|---|
| 77 | SHOT(LEXX) ; Picture of definition after edit
 | 
|---|
| 78 |  S LEXAID="SHOT" D SNAP(LEXX) K LEXAID Q
 | 
|---|
| 79 | CHANGE(LEXX) ; Detect change in definition before/after edit
 | 
|---|
| 80 |  S LEXX=""
 | 
|---|
| 81 |  I '$D(LEX("SNAP")),'$D(LEX("SHOT")) Q "0^Definition not Change"
 | 
|---|
| 82 |  I '$D(LEX("SNAP")),$D(LEX("SHOT")) Q "1^Definition Added"
 | 
|---|
| 83 |  I $D(LEX("SNAP")),'$D(LEX("SHOT")) Q "1^Definition Deleted"
 | 
|---|
| 84 |  I LEX("SNAP",0)'=LEX("SHOT",0) Q "1^Definition Changed"
 | 
|---|
| 85 |  N LEXC F LEXC=1:1:LEX("SNAP",0) Q:+LEXC=0!($L($G(LEXX),"^")>1)  D
 | 
|---|
| 86 |  . I LEX("SNAP",LEXC)'=LEX("SHOT",LEXC) D
 | 
|---|
| 87 |  . . S LEXX="1^Definition Changed"
 | 
|---|
| 88 |  I $L($G(LEXX),"^")'>1 S LEXX="0^Definition not Changed"
 | 
|---|
| 89 |  Q LEXX
 | 
|---|
| 90 | RESTORE(LEXX) ; Restore original definition
 | 
|---|
| 91 |  I '$D(LEX("SNAP")) K ^LEX(757.01,LEXX,3) Q
 | 
|---|
| 92 |  N LEXC S LEXC=0 K ^LEX(757.01,LEXX,3)
 | 
|---|
| 93 |  S ^LEX(757.01,LEXX,3,0)=LEX("SNAP")
 | 
|---|
| 94 |  F  S LEXC=$O(LEX("SNAP",LEXC)) Q:+LEXC=0  D
 | 
|---|
| 95 |  . S ^LEX(757.01,LEXX,3,LEXC,0)=LEX("SNAP",LEXC)
 | 
|---|
| 96 |  Q
 | 
|---|
| 97 | SAVE(LEXX) ; Save the edit
 | 
|---|
| 98 |  N DTOUT,DUOUT,DIR S DIR(0)="Y^AO"
 | 
|---|
| 99 |  S DIR("?",1)="By answering ""Yes"" the proposed changes you have made to"
 | 
|---|
| 100 |  S DIR("?")="the definition during this edit session will be stored."
 | 
|---|
| 101 |  S DIR("A")="Make changes permanent",DIR("B")="YES"
 | 
|---|
| 102 |  D ^DIR K DIR S LEXX=+Y S:$D(DTOUT)!($D(DUOUT)) LEXX=0 Q LEXX
 | 
|---|