Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIKCUTL1

DIKCUTL1.m

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