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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTLKMGR 4729 printed Dec 13, 2024@02:41:25 Page 2
XTLKMGR ;SFISC/JC - MANAGE MTLU CONTROL FILES ;02/13/95 11:52
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
+2 ;
KL ;Exit line.
+1 KILL XTLKY,XTLKPF,XTLKGL,XTLKUT,DIC,DIE,DR,JL,DA,DIR,X,Y,XTLKCOD,XTLKCOD1,XTLKOP
QUIT
+2 ;
SY(XTLK1,XTLK2,XTLK3) ;ADD TO SYNONYM FILE
+1 NEW DIC,DIE,DLAYGO,DA,DR,X,Y,S,IEN
+2 DO QU^XTLKEFOP(XTLK1)
IF Y<1
SET XTLKER(1,XTLK1)=""
QUIT
+3 SET (DIC,DIE,DLAYGO)=8984.3
SET DIC(0)="LMQZ"
SET X=XTLK2
DO ^DIC
IF Y<1
SET XTLKER(2,XTLK2)=""
+4 if Y<1
QUIT
SET (IEN,DA)=+Y
KILL DIC
+5 SET DR=".02///^S X=XTLK1"
DO ^DIE
KILL DIC,DIE,DA,DR
+6 SET DIC("P")="8984.31A"
SET DA(1)=IEN
SET DIC="^XT(8984.3,DA(1),1,"
+7 IF $GET(XTLK3)'=""
Begin DoDot:1
+8 KILL DIC,DA
+9 SET DIC("P")="8984.31A"
SET DA(1)=IEN
SET DIC="^XT(8984.3,DA(1),1,"
+10 SET DIC(0)="MLQZ"
SET X=XTLK3
DO ^DIC
IF Y=-1
SET XTLKER(3,XTLK3)=""
End DoDot:1
+11 SET S=""
FOR
SET S=$ORDER(XTLK3(S))
if S=""
QUIT
Begin DoDot:1
+12 KILL DIC,DA
+13 SET DIC("P")="8984.31A"
SET DA(1)=IEN
SET DIC="^XT(8984.3,DA(1),1,"
+14 SET DIC(0)="MLQZ"
SET X=XTLK3(S)
DO ^DIC
IF Y=-1
SET XTLKER(3,XTLK3)=""
End DoDot:1
+15 QUIT
K(XTLK1,XTLK2,XTLK3) ;Add Keywords
+1 NEW DIC,DIE,DLAYGO,DA,DR,X,Y,XTLKCOD,XTLKCOD1,XTLKY
+2 DO QU^XTLKEFOP(XTLK1)
IF Y<1
SET XTLKER(1,XTLK1)=""
if Y<1
QUIT
+3 SET DIC=+XTLKY
SET DIC(0)="LMQZ"
SET X=XTLK2
DO ^DIC
IF Y<1
SET XTLKER(2,XTLK2)=""
QUIT
+4 DO C1^XTLKEFOP
SET X=XTLK3
SET (DIE,DIC,DLAYGO)=8984.1
SET DIC(0)="LMQZ"
DO ^DIC
IF Y<1
SET XTLKER(3,XTLK3)=""
QUIT
+5 KILL DIC,DA
SET DA=+Y
SET DR=".02////^S X=XTLKCOD;.03///^S X=XTLKCOD1;.04///^S X=+XTLKY"
DO ^DIE
+6 QUIT
SH(XTLK1,XTLK2,XTLK3) ;POPULATE SHORTCUT FILE
+1 NEW DIC,DIE,DLAYGO,DA,DR,X,Y,XTLKCOD,XTLKCOD1,XTLKY
+2 DO QU^XTLKEFOP(XTLK1)
if Y<1
QUIT
+3 SET DIC=+XTLKY
SET DIC(0)="LMQZ"
SET X=XTLK2
DO ^DIC
IF Y<1
SET XTLKER(2,XTLK2)=""
+4 DO C1^XTLKEFOP
SET X=XTLK3
SET (DIE,DIC,DLAYGO)=8984.2
SET DIC(0)="LMQZ"
DO ^DIC
IF Y<1
SET XTLKER(3,XTLK3)=""
QUIT
+5 KILL DIC,DA
SET DA=+Y
SET DR=".02////^S X=XTLKCOD;.03///^S X=XTLKCOD1"
DO ^DIE
+6 QUIT
+7 ;
L(XTLK1,XTLK2,XTLK3,XTLK4) ;update OF LOCAL LOOKUP FILE
+1 NEW DIC,DIE,DLAYGO,DA,DR,JL0,JLY,XTLKPRE,XTLKLP
+2 SET (DIC,DIE,DLAYGO)=8984.4
SET DIC(0)="LMQZ"
SET X=XTLK1
DO ^DIC
IF Y<1
SET XTLKER(1,XTLK1)=""
QUIT
+3 SET JL0=Y(0,0)
SET JLY=+Y
SET XTLKPRE=XTLK4
+4 SET DA=+Y
SET DR=".02////^S X=$G(XTLK2);.03///^S X=XTLK3"
DO ^DIE
DO LL2^XTLKEFOP
+5 QUIT
DSH(XTLK1,XTLK2) ;Delete shortcuts for given file
+1 NEW XTLKJG,DA,DIK
+2 if $GET(XTLK1)=""
QUIT
DO QU^XTLKEFOP(XTLK1)
IF $GET(XTLKY)=""
SET XTLKER(1,XTLK1)=""
QUIT
+3 SET XTLKJG=$PIECE(^DIC(+XTLKY,0,"GL"),U,2)
+4 IF $DATA(XTLK2)
NEW C,TRM,IEN
SET C=""
FOR
SET C=$ORDER(XTLK2(C))
if C=""
QUIT
Begin DoDot:1
+5 SET TRM=$GET(XTLK2(C))
if '$DATA(^XT(8984.2,"AC",XTLKJG,TRM))
QUIT
SET IEN=$ORDER(^(TRM,""))
+6 SET DA=IEN
SET DIK="^XT(8984.2,"
DO ^DIK
KILL DIK,DA
End DoDot:1
+7 IF '$DATA(XTLK2)
NEW TRM,IEN
SET TRM=""
Begin DoDot:1
+8 FOR
SET TRM=$ORDER(^XT(8984.2,"AC",XTLKJG,TRM))
if TRM=""
QUIT
Begin DoDot:2
+9 SET IEN=0
FOR
SET IEN=$ORDER(^XT(8984.2,"AC",XTLKJG,TRM,IEN))
if IEN<1
QUIT
Begin DoDot:3
+10 SET DA=IEN
SET DIK="^XT(8984.2,"
DO ^DIK
KILL DIK,DA
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
DSY(XTLK1,XTLK2) ;Delete synonym TERMS for given file
+1 if $GET(XTLK1)=""
QUIT
DO QU^XTLKEFOP(XTLK1)
IF $GET(XTLKY)=""
SET XTLKER(1,XTLK1)=""
QUIT
+2 SET XTLKJG=$PIECE(^DIC(+XTLKY,0,"GL"),"^",2)
+3 IF $DATA(XTLK2)
NEW C,TRM,IEN
SET C=""
FOR
SET C=$ORDER(XTLK2(C))
if C=""
QUIT
Begin DoDot:1
+4 SET TRM=$GET(XTLK2(C))
if '$DATA(^XT(8984.3,"AC",XTLKJG,TRM))
QUIT
SET IEN=$ORDER(^(TRM,""))
+5 SET DA=IEN
SET DIK="^XT(8984.3,"
DO ^DIK
KILL DIK,DA
End DoDot:1
+6 IF '$DATA(XTLK2)
NEW TRM,IEN
SET TRM=""
Begin DoDot:1
+7 FOR
SET TRM=$ORDER(^XT(8984.3,"AC",XTLKJG,TRM))
if TRM=""
QUIT
Begin DoDot:2
+8 SET IEN=0
FOR
SET IEN=$ORDER(^XT(8984.3,"AC",XTLKJG,TRM,IEN))
if IEN<1
QUIT
Begin DoDot:3
+9 SET DA=IEN
SET DIK="^XT(8984.3,"
DO ^DIK
KILL DIK,DA
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
DK(XTLK1,XTLK2) ;Delete keywords from 8984.1
+1 if $GET(XTLK1)=""
QUIT
DO QU^XTLKEFOP(XTLK1)
IF $GET(XTLKY)=""
SET XTLKER(1,XTLK1)=""
QUIT
+2 if '$DATA(^XT(8984.1,"AD",+XTLKY))
QUIT
+3 IF $DATA(XTLK2)
NEW C,TRM,IEN
SET C=""
FOR
SET C=$ORDER(XTLK2(C))
if C=""
QUIT
Begin DoDot:1
+4 SET TRM=$GET(XTLK2(C))
SET IEN=$ORDER(^XT(8984.1,"AD",+XTLKY,""))
+5 if IEN=""
QUIT
if $PIECE(^XT(8984.1,IEN,0),"^")'=TRM
QUIT
+6 SET DA=IEN
SET DIK="^XT(8984.1,"
DO ^DIK
KILL DIK,DA
End DoDot:1
+7 IF '$DATA(XTLK2)
NEW TRM,IEN
SET IEN=0
Begin DoDot:1
+8 FOR
SET IEN=$ORDER(^XT(8984.1,"AD",+XTLKY,IEN))
if IEN<1
QUIT
Begin DoDot:2
+9 SET DA=IEN
SET DIK="^XT(8984.1,"
DO ^DIK
KILL DIK,DA
End DoDot:2
End DoDot:1
+10 QUIT
DLL(XTLK1) ;Delete an entry from the Local Lookup File-8984.4
+1 ;XTLK1=filename
+2 NEW XTLKJG,XTLKY,DIK,XTLKLP,DA
+3 if $GET(XTLK1)=""
QUIT
DO QU^XTLKEFOP(XTLK1)
IF $GET(XTLKY)=""
SET XTLKER(1,XTLK1)=""
QUIT
+4 SET XTLKJG=$PIECE(^DIC(+XTLKY,0,"GL"),"^",2)
+5 IF $DATA(^XT(8984.2,"AC",XTLKJG))!($DATA(^XT(8984.3,"AC",XTLKJG)))!($DATA(^XT(8984.1,"AD",+XTLKY)))
SET XTLKER(2)=""
QUIT
+6 SET DA=+XTLKY
SET DIK="^XT(8984.4,"
DO ^DIK
+7 FOR XTLKLP=8984.1,8984.2
SET DIK="^DD("_XTLKLP_",.02,""V"","
SET DA(1)=.02
SET DA(2)=XTLKLP
SET DA=$ORDER(^DD(XTLKLP,.02,"V","B",+XTLKY,0))
DO ^DIK
+8 QUIT
LKUP(FIL,XTLKX,XTLKSAY,XTLKHLP,XTLKMORE) ;General MTLU lookup utility
+1 NEW IEN,XTLKKSCH
+2 IF $GET(XTLKMORE)=""
SET XTLKMORE=1
+3 IF $GET(XTLKSAY)=""
SET XTLKSAY=1
+4 DO QU^XTLKEFOP(FIL)
IF $GET(XTLKY)=""
SET XTLKER(1,FIL)=""
QUIT
+5 if Y<1
QUIT
SET IEN=+Y
+6 SET XTLKKSCH("INDEX")=$PIECE(Y(0),"^",3)
SET XTLKKSCH("DSPLY")=$SELECT($GET(^XT(8984.4,IEN,1))="":"DGEN^XTLKKWLD",1:^(1))
SET XTLKKSCH("GBL")=+Y
+7 DO ^XTLKKWL
+8 IF $DATA(DUOUT)!(Y=-1)
Begin DoDot:1
+9 if 'XTLKMORE!(XTLKSAY=-1)
QUIT
+10 IF XTLKSAY=1
WRITE !,"...Nothing selected. Attempting Fileman lookup."
SET X=XTLKX
SET DIC=FIL
SET DIC(0)="EMNZI"
DO ^DIC
End DoDot:1
+11 IF XTLKSAY'=-1
KILL ^TMP("XTLKHITS",$JOB)
+12 QUIT
