| 1 | DIKCUTL ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;2:57 PM 25 Apr 2002
|
|---|
| 2 | ;;22.0;VA FileMan;**68,108**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | MOD ;Utility option to modify an index
|
|---|
| 6 | N DIKCCNT,DIKCFILE,DIKCQUIT,DIKCROOT,DIKCTOP,DIXR
|
|---|
| 7 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 8 | ;
|
|---|
| 9 | ;Prompt for file
|
|---|
| 10 | D SELFILE^DIKCU(.DIKCROOT,.DIKCTOP,.DIKCFILE)
|
|---|
| 11 | Q:$G(DIKCROOT)="" Q:'$G(DIKCTOP)
|
|---|
| 12 | S:'$G(DIKCFILE) DIKCFILE=DIKCTOP
|
|---|
| 13 | ;
|
|---|
| 14 | REMOD ;Get and list indexes
|
|---|
| 15 | I $G(DIKCQUIT) W ! Q
|
|---|
| 16 | D GETXR^DIKCUTL2(DIKCFILE,.DIKCCNT)
|
|---|
| 17 | W ! D LIST^DIKCUTL2(.DIKCCNT)
|
|---|
| 18 | ;
|
|---|
| 19 | ;Prompt for action
|
|---|
| 20 | I 'DIKCCNT S Y="C"
|
|---|
| 21 | E D RD^DICD I $D(DIRUT) W ! Q
|
|---|
| 22 | ;
|
|---|
| 23 | ;Delete
|
|---|
| 24 | I Y="D" D G REMOD
|
|---|
| 25 | . S DIXR=$$CHOOSE^DIKCUTL2(.DIKCCNT,"delete") Q:'DIXR
|
|---|
| 26 | . I $D(^DD("KEY","AU",DIXR)) W ! D PRTMSG^DIKCUTL2(DIXR) Q
|
|---|
| 27 | . S DIR(0)="Y"
|
|---|
| 28 | . S DIR("A")="Are you sure you want to delete the index definition"
|
|---|
| 29 | . S DIR("B")="NO"
|
|---|
| 30 | . D ^DIR K DIR Q:$D(DIRUT)!'Y
|
|---|
| 31 | . D DELETE(DIXR,DIKCTOP,DIKCFILE)
|
|---|
| 32 | ;
|
|---|
| 33 | ;Edit
|
|---|
| 34 | I Y="E" D G REMOD
|
|---|
| 35 | . S DIXR=$$CHOOSE^DIKCUTL2(.DIKCCNT,"edit") Q:'DIXR
|
|---|
| 36 | . D EDIT(DIXR,DIKCTOP,DIKCFILE)
|
|---|
| 37 | ;
|
|---|
| 38 | ;Create
|
|---|
| 39 | I Y="C" D G REMOD
|
|---|
| 40 | . S DIR(0)="Y",DIR("B")="No"
|
|---|
| 41 | . S DIR("A")="Want to create a new index for this file"
|
|---|
| 42 | . D ^DIR K DIR I $D(DIRUT)!'Y S:'DIKCCNT DIKCQUIT=1 Q
|
|---|
| 43 | . D CREATE^DIKCUTL1(DIKCTOP,DIKCFILE)
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | DELETE(DIXR,DIKCTOP,DIKCFILE) ;Delete an index
|
|---|
| 47 | N DA,DIK,DIKCFLIS,DIKCOLD
|
|---|
| 48 | D GETFLIST(DIXR,.DIKCFLIS)
|
|---|
| 49 | D LOADXREF^DIKC1(DIKCFILE,"","K",DIXR,"","DIKCOLD")
|
|---|
| 50 | ;
|
|---|
| 51 | ;Delete the index
|
|---|
| 52 | S DIK="^DD(""IX"",",DA=DIXR D ^DIK K DIK,DA
|
|---|
| 53 | W !!," Index definition deleted."
|
|---|
| 54 | ;
|
|---|
| 55 | ;Run kill logic, recompile
|
|---|
| 56 | D KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,"",.DIKCFLIS)
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | EDIT(DIXR,DIKCTOP,DIKCFILE) ;Edit an index
|
|---|
| 60 | N DA,DDSCHANG,DDSFILE,DDSPARM,DR
|
|---|
| 61 | N DIKCFLIS,DIKCNEW,DIKCOLD,DIKCREB
|
|---|
| 62 | ;
|
|---|
| 63 | ;Save original fields list and logic
|
|---|
| 64 | D GETFLIST(DIXR,.DIKCFLIS)
|
|---|
| 65 | D LOADXREF^DIKC1(DIKCFILE,"","KS",DIXR,"","DIKCOLD")
|
|---|
| 66 | ;
|
|---|
| 67 | ;Invoke form to edit, quit if there were no changes
|
|---|
| 68 | S DDSFILE=.11,DA=DIXR,DDSPARM="C"
|
|---|
| 69 | S DR="[DIKC EDIT"_$S($D(^DD("KEY","AU",DIXR)):" UI]",1:"]")
|
|---|
| 70 | D ^DDS Q:'$G(DDSCHANG) K DDSFILE,DA,DDSPARM,DR
|
|---|
| 71 | ;
|
|---|
| 72 | ;If index was deleted, run kill logic, recompile and quit
|
|---|
| 73 | I $D(^DD("IX",DIXR,0))[0 D Q
|
|---|
| 74 | . K DIKCOLD(DIKCFILE,DIXR,"S"),DIKCOLD(DIKCFILE,DIXR,"SC")
|
|---|
| 75 | . D KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,"",.DIKCFLIS)
|
|---|
| 76 | ;
|
|---|
| 77 | ;Rebuild the set/kill logic if a crv was deleted,
|
|---|
| 78 | ;but form was not saved.
|
|---|
| 79 | ;Deleting a crv sets DIKCREB; saving the form, kills it.
|
|---|
| 80 | D:$G(DIKCREB) BLDLOG^DIKCUTL2(DIXR)
|
|---|
| 81 | ;
|
|---|
| 82 | ;Load new logic; quit if equal to old logic
|
|---|
| 83 | D LOADXREF^DIKC1(DIKCFILE,"","KS",DIXR,"","DIKCNEW")
|
|---|
| 84 | Q:$$GCMP^DIKCU2("DIKCOLD","DIKCNEW")
|
|---|
| 85 | ;
|
|---|
| 86 | ;Run old kill logic and new set logic.
|
|---|
| 87 | ;Add new fields to list, and recompile input templates and xrefs.
|
|---|
| 88 | D GETFLIST(DIXR,.DIKCFLIS)
|
|---|
| 89 | K DIKCOLD(DIKCFILE,DIXR,"S"),DIKCOLD(DIKCFILE,DIXR,"SC")
|
|---|
| 90 | D KSC^DIKCUTL3(DIKCTOP,.DIKCOLD,.DIKCNEW,.DIKCFLIS)
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | ;============================
|
|---|
| 94 | ;GETFLIST(index#,.fieldList)
|
|---|
| 95 | ;============================
|
|---|
| 96 | ;Loop through Cross Reference Values multiple and
|
|---|
| 97 | ;build list of fields used in Index XR. (Existing items in fieldList
|
|---|
| 98 | ;array are NOT deleted.)
|
|---|
| 99 | ;In:
|
|---|
| 100 | ; XR = Index ien
|
|---|
| 101 | ;Out:
|
|---|
| 102 | ; FLIST(file#,field#) = ""
|
|---|
| 103 | ;
|
|---|
| 104 | GETFLIST(XR,FLIST) ;
|
|---|
| 105 | N FIL,FLD,I
|
|---|
| 106 | S I=0 F S I=$O(^DD("IX",XR,11.1,I)) Q:'I D
|
|---|
| 107 | . Q:$P($G(^DD("IX",XR,11.1,I,0)),U,2)'="F"
|
|---|
| 108 | . S FIL=$P(^DD("IX",XR,11.1,I,0),U,3),FLD=$P(^(0),U,4) Q:'FIL Q:'FLD
|
|---|
| 109 | . S FLIST(FIL,FLD)=""
|
|---|
| 110 | Q
|
|---|
