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 ---[H[J[2J[HLEXSC 1410 printed Nov 22, 2024@17:19:42 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
