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

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1DIKD ;SFISC/MKO-DELETE A CROSS REFERENCE ;9:14 AM 19 Dec 2001
2 ;;22.0;VA FileMan;**12,68,95**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5DELIX(DIFIL,DIFLD,DIXR,DIFLG,DIKDOUT,DIKDMSG) ;Delete traditional xref
6DELIXX ;Come here from DELIX^DDMOD
7 N %,DIC,X,Y,DIF,DIFINFO,DIQUIT
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 D FINFO^DIKCU1(DIFIL,.DIFINFO)
15 ;
16 ;Delete data in index
17 D:DIFLG["K" KILL^DIKD1(DIFIL,DIFLD,DIXR,$E("W",DIFLG["W")_DIF_"c")
18 ;
19 ;Audit, delete xref, recompile
20 D:$G(^DD(+DIFINFO(0),0,"DDA"))["Y" AUDIT
21 D DELDEF(DIFIL,DIFLD,DIXR,DIFLG)
22 D DIEZ(DIFIL,DIFLD,DIFLG,$G(DIKDOUT))
23 D DIKZ(+DIFINFO(0),DIFLG,$G(DIKDOUT))
24 ;
25END ;Move error message if necessary and quit
26 D:$G(DIKDMSG)]"" CALLOUT^DIEFU(DIKDMSG)
27 Q
28 ;
29DELDEF(DIFIL,DIFLD,DIXR,DIFLG) ;Delete index definition
30 N DIK,DA,DITYP
31 S DITYP=$P($G(^DD(DIFIL,DIFLD,1,DIXR,0)),U,3)
32 K:DITYP="SOUNDEX" ^DD(DIFIL,0,"LOOK"),^("QUES")
33 ;
34 W:$G(DIFLG)["W" !,"Deleting cross-reference definition ..."
35 S ^DD(DIFIL,DIFLD,1,0)="^.1"
36 S DIK="^DD("_DIFIL_","_DIFLD_",1,"
37 S DA(2)=DIFIL,DA(1)=DIFLD,DA=DIXR
38 D ^DIK
39 Q
40 ;
41DIEZ(DIFIL,DIFLD,DIFLG,DIKDOUT,DIKTEML) ;Recompile input templates containing field
42 N DIERR,DITEM,DIMAX,DIRNM
43 S DIMAX=$$ROUSIZE^DILF
44 S DITEM=0 F S DITEM=$O(^DIE("AF",DIFIL,DIFLD,DITEM)) Q:'DITEM D
45 . N DIERR,DIEZMSG
46 . Q:$D(DIKTEML(DITEM))#2 S DIKTEML(DITEM)=""
47 . K ^DIE("AF",DIFIL,DIFLD,DITEM),^DIE(DITEM,"ROU")
48 . S DIRNM=$G(^DIE(DITEM,"ROUOLD")) Q:DIRNM=""
49 . D EN2^DIEZ(DITEM,$E("T",$G(DIFLG)["W"),DIRNM,"","DIEZMSG")
50 . I '$G(DIERR),$G(DIKDOUT)]"" D
51 .. S @DIKDOUT@("DIEZ",DITEM)=$P(^DIE(DITEM,0),U)_U_$P(^(0),U,4)_U_DIRNM
52 Q
53 ;
54DIKZ(Y,DIFLG,DIKDOUT) ;Recompile xrefs
55 Q:'$G(Y)
56 N DIERR,DIKZMSG,DMAX,DIRNM
57 S DIRNM=$G(^DD(Y,0,"DIK")) Q:DIRNM=""
58 S DMAX=$$ROUSIZE^DILF
59 D EN2^DIKZ(Y,$E("T",$G(DIFLG)["W"),DIRNM,"","DIKZMSG")
60 I '$G(DIERR),$G(DIKDOUT)]"" S @DIKDOUT@("DIKZ")=DIRNM
61 Q
62 ;
63AUDIT ;Audit DD change
64 N %,%D,%T,A0,A1,A2,B0,B1,B2,B3,DA,DDA,DL,DQ,J,N
65 S DDA="D",N=DIFINFO,J(0)=+DIFINFO(0),J(N)=DIFIL,DL=DIFLD,DQ=DIXR
66 D XA^DICATTA
67 S:$G(DIKDOUT)]"" @DIKDOUT@("DDAUD")=1
68 Q
69 ;
70CHK ;Check input parameters
71 I '$G(DIFIL) D:DIF["D" ERR^DIKCU2(202,"","","","FILE") D QUIT
72 I '$G(DIFLD) D:DIF["D" ERR^DIKCU2(202,"","","","FIELD") D QUIT
73 I '$G(DIQUIT),'$$VFNUM^DIKCU1(DIFIL,DIF) D QUIT
74 I '$G(DIQUIT),'$$VFLD^DIKCU1($G(DIFIL),$G(DIFLD),DIF) D QUIT
75 ;
76 I $G(DIXR)="" D
77 . D:DIF["D" ERR^DIKCU2(202,"","","","CROSS-REFERENCE") D QUIT
78 E I '$G(DIQUIT) D
79 . I DIXR=+DIXR D
80 .. I $D(^DD(DIFIL,DIFLD,1,DIXR,0))[0 D:DIF["D" ERR^DIKCU2(202,"","","","CROSS-REFERENCE") D QUIT
81 . E D
82 .. N I,XR
83 .. S I=0 F S I=$O(^DD(DIFIL,DIFLD,1,I)) Q:'I S:$P($G(^(I,0)),U,2)=DIXR XR=$G(XR)+1,XR(XR)=I
84 .. I $G(XR)=1 S DIXR=XR(XR)
85 .. E D:DIF["D" ERR^DIKCU2(202,"","","","CROSS-REFERENCE") D QUIT
86 ;
87 D:'$$VFLAG^DIKCU1(DIFLG,"KWcd",DIF) QUIT
88 Q
89 ;
90QUIT ;Set flag to quit
91 S DIQUIT=1
92 Q
Note: See TracBrowser for help on using the repository browser.