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

DIKKUTL.m

Go to the documentation of this file. 
  1. DIKKUTL ;SFISC/MKO-UTILITY OPTION TO DEFINE A KEY ;8:13 AM  7 Jun 2001 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**68**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. MOD ;Create/Modify/Edit a Key
  1.  ;In:
  1.  ; DI  = selected top level file#
  1.  ; DIU = global root of file DI
  1.  N DIKKCNT,DIKKFILE,DIKKEY,DIKKQUIT,DIKKROOT,DIKKTOP
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  ;
  1.  ;Get subfile
  1.  S DIKKROOT=DIU,DIKKTOP=DI,DIKKFILE=$$SUB^DIKCU(DI)
  1.  S:'$G(DIKKFILE) DIKKFILE=DIKKTOP
  1.  ;
  1. REMOD ;Get and list keys on file DIKKFILE
  1.  I $G(DIKKQUIT) W ! Q
  1.  D GET^DIKKUTL2(DIKKFILE,.DIKKCNT)
  1.  W ! D LIST^DIKKUTL2(.DIKKCNT)
  1.  ;
  1.  ;Prompt for action
  1.  I 'DIKKCNT S Y="C"
  1.  E  S Y=$$RD Q:Y=""
  1.  ;
  1.  ;Delete
  1.  I Y="D" D  G REMOD
  1.  . S DIKKEY=$$CHOOSE^DIKKUTL2(.DIKKCNT,"delete") Q:'DIKKEY
  1.  . D DELETE(DIKKEY,DIKKTOP,DIKKFILE)
  1.  ;
  1.  ;Edit
  1.  I Y="E" D  G REMOD
  1.  . S DIKKEY=$$CHOOSE^DIKKUTL2(.DIKKCNT,"edit") Q:'DIKKEY
  1.  . D EDIT(DIKKEY,DIKKTOP,DIKKFILE)
  1.  ;
  1.  ;Create
  1.  I Y="C" D  G REMOD
  1.  . S DIR(0)="Y",DIR("B")="No"
  1.  . S DIR("A")="Want to create a new Key for this file"
  1.  . D ^DIR K DIR I $D(DIRUT)!'Y S:'DIKKCNT DIKKQUIT=1 Q
  1.  . D CREATE^DIKKUTL1(DIKKTOP,DIKKFILE)
  1.  ;
  1.  ;Verify
  1.  I Y="V" D  G REMOD
  1.  . S DIKKEY=$$CHOOSE^DIKKUTL2(.DIKKCNT,"verify") Q:'DIKKEY
  1.  . D VERIFY^DIKKUTL3(DIKKEY,DIKKTOP,DIKKFILE)
  1.  Q
  1.  ;
  1. DELETE(DIKKEY,DIKKTOP,DIKKFILE) ;Delete a Key
  1.  N DIKKID,DIKKUI,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  ;
  1.  ;Confirm deletion
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Are you sure you want to delete the Key"
  1.  S DIR("B")="No"
  1.  D ^DIR K DIR Q:$D(DIRUT)!'Y
  1.  ;
  1.  ;Delete
  1.  S DIKKUI=$P($G(^DD("KEY",DIKKEY,0)),U,4)
  1.  S DIKKID=$$KEYID(DIKKEY,DIKKTOP,DIKKFILE)
  1.  D DELKEY(DIKKEY,DIKKID)
  1.  ;
  1.  ;Ask/Delete Uniqueness Index
  1.  I DIKKUI,'$D(^DD("KEY","AU",DIKKUI)) D
  1.  . D DELUI(DIKKUI,DIKKTOP,DIKKFILE,DIKKID)
  1.  Q
  1.  ;
  1. EDIT(DIKKEY,DIKKTOP,DIKKFILE) ;Edit a Key
  1.  N DIKKCH,DIKKFLD,DIKKID,DIKKNO,DIKKOLD,DIKKUI0,DIKKUI1,DIKKUFLD
  1.  N DA,DDSFILE,DR
  1.  ;
  1. REEDIT ;Come back here, if user chooses to re-edit the key
  1.  S DIKKID=$$KEYID(DIKKEY,DIKKTOP,DIKKFILE)
  1.  ;
  1.  ;Save original UI, and set and kill logic of original UI
  1.  ;Invoke form to edit key
  1.  ;Set new UI
  1.  S DIKKUI0=$P($G(^DD("KEY",DIKKEY,0)),U,4)
  1.  K DIKKOLD
  1.  D:DIKKUI0 LOADXREF^DIKC1(DIKKFILE,"","K",DIKKUI0,"","DIKKOLD")
  1.  S DDSFILE=.31,DA=DIKKEY,DR="[DIKK EDIT]"
  1.  D ^DDS K DDSFILE,DA,DR
  1.  S DIKKUI1=$P($G(^DD("KEY",DIKKEY,0)),U,4)
  1.  ;
  1.  ;If UI was edited, rebuild it
  1.  I DIKKUI0,DIKKUI0=DIKKUI1 D
  1.  . N DIKKNEW,DIKKFLIS
  1.  . Q:$G(DIKKOLD(DIKKFILE,DIKKUI0,"K"))=$G(^DD("IX",DIKKUI1,2))
  1.  . W !,$C(7)_"The definition of the Uniqueness Index was modified."
  1.  . D LOADXREF^DIKC1(DIKKFILE,"","S",DIKKUI0,"","DIKKNEW")
  1.  . D GETFLIST^DIKCUTL(DIKKUI0,.DIKKFLIS)
  1.  . D KSC^DIKCUTL3(DIKKTOP,.DIKKOLD,.DIKKNEW,.DIKKFLIS)
  1.  K DIKKOLD
  1.  ;
  1.  ;If there was an old UI, and it's '= to new UI, ask/delete old UI
  1.  I DIKKUI0,DIKKUI0'=DIKKUI1 D
  1.  . D DELUI(DIKKUI0,DIKKTOP,DIKKFILE,DIKKID,DIKKEY)
  1.  ;
  1.  ;Quit if key was deleted.
  1.  Q:$D(^DD("KEY",DIKKEY,0))[0
  1.  ;
  1.  ;Get fields in key and new UI
  1.  D GETFLD^DIKKUTL2(DIKKEY,DIKKUI1,.DIKKFLD,.DIKKUFLD)
  1.  ;
  1.  ;If key has no fields and no UI, ask reedit/delete key
  1.  I 'DIKKFLD,'DIKKUI1 D  G:DIKKCH<2 REEDIT Q
  1.  . S DIKKCH=$$EORD^DIKKUTL4(DIKKID) Q:DIKKCH'=2
  1.  . D DELKEY(DIKKEY,DIKKID)
  1.  ;
  1.  ;If key has fields but no UI, create one.
  1.  I DIKKFLD,'DIKKUI1 D  G:DIKKCH=1 REEDIT Q:DIKKCH=2  G EDITEND
  1.  . F  D  Q:DIKKCH'=3
  1.  .. S DIKKCH=0
  1.  .. D UICREATE^DIKKUTL1(DIKKEY,DIKKTOP,DIKKFILE,.DIKKNO)
  1.  .. Q:'$G(DIKKNO)
  1.  .. ;
  1.  .. ;User aborted Uniqueness Index creation;
  1.  .. ;Ask edit key/delete key/create UI
  1.  .. W ! S DIKKCH=$$EDORC^DIKKUTL4 Q:DIKKCH'=2
  1.  .. D DELKEY(DIKKEY,DIKKID)
  1.  ;
  1.  ;If neither key nor UI has fields, ask reedit/delete key
  1.  I 'DIKKFLD,'DIKKUFLD D  G:DIKKCH<2 REEDIT Q
  1.  . S DIKKCH=$$EORD^DIKKUTL4(DIKKID,1) Q:DIKKCH'=2
  1.  . D DELKEY(DIKKEY,DIKKID)
  1.  ;
  1.  ;Compare fields in Key with fields in Uniqueness Index; quit if same
  1.  G:$$GCMP^DIKCU2("DIKKFLD","DIKKUFLD") EDITEND
  1.  ;
  1.  ;Key has a UI but no fields; or fields and UI don't match.
  1.  ;Prompt re-edit/make key fields match UI/or make UI match key fields
  1.  S DIKKCH=$$RORM^DIKKUTL4(DIKKUFLD,DIKKFLD)
  1.  ;
  1.  ;Re-edit
  1.  I DIKKCH=1 G REEDIT
  1.  ;
  1.  ;Make key fields match UI
  1.  E  I DIKKCH=2 D
  1.  . ;Delete all fields in Key
  1.  . W !!,"  Modifying fields in Key ..."
  1.  . N DA,DIK
  1.  . S DIK="^DD(""KEY"","_DIKKEY_",2,",DA(1)=DIKKEY
  1.  . S DA=0 F  S DA=$O(^DD("KEY",DIKKEY,2,DA)) Q:'DA  D ^DIK
  1.  . K DA,DIK
  1.  . ;
  1.  . ;Add fields to Key
  1.  . N DIKKFDA,DIKKIENS,DIKKSEQ
  1.  . S DIKKSEQ=0 F  S DIKKSEQ=$O(DIKKUFLD(DIKKSEQ)) Q:'DIKKSEQ  D
  1.  .. S DIKKIENS="+"_DIKKSEQ_","_DIKKEY_","
  1.  .. S DIKKFDA(.312,DIKKIENS,.01)=$P(DIKKUFLD(DIKKSEQ),U,2)
  1.  .. S DIKKFDA(.312,DIKKIENS,.02)=$P(DIKKUFLD(DIKKSEQ),U)
  1.  .. S DIKKFDA(.312,DIKKIENS,1)=DIKKSEQ
  1.  . D UPDATE^DIE("","DIKKFDA")
  1.  . I '$D(DIERR) W "  DONE!"
  1.  . E  D MSG^DIALOG(),EOP
  1.  ;
  1.  ;Make UI match key fields
  1.  E  I DIKKCH=3 D UIMOD^DIKKUTL1(DIKKUI1,DIKKEY,DIKKTOP,DIKKFILE)
  1.  ;
  1. EDITEND ;
  1.  S DIKKCH=$$CHECK Q:'DIKKCH
  1.  ;
  1.  W !!,"Checking key integrity ..."
  1.  I $$INTEG^DIKK(DIKKTOP,"","",DIKKEY) W "  NO PROBLEMS" D EOP Q
  1.  ;
  1.  S DIKKCH=$$EDORI^DIKKUTL4
  1.  I DIKKCH=2 G REEDIT
  1.  I DIKKCH=1 D DELETE(DIKKEY,DIKKTOP,DIKKFILE)
  1.  Q
  1.  ;
  1. DELUI(DIKKUI,DIKKTOP,DIKKFILE,DIKKID,DIKKEY) ;Delete the Uniqueness Index
  1.  N I,MSG
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  ;
  1.  ;If DIKKEY is passed in, quit if any key other than DIKKEY uses
  1.  ;this index as a Uniqueness Index. (Index can't be deleted.)
  1.  I $G(DIKKEY) D  Q:I
  1.  . S I=0 F  S I=$O(^DD("KEY","AU",DIKKUI,I)) Q:'I  Q:I'=DIKKEY
  1.  ;
  1.  S MSG(0)="Do you want to delete the "_$$UIID(DIKKUI,DIKKTOP,DIKKFILE)_" previously used by "_$S($G(DIKKID)]"":DIKKID,1:"the Key")
  1.  D WRAP^DIKCU2(.MSG)
  1.  S DIR(0)="Y"
  1.  F I=0:1 Q:'$D(MSG(I+1))  S DIR("A",I+1)=MSG(I)
  1.  S DIR("A")=MSG(I)
  1.  W ! D ^DIR K DIR S:$D(DTOUT) Y=1 Q:$D(DUOUT)!'Y
  1.  D DELETE^DIKCUTL(DIKKUI,DIKKTOP,DIKKFILE)
  1.  Q
  1.  ;
  1. DELKEY(DA,DIKKID) ;Call DIK to delete the key
  1.  N DIK
  1.  S DIK="^DD(""KEY""," D ^DIK
  1.  W !!?2,$G(DIKKID)_" deleted."
  1.  Q
  1.  ;
  1. UIID(UI,TOP,FILE) ;Return text that identifies uniqueness index
  1.  Q:$D(^DD("IX",UI,0))[0 ""
  1.  Q "'"_$P(^DD("IX",UI,0),U,2)_"' Uniqueness Index (#"_UI_") on "_$S(TOP'=FILE:"Subf",1:"F")_"ile #"_$P(^(0),U)
  1.  ;
  1. KEYID(KEY,TOP,FILE) ;Return string of text that identifies the key
  1.  Q "Key '"_$P(^DD("KEY",KEY,0),U,2)_"' of "_$S(TOP'=FILE:"Subf",1:"F")_"ile #"_$P(^(0),U)
  1.  ;
  1. RD() ;Prompt for action
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="SAO^V:VERIFY;E:EDIT;D:DELETE;C:CREATE"
  1.  S DIR("A")="Choose V (Verify)/E (Edit)/D (Delete)/C (Create): "
  1.  S DIR("?",1)="Enter 'V' to verify the integrity of a Key."
  1.  S DIR("?",2)="      'E' to edit an existing Key"
  1.  S DIR("?",3)="      'D' to delete an existing Key"
  1.  S DIR("?",4)="      'C' to create a new Key."
  1.  W ! D ^DIR S:$D(DIRUT) Y=""
  1.  Q Y
  1.  ;
  1. EOP ;Issue Press Return to continue prompt
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="E",DIR("A")="Press RETURN to continue"
  1.  S DIR("?")="Press the RETURN or ENTER key."
  1.  W ! D ^DIR
  1.  Q
  1.  ;
  1. CHECK() ;Prompt whether to check key integrity
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR("A")="Do want to check the integrity of this key now"
  1.  S DIR("?")="Enter 'Y' to run the key integrity checker."
  1.  S DIR(0)="Y"
  1.  W ! D ^DIR
  1.  Q $S($D(DIRUT):0,1:Y)