DIKCUTL.m

DIKCUTL ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;2:57 PM  25 Apr 2002 [ 12/09/2003  4:10 PM ]

 ;;22.0;VA FileMan;**68,108,1002**;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

MOD ;Utility option to modify an index

 N DIKCCNT,DIKCFILE,DIKCQUIT,DIKCROOT,DIKCTOP,DIXR

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 ;

 ;Prompt for file

 D SELFILE^DIKCU(.DIKCROOT,.DIKCTOP,.DIKCFILE)

 Q:$G(DIKCROOT)=""  Q:'$G(DIKCTOP)

 S:'$G(DIKCFILE) DIKCFILE=DIKCTOP

 ;

REMOD ;Get and list indexes

 I $G(DIKCQUIT) W ! Q

 D GETXR^DIKCUTL2(DIKCFILE,.DIKCCNT)

 W ! D LIST^DIKCUTL2(.DIKCCNT)

 ;

 ;Prompt for action

 I 'DIKCCNT S Y="C"

 E  D RD^DICD I $D(DIRUT) W ! Q

 ;

 ;Delete

 I Y="D" D  G REMOD

 . S DIXR=$$CHOOSE^DIKCUTL2(.DIKCCNT,"delete") Q:'DIXR

 . I $D(^DD("KEY","AU",DIXR)) W ! D PRTMSG^DIKCUTL2(DIXR) Q

 . S DIR(0)="Y"

 . S DIR("A")="Are you sure you want to delete the index definition"

 . S DIR("B")="NO"

 . D ^DIR K DIR Q:$D(DIRUT)!'Y

 . D DELETE(DIXR,DIKCTOP,DIKCFILE)

 ;

 ;Edit

 I Y="E" D  G REMOD

 . S DIXR=$$CHOOSE^DIKCUTL2(.DIKCCNT,"edit") Q:'DIXR

 . D EDIT(DIXR,DIKCTOP,DIKCFILE)

 ;

 ;Create

 I Y="C" D  G REMOD

 . S DIR(0)="Y",DIR("B")="No"

 . S DIR("A")="Want to create a new index for this file"

 . D ^DIR K DIR I $D(DIRUT)!'Y S:'DIKCCNT DIKCQUIT=1 Q

 . D CREATE^DIKCUTL1(DIKCTOP,DIKCFILE)

 Q

 ;

DELETE(DIXR,DIKCTOP,DIKCFILE) ;Delete an index

 N DA,DIK,DIKCFLIS,DIKCOLD

 D GETFLIST(DIXR,.DIKCFLIS)

 D LOADXREF^DIKC1(DIKCFILE,"","K",DIXR,"","DIKCOLD")

 ;

 ;Delete the index

 S DIK="^DD(""IX"",",DA=DIXR D ^DIK K DIK,DA

 W !!,"  Index definition deleted."

 ;

 ;Run kill logic, recompile

 D KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,"",.DIKCFLIS)

 Q

 ;

