1 | LEXSC3 ; ISL Shortcuts Add/Delete ; 09-23-96
|
---|
2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
|
---|
3 | ;
|
---|
4 | ADD ; Add a shortcut
|
---|
5 | N LEXADD,LEXERM
|
---|
6 | ADD2 F D Q:$G(LEXRP)[U!(+($G(Y))>0)
|
---|
7 | . W ! S LEXERM=$$TERM^LEXSC2 Q:LEXRP[U
|
---|
8 | . D LK(LEXERM)
|
---|
9 | I LEXRP[U,LEXRP'["^^" W ! S LEXRP="" Q
|
---|
10 | Q:LEXRP["^^" I +Y>0 D ASKADD I $G(LEXADD)>0 D ADDSC(+Y,LEXSC,LEXCX)
|
---|
11 | I LEXRP[U,LEXRP'["^^" S LEXRP="" G ADD2
|
---|
12 | Q
|
---|
13 | ASKADD ;
|
---|
14 | N LEXERM,LEXSTR S LEXERM=+Y
|
---|
15 | S LEXERM=$S(+LEXERM'>0:"",1:$G(^LEX(757.01,LEXERM,0)))
|
---|
16 | S LEXSTR="Add """_LEXSC_""" as a short cut "
|
---|
17 | S LEXSTR=LEXSTR_"(in the context of "_LEXCXN_")"
|
---|
18 | S:LEXERM'="" LEXSTR=LEXSTR_" pointing to the term """_LEXERM_""""
|
---|
19 | D WRT^LEXSC2(LEXSTR) S LEXADD=$$ADDOK^LEXSC2
|
---|
20 | Q
|
---|
21 | ADDSC(LEXEXP,LEXSC,LEXCX) ; Add shortcut
|
---|
22 | I '$D(^LEX(757.4,"B",LEXEXP)) D ADDR
|
---|
23 | I $D(^LEX(757.4,"B",LEXEXP)) D ADDS
|
---|
24 | Q
|
---|
25 | ADDS ; Add Shortcut to sub-file
|
---|
26 | N DIC,DLAYGO,X,Y,DTOUT,DUOUT
|
---|
27 | N LEXR S LEXR=$O(^LEX(757.4,"B",LEXEXP,0)) Q:'$D(^LEX(757.4,LEXR,0)) K DD,DO S DA(1)=LEXR,X=LEXSC
|
---|
28 | S DLAYGO=757.401,DIC="^LEX(757.4,"_DA(1)_",1,",DIC(0)="AEMQL",DIC("P")="757.401",DIC("DR")="1////^S X=LEXCX" D FILE^DICN
|
---|
29 | Q
|
---|
30 | ADDR ; Add record
|
---|
31 | N DIC,DLAYGO,X,Y,DTOUT,DUOUT
|
---|
32 | N LEXERM S LEXERM=$G(^LEX(757.01,LEXEXP,0))
|
---|
33 | K DD,DO S X=LEXEXP,DIC="^LEX(757.4,",DLAYGO=757.4,DIC(0)="AEMQL" D FILE^DICN
|
---|
34 | Q
|
---|
35 | LK(X) ; Set up Lookup
|
---|
36 | S X=$G(X) K DLAYGO N DIC,DIPGM,DO G:X=""!(X["^") LKQ S:$L($G(LEXDICS)) DIC("S")=LEXDICS
|
---|
37 | S XTLKKSCH("INDEX")="AWRD",(DIC,XTLKGBL,XTLKKSCH("GBL"))="^LEX(757.01,"
|
---|
38 | S LEXSHOW="ICD/CPT/DSM/NAN/OMA/NIC"
|
---|
39 | S:$L($G(^LEXT(757.2,1,2))) XTLKHLP="D "_^LEXT(757.2,1,2)
|
---|
40 | S:$L($G(^LEXT(757.2,1,3))) XTLKKSCH("DSPLY")=^LEXT(757.2,1,3)
|
---|
41 | S:'$L($G(XTLKHLP)) XTLKHLP="D XTLK^LEXHLP" S:'$L($G(XTLKKSCH("DSPLY"))) XTLKKSCH="XTLK^LEXPRNT"
|
---|
42 | S (X,XTLKX)=$$UP^XLFSTR(LEXERM),DO=@(DIC_"0)"),DIC(0)="EMQ",XTLKSAY=0
|
---|
43 | W !,"Searching ... "
|
---|
44 | D ^XTLKKWL K XTLKSAY,XTLKHLP S LEXRP=X
|
---|
45 | LKQ ;
|
---|
46 | K LEXSUB,LEXU,LEXAP,LEXUN,LEXLST,LEXLL,LEXSHOW
|
---|
47 | K XTLKX,XTLKKSCH,XTLKHLP,XTLKSAY,XTLKGBL,XTLKWD2
|
---|
48 | Q
|
---|
49 | DELS ;
|
---|
50 | N DIK,LEXC S LEXCX=+($G(LEXCX)) Q:'$L($G(LEXSC)) Q:LEXCX=0 N LEXR,LEXS
|
---|
51 | S LEXR=$O(^LEX(757.4,"ARA",$E($$UP^XLFSTR(LEXSC),1,63),LEXCX,0)) Q:+LEXR=0
|
---|
52 | S LEXS=$O(^LEX(757.4,"ARA",$E($$UP^XLFSTR(LEXSC),1,63),LEXCX,+LEXR,0)) Q:+LEXS=0
|
---|
53 | S DA(1)=+LEXR,DA=+LEXS,DIK="^LEX(757.4,"_DA(1)_",1," D ^DIK
|
---|
54 | S LEXC=$$CNT(LEXR) I LEXC'[U,+LEXC=0 D DELR(LEXR)
|
---|
55 | Q
|
---|
56 | DELR(DA) ;
|
---|
57 | S DA=+($G(DA)) Q:DA=0 Q:'$D(^LEX(757.4,DA)) N DIK S DIK="^LEX(757.4," D ^DIK
|
---|
58 | Q
|
---|
59 | CNT(X) ;
|
---|
60 | N LEXR,LEXC,LEXI S (LEXC,LEXI)=0,LEXR=+$G(X)
|
---|
61 | Q:'$L($G(^LEX(757.4,LEXR,0))) "^"
|
---|
62 | F S LEXI=$O(^LEX(757.4,LEXR,1,LEXI)) Q:+LEXI=0 D
|
---|
63 | . S LEXC=LEXC+1
|
---|
64 | S X=LEXC Q X
|
---|