source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIKD2.m@ 634

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1DIKD2 ;SFISC/MKO-DELETE A NEW-STYLE INDEX ;10:28 AM 1 Nov 2002
2 ;;22.0;VA FileMan;**12,95**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5DELIXN(DIFIL,DIXR,DIFLG,DIKDOUT,DIKDMSG) ;Delete new-style index
6DELIXNX ;Come here from DELIXN^DDMOD
7 N %,DIC,DIF,DIFLIST,DIINDEX,DIQUIT,DITOP,X,Y
8 ;
9 ;Init
10 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
11 S DIFLG=$G(DIFLG)
12 S DIF=$E("D",DIFLG'["d")
13 I DIFLG'["c" D CHK G:$G(DIQUIT) END
14 S DITOP=DIFIL F Q:'$D(^DD(DITOP,0,"UP")) S DITOP=^("UP")
15 D GETFLIST^DIKCUTL(DIXR,.DIFLIST)
16 D LOADXREF^DIKC1("","","K",DIXR,"","DIINDEX")
17 ;
18 ;Delete data in index
19 D:DIFLG["K" KILL(DITOP,.DIINDEX,DIFLG)
20 ;
21 ;Delete index, recompile
22 D DELDEF(DIXR)
23 D DIEZ(.DIFLIST,DIFLG,$G(DIKDOUT))
24 D DIKZ^DIKD(DITOP,DIFLG,$G(DIKDOUT))
25 ;
26END ;Move error message if necessary and quit
27 D:$G(DIKDMSG)]"" CALLOUT^DIEFU(DIKDMSG)
28 Q
29 ;
30DELDEF(DIXR) ;Delete index definition
31 N DIK,DA
32 W:$G(DIFLG)["W" !,"Deleting index definition ..."
33 S DIK="^DD(""IX"",",DA=DIXR D ^DIK
34 Q
35 ;
36DIEZ(DIFLIST,DIFLG,DIKDOUT) ;Recompile input templates containing field
37 N DIFIL,DIFLD,DIKTEML
38 S DIFIL=0 F S DIFIL=$O(DIFLIST(DIFIL)) Q:'DIFIL D
39 . S DIFLD=0 F S DIFLD=$O(DIFLIST(DIFIL,DIFLD)) Q:'DIFLD D
40 .. D DIEZ^DIKD(DIFIL,DIFLD,DIFLG,$G(DIKDOUT),.DIKTEML)
41 Q
42 ;
43CHK ;Check input parameters
44 I '$G(DIFIL) D:DIF["D" ERR^DIKCU2(202,"","","","FILE") D QUIT
45 I $G(DIXR)="" D:DIF["D" ERR^DIKCU2(202,"","","","CROSS-REFERENCE") D QUIT
46 D:'$$VFLAG^DIKCU1(DIFLG,"KWcd",DIF) QUIT
47 ;
48 S DIXR=$O(^DD("IX","BB",DIFIL,DIXR,0))
49 D:'DIXR QUIT
50 Q
51 ;
52QUIT ;Set flag to quit
53 S DIQUIT=1
54 Q
55 ;
56KILL(DITOP,DIINDEX,DIFLG) ;Delete index data
57 N DIFIL,DITYP,DICTRL,DIXR
58 ;
59 Q:'$D(DIINDEX)
60 S DIFIL=$O(DIINDEX(0)) Q:'DIFIL
61 S DIXR=$O(DIINDEX(DIFIL,0)) Q:'DIXR
62 S DITYP=$P(DIINDEX(DIFIL,DIXR),U,4)
63 ;
64 I $G(DIFLG)["W" D
65 . I DITYP="R" W !,"Removing index ..."
66 . E W !,"Executing kill logic ..."
67 ;
68 ;Call INDEX^DIKC to execute the kill logic
69 S DICTRL="K"_$S(DITOP'=DIFIL:"W"_DIFIL,1:"")
70 S DICTRL("LOGIC")="DIINDEX"
71 D INDEX^DIKC(DITOP,"","",DIXR,.DICTRL)
72 Q
Note: See TracBrowser for help on using the repository browser.