| 1 | LEXSC ; ISL Shortcuts Add/Delete                 ; 09-23-96 | 
|---|
| 2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996 | 
|---|
| 3 | ; | 
|---|
| 4 | EN N LEXCX,LEXCXN,LEXDICS,LEXEDIT,LEXRP,LEXE | 
|---|
| 5 | CTX S LEXRP="",LEXEDIT=1,LEXE=$$CNT^LEXDCXS,LEXCX=$$EN^LEXDCXS | 
|---|
| 6 | S LEXCXN=$P(LEXCX,"^",2),LEXCX=+LEXCX Q:LEXCX=0 | 
|---|
| 7 | W !! W:LEXCX>0 "Edit shortcuts for:  ",$P($G(^LEX(757.41,LEXCX,0)),"^",1),! | 
|---|
| 8 | S:$L($G(^LEX(757.41,LEXCX,2))) LEXDICS=^LEX(757.41,LEXCX,2) | 
|---|
| 9 | F  D EDIT Q:LEXRP[U | 
|---|
| 10 | G:LEXRP[U&(LEXRP'["^^")&(+($G(LEXE))>1) CTX | 
|---|
| 11 | K LEXEDIT,LEXEND,LEXERM,LEXRP,LEXSC,LEXCX,LEX | 
|---|
| 12 | Q | 
|---|
| 13 | EDIT ; | 
|---|
| 14 | S LEXSC=$$SC^LEXSC2 Q:LEXRP[U  S LEXSC=$$UP^XLFSTR(LEXSC) | 
|---|
| 15 | I '$L($G(LEXSC))!('$L($G(LEXCX))) S LEXRP=U Q | 
|---|
| 16 | I $D(^LEX(757.4,"ARA",LEXSC,LEXCX)) D FND Q | 
|---|
| 17 | D ADD^LEXSC3 | 
|---|
| 18 | Q | 
|---|
| 19 | FND ; | 
|---|
| 20 | N LEXDEL,LEXERM,LEXSTR S LEXERM=$O(^LEX(757.4,"ARA",LEXSC,LEXCX,0)) | 
|---|
| 21 | S LEXERM=+LEXERM S:LEXERM>0 LEXERM=+($G(^LEX(757.4,LEXERM,0))) | 
|---|
| 22 | S LEXERM=$S(+LEXERM=0:"",1:$G(^LEX(757.01,LEXERM,0))) | 
|---|
| 23 | S LEXSTR=""""_LEXSC_""" already exist as a shortcut " | 
|---|
| 24 | S LEXSTR=LEXSTR_"(in the context of "_LEXCXN_")" | 
|---|
| 25 | S:LEXERM'="" LEXSTR=LEXSTR_" pointing to the term """_LEXERM_"""" | 
|---|
| 26 | D WRT^LEXSC2(LEXSTR) | 
|---|
| 27 | S LEXDEL=$$DELOK^LEXSC2 I +LEXDEL>0 D DELS^LEXSC3 | 
|---|
| 28 | I '$D(^LEX(757.4,"ARA",LEXSC,LEXCX)) D ADD^LEXSC3 | 
|---|
| 29 | Q | 
|---|