111 lines
3.3 KiB
Mathematica
111 lines
3.3 KiB
Mathematica
DIKCUTL ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;2:57 PM 25 Apr 2002
|
|
;;22.0;VA FileMan;**68,108**;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
|