DIKD1 ;SFISC/MKO-DELETE XREF DATA ;1:03 PM 20 Aug 1999 ;;22.0;VA FileMan;**12**;Mar 30, 1999 ;Per VHA Directive 10-93-142, this routine should not be modified. ; KILL(DIFIL,DIFLD,DIXR,DIFLG,DIKDMSG) ;Delete xref data N DA,DIDEC,DIF,DIFILR,DIKILL,DIMF,DINAM,DIQUIT,DIROOT,DITOPF,DITYP ; ;Init I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU S DIFLG=$G(DIFLG) S DIF=$E("D",DIFLG'["d") I DIFLG'["c" D CHK G:$G(DIQUIT) END D INIT G:$D(DIQUIT) END ; ;Fire the kill logic D:$G(DIFLG)["W" . I DITYP="BULLETIN"!(DITYP="MUMPS")!(DITYP="TRIGGER") D .. W !,"Executing kill logic ..." . E W !,"Removing index ..." D FIRE(DITOPF,DIROOT) ; END ;Move error message if necessary and quit D:$G(DIKDMSG)]"" CALLOUT^DIEFU(DIKDMSG) Q ; FIRE(DIFILE,DIROOT) ;Fire the kill logic N DICNT,DILAST,DIMULTF,DISBROOT,X ; ;If we're at the level where the index resides, ;check whether we can delete the entire index with one kill I DIFILE=DIFILR,DINAM?1.E,DITYP'="MNEMONIC",DITYP'="MUMPS" D . K @DIROOT@(DINAM) ; ;Else, if we're at the level where the index is defined, ;execute the kill logic for each entry E I DIFILE=DIFIL S (DICNT,DA)=0 F S DA=$O(@DIROOT@(DA)) Q:DA'=+DA D . N X . S DICNT=DICNT+1 . X DIDEC X:X]"" DIKILL ; ;Else, for all entries, descend into multiple E S DIMULTF=$O(DIMF(DIFILE,0)) I DIMULTF S (DICNT,DA)=0 F S DA=$O(@DIROOT@(DA)) Q:DA'=+DA D . S DICNT=DICNT+1 . S DISBROOT=$NA(@DIROOT@(DA,DIMF(DIFILE,DIMULTF))) Q:'$D(@DISBROOT) . D PUSHDA^DIKCU(.DA) . D FIRE(DIMF(DIFILE,DIMULTF,0),DISBROOT) . D POPDA^DIKCU(.DA) ; I $D(DICNT),$D(@DIROOT@(0))#2 D . S DILAST=$O(@DIROOT@(" "),-1) . S:'DILAST DILAST="" S:'DICNT DICNT="" . S $P(@DIROOT@(0),U,3,4)=DILAST_U_DICNT Q ; CHK ;Check input parameters I '$G(DIFIL) D:DIF["D" ERR^DIKCU2(202,"","","","FILE") D QUIT I '$G(DIFLD) D:DIF["D" ERR^DIKCU2(202,"","","","FIELD") D QUIT I '$G(DIQUIT),'$$VFLD^DIKCU1($G(DIFIL),$G(DIFLD),DIF) D QUIT I '$G(DIXR) D:DIF["D" ERR^DIKCU2(202,"","","","CROSS-REFERENCE") D QUIT D:'$$VFLAG^DIKCU1(DIFLG,"Wcd",DIF) QUIT Q ; INIT ;Get xref info and subfile info N DIXR0 S DIXR0=$G(^DD(DIFIL,DIFLD,1,DIXR,0)) G:DIXR0="" QUIT S DIFILR=$P(DIXR0,U),DINAM=$P(DIXR0,U,2),DITYP=$P(DIXR0,U,3) G:DITYP="BULLETIN" QUIT ; S DIKILL=$G(^DD(DIFIL,DIFLD,1,DIXR,2)) G:DIKILL="Q"!(DIKILL?."^") QUIT ; D SBINFO^DIKCU(DIFIL,.DIMF) I '$D(DIMF) S DITOPF=DIFIL E S DITOPF=0 F S DITOPF=$O(DIMF(DITOPF)) Q:'$G(^DD(DITOPF,0,"UP")) ; S DIROOT=$$CREF^DILF($G(^DIC(DITOPF,0,"GL"))) S DIDEC=$$DEC^DIKC2(DIFIL,DIFLD) G:DIROOT=""!(DIDEC="") QUIT Q ; QUIT ;Set flag to quit S DIQUIT=1 Q