| [613] | 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
|
|---|
