DIKCUTL3 ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;10:00 AM 12 Nov 2002
;;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.
;
;==============================================
; KSC(topFile#,.oldLogic,.newLogic,.fieldList)
;==============================================
;Run old kill logic and/or new set logic.
;Recompile input templates and xrefs.
;In:
; DIKCTOP = top level file #
; .DIKCOLD = old kill logic (as loaded by LOADXREF^DIKC1)
; .DIKCNEW = new set logic (")
; .DIKCFLIS = list of fields for input template compilation
;
;Called from CREATE^DIKCUTL1 after a new Index is created and edited.
;Called from ^DIKKUTL1 if a Uniqueness Index is created or modified.
;
KSC(DIKCTOP,DIKCOLD,DIKCNEW,DIKCFLIS) ;
D:$D(DIKCOLD)>1 KOLD(DIKCTOP,.DIKCOLD)
D:$D(DIKCNEW)>1 SNEW(DIKCTOP,.DIKCNEW)
D:$D(DIKCFLIS)>1 DIEZ(DIKCTOP,.DIKCFLIS)
D DIKZ(DIKCTOP)
Q
;
;===========================
; DIEZ(topFile#,.fieldList)
;===========================
;Loop through file/fields in DIKCFLIS input array.
;For each of those fields loop through the ^DIE("AF") index which
; contains the iens of the compiled input templates that use that
; field. Recompile those templates.
;In:
; DIKCTOP = top level file #
; DIKCFLIS(file#,field#) = ""
;
DIEZ(DIKCTOP,DIKCFLIS) ;
N DA,DI,DIKCFD,DIKCFL,DIKCIT,DMAX,DNM,X,Y
;
S DIKCFL=0 F S DIKCFL=$O(DIKCFLIS(DIKCFL)) Q:'DIKCFL D
. S DIKCFD=0 F S DIKCFD=$O(DIKCFLIS(DIKCFL,DIKCFD)) Q:'DIKCFD D
.. S DIKCIT=0 F S DIKCIT=$O(^DIE("AF",DIKCFL,DIKCFD,DIKCIT)) Q:DIKCIT'>0 D
... Q:$D(DIKCIT(DIKCIT))#2 S DIKCIT(DIKCIT)=""
... S X=$G(^DIE(DIKCIT,"ROUOLD"))
... I X'?1(1A,1"%").7AN D I X'?1(1A,1"%").7AN D UNC^DIEZ(DIKCIT) Q
.... S X=$P($G(^DIE(DIKCIT,"ROU")),U,2)
... K ^DIE("AF",DIKCFL,DIKCFD,DIKCIT),^DIE(DIKCIT,"ROU")
... S DMAX=$G(^DD("ROU")),Y=DIKCIT
... D EN^DIEZ
.. ;
.. I $D(^DD(DIKCFL,DIKCFD)),$P($G(^DIC(DIKCTOP,"%A")),U,2)-DT D
... S ^DD(DIKCFL,DIKCFD,"DT")=DT
Q
;
;================
; DIKZ(topFile#)
;================
;Recompile cross references on file Y.
;In:
; Y = top level file #
;
DIKZ(Y) ;
Q:'$G(Y)
N DMAX,X
S X=$G(^DD(Y,0,"DIK")) Q:X=""
S DMAX=^DD("ROU")
D EN^DIKZ W !
Q
;
;===========================
; KOLD(topFile#,.xrefLogic)
;===========================
;Determine whether to execute old kill logic; if yes, execute.
;In:
; DIKCTOP = top file #
; DIKCOLD(file#,xref#) = array as built by LOADXREF^DIKC1
;
KOLD(DIKCTOP,DIKCOLD) ;
Q:'$D(DIKCOLD)
N DIKCFILE,DIKCMSG,DIKCTYP,DIKCUC,DIXR
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
;
S DIKCFILE=$O(DIKCOLD(0)) Q:'DIKCFILE
S DIXR=$O(DIKCOLD(DIKCFILE,0)) Q:'DIXR
S DIKCTYP=$P(DIKCOLD(DIKCFILE,DIXR),U,4)
;
;Ask before removing Regular index or running kill logic of MUMPS xref
I DIKCTYP="R" D
. S DIKCMSG=" Removing old index ..."
. S DIR("A")="Do you want to delete the data in the old index now"
. S DIR("B")="YES"
. S DIR("?",1)=" Enter 'YES' to delete the data in the old index now."
. S DIR("?",2)=""
. S DIR("?",3)=" You might answer 'NO' if you know that there is no data in the index, or"
. S DIR("?",4)=" in order to remove the index, FileMan must loop through a large number"
. S DIR("?",5)=" of entries, and you would rather wait until a non-peak time to perform"
. S DIR("?",6)=" deletion. Note, however, that FileMan will use the WHOLE KILL LOGIC to"
. S DIR("?")=" remove the index, so the looping time may not be an issue."
E D
. S DIKCMSG=" Executing old kill logic ..."
. S DIR("A")="Do you want to execute the old kill logic now"
. S DIR("?",1)=" Enter 'YES' to execute the original kill logic now."
. S DIR("?")=" Otherwise, enter 'NO'."
S DIR(0)="Y"
F W ! D ^DIR Q:'$D(DUOUT) W $C(7)," Up-arrow not allowed."
K DIR Q:'Y!$D(DTOUT)
;
;Write message and call INDEX^DIKC to execute the kill logic
W !,DIKCMSG
S DIKCUC="K"_$S(DIKCTOP'=DIKCFILE:"W"_DIKCFILE,1:"")
S DIKCUC("LOGIC")="DIKCOLD"
D INDEX^DIKC(DIKCTOP,"","",DIXR,.DIKCUC)
W " DONE!"
Q
;
;===========================
; SNEW(topFile#,.xrefLogic)
;===========================
;Determine whether to execute new set logic; if yes, execute.
;In:
; DIKCTOP = top file #
; DIKCNEW(file#,xref#) = array as built by LOADXREF^DIKC1
;
SNEW(DIKCTOP,DIKCNEW) ;
Q:'$D(DIKCNEW)
N DIKCFILE,DIKCMSG,DIKCTYP,DIKCUC,DIXR
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
;
S DIKCFILE=$O(DIKCNEW(0)) Q:'DIKCFILE
S DIXR=$O(DIKCNEW(DIKCFILE,0)) Q:'DIXR
S DIKCTYP=$P(DIKCNEW(DIKCFILE,DIXR),U,4)
;
;Ask before building Regular index or running set logic of MUMPS xref
I DIKCTYP="R" D
. S DIKCMSG=" Building new index ..."
. S DIR("A")="Do you want to build the index now"
. S DIR("B")="YES"
. S DIR("?",1)=" Enter 'YES' to loop through all entries in the file and build the index"
. S DIR("?",2)=" now."
. S DIR("?",3)=""
. S DIR("?",4)=" You might answer 'NO' if you know that there is no data in any of the"
. S DIR("?",5)=" fields being indexed, or if the file has a large number of entries, and"
. S DIR("?",6)=" you would rather wait until a non-peak time to build the index on a"
. S DIR("?")=" live system."
E D
. S DIKCMSG=" Executing new set logic ..."
. S DIR("A")="Do you want to cross reference existing data now"
. S DIR("?",1)=" Enter 'YES' to execute the new set logic now."
. S DIR("?")=" Otherwise, enter 'NO'."
S DIR(0)="Y"
F W ! D ^DIR Q:'$D(DUOUT) W $C(7)," Up-arrow not allowed."
K DIR Q:'Y!$D(DTOUT)
;
W !,DIKCMSG
S DIKCUC="S"_$S(DIKCTOP'=DIKCFILE:"W"_DIKCFILE,1:"")
S DIKCUC("LOGIC")="DIKCNEW"
D INDEX^DIKC(DIKCTOP,"","",DIXR,.DIKCUC)
W " DONE!"
Q
;
EOP ;Issue Press Return to continue prompt
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="E",DIR("A")="Press RETURN to continue"
S DIR("?")="Press the RETURN or ENTER key."
W ! D ^DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIKCUTL3 6181 printed Jan 18, 2025@03:49:54 Page 2
DIKCUTL3 ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;10:00 AM 12 Nov 2002
+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 ;
+7 ;==============================================
+8 ; KSC(topFile#,.oldLogic,.newLogic,.fieldList)
+9 ;==============================================
+10 ;Run old kill logic and/or new set logic.
+11 ;Recompile input templates and xrefs.
+12 ;In:
+13 ; DIKCTOP = top level file #
+14 ; .DIKCOLD = old kill logic (as loaded by LOADXREF^DIKC1)
+15 ; .DIKCNEW = new set logic (")
+16 ; .DIKCFLIS = list of fields for input template compilation
+17 ;
+18 ;Called from CREATE^DIKCUTL1 after a new Index is created and edited.
+19 ;Called from ^DIKKUTL1 if a Uniqueness Index is created or modified.
+20 ;
KSC(DIKCTOP,DIKCOLD,DIKCNEW,DIKCFLIS) ;
+1 if $DATA(DIKCOLD)>1
DO KOLD(DIKCTOP,.DIKCOLD)
+2 if $DATA(DIKCNEW)>1
DO SNEW(DIKCTOP,.DIKCNEW)
+3 if $DATA(DIKCFLIS)>1
DO DIEZ(DIKCTOP,.DIKCFLIS)
+4 DO DIKZ(DIKCTOP)
+5 QUIT
+6 ;
+7 ;===========================
+8 ; DIEZ(topFile#,.fieldList)
+9 ;===========================
+10 ;Loop through file/fields in DIKCFLIS input array.
+11 ;For each of those fields loop through the ^DIE("AF") index which
+12 ; contains the iens of the compiled input templates that use that
+13 ; field. Recompile those templates.
+14 ;In:
+15 ; DIKCTOP = top level file #
+16 ; DIKCFLIS(file#,field#) = ""
+17 ;
DIEZ(DIKCTOP,DIKCFLIS) ;
+1 NEW DA,DI,DIKCFD,DIKCFL,DIKCIT,DMAX,DNM,X,Y
+2 ;
+3 SET DIKCFL=0
FOR
SET DIKCFL=$ORDER(DIKCFLIS(DIKCFL))
if 'DIKCFL
QUIT
Begin DoDot:1
+4 SET DIKCFD=0
FOR
SET DIKCFD=$ORDER(DIKCFLIS(DIKCFL,DIKCFD))
if 'DIKCFD
QUIT
Begin DoDot:2
+5 SET DIKCIT=0
FOR
SET DIKCIT=$ORDER(^DIE("AF",DIKCFL,DIKCFD,DIKCIT))
if DIKCIT'>0
QUIT
Begin DoDot:3
+6 if $DATA(DIKCIT(DIKCIT))#2
QUIT
SET DIKCIT(DIKCIT)=""
+7 SET X=$GET(^DIE(DIKCIT,"ROUOLD"))
+8 IF X'?1(1A,1"%").7AN
Begin DoDot:4
+9 SET X=$PIECE($GET(^DIE(DIKCIT,"ROU")),U,2)
End DoDot:4
IF X'?1(1A,1"%").7AN
DO UNC^DIEZ(DIKCIT)
QUIT
+10 KILL ^DIE("AF",DIKCFL,DIKCFD,DIKCIT),^DIE(DIKCIT,"ROU")
+11 SET DMAX=$GET(^DD("ROU"))
SET Y=DIKCIT
+12 DO EN^DIEZ
End DoDot:3
+13 ;
+14 IF $DATA(^DD(DIKCFL,DIKCFD))
IF $PIECE($GET(^DIC(DIKCTOP,"%A")),U,2)-DT
Begin DoDot:3
+15 SET ^DD(DIKCFL,DIKCFD,"DT")=DT
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
+18 ;================
+19 ; DIKZ(topFile#)
+20 ;================
+21 ;Recompile cross references on file Y.
+22 ;In:
+23 ; Y = top level file #
+24 ;
DIKZ(Y) ;
+1 if '$GET(Y)
QUIT
+2 NEW DMAX,X
+3 SET X=$GET(^DD(Y,0,"DIK"))
if X=""
QUIT
+4 SET DMAX=^DD("ROU")
+5 DO EN^DIKZ
WRITE !
+6 QUIT
+7 ;
+8 ;===========================
+9 ; KOLD(topFile#,.xrefLogic)
+10 ;===========================
+11 ;Determine whether to execute old kill logic; if yes, execute.
+12 ;In:
+13 ; DIKCTOP = top file #
+14 ; DIKCOLD(file#,xref#) = array as built by LOADXREF^DIKC1
+15 ;
KOLD(DIKCTOP,DIKCOLD) ;
+1 if '$DATA(DIKCOLD)
QUIT
+2 NEW DIKCFILE,DIKCMSG,DIKCTYP,DIKCUC,DIXR
+3 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+4 ;
+5 SET DIKCFILE=$ORDER(DIKCOLD(0))
if 'DIKCFILE
QUIT
+6 SET DIXR=$ORDER(DIKCOLD(DIKCFILE,0))
if 'DIXR
QUIT
+7 SET DIKCTYP=$PIECE(DIKCOLD(DIKCFILE,DIXR),U,4)
+8 ;
+9 ;Ask before removing Regular index or running kill logic of MUMPS xref
+10 IF DIKCTYP="R"
Begin DoDot:1
+11 SET DIKCMSG=" Removing old index ..."
+12 SET DIR("A")="Do you want to delete the data in the old index now"
+13 SET DIR("B")="YES"
+14 SET DIR("?",1)=" Enter 'YES' to delete the data in the old index now."
+15 SET DIR("?",2)=""
+16 SET DIR("?",3)=" You might answer 'NO' if you know that there is no data in the index, or"
+17 SET DIR("?",4)=" in order to remove the index, FileMan must loop through a large number"
+18 SET DIR("?",5)=" of entries, and you would rather wait until a non-peak time to perform"
+19 SET DIR("?",6)=" deletion. Note, however, that FileMan will use the WHOLE KILL LOGIC to"
+20 SET DIR("?")=" remove the index, so the looping time may not be an issue."
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 SET DIKCMSG=" Executing old kill logic ..."
+23 SET DIR("A")="Do you want to execute the old kill logic now"
+24 SET DIR("?",1)=" Enter 'YES' to execute the original kill logic now."
+25 SET DIR("?")=" Otherwise, enter 'NO'."
End DoDot:1
+26 SET DIR(0)="Y"
+27 FOR
WRITE !
DO ^DIR
if '$DATA(DUOUT)
QUIT
WRITE $CHAR(7)," Up-arrow not allowed."
+28 KILL DIR
if 'Y!$DATA(DTOUT)
QUIT
+29 ;
+30 ;Write message and call INDEX^DIKC to execute the kill logic
+31 WRITE !,DIKCMSG
+32 SET DIKCUC="K"_$SELECT(DIKCTOP'=DIKCFILE:"W"_DIKCFILE,1:"")
+33 SET DIKCUC("LOGIC")="DIKCOLD"
+34 DO INDEX^DIKC(DIKCTOP,"","",DIXR,.DIKCUC)
+35 WRITE " DONE!"
+36 QUIT
+37 ;
+38 ;===========================
+39 ; SNEW(topFile#,.xrefLogic)
+40 ;===========================
+41 ;Determine whether to execute new set logic; if yes, execute.
+42 ;In:
+43 ; DIKCTOP = top file #
+44 ; DIKCNEW(file#,xref#) = array as built by LOADXREF^DIKC1
+45 ;
SNEW(DIKCTOP,DIKCNEW) ;
+1 if '$DATA(DIKCNEW)
QUIT
+2 NEW DIKCFILE,DIKCMSG,DIKCTYP,DIKCUC,DIXR
+3 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+4 ;
+5 SET DIKCFILE=$ORDER(DIKCNEW(0))
if 'DIKCFILE
QUIT
+6 SET DIXR=$ORDER(DIKCNEW(DIKCFILE,0))
if 'DIXR
QUIT
+7 SET DIKCTYP=$PIECE(DIKCNEW(DIKCFILE,DIXR),U,4)
+8 ;
+9 ;Ask before building Regular index or running set logic of MUMPS xref
+10 IF DIKCTYP="R"
Begin DoDot:1
+11 SET DIKCMSG=" Building new index ..."
+12 SET DIR("A")="Do you want to build the index now"
+13 SET DIR("B")="YES"
+14 SET DIR("?",1)=" Enter 'YES' to loop through all entries in the file and build the index"
+15 SET DIR("?",2)=" now."
+16 SET DIR("?",3)=""
+17 SET DIR("?",4)=" You might answer 'NO' if you know that there is no data in any of the"
+18 SET DIR("?",5)=" fields being indexed, or if the file has a large number of entries, and"
+19 SET DIR("?",6)=" you would rather wait until a non-peak time to build the index on a"
+20 SET DIR("?")=" live system."
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 SET DIKCMSG=" Executing new set logic ..."
+23 SET DIR("A")="Do you want to cross reference existing data now"
+24 SET DIR("?",1)=" Enter 'YES' to execute the new set logic now."
+25 SET DIR("?")=" Otherwise, enter 'NO'."
End DoDot:1
+26 SET DIR(0)="Y"
+27 FOR
WRITE !
DO ^DIR
if '$DATA(DUOUT)
QUIT
WRITE $CHAR(7)," Up-arrow not allowed."
+28 KILL DIR
if 'Y!$DATA(DTOUT)
QUIT
+29 ;
+30 WRITE !,DIKCMSG
+31 SET DIKCUC="S"_$SELECT(DIKCTOP'=DIKCFILE:"W"_DIKCFILE,1:"")
+32 SET DIKCUC("LOGIC")="DIKCNEW"
+33 DO INDEX^DIKC(DIKCTOP,"","",DIXR,.DIKCUC)
+34 WRITE " DONE!"
+35 QUIT
+36 ;
EOP ;Issue Press Return to continue prompt
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
+3 SET DIR("?")="Press the RETURN or ENTER key."
+4 WRITE !
DO ^DIR
+5 QUIT
