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

DIKKUTL1.m

Go to the documentation of this file. 
  1. DIKKUTL1 ;SFISC/MKO-KEY CREATION ;10:08 AM  12 Jan 2001
  1.  ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1.  ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1.  ;;Licensed under the terms of the Apache License, Version 2.0.
  1.  ;
  1. CREATE(DIKKTOP,DIKKFILE) ;Create a new key
  1.  N DIKKEY,DIKKFDA,DIKKNAME,DIKKIEN
  1.  ;
  1.  ;Prompt for name
  1.  S DIKKNAME=$$NAME(DIKKFILE) Q:DIKKNAME=-1
  1.  ;
  1.  ;Add new entry to Key file
  1.  W !,"  Creating new Key '"_DIKKNAME_"' ..."
  1.  S DIKKFDA(.31,"+1,",.01)=DIKKFILE
  1.  S DIKKFDA(.31,"+1,",.02)=DIKKNAME
  1.  S DIKKFDA(.31,"+1,",1)=$S($D(^DD("KEY","AP",DIKKFILE,"P")):"S",1:"P")
  1.  D UPDATE^DIE("","DIKKFDA","DIKKIEN") I $D(DIERR) D MSG^DIALOG() Q
  1.  ;
  1.  S DIKKEY=DIKKIEN(1) K DIKKIEN
  1.  D EDIT^DIKKUTL(DIKKEY,DIKKTOP,DIKKFILE)
  1.  Q
  1.  ;
  1. UIMOD(DIXR,DIKKEY,DIKKTOP,DIKKFILE) ;Modify the UI to match the Key
  1.  N DIKKERR,DIKKFLD,DIKKFLIS,DIKKID,DIKKMSG,DIKKNEW,DIKKOLD
  1.  S DIKKID=$$KEYID(DIKKEY,DIKKTOP,DIKKFILE)
  1.  ;
  1.  ;Write message
  1.  W !!,"  Modifying Uniqueness Index ..."
  1.  ;
  1.  ;Get list of fields and original kill logic
  1.  D GETFLIST^DIKCUTL(DIXR,.DIKKFLIS)
  1.  D LOADXREF^DIKC1(DIKKFILE,"","K",DIXR,"","DIKKOLD")
  1.  ;
  1.  ;Get list of fields in key
  1.  D GETFLD(DIKKEY,.DIKKFLD)
  1.  ;
  1.  ;Stuff values into Uniqueness Index and fields into CRV multiple
  1.  D STUFF(DIXR,$P(^DD("IX",DIXR,0),U),DIKKFILE,$P(^(0),U,2),.DIKKFLD,DIKKID)
  1.  D DELCRV(DIXR)
  1.  D ADDCRV(DIXR,.DIKKFLD)
  1.  W "  DONE!"
  1.  ;
  1.  ;Get list of fields and new set logic.
  1.  ;Kill old and set new index, and recompile input templates and xrefs.
  1.  D GETFLIST^DIKCUTL(DIXR,.DIKKFLIS)
  1.  D LOADXREF^DIKC1(DIKKFILE,"","S",DIXR,"","DIKKNEW")
  1.  D KSC^DIKCUTL3(DIKKTOP,.DIKKOLD,.DIKKNEW,.DIKKFLIS)
  1.  Q
  1.  ;
  1. UICREATE(DIKKEY,DIKKTOP,DIKKFILE,DIKKNO) ;Create a new UI for key
  1.  ;Returns DIKKNO=1 if the Index could not be created.
  1.  N DIERR,DIKKERR,DIKKFDA,DIKKFLIS,DIKKID,DIKKMSG,DIKKNAM,DIKKNEW,DIXR,I
  1.  ;
  1.  K DIKKNO
  1.  S DIKKID=$$KEYID(DIKKEY,DIKKTOP,DIKKFILE)
  1.  ;
  1.  ;Write message
  1.  K DIKKMSG
  1.  S DIKKMSG(0)="I'm going to create a new Uniqueness Index to support "_DIKKID_"."
  1.  D WRAP^DIKCU2(.DIKKMSG)
  1.  W ! F I=0:1 Q:'$D(DIKKMSG(I))  W !,DIKKMSG(I)
  1.  K I,DIKKMSG
  1.  ;
  1.  ;Get Index Name and list of fields
  1.  S DIKKNAM=$$NAME^DIKCUTL1(DIKKFILE,"LS") I DIKKNAM=-1 S DIKKNO=1 Q
  1.  D GETFLD(DIKKEY,.DIKKFLD)
  1.  ;
  1.  ;Add uniqueness index to Index file, and fields into CRV multiple
  1.  D ADDUI(DIKKFILE,DIKKNAM,.DIXR) I DIXR=-1 S DIKKNO=1 Q
  1.  D STUFF(DIXR,DIKKFILE,DIKKFILE,DIKKNAM,.DIKKFLD,DIKKID)
  1.  D ADDCRV(DIXR,.DIKKFLD,.DIKKERR) I $G(DIKKERR) S DIKKNO=1 Q
  1.  ;
  1.  ;Set Uniqueness Index pointer in Key file
  1.  S DIKKFDA(.31,DIKKEY_",",3)=DIXR
  1.  D FILE^DIE("","DIKKFDA") I $D(DIERR) D MSG^DIALOG() S DIKKNO=1 Q
  1.  K DIKKFDA
  1.  ;
  1.  ;Get new field list and set logic.
  1.  ;Set new index and recompile input templates and xrefs.
  1.  D GETFLIST^DIKCUTL(DIXR,.DIKKFLIS)
  1.  D LOADXREF^DIKC1(DIKKFILE,"","S",DIXR,"","DIKKNEW")
  1.  D KSC^DIKCUTL3(DIKKTOP,"",.DIKKNEW,.DIKKFLIS)
  1.  Q
  1.  ;
  1. ADDUI(DIKKFILE,DIKKNAM,DIXR) ;Add new entry to Index file
  1.  N DIKKFDA,DIKKIEN
  1.  W !!,"  One moment please ..."
  1.  S DIKKFDA(.11,"+1,",.01)=DIKKFILE
  1.  S DIKKFDA(.11,"+1,",.02)=DIKKNAM
  1.  D UPDATE^DIE("","DIKKFDA","DIKKIEN") I $D(DIERR) D MSG^DIALOG() Q
  1.  S DIXR=DIKKIEN(1)
  1.  Q
  1.  ;
  1. STUFF(DIXR,DIKKF01,DIKKFILE,DIKKNAM,DIKKFLD,DIKKID) ;Stuff other values into
  1.  ;index
  1.  N DIERR,DIKKFDA,DIKKILL,DIKKSET,DIKKWKIL
  1.  ;
  1.  ;Build logic
  1.  D BLDLOG(DIKKF01,DIKKFILE,DIKKNAM,.DIKKFLD,.DIKKSET,.DIKKILL,.DIKKWKIL)
  1.  ;
  1.  ;Stuff values into other fields in Index file entry
  1.  S DIKKFDA(.11,DIXR_",",.11)="Uniqueness Index for "_DIKKID
  1.  S DIKKFDA(.11,DIXR_",",.2)="R"
  1.  S DIKKFDA(.11,DIXR_",",.4)=$S(DIKKFLD>1:"R",1:"F")
  1.  S DIKKFDA(.11,DIXR_",",.41)="IR"
  1.  S DIKKFDA(.11,DIXR_",",.42)="LS"
  1.  S DIKKFDA(.11,DIXR_",",.5)=$S(DIKKF01=DIKKFILE:"I",1:"W")
  1.  S DIKKFDA(.11,DIXR_",",.51)=DIKKFILE
  1.  S DIKKFDA(.11,DIXR_",",1.1)=DIKKSET
  1.  S DIKKFDA(.11,DIXR_",",2.1)=DIKKILL
  1.  S DIKKFDA(.11,DIXR_",",2.5)=DIKKWKIL
  1.  D FILE^DIE("","DIKKFDA")
  1.  I $D(DIERR) D MSG^DIALOG()
  1.  Q
  1.  ;
  1. ADDCRV(DIXR,DIKKFLD,DIKKERR) ;Add fields to Cross-Reference Values multiple
  1.  N DA,DD,DIC,DIERR,DIKKFDA,DIKKSS,DINUM,DO,X,Y
  1.  ;
  1.  S DIC("P")=$P(^DD(.11,11.1,0),U,2)
  1.  F DIKKSS=1:1 Q:$D(DIKKFLD(DIKKSS))[0  D  Q:$G(DIKKERR)
  1.  . ;Add subentry
  1.  . S DIC="^DD(""IX"","_DIXR_",11.1,",DIC(0)="QL",DA(1)=DIXR
  1.  . S (X,DINUM)=DIKKSS
  1.  . K DD,DO D FILE^DICN K DA,DIC,DINUM
  1.  . I Y=-1 S DIKKERR=1 Q
  1.  . ;
  1.  . ;Stuff other values
  1.  . S DIKKFDA(.114,DIKKSS_","_DIXR_",",.5)=DIKKSS
  1.  . S DIKKFDA(.114,DIKKSS_","_DIXR_",",1)="F"
  1.  . S DIKKFDA(.114,DIKKSS_","_DIXR_",",2)=$P(DIKKFLD(DIKKSS),U,2)
  1.  . S DIKKFDA(.114,DIKKSS_","_DIXR_",",3)=$P(DIKKFLD(DIKKSS),U)
  1.  . D FILE^DIE("","DIKKFDA")
  1.  . I $D(DIERR) D MSG^DIALOG() S DIKKERR=1
  1.  Q
  1.  ;
  1. DELCRV(DIXR) ;Delete all entries in CRV multiple
  1.  N DA,DIK
  1.  S DIK="^DD(""IX"","_DIXR_",11.1,",DA(1)=DIXR
  1.  S DA=0 F  S DA=$O(^DD("IX",DIXR,11.1,DA)) Q:'DA  D ^DIK
  1.  Q
  1.  ;
  1. GETFLD(KEY,FLD) ;Get list fields in key
  1.  ;In:
  1.  ; KEY = key #
  1.  ;Out:
  1.  ; FLD = # subscripts
  1.  ; FLD(subscript#) = field^file
  1.  ;
  1.  N DA,FD,FI,SQ
  1.  K FLD S (FLD,SQ)=0
  1.  F  S SQ=$O(^DD("KEY",KEY,2,"S",SQ)) Q:'SQ  D
  1.  . S FD=$O(^DD("KEY",KEY,2,"S",SQ,0)) Q:'FD
  1.  . S FI=$O(^DD("KEY",KEY,2,"S",SQ,FD,0)) Q:'FI
  1.  . S DA=$O(^DD("KEY",KEY,2,"S",SQ,FD,FI,0)) Q:'DA
  1.  . Q:$D(^DD("KEY",KEY,2,DA,0))[0
  1.  . S FLD=FLD+1,FLD(FLD)=FD_U_FI
  1.  Q
  1.  ;
  1. BLDLOG(DIKKF01,DIKKFILE,DIKKNAM,DIKKFLD,DIKKSET,DIKKILL,DIKKWKIL) ;
  1.  ;Build the logic of the xref
  1.  N DIKKLDIF,DIKKROOT,DIKKSS,L
  1.  I 'DIKKFLD S (DIKKSET,DIKKILL)="Q",DIKKWKIL="" Q
  1.  ;
  1.  ;Build index root and entire kill logic
  1.  I DIKKF01'=DIKKFILE S DIKKLDIF=$$FLEVDIFF^DIKCU(DIKKF01,DIKKFILE)
  1.  E  S DIKKLDIF=0
  1.  S DIKKROOT=$$FROOTDA^DIKCU(DIKKF01,DIKKLDIF_"O")_""""_DIKKNAM_""""
  1.  S DIKKWKIL="K "_DIKKROOT_")"
  1.  ;
  1.  ;Build root for set/kill logic
  1.  F DIKKSS=1:1 Q:$D(DIKKFLD(DIKKSS))[0  D
  1.  . S DIKKROOT=DIKKROOT_","_$S($G(DIKKFLD)=1:"X",1:"X("_DIKKSS_")")
  1.  ;
  1.  ;Append DA(n) to root
  1.  F L=DIKKLDIF:-1:1 S DIKKROOT=DIKKROOT_",DA("_L_")"
  1.  S DIKKROOT=DIKKROOT_",DA)"
  1.  ;
  1.  ;Build set/kill logic
  1.  S DIKKSET="S "_DIKKROOT_"=""""",DIKKILL="K "_DIKKROOT
  1.  Q
  1.  ;
  1. NAME(DIKKFILE) ;Get next available Key name
  1.  N DIKKNAME
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  ;
  1.  S DIKKNAME=$O(^DD("KEY","BB",DIKKFILE,""),-1)
  1.  S DIKKNAME=$S(DIKKNAME="":"A",1:$C($A(DIKKNAME)+1))
  1.  ;
  1.  S DIR(0)=".31,.02"
  1.  S DIR("A")="Enter a Name for the new Key"
  1.  S DIR("B")=DIKKNAME
  1.  W ! F  D  Q:$D(X)!$D(DIRUT)
  1.  . D ^DIR Q:$D(DIRUT)
  1.  . Q:'$D(^DD("KEY","BB",DIKKFILE,X))
  1.  . D NAMERR("A key already exists with this name.")
  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. 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.  ;