EDIT(DIXR,DIKCTOP,DIKCFILE) ;Edit an index

 N DA,DDSCHANG,DDSFILE,DDSPARM,DR

 N DIKCFLIS,DIKCNEW,DIKCOLD,DIKCREB

 ;

 ;Save original fields list and logic

 D GETFLIST(DIXR,.DIKCFLIS)

 D LOADXREF^DIKC1(DIKCFILE,"","KS",DIXR,"","DIKCOLD")

 ;

 ;Invoke form to edit, quit if there were no changes

 S DDSFILE=.11,DA=DIXR,DDSPARM="C"

 S DR="[DIKC EDIT"_$S($D(^DD("KEY","AU",DIXR)):" UI]",1:"]")

 D ^DDS Q:'$G(DDSCHANG)  K DDSFILE,DA,DDSPARM,DR

 ;

 ;If index was deleted, run kill logic, recompile and quit

 I $D(^DD("IX",DIXR,0))[0 D  Q

 . K DIKCOLD(DIKCFILE,DIXR,"S"),DIKCOLD(DIKCFILE,DIXR,"SC")

 . D KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,"",.DIKCFLIS)

 ;

 ;Rebuild the set/kill logic if a crv was deleted,

 ;but form was not saved.

 ;Deleting a crv sets DIKCREB; saving the form, kills it.

 D:$G(DIKCREB) BLDLOG^DIKCUTL2(DIXR)

 ;

 ;Load new logic; quit if equal to old logic

 D LOADXREF^DIKC1(DIKCFILE,"","KS",DIXR,"","DIKCNEW")

 Q:$$GCMP^DIKCU2("DIKCOLD","DIKCNEW")

 ;

 ;Run old kill logic and new set logic.

 ;Add new fields to list, and recompile input templates and xrefs.

 D GETFLIST(DIXR,.DIKCFLIS)

 K DIKCOLD(DIKCFILE,DIXR,"S"),DIKCOLD(DIKCFILE,DIXR,"SC")

 D KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,.DIKCNEW,.DIKCFLIS)

 Q

 ;

 ;============================

 ;GETFLIST(index#,.fieldList)

 ;============================

 ;Loop through Cross Reference Values multiple and

 ;build list of fields used in Index XR. (Existing items in fieldList

 ;array are NOT deleted.)

 ;In:

 ; XR = Index ien

 ;Out:

 ; FLIST(file#,field#) = ""

 ;

GETFLIST(XR,FLIST) ;

 N FIL,FLD,I

 S I=0 F  S I=$O(^DD("IX",XR,11.1,I)) Q:'I  D

 . Q:$P($G(^DD("IX",XR,11.1,I,0)),U,2)'="F"

 . S FIL=$P(^DD("IX",XR,11.1,I,0),U,3),FLD=$P(^(0),U,4) Q:'FIL  Q:'FLD

 . S FLIST(FIL,FLD)=""

 Q

DIKCUTL   ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;2:57 PM  25 Apr 2002 [ 12/09/2003  4:10 PM ]

 +1       ;;22.0;VA FileMan;**68,108,1002**;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

MOD       ;Utility option to modify an index

 +1        NEW DIKCCNT,DIKCFILE,DIKCQUIT,DIKCROOT,DIKCTOP,DIXR

 +2        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 +3       ;

 +4       ;Prompt for file

 +5        DO SELFILE^DIKCU(.DIKCROOT,.DIKCTOP,.DIKCFILE)

 +6        IF $GET(DIKCROOT)=""

               QUIT 

           IF '$GET(DIKCTOP)

               QUIT 

 +7        IF '$GET(DIKCFILE)

               SET DIKCFILE=DIKCTOP

 +8       ;

REMOD     ;Get and list indexes

 +1        IF $GET(DIKCQUIT)

               WRITE !

               QUIT 

 +2        DO GETXR^DIKCUTL2(DIKCFILE,.DIKCCNT)

 +3        WRITE !

           DO LIST^DIKCUTL2(.DIKCCNT)

 +4       ;

 +5       ;Prompt for action

 +6        IF 'DIKCCNT

               SET Y="C"

 +7       IF '$TEST

               DO RD^DICD

               IF $DATA(DIRUT)

                   WRITE !

                   QUIT 

 +8       ;

 +9       ;Delete

 +10       IF Y="D"

               Begin DoDot:1

 +11               SET DIXR=$$CHOOSE^DIKCUTL2(.DIKCCNT,"delete")

                   IF 'DIXR

                       QUIT 

 +12               IF $DATA(^DD("KEY","AU",DIXR))

                       WRITE !

                       DO PRTMSG^DIKCUTL2(DIXR)

                       QUIT 

 +13               SET DIR(0)="Y"

 +14               SET DIR("A")="Are you sure you want to delete the index definition"

 +15               SET DIR("B")="NO"

 +16               DO ^DIR

                   KILL DIR

                   IF $DATA(DIRUT)!'Y

                       QUIT 

 +17               DO DELETE(DIXR,DIKCTOP,DIKCFILE)

               End DoDot:1

               GOTO REMOD

 +18      ;

 +19      ;Edit

 +20       IF Y="E"

               Begin DoDot:1

 +21               SET DIXR=$$CHOOSE^DIKCUTL2(.DIKCCNT,"edit")

                   IF 'DIXR

                       QUIT 

 +22               DO EDIT(DIXR,DIKCTOP,DIKCFILE)

               End DoDot:1

               GOTO REMOD

 +23      ;

 +24      ;Create

 +25       IF Y="C"

               Begin DoDot:1

 +26               SET DIR(0)="Y"

                   SET DIR("B")="No"

 +27               SET DIR("A")="Want to create a new index for this file"

 +28               DO ^DIR

                   KILL DIR

                   IF $DATA(DIRUT)!'Y

                       IF 'DIKCCNT

                           SET DIKCQUIT=1

                       QUIT 

 +29               DO CREATE^DIKCUTL1(DIKCTOP,DIKCFILE)

               End DoDot:1

               GOTO REMOD

 +30       QUIT 

 +31      ;

DELETE(DIXR,DIKCTOP,DIKCFILE) ;Delete an index

 +1        NEW DA,DIK,DIKCFLIS,DIKCOLD

 +2        DO GETFLIST(DIXR,.DIKCFLIS)

 +3        DO LOADXREF^DIKC1(DIKCFILE,"","K",DIXR,"","DIKCOLD")

 +4       ;

 +5       ;Delete the index

 +6        SET DIK="^DD(""IX"","

           SET DA=DIXR

           DO ^DIK

           KILL DIK,DA

 +7        WRITE !!,"  Index definition deleted."

 +8       ;

 +9       ;Run kill logic, recompile

 +10       DO KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,"",.DIKCFLIS)

 +11       QUIT 

 +12      ;

EDIT(DIXR,DIKCTOP,DIKCFILE) ;Edit an index

 +1        NEW DA,DDSCHANG,DDSFILE,DDSPARM,DR

 +2        NEW DIKCFLIS,DIKCNEW,DIKCOLD,DIKCREB

 +3       ;

 +4       ;Save original fields list and logic

 +5        DO GETFLIST(DIXR,.DIKCFLIS)

 +6        DO LOADXREF^DIKC1(DIKCFILE,"","KS",DIXR,"","DIKCOLD")

 +7       ;

 +8       ;Invoke form to edit, quit if there were no changes

 +9        SET DDSFILE=.11

           SET DA=DIXR

           SET DDSPARM="C"

 +10       SET DR="[DIKC EDIT"_$SELECT($DATA(^DD("KEY","AU",DIXR)):" UI]",1:"]")

 +11       DO ^DDS

           IF '$GET(DDSCHANG)

               QUIT 

           KILL DDSFILE,DA,DDSPARM,DR

 +12      ;

 +13      ;If index was deleted, run kill logic, recompile and quit

 +14       IF $DATA(^DD("IX",DIXR,0))[0

               Begin DoDot:1

 +15               KILL DIKCOLD(DIKCFILE,DIXR,"S"),DIKCOLD(DIKCFILE,DIXR,"SC")

 +16               DO KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,"",.DIKCFLIS)

               End DoDot:1

               QUIT 

 +17      ;

 +18      ;Rebuild the set/kill logic if a crv was deleted,

 +19      ;but form was not saved.

 +20      ;Deleting a crv sets DIKCREB; saving the form, kills it.

 +21       IF $GET(DIKCREB)

               DO BLDLOG^DIKCUTL2(DIXR)

 +22      ;

 +23      ;Load new logic; quit if equal to old logic

 +24       DO LOADXREF^DIKC1(DIKCFILE,"","KS",DIXR,"","DIKCNEW")

 +25       IF $$GCMP^DIKCU2("DIKCOLD","DIKCNEW")

               QUIT 

 +26      ;

 +27      ;Run old kill logic and new set logic.

 +28      ;Add new fields to list, and recompile input templates and xrefs.

 +29       DO GETFLIST(DIXR,.DIKCFLIS)

 +30       KILL DIKCOLD(DIKCFILE,DIXR,"S"),DIKCOLD(DIKCFILE,DIXR,"SC")

 +31       DO KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,.DIKCNEW,.DIKCFLIS)

 +32       QUIT 

 +33      ;

 +34      ;============================

 +35      ;GETFLIST(index#,.fieldList)

 +36      ;============================

 +37      ;Loop through Cross Reference Values multiple and

 +38      ;build list of fields used in Index XR. (Existing items in fieldList

 +39      ;array are NOT deleted.)

 +40      ;In:

 +41      ; XR = Index ien

 +42      ;Out:

 +43      ; FLIST(file#,field#) = ""

 +44      ;

GETFLIST(XR,FLIST) ;

 +1        NEW FIL,FLD,I

 +2        SET I=0

           FOR 

               SET I=$ORDER(^DD("IX",XR,11.1,I))

               IF 'I

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^DD("IX",XR,11.1,I,0)),U,2)'="F"

                       QUIT 

 +4                SET FIL=$PIECE(^DD("IX",XR,11.1,I,0),U,3)

                   SET FLD=$PIECE(^(0),U,4)

                   IF 'FIL

                       QUIT 

                   IF 'FLD

                       QUIT 

 +5                SET FLIST(FIL,FLD)=""

               End DoDot:1

 +6        QUIT