- 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 Feb 19, 2025@00:15:10 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