147 lines
4.9 KiB
Mathematica
147 lines
4.9 KiB
Mathematica
DIKCUTL1 ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;9:10 AM 7 Aug 2001
|
|
;;22.0;VA FileMan;**11,68**;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
CREATE(DIKCTOP,DIKCFILE) ;Create a new index
|
|
N DIKCF01,DIKCFLIS,DIKCNAME,DIKCNEW,DIKCTLIS,DIKCTYPE,DIKCUSE,DIXR
|
|
N DA,DDSFILE,DR
|
|
;
|
|
;Get Type, File, Use, and Name
|
|
S DIKCTYPE=$$TYPE Q:DIKCTYPE=-1
|
|
S DIKCF01=$$FILE01(DIKCTOP,DIKCFILE) Q:DIKCF01=-1
|
|
S DIKCUSE=$$USE(DIKCTYPE) Q:DIKCUSE=-1
|
|
S DIKCNAME=$$NAME(DIKCF01,DIKCUSE) Q:DIKCNAME=-1
|
|
;
|
|
;Create the new index in the Index file
|
|
D ADD(DIKCF01,DIKCFILE,DIKCNAME,DIKCTYPE,DIKCUSE,.DIXR) Q:DIXR=-1
|
|
;
|
|
;Invoke form to edit index, quit if deleted,
|
|
;delete if no short description
|
|
S DDSFILE=.11,DA=DIXR,DR="[DIKC EDIT]" D ^DDS K DDSFILE,DA,DR
|
|
Q:$D(^DD("IX",DIXR,0))[0
|
|
I $P($G(^DD("IX",DIXR,0)),U,3)="" D Q
|
|
. N DIK,DA
|
|
. S DIK="^DD(""IX"",",DA=DIXR D ^DIK
|
|
. W !!," Index definition deleted."
|
|
;
|
|
;Get new fields list and set logic.
|
|
;Modify the trigger logic of fields that trigger fields in the index
|
|
;Set new index, recompile input templates and xrefs.
|
|
D GETFLIST^DIKCUTL(DIXR,.DIKCFLIS)
|
|
K DIKCTLIS D TRIG^DICR(.DIKCFLIS,.DIKCTLIS)
|
|
D:$D(DIKCTLIS) DIEZ^DIKCUTL3(" ",.DIKCTLIS)
|
|
D LOADXREF^DIKC1(DIKCFILE,"","S",DIXR,"","DIKCNEW")
|
|
D KSC^DIKCUTL3(DIKCTOP,"",.DIKCNEW,.DIKCFLIS)
|
|
Q
|
|
;
|
|
TYPE() ;Prompt for index type (regular or MUMPS)
|
|
N DIKCTYPE,DIR,DIROUT,DIRUT,DTOUT,X,Y
|
|
;
|
|
S DIR(0)=".11,.2",DIR("A")="Type of index",DIR("B")="REGULAR"
|
|
F D Q:$D(DIRUT)!$D(DIKCTYPE)
|
|
. W ! D ^DIR Q:$D(DIRUT)
|
|
. I Y="MU",$G(DUZ(0))'="@" D
|
|
.. W !,$C(7)_"Only programmers can create MUMPS cross references."
|
|
. E I Y="MU",$P($G(^DD(DIKCTOP,0,"DI")),U)="Y" D
|
|
.. W !,$C(7)_"Cannot create MUMPS cross references on archived files."
|
|
. E S DIKCTYPE=Y
|
|
;
|
|
Q $S($D(DIRUT):-1,1:DIKCTYPE)
|
|
;
|
|
FILE01(DIKCTOP,DIKCFILE) ;Return file on which to store xref
|
|
;If DIKCFILE is not a subfile, return that file #
|
|
I DIKCTOP=DIKCFILE Q DIKCFILE
|
|
;
|
|
;Otherwise, prompt for file on which to store xref
|
|
N FILE01,FINFO,LEV
|
|
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|
;
|
|
;Get info on subfile DICKFILE
|
|
D FINFO^DIKCU1(DIKCFILE,.FINFO)
|
|
;
|
|
;Prompt for whether whole file indexes should be created
|
|
W !
|
|
S DIR(0)="Y",DIR("B")="Yes"
|
|
S DIR("?")=" Enter 'Yes' if you want the index to reside at this level."
|
|
F LEV=0:1:$O(FINFO(""),-1)-1 D Q:$D(DIRUT)!$D(FILE01)
|
|
. S DIR("A")="Want to index whole "_$S(LEV:"sub",1:"")_"file "_$P(FINFO(LEV),U,3)_" (#"_$P(FINFO(LEV),U)_")"
|
|
. D ^DIR Q:$D(DIRUT)!'Y
|
|
. S FILE01=$P(FINFO(LEV),U)
|
|
;
|
|
Q $S($D(DIRUT):-1,'$D(FILE01):DIKCFILE,1:FILE01)
|
|
;
|
|
USE(DIKCTYPE) ;Prompt for Use (Lookup or Lookup & Sorting)
|
|
;DIKCTYPE = type of index
|
|
;
|
|
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|
S DIR(0)=".11,.42"
|
|
I $G(DIKCTYPE)="MU" D
|
|
. S DIR("A")="How is this MUMPS cross reference to be used"
|
|
. S DIR("B")="ACTION"
|
|
E D
|
|
. S DIR("A",1)="Want index to be used for Lookup & Sorting"
|
|
. S DIR("A")=" or Sorting Only"
|
|
. S DIR("B")="LOOKUP & SORTING"
|
|
. S DIR(0)=DIR(0)_"^^I X=""A"" W !!,$C(7)_""** Only MUMPS cross references can be ACTION-type cross references. **"" K X"
|
|
W ! D ^DIR K DIR
|
|
Q $S($D(DTOUT)!$D(DUOUT):-1,1:Y)
|
|
;
|
|
NAME(DIKCF01,DIKCUSE) ;Get next available index name
|
|
N DIKCASC,DIKCNAME,DIKCSTRT
|
|
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|
;
|
|
;Get next available index name
|
|
S DIKCSTRT=$S(DIKCUSE="LS":"",1:"A")
|
|
F DIKCASC=67:1 D Q:DIKCNAME]""
|
|
. S DIKCNAME=DIKCSTRT_$C(DIKCASC)
|
|
. I $D(^DD("IX","BB",DIKCF01,DIKCNAME)) S DIKCNAME="" Q
|
|
. I $D(^DD(DIKCF01,0,"IX",DIKCNAME)) S DIKCNAME="" Q
|
|
;
|
|
;If not a programmer, return next available index name
|
|
Q:DUZ(0)'="@" DIKCNAME
|
|
;
|
|
;Otherwise, prompt for index name
|
|
W !
|
|
S DIR(0)=".11,.02"
|
|
S DIR("A")="Index Name",DIR("B")=DIKCNAME
|
|
F D Q:$D(X)!$D(DIRUT)
|
|
. D ^DIR Q:$D(DIRUT)
|
|
. ;
|
|
. ;Check response; print message and kill X if invalid
|
|
. I DIKCUSE="LS",$E(X)="A" D Q
|
|
.. D NAMERR("Indexes used for Lookup & Sorting cannot start with 'A'")
|
|
. I DIKCUSE="S",$E(X)'="A" D Q
|
|
.. D NAMERR("Indexes used for Sorting Only must start with 'A'")
|
|
. I DIKCUSE="A",$E(X)'="A" D Q
|
|
.. D NAMERR("Action-type indexes must start with 'A'")
|
|
. I $D(^DD("IX","BB",DIKCF01,X)) D Q
|
|
.. D NAMERR("There is already an index defined with this name.")
|
|
. I $D(^DD(DIKCF01,0,"IX",X)) D Q
|
|
.. D NAMERR("There is already a cross-reference defined with this name.") Q
|
|
;
|
|
Q $S($D(DIRUT):-1,1:X)
|
|
;
|
|
NAMERR(MSG) ;Invalid index name error
|
|
W !!,$C(7)_$G(MSG),!
|
|
K X
|
|
Q
|
|
;
|
|
ADD(DIKCF01,DIKCFILE,DIKCNAME,DIKCTYPE,DIKCUSE,DIXR) ;
|
|
;Add new entry to Index file
|
|
;Returns DIXR=-1 if error
|
|
N DIKCFDA,DIKCIEN
|
|
S DIKCFDA(.11,"+1,",.01)=DIKCF01
|
|
S DIKCFDA(.11,"+1,",.02)=DIKCNAME
|
|
S DIKCFDA(.11,"+1,",.2)=DIKCTYPE
|
|
S DIKCFDA(.11,"+1,",.4)="F"
|
|
S DIKCFDA(.11,"+1,",.41)="IR"
|
|
S:$G(DIKCUSE)]"" DIKCFDA(.11,"+1,",.42)=DIKCUSE
|
|
S DIKCFDA(.11,"+1,",.5)=$S(DIKCF01=DIKCFILE:"I",1:"W")
|
|
S DIKCFDA(.11,"+1,",.51)=DIKCFILE
|
|
S DIKCFDA(.11,"+1,",1.1)="Q"
|
|
S DIKCFDA(.11,"+1,",2.1)="Q"
|
|
D UPDATE^DIE("","DIKCFDA","DIKCIEN")
|
|
I '$D(DIERR) S DIXR=DIKCIEN(1)
|
|
E D MSG^DIALOG() S DIXR=-1
|
|
Q
|