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

DIKCUTL3.m

Go to the documentation of this file.
  1. DIKCUTL3 ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;10:00 AM 12 Nov 2002
  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. ;==============================================
  1. ; KSC(topFile#,.oldLogic,.newLogic,.fieldList)
  1. ;==============================================
  1. ;Run old kill logic and/or new set logic.
  1. ;Recompile input templates and xrefs.
  1. ;In:
  1. ; DIKCTOP = top level file #
  1. ; .DIKCOLD = old kill logic (as loaded by LOADXREF^DIKC1)
  1. ; .DIKCNEW = new set logic (")
  1. ; .DIKCFLIS = list of fields for input template compilation
  1. ;
  1. ;Called from CREATE^DIKCUTL1 after a new Index is created and edited.
  1. ;Called from ^DIKKUTL1 if a Uniqueness Index is created or modified.
  1. ;
  1. KSC(DIKCTOP,DIKCOLD,DIKCNEW,DIKCFLIS) ;
  1. D:$D(DIKCOLD)>1 KOLD(DIKCTOP,.DIKCOLD)
  1. D:$D(DIKCNEW)>1 SNEW(DIKCTOP,.DIKCNEW)
  1. D:$D(DIKCFLIS)>1 DIEZ(DIKCTOP,.DIKCFLIS)
  1. D DIKZ(DIKCTOP)
  1. Q
  1. ;
  1. ;===========================
  1. ; DIEZ(topFile#,.fieldList)
  1. ;===========================
  1. ;Loop through file/fields in DIKCFLIS input array.
  1. ;For each of those fields loop through the ^DIE("AF") index which
  1. ; contains the iens of the compiled input templates that use that
  1. ; field. Recompile those templates.
  1. ;In:
  1. ; DIKCTOP = top level file #
  1. ; DIKCFLIS(file#,field#) = ""
  1. ;
  1. DIEZ(DIKCTOP,DIKCFLIS) ;
  1. N DA,DI,DIKCFD,DIKCFL,DIKCIT,DMAX,DNM,X,Y
  1. ;
  1. S DIKCFL=0 F S DIKCFL=$O(DIKCFLIS(DIKCFL)) Q:'DIKCFL D
  1. . S DIKCFD=0 F S DIKCFD=$O(DIKCFLIS(DIKCFL,DIKCFD)) Q:'DIKCFD D
  1. .. S DIKCIT=0 F S DIKCIT=$O(^DIE("AF",DIKCFL,DIKCFD,DIKCIT)) Q:DIKCIT'>0 D
  1. ... Q:$D(DIKCIT(DIKCIT))#2 S DIKCIT(DIKCIT)=""
  1. ... S X=$G(^DIE(DIKCIT,"ROUOLD"))
  1. ... I X'?1(1A,1"%").7AN D I X'?1(1A,1"%").7AN D UNC^DIEZ(DIKCIT) Q
  1. .... S X=$P($G(^DIE(DIKCIT,"ROU")),U,2)
  1. ... K ^DIE("AF",DIKCFL,DIKCFD,DIKCIT),^DIE(DIKCIT,"ROU")
  1. ... S DMAX=$G(^DD("ROU")),Y=DIKCIT
  1. ... D EN^DIEZ
  1. .. ;
  1. .. I $D(^DD(DIKCFL,DIKCFD)),$P($G(^DIC(DIKCTOP,"%A")),U,2)-DT D
  1. ... S ^DD(DIKCFL,DIKCFD,"DT")=DT
  1. Q
  1. ;
  1. ;================
  1. ; DIKZ(topFile#)
  1. ;================
  1. ;Recompile cross references on file Y.
  1. ;In:
  1. ; Y = top level file #
  1. ;
  1. DIKZ(Y) ;
  1. Q:'$G(Y)
  1. N DMAX,X
  1. S X=$G(^DD(Y,0,"DIK")) Q:X=""
  1. S DMAX=^DD("ROU")
  1. D EN^DIKZ W !
  1. Q
  1. ;
  1. ;===========================
  1. ; KOLD(topFile#,.xrefLogic)
  1. ;===========================
  1. ;Determine whether to execute old kill logic; if yes, execute.
  1. ;In:
  1. ; DIKCTOP = top file #
  1. ; DIKCOLD(file#,xref#) = array as built by LOADXREF^DIKC1
  1. ;
  1. KOLD(DIKCTOP,DIKCOLD) ;
  1. Q:'$D(DIKCOLD)
  1. N DIKCFILE,DIKCMSG,DIKCTYP,DIKCUC,DIXR
  1. N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
  1. ;
  1. S DIKCFILE=$O(DIKCOLD(0)) Q:'DIKCFILE
  1. S DIXR=$O(DIKCOLD(DIKCFILE,0)) Q:'DIXR
  1. S DIKCTYP=$P(DIKCOLD(DIKCFILE,DIXR),U,4)
  1. ;
  1. ;Ask before removing Regular index or running kill logic of MUMPS xref
  1. I DIKCTYP="R" D
  1. . S DIKCMSG=" Removing old index ..."
  1. . S DIR("A")="Do you want to delete the data in the old index now"
  1. . S DIR("B")="YES"
  1. . S DIR("?",1)=" Enter 'YES' to delete the data in the old index now."
  1. . S DIR("?",2)=""
  1. . S DIR("?",3)=" You might answer 'NO' if you know that there is no data in the index, or"
  1. . S DIR("?",4)=" in order to remove the index, FileMan must loop through a large number"
  1. . S DIR("?",5)=" of entries, and you would rather wait until a non-peak time to perform"
  1. . S DIR("?",6)=" deletion. Note, however, that FileMan will use the WHOLE KILL LOGIC to"
  1. . S DIR("?")=" remove the index, so the looping time may not be an issue."
  1. E D
  1. . S DIKCMSG=" Executing old kill logic ..."
  1. . S DIR("A")="Do you want to execute the old kill logic now"
  1. . S DIR("?",1)=" Enter 'YES' to execute the original kill logic now."
  1. . S DIR("?")=" Otherwise, enter 'NO'."
  1. S DIR(0)="Y"
  1. F W ! D ^DIR Q:'$D(DUOUT) W $C(7)," Up-arrow not allowed."
  1. K DIR Q:'Y!$D(DTOUT)
  1. ;
  1. ;Write message and call INDEX^DIKC to execute the kill logic
  1. W !,DIKCMSG
  1. S DIKCUC="K"_$S(DIKCTOP'=DIKCFILE:"W"_DIKCFILE,1:"")
  1. S DIKCUC("LOGIC")="DIKCOLD"
  1. D INDEX^DIKC(DIKCTOP,"","",DIXR,.DIKCUC)
  1. W " DONE!"
  1. Q
  1. ;
  1. ;===========================
  1. ; SNEW(topFile#,.xrefLogic)
  1. ;===========================
  1. ;Determine whether to execute new set logic; if yes, execute.
  1. ;In:
  1. ; DIKCTOP = top file #
  1. ; DIKCNEW(file#,xref#) = array as built by LOADXREF^DIKC1
  1. ;
  1. SNEW(DIKCTOP,DIKCNEW) ;
  1. Q:'$D(DIKCNEW)
  1. N DIKCFILE,DIKCMSG,DIKCTYP,DIKCUC,DIXR
  1. N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
  1. ;
  1. S DIKCFILE=$O(DIKCNEW(0)) Q:'DIKCFILE
  1. S DIXR=$O(DIKCNEW(DIKCFILE,0)) Q:'DIXR
  1. S DIKCTYP=$P(DIKCNEW(DIKCFILE,DIXR),U,4)
  1. ;
  1. ;Ask before building Regular index or running set logic of MUMPS xref
  1. I DIKCTYP="R" D
  1. . S DIKCMSG=" Building new index ..."
  1. . S DIR("A")="Do you want to build the index now"
  1. . S DIR("B")="YES"
  1. . S DIR("?",1)=" Enter 'YES' to loop through all entries in the file and build the index"
  1. . S DIR("?",2)=" now."
  1. . S DIR("?",3)=""
  1. . S DIR("?",4)=" You might answer 'NO' if you know that there is no data in any of the"
  1. . S DIR("?",5)=" fields being indexed, or if the file has a large number of entries, and"
  1. . S DIR("?",6)=" you would rather wait until a non-peak time to build the index on a"
  1. . S DIR("?")=" live system."
  1. E D
  1. . S DIKCMSG=" Executing new set logic ..."
  1. . S DIR("A")="Do you want to cross reference existing data now"
  1. . S DIR("?",1)=" Enter 'YES' to execute the new set logic now."
  1. . S DIR("?")=" Otherwise, enter 'NO'."
  1. S DIR(0)="Y"
  1. F W ! D ^DIR Q:'$D(DUOUT) W $C(7)," Up-arrow not allowed."
  1. K DIR Q:'Y!$D(DTOUT)
  1. ;
  1. W !,DIKCMSG
  1. S DIKCUC="S"_$S(DIKCTOP'=DIKCFILE:"W"_DIKCFILE,1:"")
  1. S DIKCUC("LOGIC")="DIKCNEW"
  1. D INDEX^DIKC(DIKCTOP,"","",DIXR,.DIKCUC)
  1. W " DONE!"
  1. Q
  1. ;
  1. EOP ;Issue Press Return to continue prompt
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="E",DIR("A")="Press RETURN to continue"
  1. S DIR("?")="Press the RETURN or ENTER key."
  1. W ! D ^DIR
  1. Q