LEXEDF1 ;ISL/KER - Edit/Display a Definition (Part 1) ;04/21/2014
;;2.0;LEXICON UTILITY;**3,25,80**;Sep 23, 1996;Build 1
;
; Global Variables
; ^TMP("LEXDEF") SACC 2.3.2.5.1
;
; External References
; YN^DICN ICR 10009
; ^DIE ICR 10018
; ^XMD ICR 10070
;
N DIC,DIE,DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT,DA,X,Y
N LEX,LEXAID,LEXC,LEXDIC0,LEXE,LEXI,LEXL,LEXLC
N LEXMC,LEXME,LEXMP,LEXS,LEXSAV,LEXST,LEXTY,LEXX
K X I $D(DUZ)#2=0 G EXIT
ASK ; Ask user to select an expression to edit the definition
N LEXAP S DIC("A")="Enter a concept to edit definition: "
S:'$D(DIC(0)) DIC(0)="QEAM" S LEXAP=1 D ^LEXA1 I X=""!(+Y'>0) G EXIT
I +Y<3,+Y>0 D G EXIT
. W !,"The definition for ",^LEX(757.01,+Y,0)," is not editable"
S LEXE=$$EXP^LEXEDF2(+Y) G:'$D(LEXE) EXIT
;
I LEXE="" D G:'$D(LEXE) ASK G:LEXE="" EXIT
. W !!,"No selection made, try again using the same concept"
AGAIN . ; Ask user to try again using the same expression
. S %=2 D YN^DICN S DIC(0)=$S(%=1:"QEM",1:"QEAM")
. S LEXE=$S(%=-1:"",%=2:"",1:%) K:LEXE=% LEXE W:%=1 ! Q:%'=0
. I '% D G AGAIN
. . W !!,"You were given various forms of an expression "
. . W "(concept, synonyms and"
. . W !,"lexical variants) to select from. "
. . W "Do you wish to try again using"
. . W !,"the same concept"
D:+($G(LEXE))>1&($D(^LEX(757.01,+($G(LEXE)),0))) EDIT(LEXE) G EXIT ; PCH 3
EDIT(LEXE) ; Edit the expression definition
W !,$E(^LEX(757.01,LEXE,0),1,78),! K ^TMP("LEXDEF",$J)
G:'$D(LEXE) EDITQ
S LEXMP=0 I $D(^LEX(757.01,LEXE,3,0)) D
. S ^TMP("LEXDEF",$J,4)="Old Definition:"
. S ^TMP("LEXDEF",$J,5)=^LEX(757.01,LEXE,3,0),(LEXMP,LEXLC)=0
. F S LEXLC=$O(^LEX(757.01,LEXE,3,LEXLC)) Q:+LEXLC=0 D
. . S LEXMP=LEXLC+5
. . S ^TMP("LEXDEF",$J,LEXMP)=^LEX(757.01,LEXE,3,LEXLC,0)
N LEXDIC0 S DA=+LEXE,DIE="^LEX(757.01,",DR="6"
S:DIC(0)'["L" DIC(0)=DIC(0)_"L" S LEXDIC0=DIC(0),DLAYGO=757
L +^LEX(757.01,LEXE):1
I '$T D G EDITQ
. W !,"This record is being edited by "
. W "another user, try again later"
S LEXSAV=0 D SNAP^LEXEDF2(+LEXE),^DIE,SHOT^LEXEDF2(+LEXE)
S LEX=$$CHANGE^LEXEDF2
I +LEX>0 S LEXSAV=$$SAVE^LEXEDF2
I 'LEXSAV,+LEX>0 D RESTORE^LEXEDF2(+LEXE)
K DLAYGO,LEXDIC0 L -^LEX(757.01,LEXE) G:+LEX=0!(+LEXSAV=0) RESULTS
I $D(^LEX(757.01,LEXE,3,0)) D
. S ^TMP("LEXDEF",$J,1)="TXT: "_^LEX(757.01,LEXE,0)
. S ^TMP("LEXDEF",$J,2)="IFN: "_LEXE,^TMP("LEXDEF",$J,3)=""
S:LEXMP=0 LEXMP=2
I $D(^LEX(757.01,LEXE,3,0)) D
. S ^TMP("LEXDEF",$J,(LEXMP+1))=""
. S ^TMP("LEXDEF",$J,LEXMP+2)="New Definition:"
. S ^TMP("LEXDEF",$J,LEXMP+3)=^LEX(757.01,LEXE,3,0)
. S LEXMP=LEXMP+4
. S LEXLC=0 F S LEXLC=$O(^LEX(757.01,LEXE,3,LEXLC)) Q:+LEXLC=0 D
. . S ^TMP("LEXDEF",$J,LEXMP)=^LEX(757.01,LEXE,3,LEXLC,0)
. . S LEXMP=LEXMP+1
D:+LEX>0&(+LEXSAV>0) SENDDEF
RESULTS ; Display results of edit
I +LEXSAV=0 D
. I +LEX W !,"Changes to the definition were not saved" Q
. W !,"No changes made"
I +LEXSAV>0 W !,$P(LEX,U,2)
EDITQ ; Quit edit
K DIC,DIE,DIR,DLAYGO,DR,LEX,LEXAID,LEXC,LEXDIC0
K LEXE,LEXI,LEXL,LEXLC,LEXMC,LEXME,LEXMP,LEXS
K LEXSAV,LEXST,LEXTY,LEXX,^TMP("LEXDEF",$J) Q
DISP(LEXX) ; Display a definition
Q:+($G(LEXX))=0 I '$D(^LEX(757.01,LEXX,3,1,0)) Q
N X S X=0 F S X=$O(^LEX(757.01,LEXX,3,X)) Q:+X=0 D
. W:X=1 !!,"Definition: ",! W !,^LEX(757.01,LEXX,3,X,0)
Q
EXIT ; Clean up and exit
K DIC,DIE,DIR,DLAYGO,DR,DA,X,Y,LEX,LEXAID,LEXC,LEXDIC0
K LEXE,LEXI,LEXL,LEXLC,LEXMC,LEXME,LEXMP,LEXS
K LEXSAV,LEXST,LEXTY,LEXX,^TMP("LEXDEF",$J) Q
SENDDEF ; Send edited definition to ISC
N DIFROM,LEXADR K XMZ Q:'$D(^TMP("LEXDEF",$J)) S LEXADR=$$ADR^LEXU Q:'$L(LEXADR)
S XMSUB=$P(LEX,U,2)_" in Expression File (#757.01)"
S XMY(("G.LEXICON@"_LEXADR))=""
S XMTEXT="^TMP(""LEXDEF"",$J,",XMDUZ=.5 D ^XMD
K ^TMP("LEXDEF",$J),XCNP,XMDUZ,XMY("G.LEXICON@ISC-SLC.DOMAIN.EXT"),XMZ
K XMSUB,XMY,XMTEXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXEDF1 3995 printed Oct 16, 2024@18:08:41 Page 2
LEXEDF1 ;ISL/KER - Edit/Display a Definition (Part 1) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**3,25,80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXDEF") SACC 2.3.2.5.1
+5 ;
+6 ; External References
+7 ; YN^DICN ICR 10009
+8 ; ^DIE ICR 10018
+9 ; ^XMD ICR 10070
+10 ;
+11 NEW DIC,DIE,DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT,DA,X,Y
+12 NEW LEX,LEXAID,LEXC,LEXDIC0,LEXE,LEXI,LEXL,LEXLC
+13 NEW LEXMC,LEXME,LEXMP,LEXS,LEXSAV,LEXST,LEXTY,LEXX
+14 KILL X
IF $DATA(DUZ)#2=0
GOTO EXIT
ASK ; Ask user to select an expression to edit the definition
+1 NEW LEXAP
SET DIC("A")="Enter a concept to edit definition: "
+2 if '$DATA(DIC(0))
SET DIC(0)="QEAM"
SET LEXAP=1
DO ^LEXA1
IF X=""!(+Y'>0)
GOTO EXIT
+3 IF +Y<3
IF +Y>0
Begin DoDot:1
+4 WRITE !,"The definition for ",^LEX(757.01,+Y,0)," is not editable"
End DoDot:1
GOTO EXIT
+5 SET LEXE=$$EXP^LEXEDF2(+Y)
if '$DATA(LEXE)
GOTO EXIT
+6 ;
+7 IF LEXE=""
Begin DoDot:1
+8 WRITE !!,"No selection made, try again using the same concept"
AGAIN ; Ask user to try again using the same expression
+1 SET %=2
DO YN^DICN
SET DIC(0)=$SELECT(%=1:"QEM",1:"QEAM")
+2 SET LEXE=$SELECT(%=-1:"",%=2:"",1:%)
if LEXE=%
KILL LEXE
if %=1
WRITE !
if %'=0
QUIT
+3 IF '%
Begin DoDot:2
+4 WRITE !!,"You were given various forms of an expression "
+5 WRITE "(concept, synonyms and"
+6 WRITE !,"lexical variants) to select from. "
+7 WRITE "Do you wish to try again using"
+8 WRITE !,"the same concept"
End DoDot:2
GOTO AGAIN
End DoDot:1
if '$DATA(LEXE)
GOTO ASK
if LEXE=""
GOTO EXIT
+9 ; PCH 3
if +($GET(LEXE))>1&($DATA(^LEX(757.01,+($GET(LEXE)),0)))
DO EDIT(LEXE)
GOTO EXIT
EDIT(LEXE) ; Edit the expression definition
+1 WRITE !,$EXTRACT(^LEX(757.01,LEXE,0),1,78),!
KILL ^TMP("LEXDEF",$JOB)
+2 if '$DATA(LEXE)
GOTO EDITQ
+3 SET LEXMP=0
IF $DATA(^LEX(757.01,LEXE,3,0))
Begin DoDot:1
+4 SET ^TMP("LEXDEF",$JOB,4)="Old Definition:"
+5 SET ^TMP("LEXDEF",$JOB,5)=^LEX(757.01,LEXE,3,0)
SET (LEXMP,LEXLC)=0
+6 FOR
SET LEXLC=$ORDER(^LEX(757.01,LEXE,3,LEXLC))
if +LEXLC=0
QUIT
Begin DoDot:2
+7 SET LEXMP=LEXLC+5
+8 SET ^TMP("LEXDEF",$JOB,LEXMP)=^LEX(757.01,LEXE,3,LEXLC,0)
End DoDot:2
End DoDot:1
+9 NEW LEXDIC0
SET DA=+LEXE
SET DIE="^LEX(757.01,"
SET DR="6"
+10 if DIC(0)'["L"
SET DIC(0)=DIC(0)_"L"
SET LEXDIC0=DIC(0)
SET DLAYGO=757
+11 LOCK +^LEX(757.01,LEXE):1
+12 IF '$TEST
Begin DoDot:1
+13 WRITE !,"This record is being edited by "
+14 WRITE "another user, try again later"
End DoDot:1
GOTO EDITQ
+15 SET LEXSAV=0
DO SNAP^LEXEDF2(+LEXE)
DO ^DIE
DO SHOT^LEXEDF2(+LEXE)
+16 SET LEX=$$CHANGE^LEXEDF2
+17 IF +LEX>0
SET LEXSAV=$$SAVE^LEXEDF2
+18 IF 'LEXSAV
IF +LEX>0
DO RESTORE^LEXEDF2(+LEXE)
+19 KILL DLAYGO,LEXDIC0
LOCK -^LEX(757.01,LEXE)
if +LEX=0!(+LEXSAV=0)
GOTO RESULTS
+20 IF $DATA(^LEX(757.01,LEXE,3,0))
Begin DoDot:1
+21 SET ^TMP("LEXDEF",$JOB,1)="TXT: "_^LEX(757.01,LEXE,0)
+22 SET ^TMP("LEXDEF",$JOB,2)="IFN: "_LEXE
SET ^TMP("LEXDEF",$JOB,3)=""
End DoDot:1
+23 if LEXMP=0
SET LEXMP=2
+24 IF $DATA(^LEX(757.01,LEXE,3,0))
Begin DoDot:1
+25 SET ^TMP("LEXDEF",$JOB,(LEXMP+1))=""
+26 SET ^TMP("LEXDEF",$JOB,LEXMP+2)="New Definition:"
+27 SET ^TMP("LEXDEF",$JOB,LEXMP+3)=^LEX(757.01,LEXE,3,0)
+28 SET LEXMP=LEXMP+4
+29 SET LEXLC=0
FOR
SET LEXLC=$ORDER(^LEX(757.01,LEXE,3,LEXLC))
if +LEXLC=0
QUIT
Begin DoDot:2
+30 SET ^TMP("LEXDEF",$JOB,LEXMP)=^LEX(757.01,LEXE,3,LEXLC,0)
+31 SET LEXMP=LEXMP+1
End DoDot:2
End DoDot:1
+32 if +LEX>0&(+LEXSAV>0)
DO SENDDEF
RESULTS ; Display results of edit
+1 IF +LEXSAV=0
Begin DoDot:1
+2 IF +LEX
WRITE !,"Changes to the definition were not saved"
QUIT
+3 WRITE !,"No changes made"
End DoDot:1
+4 IF +LEXSAV>0
WRITE !,$PIECE(LEX,U,2)
EDITQ ; Quit edit
+1 KILL DIC,DIE,DIR,DLAYGO,DR,LEX,LEXAID,LEXC,LEXDIC0
+2 KILL LEXE,LEXI,LEXL,LEXLC,LEXMC,LEXME,LEXMP,LEXS
+3 KILL LEXSAV,LEXST,LEXTY,LEXX,^TMP("LEXDEF",$JOB)
QUIT
DISP(LEXX) ; Display a definition
+1 if +($GET(LEXX))=0
QUIT
IF '$DATA(^LEX(757.01,LEXX,3,1,0))
QUIT
+2 NEW X
SET X=0
FOR
SET X=$ORDER(^LEX(757.01,LEXX,3,X))
if +X=0
QUIT
Begin DoDot:1
+3 if X=1
WRITE !!,"Definition: ",!
WRITE !,^LEX(757.01,LEXX,3,X,0)
End DoDot:1
+4 QUIT
EXIT ; Clean up and exit
+1 KILL DIC,DIE,DIR,DLAYGO,DR,DA,X,Y,LEX,LEXAID,LEXC,LEXDIC0
+2 KILL LEXE,LEXI,LEXL,LEXLC,LEXMC,LEXME,LEXMP,LEXS
+3 KILL LEXSAV,LEXST,LEXTY,LEXX,^TMP("LEXDEF",$JOB)
QUIT
SENDDEF ; Send edited definition to ISC
+1 NEW DIFROM,LEXADR
KILL XMZ
if '$DATA(^TMP("LEXDEF",$JOB))
QUIT
SET LEXADR=$$ADR^LEXU
if '$LENGTH(LEXADR)
QUIT
+2 SET XMSUB=$PIECE(LEX,U,2)_" in Expression File (#757.01)"
+3 SET XMY(("G.LEXICON@"_LEXADR))=""
+4 SET XMTEXT="^TMP(""LEXDEF"",$J,"
SET XMDUZ=.5
DO ^XMD
+5 KILL ^TMP("LEXDEF",$JOB),XCNP,XMDUZ,XMY("G.LEXICON@ISC-SLC.DOMAIN.EXT"),XMZ
+6 KILL XMSUB,XMY,XMTEXT
+7 QUIT
