- 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 Feb 18, 2025@23:34:04 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
