Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTLKMGR

XTLKMGR.m

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