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

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1XTLKMGR ;SFISC/JC - MANAGE MTLU CONTROL FILES ;02/13/95 11:52
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3 ;
4KL ;Exit line.
5 K XTLKY,XTLKPF,XTLKGL,XTLKUT,DIC,DIE,DR,JL,DA,DIR,X,Y,XTLKCOD,XTLKCOD1,XTLKOP Q
6 ;
7SY(XTLK1,XTLK2,XTLK3) ;ADD TO SYNONYM FILE
8 N DIC,DIE,DLAYGO,DA,DR,X,Y,S,IEN
9 D QU^XTLKEFOP(XTLK1) I Y<1 S XTLKER(1,XTLK1)="" Q
10 S (DIC,DIE,DLAYGO)=8984.3,DIC(0)="LMQZ",X=XTLK2 D ^DIC I Y<1 S XTLKER(2,XTLK2)=""
11 Q:Y<1 S (IEN,DA)=+Y K DIC
12 S DR=".02///^S X=XTLK1" D ^DIE K DIC,DIE,DA,DR
13 S DIC("P")="8984.31A",DA(1)=IEN,DIC="^XT(8984.3,DA(1),1,"
14 I $G(XTLK3)'="" D
15 .K DIC,DA
16 .S DIC("P")="8984.31A",DA(1)=IEN,DIC="^XT(8984.3,DA(1),1,"
17 .S DIC(0)="MLQZ",X=XTLK3 D ^DIC I Y=-1 S XTLKER(3,XTLK3)=""
18 S S="" F S S=$O(XTLK3(S)) Q:S="" D
19 .K DIC,DA
20 .S DIC("P")="8984.31A",DA(1)=IEN,DIC="^XT(8984.3,DA(1),1,"
21 .S DIC(0)="MLQZ",X=XTLK3(S) D ^DIC I Y=-1 S XTLKER(3,XTLK3)=""
22 Q
23K(XTLK1,XTLK2,XTLK3) ;Add Keywords
24 N DIC,DIE,DLAYGO,DA,DR,X,Y,XTLKCOD,XTLKCOD1,XTLKY
25 D QU^XTLKEFOP(XTLK1) I Y<1 S XTLKER(1,XTLK1)="" Q:Y<1
26 S DIC=+XTLKY,DIC(0)="LMQZ",X=XTLK2 D ^DIC I Y<1 S XTLKER(2,XTLK2)="" Q
27 D C1^XTLKEFOP S X=XTLK3,(DIE,DIC,DLAYGO)=8984.1,DIC(0)="LMQZ" D ^DIC I Y<1 S XTLKER(3,XTLK3)="" Q
28 K DIC,DA S DA=+Y,DR=".02////^S X=XTLKCOD;.03///^S X=XTLKCOD1;.04///^S X=+XTLKY" D ^DIE
29 Q
30SH(XTLK1,XTLK2,XTLK3) ;POPULATE SHORTCUT FILE
31 N DIC,DIE,DLAYGO,DA,DR,X,Y,XTLKCOD,XTLKCOD1,XTLKY
32 D QU^XTLKEFOP(XTLK1) Q:Y<1
33 S DIC=+XTLKY,DIC(0)="LMQZ",X=XTLK2 D ^DIC I Y<1 S XTLKER(2,XTLK2)=""
34 D C1^XTLKEFOP S X=XTLK3,(DIE,DIC,DLAYGO)=8984.2,DIC(0)="LMQZ" D ^DIC I Y<1 S XTLKER(3,XTLK3)="" Q
35 K DIC,DA S DA=+Y,DR=".02////^S X=XTLKCOD;.03///^S X=XTLKCOD1" D ^DIE
36 Q
37 ;
38L(XTLK1,XTLK2,XTLK3,XTLK4) ;update OF LOCAL LOOKUP FILE
39 N DIC,DIE,DLAYGO,DA,DR,JL0,JLY,XTLKPRE,XTLKLP
40 S (DIC,DIE,DLAYGO)=8984.4,DIC(0)="LMQZ",X=XTLK1 D ^DIC I Y<1 S XTLKER(1,XTLK1)="" Q
41 S JL0=Y(0,0),JLY=+Y,XTLKPRE=XTLK4
42 S DA=+Y,DR=".02////^S X=$G(XTLK2);.03///^S X=XTLK3" D ^DIE,LL2^XTLKEFOP
43 Q
44DSH(XTLK1,XTLK2) ;Delete shortcuts for given file
45 N XTLKJG,DA,DIK
46 Q:$G(XTLK1)="" D QU^XTLKEFOP(XTLK1) I $G(XTLKY)="" S XTLKER(1,XTLK1)="" Q
47 S XTLKJG=$P(^DIC(+XTLKY,0,"GL"),U,2)
48 I $D(XTLK2) N C,TRM,IEN S C="" F S C=$O(XTLK2(C)) Q:C="" D
49 .S TRM=$G(XTLK2(C)) Q:'$D(^XT(8984.2,"AC",XTLKJG,TRM)) S IEN=$O(^(TRM,""))
50 .S DA=IEN,DIK="^XT(8984.2," D ^DIK K DIK,DA
51 I '$D(XTLK2) N TRM,IEN S TRM="" D
52 .F S TRM=$O(^XT(8984.2,"AC",XTLKJG,TRM)) Q:TRM="" D
53 ..S IEN=0 F S IEN=$O(^XT(8984.2,"AC",XTLKJG,TRM,IEN)) Q:IEN<1 D
54 ...S DA=IEN,DIK="^XT(8984.2," D ^DIK K DIK,DA
55 Q
56DSY(XTLK1,XTLK2) ;Delete synonym TERMS for given file
57 Q:$G(XTLK1)="" D QU^XTLKEFOP(XTLK1) I $G(XTLKY)="" S XTLKER(1,XTLK1)="" Q
58 S XTLKJG=$P(^DIC(+XTLKY,0,"GL"),"^",2)
59 I $D(XTLK2) N C,TRM,IEN S C="" F S C=$O(XTLK2(C)) Q:C="" D
60 .S TRM=$G(XTLK2(C)) Q:'$D(^XT(8984.3,"AC",XTLKJG,TRM)) S IEN=$O(^(TRM,""))
61 .S DA=IEN,DIK="^XT(8984.3," D ^DIK K DIK,DA
62 I '$D(XTLK2) N TRM,IEN S TRM="" D
63 .F S TRM=$O(^XT(8984.3,"AC",XTLKJG,TRM)) Q:TRM="" D
64 ..S IEN=0 F S IEN=$O(^XT(8984.3,"AC",XTLKJG,TRM,IEN)) Q:IEN<1 D
65 ...S DA=IEN,DIK="^XT(8984.3," D ^DIK K DIK,DA
66 Q
67DK(XTLK1,XTLK2) ;Delete keywords from 8984.1
68 Q:$G(XTLK1)="" D QU^XTLKEFOP(XTLK1) I $G(XTLKY)="" S XTLKER(1,XTLK1)="" Q
69 Q:'$D(^XT(8984.1,"AD",+XTLKY))
70 I $D(XTLK2) N C,TRM,IEN S C="" F S C=$O(XTLK2(C)) Q:C="" D
71 .S TRM=$G(XTLK2(C)) S IEN=$O(^XT(8984.1,"AD",+XTLKY,""))
72 .Q:IEN="" Q:$P(^XT(8984.1,IEN,0),"^")'=TRM
73 .S DA=IEN,DIK="^XT(8984.1," D ^DIK K DIK,DA
74 I '$D(XTLK2) N TRM,IEN S IEN=0 D
75 .F S IEN=$O(^XT(8984.1,"AD",+XTLKY,IEN)) Q:IEN<1 D
76 ..S DA=IEN,DIK="^XT(8984.1," D ^DIK K DIK,DA
77 Q
78DLL(XTLK1) ;Delete an entry from the Local Lookup File-8984.4
79 ;XTLK1=filename
80 N XTLKJG,XTLKY,DIK,XTLKLP,DA
81 Q:$G(XTLK1)="" D QU^XTLKEFOP(XTLK1) I $G(XTLKY)="" S XTLKER(1,XTLK1)="" Q
82 S XTLKJG=$P(^DIC(+XTLKY,0,"GL"),"^",2)
83 I $D(^XT(8984.2,"AC",XTLKJG))!($D(^XT(8984.3,"AC",XTLKJG)))!($D(^XT(8984.1,"AD",+XTLKY))) S XTLKER(2)="" Q
84 S DA=+XTLKY,DIK="^XT(8984.4," D ^DIK
85 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
86 Q
87LKUP(FIL,XTLKX,XTLKSAY,XTLKHLP,XTLKMORE) ;General MTLU lookup utility
88 N IEN,XTLKKSCH
89 I $G(XTLKMORE)="" S XTLKMORE=1
90 I $G(XTLKSAY)="" S XTLKSAY=1
91 D QU^XTLKEFOP(FIL) I $G(XTLKY)="" S XTLKER(1,FIL)="" Q
92 Q:Y<1 S IEN=+Y
93 S XTLKKSCH("INDEX")=$P(Y(0),"^",3),XTLKKSCH("DSPLY")=$S($G(^XT(8984.4,IEN,1))="":"DGEN^XTLKKWLD",1:^(1)),XTLKKSCH("GBL")=+Y
94 D ^XTLKKWL
95 I $D(DUOUT)!(Y=-1) D
96 .Q:'XTLKMORE!(XTLKSAY=-1)
97 .I XTLKSAY=1 W !,"...Nothing selected. Attempting Fileman lookup." S X=XTLKX,DIC=FIL,DIC(0)="EMNZI" D ^DIC
98 I XTLKSAY'=-1 K ^TMP("XTLKHITS",$J)
99 Q
Note: See TracBrowser for help on using the repository browser.