| 1 | DIKD1 ;SFISC/MKO-DELETE XREF DATA ;1:03 PM 20 Aug 1999
|
|---|
| 2 | ;;22.0;VA FileMan;**12**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | KILL(DIFIL,DIFLD,DIXR,DIFLG,DIKDMSG) ;Delete xref data
|
|---|
| 6 | N DA,DIDEC,DIF,DIFILR,DIKILL,DIMF,DINAM,DIQUIT,DIROOT,DITOPF,DITYP
|
|---|
| 7 | ;
|
|---|
| 8 | ;Init
|
|---|
| 9 | I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
|
|---|
| 10 | S DIFLG=$G(DIFLG)
|
|---|
| 11 | S DIF=$E("D",DIFLG'["d")
|
|---|
| 12 | I DIFLG'["c" D CHK G:$G(DIQUIT) END
|
|---|
| 13 | D INIT G:$D(DIQUIT) END
|
|---|
| 14 | ;
|
|---|
| 15 | ;Fire the kill logic
|
|---|
| 16 | D:$G(DIFLG)["W"
|
|---|
| 17 | . I DITYP="BULLETIN"!(DITYP="MUMPS")!(DITYP="TRIGGER") D
|
|---|
| 18 | .. W !,"Executing kill logic ..."
|
|---|
| 19 | . E W !,"Removing index ..."
|
|---|
| 20 | D FIRE(DITOPF,DIROOT)
|
|---|
| 21 | ;
|
|---|
| 22 | END ;Move error message if necessary and quit
|
|---|
| 23 | D:$G(DIKDMSG)]"" CALLOUT^DIEFU(DIKDMSG)
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | FIRE(DIFILE,DIROOT) ;Fire the kill logic
|
|---|
| 27 | N DICNT,DILAST,DIMULTF,DISBROOT,X
|
|---|
| 28 | ;
|
|---|
| 29 | ;If we're at the level where the index resides,
|
|---|
| 30 | ;check whether we can delete the entire index with one kill
|
|---|
| 31 | I DIFILE=DIFILR,DINAM?1.E,DITYP'="MNEMONIC",DITYP'="MUMPS" D
|
|---|
| 32 | . K @DIROOT@(DINAM)
|
|---|
| 33 | ;
|
|---|
| 34 | ;Else, if we're at the level where the index is defined,
|
|---|
| 35 | ;execute the kill logic for each entry
|
|---|
| 36 | E I DIFILE=DIFIL S (DICNT,DA)=0 F S DA=$O(@DIROOT@(DA)) Q:DA'=+DA D
|
|---|
| 37 | . N X
|
|---|
| 38 | . S DICNT=DICNT+1
|
|---|
| 39 | . X DIDEC X:X]"" DIKILL
|
|---|
| 40 | ;
|
|---|
| 41 | ;Else, for all entries, descend into multiple
|
|---|
| 42 | E S DIMULTF=$O(DIMF(DIFILE,0)) I DIMULTF S (DICNT,DA)=0 F S DA=$O(@DIROOT@(DA)) Q:DA'=+DA D
|
|---|
| 43 | . S DICNT=DICNT+1
|
|---|
| 44 | . S DISBROOT=$NA(@DIROOT@(DA,DIMF(DIFILE,DIMULTF))) Q:'$D(@DISBROOT)
|
|---|
| 45 | . D PUSHDA^DIKCU(.DA)
|
|---|
| 46 | . D FIRE(DIMF(DIFILE,DIMULTF,0),DISBROOT)
|
|---|
| 47 | . D POPDA^DIKCU(.DA)
|
|---|
| 48 | ;
|
|---|
| 49 | I $D(DICNT),$D(@DIROOT@(0))#2 D
|
|---|
| 50 | . S DILAST=$O(@DIROOT@(" "),-1)
|
|---|
| 51 | . S:'DILAST DILAST="" S:'DICNT DICNT=""
|
|---|
| 52 | . S $P(@DIROOT@(0),U,3,4)=DILAST_U_DICNT
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | CHK ;Check input parameters
|
|---|
| 56 | I '$G(DIFIL) D:DIF["D" ERR^DIKCU2(202,"","","","FILE") D QUIT
|
|---|
| 57 | I '$G(DIFLD) D:DIF["D" ERR^DIKCU2(202,"","","","FIELD") D QUIT
|
|---|
| 58 | I '$G(DIQUIT),'$$VFLD^DIKCU1($G(DIFIL),$G(DIFLD),DIF) D QUIT
|
|---|
| 59 | I '$G(DIXR) D:DIF["D" ERR^DIKCU2(202,"","","","CROSS-REFERENCE") D QUIT
|
|---|
| 60 | D:'$$VFLAG^DIKCU1(DIFLG,"Wcd",DIF) QUIT
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | INIT ;Get xref info and subfile info
|
|---|
| 64 | N DIXR0
|
|---|
| 65 | S DIXR0=$G(^DD(DIFIL,DIFLD,1,DIXR,0)) G:DIXR0="" QUIT
|
|---|
| 66 | S DIFILR=$P(DIXR0,U),DINAM=$P(DIXR0,U,2),DITYP=$P(DIXR0,U,3)
|
|---|
| 67 | G:DITYP="BULLETIN" QUIT
|
|---|
| 68 | ;
|
|---|
| 69 | S DIKILL=$G(^DD(DIFIL,DIFLD,1,DIXR,2))
|
|---|
| 70 | G:DIKILL="Q"!(DIKILL?."^") QUIT
|
|---|
| 71 | ;
|
|---|
| 72 | D SBINFO^DIKCU(DIFIL,.DIMF)
|
|---|
| 73 | I '$D(DIMF) S DITOPF=DIFIL
|
|---|
| 74 | E S DITOPF=0 F S DITOPF=$O(DIMF(DITOPF)) Q:'$G(^DD(DITOPF,0,"UP"))
|
|---|
| 75 | ;
|
|---|
| 76 | S DIROOT=$$CREF^DILF($G(^DIC(DITOPF,0,"GL")))
|
|---|
| 77 | S DIDEC=$$DEC^DIKC2(DIFIL,DIFLD)
|
|---|
| 78 | G:DIROOT=""!(DIDEC="") QUIT
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | QUIT ;Set flag to quit
|
|---|
| 82 | S DIQUIT=1
|
|---|
| 83 | Q
|
|---|
