| 1 | LEXSC ; ISL Shortcuts Add/Delete ; 09-23-96
|
|---|
| 2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
|
|---|
| 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
|
|---|
