source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTLKMGR.m@ 710

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