Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIKD1

DIKD1.m

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