source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTLKEFOP.m@ 1710

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1XTLKEFOP ; ALB/JLU ISC,IHS/OHPRD/ACC,SFISC/JC - EDIT FREQUENTLY USED OP NARR, SHORTCUT ;03/01/95 15:31
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3 ;
4C ;GETS THE CODE FROM THE NECESSARY FILE.
5 W ! S DIC("A")="Which code in the "_$P(^DIC(+XTLKY,0),U)_" file?: ",DIC(0)="AEMQ",DIC=^DIC(+XTLKY,0,"GL") D ^DIC I Y<1 K DIC Q
6C1 S XTLKCOD=+Y_";"_$P(DIC,U,2),XTLKCOD1=$P(Y,U,2)
7 K DIC Q
8 ;
9QU(XTLKF) ;Deciding on which file proc/diag Etc.
10 ;XTLKF=filename (optional)
11 W !!
12 I $G(XTLKF)="" S DIC("A")=$S($D(XTLKOPP):"Print "_XTLKOPP_" for ",$D(XTLKOP):"Additions/Modifications to ",1:"Lookup on ")_$S($D(XTLKOP):XTLKOP_" in ",1:"")_"which file?: ",DIC(0)="AEMQ",DIC="^XT(8984.4," D ^DIC K DIC Q:Y<1
13 I $G(XTLKF)'="" S X=XTLKF,DIC=8984.4,DIC(0)="MQZ" D ^DIC K DIC I Y<1 W "...",XTLKF," not found in local lookup file." Q
14 S XTLKY=Y,XTLKPF=+$O(^DD(8984.2,.02,"V","B",+Y,"")) G:'XTLKPF KL
15 S XTLKPF=$P(^DD(8984.2,.02,"V",XTLKPF,0),U,4),XTLKUT=1
16 Q
17 ;
18KL ;Exit line.
19 K XTLKY,XTLKPF,XTLKGL,XTLKUT,DIC,DIE,DR,JL,DA,DIR,X,Y,XTLKCOD,XTLKCOD1,XTLKOP Q
20 ;
21 ;Editing synonym file.
22SY D QU() I Y<1 D KL Q
23SY1 ;
24 W ! S (DIC,DIE)="^XT(8984.3,",DIC(0)="AELMQ",DIC("DR")="[XTLK EDIT SYN]",DIC("S")="I $P(^(0),U,2)="_+XTLKY,DLAYGO="8984.3" D ^DIC K DLAYGO,DIC("S") I Y<1 G SY
25 I '$P(Y,U,3) S DA=+Y,DR="[XTLK EDIT SYN]" D ^DIE
26 K DIC,DIE,DA,DR,Y
27 G SY1
28 ;
29 ;Editing keyword file.
30KE D QU() I Y<1 D KL Q
31 D C I Y<1 D KL Q
32KE1 R !,"Select LOCAL KEYWORD NAME: ",X:DTIME I '$T!(X[U)!(X="") D KL G KE Q
33 I X["?" D HL G KE1
34 W ! S (DIE,DIC)="^XT(8984.1,",DIC(0)="EILMQ",DIC("DR")="[XTLK EDIT KEY]",DIC("S")="I $P(^(0),U,2)[JL&($P(^(0),U,3)[XTLKCOD1)",JL=$P(^DIC(+XTLKY,0,"GL"),U,2),DLAYGO="8984.1" D ^DIC K DLAYGO,DIC("S") G:Y<1 KE1
35 I '$P(Y,U,3) S DA=+Y,DR="[XTLK EDIT KEY]" D ^DIE
36 K DIE,DIC
37 G KE1
38 ;
39 ;Editing shortcut file.
40SH D QU() I Y<1 D KL Q
41SH1 ;
42 W ! S (DIE,DIC)="^XT(8984.2,",DIC(0)="AELMQ",DIC("DR")="[XTLK EDIT SHORT]",DIC("S")="I $P(^(0),U,2)[JL",JL=$P(^DIC(+XTLKY,0,"GL"),U,2),DLAYGO="8984.2" D ^DIC K DLAYGO,DIC("S") G:Y<1 SH
43 I '$P(Y,U,3) S DA=+Y,DR="[XTLK EDIT SHORT]" D ^DIE
44 K DIE,DIC
45 G SH1
46 ;
47LL ;Interactive Entry point to edit Local Lookup File.
48 D LL1 Q:$G(Y)=-1!($D(DTOUT))!($D(DUOUT))
49 D LL2
50 D LL3
51 K XTLKPRE,DIC,DIE,DA,Y,DR,JL0,JLY,XTLKLP
52 Q
53 ;
54LL1 ;
55 S (DIE,DIC)="^XT(8984.4,",DIC(0)="EALMQZ" D ^DIC K DIC
56 Q:Y=-1!($D(DTOUT))!($D(DUOUT))
57 ;S X=$P(Y,U,2),(DIE,DIC)="^XT(8984.4,",DIC(0)="ELMQZ",DIC("DR")="[XTLK EDIT LOOKUP]" D ^DIC
58 S JL0=Y(0,0),JLY=+Y
59 S DIE("NO^")="",DA=+Y,DR="[XTLK EDIT LOOKUP]" D ^DIE
60 Q:$D(DTOUT)
61 ;I '$P(Y,U,3) S DA=+Y,DR="[XTLK EDIT LOOKUP]" D ^DIE Q
62 W !!,"...Ok, will now setup KEYWORD and SHORTCUT file DD's"
63 W !," to allow terms for '",JL0,"' entries..."
64 Q
65LL2 ;
66 S XTLKPRE=$G(XTLKPRE)
67 F XTLKLP=8984.1,8984.2 D
68 .S (DIE,DIC)="^DD("_XTLKLP_",.02,""V"",",DIC(0)="L",X=+JLY,DA(1)=.02,DA(2)=XTLKLP D ^DIC K DIC Q:Y=-1 D S,^DIE
69 Q
70LL3 ;
71 ;S ^DD(JLY,0,"DIC")="XTLKDICL"
72 W !,"<REMINDER> Using 'Edit File', set the lookup routine, XTLKDICL, in ",JL0," DD."
73 K XTLKPRE,DIC,DIE,DA,Y G LL1
74 Q
75 ;
76S S DA=+Y,DR=".02////"_JL0_";.03////"_DA_";.05////n;.06////n;.04"_$S(XTLKPRE="":"",1:"////"_XTLKPRE)_";S XTLKPRE=X"
77 Q
78 ;Entry point to delete from 8984.4 and the variable pts in 8984.1,8984.2
79DD D DD1
80 K DIC,DIE,DR,DIR,XTLKY,XTLKLP,DIK,DA,JL0
81 Q
82 ;
83DD1 S DIC="^XT(8984.4,",DIC(0)="AEMQZ" D ^DIC Q:Y<1 W !,$C(7)
84 S (XTLKY,DA)=+Y,JL0=Y(0,0),DIR(0)="Y",DIR("A")="Are you sure you want to delete "_Y(0,0) D ^DIR Q:Y<1
85 S XTLKJG=$P(^DIC(+XTLKY,0,"GL"),U,2)
86 I $D(^XT(8984.2,"AC",XTLKJG))!($D(^XT(8984.3,"AC",XTLKJG)))!($D(^XT(8984.1,"AD",+XTLKY))) W $C(7),!!,"There are still Keywords, Shortcuts and/or Synonyms for this entry.",!," <<Nothing Deleted!>>" Q
87 W !!,"Deleting from Local Lookup file....."
88 S DIK="^XT(8984.4," D ^DIK
89 W !,"Deleting variable pointers from Local Keyword and Shortcut files."
90 F XTLKLP=8984.1,8984.2 S DIK="^DD("_XTLKLP_",.02,""V"",",DA(1)=.02,DA(2)=XTLKLP,DA=$O(@($NA(^DD(XTLKLP,.02,"V","B",+XTLKY,0)))) D ^DIK
91 W !,"<REMINDER> Delete the lookup routine, XTLKDICL, from ",JL0," DD."
92 ;K ^DD(XTLKY,0,"DIC")
93 Q
94 ;HELP ENTRY POINT
95HL W !,"ANSWER WITH LOCAL KEYWORD NAME, OR CODE",!,"CHOOSE FROM:"
96 S (XTLKC,XTLKF)=0
97 F LP=0:0 S LP=$O(^XT(8984.1,"C",XTLKCOD1_" ",LP)) Q:'LP D WR Q:XTLKF
98 K LP,XTLKC,XTLKF Q
99WR I XTLKC>(IOSL-4) S DIR(0)="E" D ^DIR I 'Y S XTLKF=1 Q
100 Q:'$D(^XT(8984.1,LP,0)) W !,$P(^(0),U)," ",$P(^(0),U,3)
101 Q
Note: See TracBrowser for help on using the repository browser.