DIKD2 ;SFISC/MKO-DELETE A NEW-STYLE INDEX ;4JAN2012
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIKD2 2451 printed Oct 16, 2024@18:49:32 Page 2
DIKD2 ;SFISC/MKO-DELETE A NEW-STYLE INDEX ;4JAN2012
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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
