LEXSC.m

LEXSC ;ISL/KER - Shortcuts Add/Delete ;04/21/2014

 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1

 ;               

 ; Global Variables

 ;    ^LEX(757.4)         N/A

 ;    ^LEX(757.41)        N/A

 ;               

 ; External References

 ;    $$UP^XLFSTR         ICR  10103

 ;               

EN N LEXCX,LEXCXN,LEXDICS,LEXEDIT,LEXRP,LEXE

CTX S LEXRP="",LEXEDIT=1,LEXE=$$CNT^LEXDCXS,LEXCX=$$EN^LEXDCXS

 S LEXCXN=$P(LEXCX,"^",2),LEXCX=+LEXCX Q:LEXCX=0

 W !! W:LEXCX>0 "Edit shortcuts for:  ",$P($G(^LEX(757.41,LEXCX,0)),"^",1),!

 S:$L($G(^LEX(757.41,LEXCX,2))) LEXDICS=^LEX(757.41,LEXCX,2)

 F  D EDIT Q:LEXRP[U

 G:LEXRP[U&(LEXRP'["^^")&(+($G(LEXE))>1) CTX

 K LEXEDIT,LEXEND,LEXERM,LEXRP,LEXSC,LEXCX,LEX

 Q

EDIT ;

 S LEXSC=$$SC^LEXSC2 Q:LEXRP[U  S LEXSC=$$UP^XLFSTR(LEXSC)

 I '$L($G(LEXSC))!('$L($G(LEXCX))) S LEXRP=U Q

 I $D(^LEX(757.4,"ARA",LEXSC,LEXCX)) D FND Q

 D ADD^LEXSC3

 Q

FND ;

 N LEXDEL,LEXERM,LEXSTR S LEXERM=$O(^LEX(757.4,"ARA",LEXSC,LEXCX,0))

 S LEXERM=+LEXERM S:LEXERM>0 LEXERM=+($G(^LEX(757.4,LEXERM,0)))

 S LEXERM=$S(+LEXERM=0:"",1:$G(^LEX(757.01,LEXERM,0)))

 S LEXSTR=""""_LEXSC_""" already exist as a shortcut "

 S LEXSTR=LEXSTR_"(in the context of "_LEXCXN_")"

 S:LEXERM'="" LEXSTR=LEXSTR_" pointing to the term """_LEXERM_""""

 D WRT^LEXSC2(LEXSTR)

 S LEXDEL=$$DELOK^LEXSC2 I +LEXDEL>0 D DELS^LEXSC3

 I '$D(^LEX(757.4,"ARA",LEXSC,LEXCX)) D ADD^LEXSC3

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LEXSC   1410     printed  Apr 09, 2024@21:12:44                                                                                                                                                                                                       Page 2

LEXSC     ;ISL/KER - Shortcuts Add/Delete ;04/21/2014

 +1       ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1

 +2       ;               

 +3       ; Global Variables

 +4       ;    ^LEX(757.4)         N/A

 +5       ;    ^LEX(757.41)        N/A

 +6       ;               

 +7       ; External References

 +8       ;    $$UP^XLFSTR         ICR  10103

 +9       ;               

EN         NEW LEXCX,LEXCXN,LEXDICS,LEXEDIT,LEXRP,LEXE

CTX        SET LEXRP=""

           SET LEXEDIT=1

           SET LEXE=$$CNT^LEXDCXS

           SET LEXCX=$$EN^LEXDCXS

 +1        SET LEXCXN=$PIECE(LEXCX,"^",2)

           SET LEXCX=+LEXCX

           if LEXCX=0

               QUIT 

 +2        WRITE !!

           if LEXCX>0

               WRITE "Edit shortcuts for:  ",$PIECE($GET(^LEX(757.41,LEXCX,0)),"^",1),!

 +3        if $LENGTH($GET(^LEX(757.41,LEXCX,2)))

               SET LEXDICS=^LEX(757.41,LEXCX,2)

 +4        FOR 

               DO EDIT

               if LEXRP[U

                   QUIT 

 +5        if LEXRP[U&(LEXRP'["^^")&(+($GET(LEXE))>1)

               GOTO CTX

 +6        KILL LEXEDIT,LEXEND,LEXERM,LEXRP,LEXSC,LEXCX,LEX

 +7        QUIT 

EDIT      ;

 +1        SET LEXSC=$$SC^LEXSC2

           if LEXRP[U

               QUIT 

           SET LEXSC=$$UP^XLFSTR(LEXSC)

 +2        IF '$LENGTH($GET(LEXSC))!('$LENGTH($GET(LEXCX)))

               SET LEXRP=U

               QUIT 

 +3        IF $DATA(^LEX(757.4,"ARA",LEXSC,LEXCX))

               DO FND

               QUIT 

 +4        DO ADD^LEXSC3

 +5        QUIT 

FND       ;

 +1        NEW LEXDEL,LEXERM,LEXSTR

           SET LEXERM=$ORDER(^LEX(757.4,"ARA",LEXSC,LEXCX,0))

 +2        SET LEXERM=+LEXERM

           if LEXERM>0

               SET LEXERM=+($GET(^LEX(757.4,LEXERM,0)))

 +3        SET LEXERM=$SELECT(+LEXERM=0:"",1:$GET(^LEX(757.01,LEXERM,0)))

 +4        SET LEXSTR=""""_LEXSC_""" already exist as a shortcut "

 +5        SET LEXSTR=LEXSTR_"(in the context of "_LEXCXN_")"

 +6        if LEXERM'=""

               SET LEXSTR=LEXSTR_" pointing to the term """_LEXERM_""""

 +7        DO WRT^LEXSC2(LEXSTR)

 +8        SET LEXDEL=$$DELOK^LEXSC2

           IF +LEXDEL>0

               DO DELS^LEXSC3

 +9        IF '$DATA(^LEX(757.4,"ARA",LEXSC,LEXCX))

               DO ADD^LEXSC3

 +10       QUIT