source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIKCUTL3.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: 5.7 KB
RevLine 
[613]1DIKCUTL3 ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;10:00 AM 12 Nov 2002
2 ;;22.0;VA FileMan;**58,68,116**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;==============================================
5 ; KSC(topFile#,.oldLogic,.newLogic,.fieldList)
6 ;==============================================
7 ;Run old kill logic and/or new set logic.
8 ;Recompile input templates and xrefs.
9 ;In:
10 ; DIKCTOP = top level file #
11 ; .DIKCOLD = old kill logic (as loaded by LOADXREF^DIKC1)
12 ; .DIKCNEW = new set logic (")
13 ; .DIKCFLIS = list of fields for input template compilation
14 ;
15 ;Called from CREATE^DIKCUTL1 after a new Index is created and edited.
16 ;Called from ^DIKKUTL1 if a Uniqueness Index is created or modified.
17 ;
18KSC(DIKCTOP,DIKCOLD,DIKCNEW,DIKCFLIS) ;
19 D:$D(DIKCOLD)>1 KOLD(DIKCTOP,.DIKCOLD)
20 D:$D(DIKCNEW)>1 SNEW(DIKCTOP,.DIKCNEW)
21 D:$D(DIKCFLIS)>1 DIEZ(DIKCTOP,.DIKCFLIS)
22 D DIKZ(DIKCTOP)
23 Q
24 ;
25 ;===========================
26 ; DIEZ(topFile#,.fieldList)
27 ;===========================
28 ;Loop through file/fields in DIKCFLIS input array.
29 ;For each of those fields loop through the ^DIE("AF") index which
30 ; contains the iens of the compiled input templates that use that
31 ; field. Recompile those templates.
32 ;In:
33 ; DIKCTOP = top level file #
34 ; DIKCFLIS(file#,field#) = ""
35 ;
36DIEZ(DIKCTOP,DIKCFLIS) ;
37 N DA,DI,DIKCFD,DIKCFL,DIKCIT,DMAX,DNM,X,Y
38 ;
39 S DIKCFL=0 F S DIKCFL=$O(DIKCFLIS(DIKCFL)) Q:'DIKCFL D
40 . S DIKCFD=0 F S DIKCFD=$O(DIKCFLIS(DIKCFL,DIKCFD)) Q:'DIKCFD D
41 .. S DIKCIT=0 F S DIKCIT=$O(^DIE("AF",DIKCFL,DIKCFD,DIKCIT)) Q:DIKCIT'>0 D
42 ... Q:$D(DIKCIT(DIKCIT))#2 S DIKCIT(DIKCIT)=""
43 ... S X=$G(^DIE(DIKCIT,"ROUOLD"))
44 ... I X'?1(1A,1"%").7AN D I X'?1(1A,1"%").7AN D UNC^DIEZ(DIKCIT) Q
45 .... S X=$P($G(^DIE(DIKCIT,"ROU")),U,2)
46 ... K ^DIE("AF",DIKCFL,DIKCFD,DIKCIT),^DIE(DIKCIT,"ROU")
47 ... S DMAX=$G(^DD("ROU")),Y=DIKCIT
48 ... D EN^DIEZ
49 .. ;
50 .. I $D(^DD(DIKCFL,DIKCFD)),$P($G(^DIC(DIKCTOP,"%A")),U,2)-DT D
51 ... S ^DD(DIKCFL,DIKCFD,"DT")=DT
52 Q
53 ;
54 ;================
55 ; DIKZ(topFile#)
56 ;================
57 ;Recompile cross references on file Y.
58 ;In:
59 ; Y = top level file #
60 ;
61DIKZ(Y) ;
62 Q:'$G(Y)
63 N DMAX,X
64 S X=$G(^DD(Y,0,"DIK")) Q:X=""
65 S DMAX=^DD("ROU")
66 D EN^DIKZ W !
67 Q
68 ;
69 ;===========================
70 ; KOLD(topFile#,.xrefLogic)
71 ;===========================
72 ;Determine whether to execute old kill logic; if yes, execute.
73 ;In:
74 ; DIKCTOP = top file #
75 ; DIKCOLD(file#,xref#) = array as built by LOADXREF^DIKC1
76 ;
77KOLD(DIKCTOP,DIKCOLD) ;
78 Q:'$D(DIKCOLD)
79 N DIKCFILE,DIKCMSG,DIKCTYP,DIKCUC,DIXR
80 N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
81 ;
82 S DIKCFILE=$O(DIKCOLD(0)) Q:'DIKCFILE
83 S DIXR=$O(DIKCOLD(DIKCFILE,0)) Q:'DIXR
84 S DIKCTYP=$P(DIKCOLD(DIKCFILE,DIXR),U,4)
85 ;
86 ;Ask before removing Regular index or running kill logic of MUMPS xref
87 I DIKCTYP="R" D
88 . S DIKCMSG=" Removing old index ..."
89 . S DIR("A")="Do you want to delete the data in the old index now"
90 . S DIR("B")="YES"
91 . S DIR("?",1)=" Enter 'YES' to delete the data in the old index now."
92 . S DIR("?",2)=""
93 . S DIR("?",3)=" You might answer 'NO' if you know that there is no data in the index, or"
94 . S DIR("?",4)=" in order to remove the index, FileMan must loop through a large number"
95 . S DIR("?",5)=" of entries, and you would rather wait until a non-peak time to perform"
96 . S DIR("?",6)=" deletion. Note, however, that FileMan will use the WHOLE KILL LOGIC to"
97 . S DIR("?")=" remove the index, so the looping time may not be an issue."
98 E D
99 . S DIKCMSG=" Executing old kill logic ..."
100 . S DIR("A")="Do you want to execute the old kill logic now"
101 . S DIR("?",1)=" Enter 'YES' to execute the original kill logic now."
102 . S DIR("?")=" Otherwise, enter 'NO'."
103 S DIR(0)="Y"
104 F W ! D ^DIR Q:'$D(DUOUT) W $C(7)," Up-arrow not allowed."
105 K DIR Q:'Y!$D(DTOUT)
106 ;
107 ;Write message and call INDEX^DIKC to execute the kill logic
108 W !,DIKCMSG
109 S DIKCUC="K"_$S(DIKCTOP'=DIKCFILE:"W"_DIKCFILE,1:"")
110 S DIKCUC("LOGIC")="DIKCOLD"
111 D INDEX^DIKC(DIKCTOP,"","",DIXR,.DIKCUC)
112 W " DONE!"
113 Q
114 ;
115 ;===========================
116 ; SNEW(topFile#,.xrefLogic)
117 ;===========================
118 ;Determine whether to execute new set logic; if yes, execute.
119 ;In:
120 ; DIKCTOP = top file #
121 ; DIKCNEW(file#,xref#) = array as built by LOADXREF^DIKC1
122 ;
123SNEW(DIKCTOP,DIKCNEW) ;
124 Q:'$D(DIKCNEW)
125 N DIKCFILE,DIKCMSG,DIKCTYP,DIKCUC,DIXR
126 N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
127 ;
128 S DIKCFILE=$O(DIKCNEW(0)) Q:'DIKCFILE
129 S DIXR=$O(DIKCNEW(DIKCFILE,0)) Q:'DIXR
130 S DIKCTYP=$P(DIKCNEW(DIKCFILE,DIXR),U,4)
131 ;
132 ;Ask before building Regular index or running set logic of MUMPS xref
133 I DIKCTYP="R" D
134 . S DIKCMSG=" Building new index ..."
135 . S DIR("A")="Do you want to build the index now"
136 . S DIR("B")="YES"
137 . S DIR("?",1)=" Enter 'YES' to loop through all entries in the file and build the index"
138 . S DIR("?",2)=" now."
139 . S DIR("?",3)=""
140 . S DIR("?",4)=" You might answer 'NO' if you know that there is no data in any of the"
141 . S DIR("?",5)=" fields being indexed, or if the file has a large number of entries, and"
142 . S DIR("?",6)=" you would rather wait until a non-peak time to build the index on a"
143 . S DIR("?")=" live system."
144 E D
145 . S DIKCMSG=" Executing new set logic ..."
146 . S DIR("A")="Do you want to cross reference existing data now"
147 . S DIR("?",1)=" Enter 'YES' to execute the new set logic now."
148 . S DIR("?")=" Otherwise, enter 'NO'."
149 S DIR(0)="Y"
150 F W ! D ^DIR Q:'$D(DUOUT) W $C(7)," Up-arrow not allowed."
151 K DIR Q:'Y!$D(DTOUT)
152 ;
153 W !,DIKCMSG
154 S DIKCUC="S"_$S(DIKCTOP'=DIKCFILE:"W"_DIKCFILE,1:"")
155 S DIKCUC("LOGIC")="DIKCNEW"
156 D INDEX^DIKC(DIKCTOP,"","",DIXR,.DIKCUC)
157 W " DONE!"
158 Q
159 ;
160EOP ;Issue Press Return to continue prompt
161 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
162 S DIR(0)="E",DIR("A")="Press RETURN to continue"
163 S DIR("?")="Press the RETURN or ENTER key."
164 W ! D ^DIR
165 Q
Note: See TracBrowser for help on using the repository browser.