- DIKD2 ;SFISC/MKO-DELETE A NEW-STYLE INDEX ;4JAN2012
- ;;22.0;VA FileMan;**12,95,169**;Mar 30, 1999;Build 28
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- DELIXN(DIFIL,DIXR,DIFLG,DIKDOUT,DIKDMSG) ;Delete new-style index
- DELIXNX ;Come here from DELIXN^DDMOD
- N %,DIC,DIF,DIFLIST,DIINDEX,DIQUIT,DITOP,X,Y
- ;
- ;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
- S DITOP=DIFIL F Q:'$D(^DD(DITOP,0,"UP")) S DITOP=^("UP")
- D GETFLIST^DIKCUTL(DIXR,.DIFLIST)
- D LOADXREF^DIKC1("","","K",DIXR,"","DIINDEX")
- ;
- ;Delete data in index
- D:DIFLG["K" KILL(DITOP,.DIINDEX,DIFLG)
- ;
- ;Delete index, recompile
- D DELDEF(DIXR)
- D DIEZ(.DIFLIST,DIFLG,$G(DIKDOUT))
- D DIKZ^DIKD(DITOP,DIFLG,$G(DIKDOUT))
- ;
- END ;Move error message if necessary and quit
- D:$G(DIKDMSG)]"" CALLOUT^DIEFU(DIKDMSG)
- Q
- ;
- DELDEF(DIXR) ;Delete index definition
- N DIK,DA
- W:$G(DIFLG)["W" !,"Deleting index definition ..."
- S DIK="^DD(""IX"",",DA=DIXR D ^DIK
- Q
- ;
- DIEZ(DIFLIST,DIFLG,DIKDOUT) ;Recompile input templates containing field
- N DIFIL,DIFLD,DIKTEML
- S DIFIL=0 F S DIFIL=$O(DIFLIST(DIFIL)) Q:'DIFIL D
- . S DIFLD=0 F S DIFLD=$O(DIFLIST(DIFIL,DIFLD)) Q:'DIFLD D
- .. D DIEZ^DIKD(DIFIL,DIFLD,DIFLG,$G(DIKDOUT),.DIKTEML)
- Q
- ;
- CHK ;Check input parameters
- I '$G(DIFIL) D:DIF["D" ERR^DIKCU2(202,"","","","FILE") D QUIT
- I $G(DIXR)]"" D
- .N I F I=0:0 S I=$O(^DD("IX","IX",DIXR,I)) Q:'I I +$G(^DD("IX",I,0))=$G(DIFIL) Q
- .I 'I K DIXR
- I $G(DIXR)="" D:DIF["D" ERR^DIKCU2(202,"","","","CROSS-REFERENCE") D QUIT
- D:'$$VFLAG^DIKCU1(DIFLG,"KWcd",DIF) QUIT
- Q:$G(DIQUIT)
- S DIXR=$O(^DD("IX","BB",DIFIL,DIXR,0))
- D:'DIXR QUIT
- Q
- ;
- QUIT ;Set flag to quit
- S DIQUIT=1
- Q
- ;
- KILL(DITOP,DIINDEX,DIFLG) ;Delete index data
- N DIFIL,DITYP,DICTRL,DIXR
- ;
- Q:'$D(DIINDEX)
- S DIFIL=$O(DIINDEX(0)) Q:'DIFIL
- S DIXR=$O(DIINDEX(DIFIL,0)) Q:'DIXR
- S DITYP=$P(DIINDEX(DIFIL,DIXR),U,4)
- ;
- I $G(DIFLG)["W" D
- . I DITYP="R" W !,"Removing index ..."
- . E W !,"Executing kill logic ..."
- ;
- ;Call INDEX^DIKC to execute the kill logic
- S DICTRL="K"_$S(DITOP'=DIFIL:"W"_DIFIL,1:"")
- S DICTRL("LOGIC")="DIINDEX"
- D INDEX^DIKC(DITOP,"","",DIXR,.DICTRL)
- Q
- DIKD2 ;SFISC/MKO-DELETE A NEW-STYLE INDEX ;4JAN2012
- +1 ;;22.0;VA FileMan;**12,95,169**;Mar 30, 1999;Build 28
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- DELIXN(DIFIL,DIXR,DIFLG,DIKDOUT,DIKDMSG) ;Delete new-style index
- DELIXNX ;Come here from DELIXN^DDMOD
- +1 NEW %,DIC,DIF,DIFLIST,DIINDEX,DIQUIT,DITOP,X,Y
- +2 ;
- +3 ;Init
- +4 IF '$DATA(DIFM)
- NEW DIFM
- SET DIFM=1
- DO INIZE^DIEFU
- +5 SET DIFLG=$GET(DIFLG)
- +6 SET DIF=$EXTRACT("D",DIFLG'["d")
- +7 IF DIFLG'["c"
- DO CHK
- IF $GET(DIQUIT)
- GOTO END
- +8 SET DITOP=DIFIL
- FOR
- IF '$DATA(^DD(DITOP,0,"UP"))
- QUIT
- SET DITOP=^("UP")
- +9 DO GETFLIST^DIKCUTL(DIXR,.DIFLIST)
- +10 DO LOADXREF^DIKC1("","","K",DIXR,"","DIINDEX")
- +11 ;
- +12 ;Delete data in index
- +13 IF DIFLG["K"
- DO KILL(DITOP,.DIINDEX,DIFLG)
- +14 ;
- +15 ;Delete index, recompile
- +16 DO DELDEF(DIXR)
- +17 DO DIEZ(.DIFLIST,DIFLG,$GET(DIKDOUT))
- +18 DO DIKZ^DIKD(DITOP,DIFLG,$GET(DIKDOUT))
- +19 ;
- END ;Move error message if necessary and quit
- +1 IF $GET(DIKDMSG)]""
- DO CALLOUT^DIEFU(DIKDMSG)
- +2 QUIT
- +3 ;
- DELDEF(DIXR) ;Delete index definition
- +1 NEW DIK,DA
- +2 IF $GET(DIFLG)["W"
- WRITE !,"Deleting index definition ..."
- +3 SET DIK="^DD(""IX"","
- SET DA=DIXR
- DO ^DIK
- +4 QUIT
- +5 ;
- DIEZ(DIFLIST,DIFLG,DIKDOUT) ;Recompile input templates containing field
- +1 NEW DIFIL,DIFLD,DIKTEML
- +2 SET DIFIL=0
- FOR
- SET DIFIL=$ORDER(DIFLIST(DIFIL))
- IF 'DIFIL
- QUIT
- Begin DoDot:1
- +3 SET DIFLD=0
- FOR
- SET DIFLD=$ORDER(DIFLIST(DIFIL,DIFLD))
- IF 'DIFLD
- QUIT
- Begin DoDot:2
- +4 DO DIEZ^DIKD(DIFIL,DIFLD,DIFLG,$GET(DIKDOUT),.DIKTEML)
- End DoDot:2
- End DoDot:1
- +5 QUIT
- +6 ;
- CHK ;Check input parameters
- +1 IF '$GET(DIFIL)
- IF DIF["D"
- DO ERR^DIKCU2(202,"","","","FILE")
- DO QUIT
- +2 IF $GET(DIXR)]""
- Begin DoDot:1
- +3 NEW I
- FOR I=0:0
- SET I=$ORDER(^DD("IX","IX",DIXR,I))
- IF 'I
- QUIT
- IF +$GET(^DD("IX",I,0))=$GET(DIFIL)
- QUIT
- +4 IF 'I
- KILL DIXR
- End DoDot:1
- +5 IF $GET(DIXR)=""
- IF DIF["D"
- DO ERR^DIKCU2(202,"","","","CROSS-REFERENCE")
- DO QUIT
- +6 IF '$$VFLAG^DIKCU1(DIFLG,"KWcd",DIF)
- DO QUIT
- +7 IF $GET(DIQUIT)
- QUIT
- +8 SET DIXR=$ORDER(^DD("IX","BB",DIFIL,DIXR,0))
- +9 IF 'DIXR
- DO QUIT
- +10 QUIT
- +11 ;
- QUIT ;Set flag to quit
- +1 SET DIQUIT=1
- +2 QUIT
- +3 ;
- KILL(DITOP,DIINDEX,DIFLG) ;Delete index data
- +1 NEW DIFIL,DITYP,DICTRL,DIXR
- +2 ;
- +3 IF '$DATA(DIINDEX)
- QUIT
- +4 SET DIFIL=$ORDER(DIINDEX(0))
- IF 'DIFIL
- QUIT
- +5 SET DIXR=$ORDER(DIINDEX(DIFIL,0))
- IF 'DIXR
- QUIT
- +6 SET DITYP=$PIECE(DIINDEX(DIFIL,DIXR),U,4)
- +7 ;
- +8 IF $GET(DIFLG)["W"
- Begin DoDot:1
- +9 IF DITYP="R"
- WRITE !,"Removing index ..."
- +10 IF '$TEST
- WRITE !,"Executing kill logic ..."
- End DoDot:1
- +11 ;
- +12 ;Call INDEX^DIKC to execute the kill logic
- +13 SET DICTRL="K"_$SELECT(DITOP'=DIFIL:"W"_DIFIL,1:"")
- +14 SET DICTRL("LOGIC")="DIINDEX"
- +15 DO INDEX^DIKC(DITOP,"","",DIXR,.DICTRL)
- +16 QUIT
