| 1 | LEXEDF1 ; ISL Edit/Display a Definition (Part 1)   ; 05/14/2003 | 
|---|
| 2 | ;;2.0;LEXICON UTILITY;**3,25**;Sep 23, 1996 | 
|---|
| 3 | ; | 
|---|
| 4 | N DIC,DIE,DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT,DA,X,Y | 
|---|
| 5 | N LEX,LEXAID,LEXC,LEXDIC0,LEXE,LEXI,LEXL,LEXLC | 
|---|
| 6 | N LEXMC,LEXME,LEXMP,LEXS,LEXSAV,LEXST,LEXTY,LEXX | 
|---|
| 7 | K X I $D(DUZ)#2=0 G EXIT | 
|---|
| 8 | ASK ; Ask user to select an expression to edit the definition | 
|---|
| 9 | N LEXAP S DIC("A")="Enter a concept to edit definition:  " | 
|---|
| 10 | S:'$D(DIC(0)) DIC(0)="QEAM" S LEXAP=1 D ^LEXA1 I X=""!(+Y'>0) G EXIT | 
|---|
| 11 | I +Y<3,+Y>0 D  G EXIT | 
|---|
| 12 | . W !,"The definition for ",^LEX(757.01,+Y,0)," is not editable" | 
|---|
| 13 | S LEXE=$$EXP^LEXEDF2(+Y) G:'$D(LEXE) EXIT | 
|---|
| 14 | ; | 
|---|
| 15 | I LEXE="" D  G:'$D(LEXE) ASK G:LEXE="" EXIT | 
|---|
| 16 | . W !!,"No selection made, try again using the same concept" | 
|---|
| 17 | AGAIN . ; Ask user to try again using the same expression | 
|---|
| 18 | . S %=2 D YN^DICN S DIC(0)=$S(%=1:"QEM",1:"QEAM") | 
|---|
| 19 | . S LEXE=$S(%=-1:"",%=2:"",1:%) K:LEXE=% LEXE W:%=1 ! Q:%'=0 | 
|---|
| 20 | . I '% D  G AGAIN | 
|---|
| 21 | . . W !!,"You were given various forms of an expression " | 
|---|
| 22 | . . W "(concept, synonyms and" | 
|---|
| 23 | . . W !,"lexical variants) to select from.  " | 
|---|
| 24 | . . W "Do you wish to try again using" | 
|---|
| 25 | . . W !,"the same concept" | 
|---|
| 26 | D:+($G(LEXE))>1&($D(^LEX(757.01,+($G(LEXE)),0))) EDIT(LEXE) G EXIT  ; PCH 3 | 
|---|
| 27 | EDIT(LEXE) ; Edit the expression definition | 
|---|
| 28 | W !,$E(^LEX(757.01,LEXE,0),1,78),! K ^TMP("LEXDEF",$J) | 
|---|
| 29 | G:'$D(LEXE) EDITQ | 
|---|
| 30 | S LEXMP=0 I $D(^LEX(757.01,LEXE,3,0)) D | 
|---|
| 31 | . S ^TMP("LEXDEF",$J,4)="Old Definition:" | 
|---|
| 32 | . S ^TMP("LEXDEF",$J,5)=^LEX(757.01,LEXE,3,0),(LEXMP,LEXLC)=0 | 
|---|
| 33 | . F  S LEXLC=$O(^LEX(757.01,LEXE,3,LEXLC)) Q:+LEXLC=0  D | 
|---|
| 34 | . . S LEXMP=LEXLC+5 | 
|---|
| 35 | . . S ^TMP("LEXDEF",$J,LEXMP)=^LEX(757.01,LEXE,3,LEXLC,0) | 
|---|
| 36 | N LEXDIC0 S DA=+LEXE,DIE="^LEX(757.01,",DR="6" | 
|---|
| 37 | S:DIC(0)'["L" DIC(0)=DIC(0)_"L" S LEXDIC0=DIC(0),DLAYGO=757 | 
|---|
| 38 | L +^LEX(757.01,LEXE):1 | 
|---|
| 39 | I '$T D  G EDITQ | 
|---|
| 40 | . W !,"This record is being edited by " | 
|---|
| 41 | . W "another user, try again later" | 
|---|
| 42 | S LEXSAV=0 D SNAP^LEXEDF2(+LEXE),^DIE,SHOT^LEXEDF2(+LEXE) | 
|---|
| 43 | S LEX=$$CHANGE^LEXEDF2 | 
|---|
| 44 | I +LEX>0 S LEXSAV=$$SAVE^LEXEDF2 | 
|---|
| 45 | I 'LEXSAV,+LEX>0 D RESTORE^LEXEDF2(+LEXE) | 
|---|
| 46 | K DLAYGO,LEXDIC0 L -^LEX(757.01,LEXE) G:+LEX=0!(+LEXSAV=0) RESULTS | 
|---|
| 47 | I $D(^LEX(757.01,LEXE,3,0)) D | 
|---|
| 48 | . S ^TMP("LEXDEF",$J,1)="TXT:  "_^LEX(757.01,LEXE,0) | 
|---|
| 49 | . S ^TMP("LEXDEF",$J,2)="IFN:  "_LEXE,^TMP("LEXDEF",$J,3)="" | 
|---|
| 50 | S:LEXMP=0 LEXMP=2 | 
|---|
| 51 | I $D(^LEX(757.01,LEXE,3,0)) D | 
|---|
| 52 | . S ^TMP("LEXDEF",$J,(LEXMP+1))="" | 
|---|
| 53 | . S ^TMP("LEXDEF",$J,LEXMP+2)="New Definition:" | 
|---|
| 54 | . S ^TMP("LEXDEF",$J,LEXMP+3)=^LEX(757.01,LEXE,3,0) | 
|---|
| 55 | . S LEXMP=LEXMP+4 | 
|---|
| 56 | . S LEXLC=0 F  S LEXLC=$O(^LEX(757.01,LEXE,3,LEXLC)) Q:+LEXLC=0  D | 
|---|
| 57 | . . S ^TMP("LEXDEF",$J,LEXMP)=^LEX(757.01,LEXE,3,LEXLC,0) | 
|---|
| 58 | . . S LEXMP=LEXMP+1 | 
|---|
| 59 | D:+LEX>0&(+LEXSAV>0) SENDDEF | 
|---|
| 60 | RESULTS ; Display results of edit | 
|---|
| 61 | I +LEXSAV=0 D | 
|---|
| 62 | . I +LEX W !,"Changes to the definition were not saved" Q | 
|---|
| 63 | . W !,"No changes made" | 
|---|
| 64 | I +LEXSAV>0 W !,$P(LEX,U,2) | 
|---|
| 65 | EDITQ ; Quit edit | 
|---|
| 66 | K DIC,DIE,DIR,DLAYGO,DR,LEX,LEXAID,LEXC,LEXDIC0 | 
|---|
| 67 | K LEXE,LEXI,LEXL,LEXLC,LEXMC,LEXME,LEXMP,LEXS | 
|---|
| 68 | K LEXSAV,LEXST,LEXTY,LEXX,^TMP("LEXDEF",$J) Q | 
|---|
| 69 | DISP(LEXX) ; Display a definition | 
|---|
| 70 | Q:+($G(LEXX))=0  I '$D(^LEX(757.01,LEXX,3,1,0)) Q | 
|---|
| 71 | N X S X=0 F  S X=$O(^LEX(757.01,LEXX,3,X)) Q:+X=0  D | 
|---|
| 72 | . W:X=1 !!,"Definition:  ",! W !,^LEX(757.01,LEXX,3,X,0) | 
|---|
| 73 | Q | 
|---|
| 74 | EXIT ; Clean up and exit | 
|---|
| 75 | K DIC,DIE,DIR,DLAYGO,DR,DA,X,Y,LEX,LEXAID,LEXC,LEXDIC0 | 
|---|
| 76 | K LEXE,LEXI,LEXL,LEXLC,LEXMC,LEXME,LEXMP,LEXS | 
|---|
| 77 | K LEXSAV,LEXST,LEXTY,LEXX,^TMP("LEXDEF",$J) Q | 
|---|
| 78 | SENDDEF ; Send edited definition to ISC | 
|---|
| 79 | N DIFROM,LEXADR K XMZ Q:'$D(^TMP("LEXDEF",$J))  S LEXADR=$$ADR^LEXU Q:'$L(LEXADR) | 
|---|
| 80 | S XMSUB=$P(LEX,U,2)_" in Expression File (#757.01)" | 
|---|
| 81 | S XMY(("G.LEXICON@"_LEXADR))="" | 
|---|
| 82 | S XMTEXT="^TMP(""LEXDEF"",$J,",XMDUZ=.5 D ^XMD | 
|---|
| 83 | K ^TMP("LEXDEF",$J),XCNP,XMDUZ,XMY("G.LEXICON@ISC-SLC.VA.GOV"),XMZ | 
|---|
| 84 | K XMSUB,XMY,XMTEXT | 
|---|
| 85 | Q | 
|---|