100 lines
4.5 KiB
Mathematica
100 lines
4.5 KiB
Mathematica
XTLKMGR ;SFISC/JC - MANAGE MTLU CONTROL FILES ;02/13/95 11:52
|
|
;;7.3;TOOLKIT;;Apr 25, 1995
|
|
;
|
|
KL ;Exit line.
|
|
K XTLKY,XTLKPF,XTLKGL,XTLKUT,DIC,DIE,DR,JL,DA,DIR,X,Y,XTLKCOD,XTLKCOD1,XTLKOP Q
|
|
;
|
|
SY(XTLK1,XTLK2,XTLK3) ;ADD TO SYNONYM FILE
|
|
N DIC,DIE,DLAYGO,DA,DR,X,Y,S,IEN
|
|
D QU^XTLKEFOP(XTLK1) I Y<1 S XTLKER(1,XTLK1)="" Q
|
|
S (DIC,DIE,DLAYGO)=8984.3,DIC(0)="LMQZ",X=XTLK2 D ^DIC I Y<1 S XTLKER(2,XTLK2)=""
|
|
Q:Y<1 S (IEN,DA)=+Y K DIC
|
|
S DR=".02///^S X=XTLK1" D ^DIE K DIC,DIE,DA,DR
|
|
S DIC("P")="8984.31A",DA(1)=IEN,DIC="^XT(8984.3,DA(1),1,"
|
|
I $G(XTLK3)'="" D
|
|
.K DIC,DA
|
|
.S DIC("P")="8984.31A",DA(1)=IEN,DIC="^XT(8984.3,DA(1),1,"
|
|
.S DIC(0)="MLQZ",X=XTLK3 D ^DIC I Y=-1 S XTLKER(3,XTLK3)=""
|
|
S S="" F S S=$O(XTLK3(S)) Q:S="" D
|
|
.K DIC,DA
|
|
.S DIC("P")="8984.31A",DA(1)=IEN,DIC="^XT(8984.3,DA(1),1,"
|
|
.S DIC(0)="MLQZ",X=XTLK3(S) D ^DIC I Y=-1 S XTLKER(3,XTLK3)=""
|
|
Q
|
|
K(XTLK1,XTLK2,XTLK3) ;Add Keywords
|
|
N DIC,DIE,DLAYGO,DA,DR,X,Y,XTLKCOD,XTLKCOD1,XTLKY
|
|
D QU^XTLKEFOP(XTLK1) I Y<1 S XTLKER(1,XTLK1)="" Q:Y<1
|
|
S DIC=+XTLKY,DIC(0)="LMQZ",X=XTLK2 D ^DIC I Y<1 S XTLKER(2,XTLK2)="" Q
|
|
D C1^XTLKEFOP S X=XTLK3,(DIE,DIC,DLAYGO)=8984.1,DIC(0)="LMQZ" D ^DIC I Y<1 S XTLKER(3,XTLK3)="" Q
|
|
K DIC,DA S DA=+Y,DR=".02////^S X=XTLKCOD;.03///^S X=XTLKCOD1;.04///^S X=+XTLKY" D ^DIE
|
|
Q
|
|
SH(XTLK1,XTLK2,XTLK3) ;POPULATE SHORTCUT FILE
|
|
N DIC,DIE,DLAYGO,DA,DR,X,Y,XTLKCOD,XTLKCOD1,XTLKY
|
|
D QU^XTLKEFOP(XTLK1) Q:Y<1
|
|
S DIC=+XTLKY,DIC(0)="LMQZ",X=XTLK2 D ^DIC I Y<1 S XTLKER(2,XTLK2)=""
|
|
D C1^XTLKEFOP S X=XTLK3,(DIE,DIC,DLAYGO)=8984.2,DIC(0)="LMQZ" D ^DIC I Y<1 S XTLKER(3,XTLK3)="" Q
|
|
K DIC,DA S DA=+Y,DR=".02////^S X=XTLKCOD;.03///^S X=XTLKCOD1" D ^DIE
|
|
Q
|
|
;
|
|
L(XTLK1,XTLK2,XTLK3,XTLK4) ;update OF LOCAL LOOKUP FILE
|
|
N DIC,DIE,DLAYGO,DA,DR,JL0,JLY,XTLKPRE,XTLKLP
|
|
S (DIC,DIE,DLAYGO)=8984.4,DIC(0)="LMQZ",X=XTLK1 D ^DIC I Y<1 S XTLKER(1,XTLK1)="" Q
|
|
S JL0=Y(0,0),JLY=+Y,XTLKPRE=XTLK4
|
|
S DA=+Y,DR=".02////^S X=$G(XTLK2);.03///^S X=XTLK3" D ^DIE,LL2^XTLKEFOP
|
|
Q
|
|
DSH(XTLK1,XTLK2) ;Delete shortcuts for given file
|
|
N XTLKJG,DA,DIK
|
|
Q:$G(XTLK1)="" D QU^XTLKEFOP(XTLK1) I $G(XTLKY)="" S XTLKER(1,XTLK1)="" Q
|
|
S XTLKJG=$P(^DIC(+XTLKY,0,"GL"),U,2)
|
|
I $D(XTLK2) N C,TRM,IEN S C="" F S C=$O(XTLK2(C)) Q:C="" D
|
|
.S TRM=$G(XTLK2(C)) Q:'$D(^XT(8984.2,"AC",XTLKJG,TRM)) S IEN=$O(^(TRM,""))
|
|
.S DA=IEN,DIK="^XT(8984.2," D ^DIK K DIK,DA
|
|
I '$D(XTLK2) N TRM,IEN S TRM="" D
|
|
.F S TRM=$O(^XT(8984.2,"AC",XTLKJG,TRM)) Q:TRM="" D
|
|
..S IEN=0 F S IEN=$O(^XT(8984.2,"AC",XTLKJG,TRM,IEN)) Q:IEN<1 D
|
|
...S DA=IEN,DIK="^XT(8984.2," D ^DIK K DIK,DA
|
|
Q
|
|
DSY(XTLK1,XTLK2) ;Delete synonym TERMS for given file
|
|
Q:$G(XTLK1)="" D QU^XTLKEFOP(XTLK1) I $G(XTLKY)="" S XTLKER(1,XTLK1)="" Q
|
|
S XTLKJG=$P(^DIC(+XTLKY,0,"GL"),"^",2)
|
|
I $D(XTLK2) N C,TRM,IEN S C="" F S C=$O(XTLK2(C)) Q:C="" D
|
|
.S TRM=$G(XTLK2(C)) Q:'$D(^XT(8984.3,"AC",XTLKJG,TRM)) S IEN=$O(^(TRM,""))
|
|
.S DA=IEN,DIK="^XT(8984.3," D ^DIK K DIK,DA
|
|
I '$D(XTLK2) N TRM,IEN S TRM="" D
|
|
.F S TRM=$O(^XT(8984.3,"AC",XTLKJG,TRM)) Q:TRM="" D
|
|
..S IEN=0 F S IEN=$O(^XT(8984.3,"AC",XTLKJG,TRM,IEN)) Q:IEN<1 D
|
|
...S DA=IEN,DIK="^XT(8984.3," D ^DIK K DIK,DA
|
|
Q
|
|
DK(XTLK1,XTLK2) ;Delete keywords from 8984.1
|
|
Q:$G(XTLK1)="" D QU^XTLKEFOP(XTLK1) I $G(XTLKY)="" S XTLKER(1,XTLK1)="" Q
|
|
Q:'$D(^XT(8984.1,"AD",+XTLKY))
|
|
I $D(XTLK2) N C,TRM,IEN S C="" F S C=$O(XTLK2(C)) Q:C="" D
|
|
.S TRM=$G(XTLK2(C)) S IEN=$O(^XT(8984.1,"AD",+XTLKY,""))
|
|
.Q:IEN="" Q:$P(^XT(8984.1,IEN,0),"^")'=TRM
|
|
.S DA=IEN,DIK="^XT(8984.1," D ^DIK K DIK,DA
|
|
I '$D(XTLK2) N TRM,IEN S IEN=0 D
|
|
.F S IEN=$O(^XT(8984.1,"AD",+XTLKY,IEN)) Q:IEN<1 D
|
|
..S DA=IEN,DIK="^XT(8984.1," D ^DIK K DIK,DA
|
|
Q
|
|
DLL(XTLK1) ;Delete an entry from the Local Lookup File-8984.4
|
|
;XTLK1=filename
|
|
N XTLKJG,XTLKY,DIK,XTLKLP,DA
|
|
Q:$G(XTLK1)="" D QU^XTLKEFOP(XTLK1) I $G(XTLKY)="" S XTLKER(1,XTLK1)="" Q
|
|
S XTLKJG=$P(^DIC(+XTLKY,0,"GL"),"^",2)
|
|
I $D(^XT(8984.2,"AC",XTLKJG))!($D(^XT(8984.3,"AC",XTLKJG)))!($D(^XT(8984.1,"AD",+XTLKY))) S XTLKER(2)="" Q
|
|
S DA=+XTLKY,DIK="^XT(8984.4," D ^DIK
|
|
F XTLKLP=8984.1,8984.2 S DIK="^DD("_XTLKLP_",.02,""V"",",DA(1)=.02,DA(2)=XTLKLP,DA=$O(^DD(XTLKLP,.02,"V","B",+XTLKY,0)) D ^DIK
|
|
Q
|
|
LKUP(FIL,XTLKX,XTLKSAY,XTLKHLP,XTLKMORE) ;General MTLU lookup utility
|
|
N IEN,XTLKKSCH
|
|
I $G(XTLKMORE)="" S XTLKMORE=1
|
|
I $G(XTLKSAY)="" S XTLKSAY=1
|
|
D QU^XTLKEFOP(FIL) I $G(XTLKY)="" S XTLKER(1,FIL)="" Q
|
|
Q:Y<1 S IEN=+Y
|
|
S XTLKKSCH("INDEX")=$P(Y(0),"^",3),XTLKKSCH("DSPLY")=$S($G(^XT(8984.4,IEN,1))="":"DGEN^XTLKKWLD",1:^(1)),XTLKKSCH("GBL")=+Y
|
|
D ^XTLKKWL
|
|
I $D(DUOUT)!(Y=-1) D
|
|
.Q:'XTLKMORE!(XTLKSAY=-1)
|
|
.I XTLKSAY=1 W !,"...Nothing selected. Attempting Fileman lookup." S X=XTLKX,DIC=FIL,DIC(0)="EMNZI" D ^DIC
|
|
I XTLKSAY'=-1 K ^TMP("XTLKHITS",$J)
|
|
Q
|