LEXEDF2 ;ISL/KER - Edit/Display a Definition (Part 2) ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Global Variables
; ^TMP("LEXE") SACC 2.3.2.5.1
;
; External References
; YN^DICN ICR 10009
; ^DIR ICR 10026
;
EXP(LEXX) ; Select an expression
N Y,LEXS,LEXC,LEXMC,LEXE,LEXI,LEXME S Y=LEXX,(LEXS,LEXC)=0
S LEXMC=$P($G(^LEX(757.01,+Y,1)),U,1),LEXME=$P(^LEX(757,LEXMC,0),U,1)
S ^TMP("LEXE",$J,0)=1,^TMP("LEXE",$J,1)=LEXME,(LEXI,LEXE)=0
F S LEXI=$O(^LEX(757.01,"AMC",LEXMC,LEXI)) Q:+LEXI=0 D
. I +($P($G(^LEX(757.01,LEXI,1)),U,2))>1,+($P($G(^LEX(757.01,LEXI,1)),U,2))<4 D
. . S ^TMP("LEXE",$J,0)=^TMP("LEXE",$J,0)+1
. . S ^TMP("LEXE",$J,^TMP("LEXE",$J,0))=LEXI
W ! W $S(^TMP("LEXE",$J,0)>1:"",1:"Only "),^TMP("LEXE",$J,0)
W $S(^TMP("LEXE",$J,0)>1:" expressions were ",1:" expression was ")
W "found representing the selected concept:"
W:^TMP("LEXE",$J,0)=1 !
I $D(^TMP("LEXE",$J,0)),^TMP("LEXE",$J,0)>1 D
MULTI . ; Multiple expression found
. K LEXE
. F LEXC=1:1:^TMP("LEXE",$J,0) Q:((LEXS>0)&(LEXS<LEXC+1)) D
. . W:LEXC#5=1 ! W !,$J(LEXC,4),": "
. . N LEXTY S LEXTY=$$TYPE(^TMP("LEXE",$J,LEXC)) W LEXTY
. . W $E(^LEX(757.01,^TMP("LEXE",$J,LEXC),0),1,64)
. . W:LEXC#5=0 ! S:LEXC#5=0 LEXS=$$SEL
. . I LEXS>0&(LEXS<LEXC+1) S LEXE=^TMP("LEXE",$J,LEXS) Q
. I LEXC#5'=0,+LEXS=0 D
. . W ! S LEXS=$$SEL
. . I LEXS>0&(LEXS<LEXC+1) S LEXE=^TMP("LEXE",$J,LEXS)
I $D(^TMP("LEXE",$J,0)),^TMP("LEXE",$J,0)=1 D
ONE . ; One expression found
. K LEXE N LEXTY
. S LEXTY=$$TYPE(^TMP("LEXE",$J,1)) W LEXTY
. W $E(^LEX(757.01,^TMP("LEXE",$J,1),0),1,69)
. W !," OK" S %=1 D YN^DICN D:'% EXPHLP G:'% ONE
. S:%=1 LEXE=^TMP("LEXE",$J,1) S:%=-1!(%=2) LEXE="" K %,%Y
S:'$D(LEXE) LEXE=0 K ^TMP("LEXE",$J),LEXC,LEXS,LEXMC
S LEXX=LEXE Q LEXX
SEL(X) ; Select expression
N Y,DTOUT,DUOUT,DIRUT,DIROUT S DIR("A")="Select 1-"_LEXC_": "
S DIR("?")="Answer must be from 1 to "_LEXC_", or <Return> to continue"
S DIR("??")="^D EXPHLP^LEXEDF2"
S DIR(0)="NAO^1:"_LEXC_":0" D ^DIR S:$D(DTOUT)!(X[U) X=U K DIR Q X
EXPHLP ; Selection help
W !!,"There are several types of expressions "
W "which can represent a concept:"
W !!," Major Concept"
W !," Synonym of the Concept"
W !," Lexical Variant of the Concept"
W !," Lexical Variant of a Synonym of the Concept"
I $D(^TMP("LEXE",$J,0)),^TMP("LEXE",$J,0)>1 D
. W !!,"You may edit any of these forms of expressions.",!
. N LEXST,LEXI S:LEXC#5<1 LEXST=1
. S:LEXC#5>0 LEXST=(((LEXC\5)*5)+1)
. F LEXI=LEXST:1:LEXC D
. . W !,$J(LEXI,4),": "
. . N LEXTY S LEXTY=$$TYPE(^TMP("LEXE",$J,LEXI)) W LEXTY
. . W $E(^LEX(757.01,^TMP("LEXE",$J,LEXI),0),1,64)
I $D(^TMP("LEXE",$J,0)),^TMP("LEXE",$J,0)=1 D
. W !!,"In this case, there are no Synonyms or "
. W "Lexical Variants to select from,"
. W !,"you can only edit the Concept",!
Q
TYPE(LEXX) ; Expression type
S LEXX=$P(^LEX(757.01,LEXX,1),U,2)
S:LEXX=1 LEXX="Concept - " S:LEXX=2 LEXX="Synonym - " S:LEXX=3 LEXX="Variant - "
S:LEXX=991 LEXX="Related - " S:LEXX=992 LEXX="Modified - " S:LEXX'["-" LEXX="Other - "
Q LEXX
SNAP(LEXX) ; Picture of definition before edit
Q:+($G(LEXX))'>2 S LEXX=+LEXX
S:'$D(LEXAID) LEXAID="SNAP" K LEX(LEXAID)
I '$D(^LEX(757.01,LEXX,3,0)) K LEXAID Q
N LEXC,LEXL S (LEXC,LEXL)=0
S:$D(^LEX(757.01,LEXX,3,0)) LEX(LEXAID)=^LEX(757.01,LEXX,3,0)
F S LEXC=$O(^LEX(757.01,LEXX,3,LEXC)) Q:+LEXC=0 D
. S LEXL=LEXL+1,LEX(LEXAID,LEXL)=^LEX(757.01,LEXX,3,LEXC,0)
S:+LEXL>0 LEX(LEXAID,0)=LEXL K LEXAID
Q
SHOT(LEXX) ; Picture of definition after edit
S LEXAID="SHOT" D SNAP(LEXX) K LEXAID Q
CHANGE(LEXX) ; Detect change in definition before/after edit
S LEXX=""
I '$D(LEX("SNAP")),'$D(LEX("SHOT")) Q "0^Definition not Change"
I '$D(LEX("SNAP")),$D(LEX("SHOT")) Q "1^Definition Added"
I $D(LEX("SNAP")),'$D(LEX("SHOT")) Q "1^Definition Deleted"
I LEX("SNAP",0)'=LEX("SHOT",0) Q "1^Definition Changed"
N LEXC F LEXC=1:1:LEX("SNAP",0) Q:+LEXC=0!($L($G(LEXX),"^")>1) D
. I LEX("SNAP",LEXC)'=LEX("SHOT",LEXC) D
. . S LEXX="1^Definition Changed"
I $L($G(LEXX),"^")'>1 S LEXX="0^Definition not Changed"
Q LEXX
RESTORE(LEXX) ; Restore original definition
I '$D(LEX("SNAP")) K ^LEX(757.01,LEXX,3) Q
N LEXC S LEXC=0 K ^LEX(757.01,LEXX,3)
S ^LEX(757.01,LEXX,3,0)=LEX("SNAP")
F S LEXC=$O(LEX("SNAP",LEXC)) Q:+LEXC=0 D
. S ^LEX(757.01,LEXX,3,LEXC,0)=LEX("SNAP",LEXC)
Q
SAVE(LEXX) ; Save the edit
N DTOUT,DUOUT,DIR S DIR(0)="Y^AO"
S DIR("?",1)="By answering ""Yes"" the proposed changes you have made to"
S DIR("?")="the definition during this edit session will be stored."
S DIR("A")="Make changes permanent",DIR("B")="YES"
D ^DIR K DIR S LEXX=+Y S:$D(DTOUT)!($D(DUOUT)) LEXX=0 Q LEXX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXEDF2 4872 printed Apr 09, 2024@21:10:49 Page 2
LEXEDF2 ;ISL/KER - Edit/Display a Definition (Part 2) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXE") SACC 2.3.2.5.1
+5 ;
+6 ; External References
+7 ; YN^DICN ICR 10009
+8 ; ^DIR ICR 10026
+9 ;
EXP(LEXX) ; Select an expression
+1 NEW Y,LEXS,LEXC,LEXMC,LEXE,LEXI,LEXME
SET Y=LEXX
SET (LEXS,LEXC)=0
+2 SET LEXMC=$PIECE($GET(^LEX(757.01,+Y,1)),U,1)
SET LEXME=$PIECE(^LEX(757,LEXMC,0),U,1)
+3 SET ^TMP("LEXE",$JOB,0)=1
SET ^TMP("LEXE",$JOB,1)=LEXME
SET (LEXI,LEXE)=0
+4 FOR
SET LEXI=$ORDER(^LEX(757.01,"AMC",LEXMC,LEXI))
if +LEXI=0
QUIT
Begin DoDot:1
+5 IF +($PIECE($GET(^LEX(757.01,LEXI,1)),U,2))>1
IF +($PIECE($GET(^LEX(757.01,LEXI,1)),U,2))<4
Begin DoDot:2
+6 SET ^TMP("LEXE",$JOB,0)=^TMP("LEXE",$JOB,0)+1
+7 SET ^TMP("LEXE",$JOB,^TMP("LEXE",$JOB,0))=LEXI
End DoDot:2
End DoDot:1
+8 WRITE !
WRITE $SELECT(^TMP("LEXE",$JOB,0)>1:"",1:"Only "),^TMP("LEXE",$JOB,0)
+9 WRITE $SELECT(^TMP("LEXE",$JOB,0)>1:" expressions were ",1:" expression was ")
+10 WRITE "found representing the selected concept:"
+11 if ^TMP("LEXE",$JOB,0)=1
WRITE !
+12 IF $DATA(^TMP("LEXE",$JOB,0))
IF ^TMP("LEXE",$JOB,0)>1
Begin DoDot:1
MULTI ; Multiple expression found
+1 KILL LEXE
+2 FOR LEXC=1:1:^TMP("LEXE",$JOB,0)
if ((LEXS>0)&(LEXS<LEXC+1))
QUIT
Begin DoDot:2
+3 if LEXC#5=1
WRITE !
WRITE !,$JUSTIFY(LEXC,4),": "
+4 NEW LEXTY
SET LEXTY=$$TYPE(^TMP("LEXE",$JOB,LEXC))
WRITE LEXTY
+5 WRITE $EXTRACT(^LEX(757.01,^TMP("LEXE",$JOB,LEXC),0),1,64)
+6 if LEXC#5=0
WRITE !
if LEXC#5=0
SET LEXS=$$SEL
+7 IF LEXS>0&(LEXS<LEXC+1)
SET LEXE=^TMP("LEXE",$JOB,LEXS)
QUIT
End DoDot:2
+8 IF LEXC#5'=0
IF +LEXS=0
Begin DoDot:2
+9 WRITE !
SET LEXS=$$SEL
+10 IF LEXS>0&(LEXS<LEXC+1)
SET LEXE=^TMP("LEXE",$JOB,LEXS)
End DoDot:2
End DoDot:1
+11 IF $DATA(^TMP("LEXE",$JOB,0))
IF ^TMP("LEXE",$JOB,0)=1
Begin DoDot:1
ONE ; One expression found
+1 KILL LEXE
NEW LEXTY
+2 SET LEXTY=$$TYPE(^TMP("LEXE",$JOB,1))
WRITE LEXTY
+3 WRITE $EXTRACT(^LEX(757.01,^TMP("LEXE",$JOB,1),0),1,69)
+4 WRITE !," OK"
SET %=1
DO YN^DICN
if '%
DO EXPHLP
if '%
GOTO ONE
+5 if %=1
SET LEXE=^TMP("LEXE",$JOB,1)
if %=-1!(%=2)
SET LEXE=""
KILL %,%Y
End DoDot:1
+6 if '$DATA(LEXE)
SET LEXE=0
KILL ^TMP("LEXE",$JOB),LEXC,LEXS,LEXMC
+7 SET LEXX=LEXE
QUIT LEXX
SEL(X) ; Select expression
+1 NEW Y,DTOUT,DUOUT,DIRUT,DIROUT
SET DIR("A")="Select 1-"_LEXC_": "
+2 SET DIR("?")="Answer must be from 1 to "_LEXC_", or <Return> to continue"
+3 SET DIR("??")="^D EXPHLP^LEXEDF2"
+4 SET DIR(0)="NAO^1:"_LEXC_":0"
DO ^DIR
if $DATA(DTOUT)!(X[U)
SET X=U
KILL DIR
QUIT X
EXPHLP ; Selection help
+1 WRITE !!,"There are several types of expressions "
+2 WRITE "which can represent a concept:"
+3 WRITE !!," Major Concept"
+4 WRITE !," Synonym of the Concept"
+5 WRITE !," Lexical Variant of the Concept"
+6 WRITE !," Lexical Variant of a Synonym of the Concept"
+7 IF $DATA(^TMP("LEXE",$JOB,0))
IF ^TMP("LEXE",$JOB,0)>1
Begin DoDot:1
+8 WRITE !!,"You may edit any of these forms of expressions.",!
+9 NEW LEXST,LEXI
if LEXC#5<1
SET LEXST=1
+10 if LEXC#5>0
SET LEXST=(((LEXC\5)*5)+1)
+11 FOR LEXI=LEXST:1:LEXC
Begin DoDot:2
+12 WRITE !,$JUSTIFY(LEXI,4),": "
+13 NEW LEXTY
SET LEXTY=$$TYPE(^TMP("LEXE",$JOB,LEXI))
WRITE LEXTY
+14 WRITE $EXTRACT(^LEX(757.01,^TMP("LEXE",$JOB,LEXI),0),1,64)
End DoDot:2
End DoDot:1
+15 IF $DATA(^TMP("LEXE",$JOB,0))
IF ^TMP("LEXE",$JOB,0)=1
Begin DoDot:1
+16 WRITE !!,"In this case, there are no Synonyms or "
+17 WRITE "Lexical Variants to select from,"
+18 WRITE !,"you can only edit the Concept",!
End DoDot:1
+19 QUIT
TYPE(LEXX) ; Expression type
+1 SET LEXX=$PIECE(^LEX(757.01,LEXX,1),U,2)
+2 if LEXX=1
SET LEXX="Concept - "
if LEXX=2
SET LEXX="Synonym - "
if LEXX=3
SET LEXX="Variant - "
+3 if LEXX=991
SET LEXX="Related - "
if LEXX=992
SET LEXX="Modified - "
if LEXX'["-"
SET LEXX="Other - "
+4 QUIT LEXX
SNAP(LEXX) ; Picture of definition before edit
+1 if +($GET(LEXX))'>2
QUIT
SET LEXX=+LEXX
+2 if '$DATA(LEXAID)
SET LEXAID="SNAP"
KILL LEX(LEXAID)
+3 IF '$DATA(^LEX(757.01,LEXX,3,0))
KILL LEXAID
QUIT
+4 NEW LEXC,LEXL
SET (LEXC,LEXL)=0
+5 if $DATA(^LEX(757.01,LEXX,3,0))
SET LEX(LEXAID)=^LEX(757.01,LEXX,3,0)
+6 FOR
SET LEXC=$ORDER(^LEX(757.01,LEXX,3,LEXC))
if +LEXC=0
QUIT
Begin DoDot:1
+7 SET LEXL=LEXL+1
SET LEX(LEXAID,LEXL)=^LEX(757.01,LEXX,3,LEXC,0)
End DoDot:1
+8 if +LEXL>0
SET LEX(LEXAID,0)=LEXL
KILL LEXAID
+9 QUIT
SHOT(LEXX) ; Picture of definition after edit
+1 SET LEXAID="SHOT"
DO SNAP(LEXX)
KILL LEXAID
QUIT
CHANGE(LEXX) ; Detect change in definition before/after edit
+1 SET LEXX=""
+2 IF '$DATA(LEX("SNAP"))
IF '$DATA(LEX("SHOT"))
QUIT "0^Definition not Change"
+3 IF '$DATA(LEX("SNAP"))
IF $DATA(LEX("SHOT"))
QUIT "1^Definition Added"
+4 IF $DATA(LEX("SNAP"))
IF '$DATA(LEX("SHOT"))
QUIT "1^Definition Deleted"
+5 IF LEX("SNAP",0)'=LEX("SHOT",0)
QUIT "1^Definition Changed"
+6 NEW LEXC
FOR LEXC=1:1:LEX("SNAP",0)
if +LEXC=0!($LENGTH($GET(LEXX),"^")>1)
QUIT
Begin DoDot:1
+7 IF LEX("SNAP",LEXC)'=LEX("SHOT",LEXC)
Begin DoDot:2
+8 SET LEXX="1^Definition Changed"
End DoDot:2
End DoDot:1
+9 IF $LENGTH($GET(LEXX),"^")'>1
SET LEXX="0^Definition not Changed"
+10 QUIT LEXX
RESTORE(LEXX) ; Restore original definition
+1 IF '$DATA(LEX("SNAP"))
KILL ^LEX(757.01,LEXX,3)
QUIT
+2 NEW LEXC
SET LEXC=0
KILL ^LEX(757.01,LEXX,3)
+3 SET ^LEX(757.01,LEXX,3,0)=LEX("SNAP")
+4 FOR
SET LEXC=$ORDER(LEX("SNAP",LEXC))
if +LEXC=0
QUIT
Begin DoDot:1
+5 SET ^LEX(757.01,LEXX,3,LEXC,0)=LEX("SNAP",LEXC)
End DoDot:1
+6 QUIT
SAVE(LEXX) ; Save the edit
+1 NEW DTOUT,DUOUT,DIR
SET DIR(0)="Y^AO"
+2 SET DIR("?",1)="By answering ""Yes"" the proposed changes you have made to"
+3 SET DIR("?")="the definition during this edit session will be stored."
+4 SET DIR("A")="Make changes permanent"
SET DIR("B")="YES"
+5 DO ^DIR
KILL DIR
SET LEXX=+Y
if $DATA(DTOUT)!($DATA(DUOUT))
SET LEXX=0
QUIT LEXX
