LEXSC3 ; ISL Shortcuts Add/Delete                 ; 09-23-96
 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
 ;
ADD ; Add a shortcut
 N LEXADD,LEXERM
ADD2 F  D  Q:$G(LEXRP)[U!(+($G(Y))>0)
 . W ! S LEXERM=$$TERM^LEXSC2 Q:LEXRP[U
 . D LK(LEXERM)
 I LEXRP[U,LEXRP'["^^" W ! S LEXRP="" Q
 Q:LEXRP["^^"  I +Y>0 D ASKADD I $G(LEXADD)>0 D ADDSC(+Y,LEXSC,LEXCX)
 I LEXRP[U,LEXRP'["^^" S LEXRP="" G ADD2
 Q
ASKADD ;
 N LEXERM,LEXSTR S LEXERM=+Y
 S LEXERM=$S(+LEXERM'>0:"",1:$G(^LEX(757.01,LEXERM,0)))
 S LEXSTR="Add """_LEXSC_""" as a short cut "
 S LEXSTR=LEXSTR_"(in the context of "_LEXCXN_")"
 S:LEXERM'="" LEXSTR=LEXSTR_" pointing to the term """_LEXERM_""""
 D WRT^LEXSC2(LEXSTR) S LEXADD=$$ADDOK^LEXSC2
 Q
ADDSC(LEXEXP,LEXSC,LEXCX) ; Add shortcut
 I '$D(^LEX(757.4,"B",LEXEXP)) D ADDR
 I $D(^LEX(757.4,"B",LEXEXP)) D ADDS
 Q
ADDS ; Add Shortcut to sub-file
 N DIC,DLAYGO,X,Y,DTOUT,DUOUT
 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
 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
 Q
ADDR ; Add record
 N DIC,DLAYGO,X,Y,DTOUT,DUOUT
 N LEXERM S LEXERM=$G(^LEX(757.01,LEXEXP,0))
 K DD,DO S X=LEXEXP,DIC="^LEX(757.4,",DLAYGO=757.4,DIC(0)="AEMQL" D FILE^DICN
 Q
LK(X) ; Set up Lookup
 S X=$G(X) K DLAYGO N DIC,DIPGM,DO G:X=""!(X["^") LKQ S:$L($G(LEXDICS)) DIC("S")=LEXDICS
 S XTLKKSCH("INDEX")="AWRD",(DIC,XTLKGBL,XTLKKSCH("GBL"))="^LEX(757.01,"
 S LEXSHOW="ICD/CPT/DSM/NAN/OMA/NIC"
 S:$L($G(^LEXT(757.2,1,2))) XTLKHLP="D "_^LEXT(757.2,1,2)
 S:$L($G(^LEXT(757.2,1,3))) XTLKKSCH("DSPLY")=^LEXT(757.2,1,3)
 S:'$L($G(XTLKHLP)) XTLKHLP="D XTLK^LEXHLP" S:'$L($G(XTLKKSCH("DSPLY"))) XTLKKSCH="XTLK^LEXPRNT"
 S (X,XTLKX)=$$UP^XLFSTR(LEXERM),DO=@(DIC_"0)"),DIC(0)="EMQ",XTLKSAY=0
 W !,"Searching ...  "
 D ^XTLKKWL K XTLKSAY,XTLKHLP S LEXRP=X
LKQ ;
 K LEXSUB,LEXU,LEXAP,LEXUN,LEXLST,LEXLL,LEXSHOW
 K XTLKX,XTLKKSCH,XTLKHLP,XTLKSAY,XTLKGBL,XTLKWD2
 Q
DELS ;
 N DIK,LEXC S LEXCX=+($G(LEXCX)) Q:'$L($G(LEXSC))  Q:LEXCX=0  N LEXR,LEXS
 S LEXR=$O(^LEX(757.4,"ARA",$E($$UP^XLFSTR(LEXSC),1,63),LEXCX,0)) Q:+LEXR=0
 S LEXS=$O(^LEX(757.4,"ARA",$E($$UP^XLFSTR(LEXSC),1,63),LEXCX,+LEXR,0)) Q:+LEXS=0
 S DA(1)=+LEXR,DA=+LEXS,DIK="^LEX(757.4,"_DA(1)_",1," D ^DIK
 S LEXC=$$CNT(LEXR) I LEXC'[U,+LEXC=0 D DELR(LEXR)
 Q
DELR(DA) ;
 S DA=+($G(DA)) Q:DA=0  Q:'$D(^LEX(757.4,DA))  N DIK S DIK="^LEX(757.4," D ^DIK
 Q
CNT(X) ;
 N LEXR,LEXC,LEXI S (LEXC,LEXI)=0,LEXR=+$G(X)
 Q:'$L($G(^LEX(757.4,LEXR,0))) "^"
 F  S LEXI=$O(^LEX(757.4,LEXR,1,LEXI)) Q:+LEXI=0  D
 . S LEXC=LEXC+1
 S X=LEXC Q X