- 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 Mar 13, 2025@21:12:29 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
