| [613] | 1 | DIKD ;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 | ;
|
|---|
| 5 | DELIX(DIFIL,DIFLD,DIXR,DIFLG,DIKDOUT,DIKDMSG) ;Delete traditional xref
|
|---|
| 6 | DELIXX ;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 | ;
|
|---|
| 25 | END ;Move error message if necessary and quit
|
|---|
| 26 | D:$G(DIKDMSG)]"" CALLOUT^DIEFU(DIKDMSG)
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | DELDEF(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 | ;
|
|---|
| 41 | DIEZ(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 | ;
|
|---|
| 54 | DIKZ(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 | ;
|
|---|
| 63 | AUDIT ;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 | ;
|
|---|
| 70 | CHK ;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 | ;
|
|---|
| 90 | QUIT ;Set flag to quit
|
|---|
| 91 | S DIQUIT=1
|
|---|
| 92 | Q
|
|---|
