source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXSC.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1LEXSC ; ISL Shortcuts Add/Delete ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4EN N LEXCX,LEXCXN,LEXDICS,LEXEDIT,LEXRP,LEXE
5CTX 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
13EDIT ;
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
19FND ;
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
Note: See TracBrowser for help on using the repository browser.