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

DIVC.m

Go to the documentation of this file. 
  1. DIVC ;SFISC/MKO-VERIFY INDEXES/KEYS ;2:47 PM  23 Jan 1998
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;============================================
  1.  ; VINDEX(file,record,field,flag,.index,.key)
  1.  ;============================================
  1.  ;Programmer entry point to check the existence of indexes and
  1.  ;key integrity for a single file/field/record. (Currently not used)
  1.  ;In:
  1.  ; DIFILE = file or subfile # (required)
  1.  ; DIREC  = DA array or IENS (required)
  1.  ; DIFLD  = field # (required)
  1.  ; DIFLAG [ D : generate dialog errors
  1.  ;Out:
  1.  ; For invalid indexes/keys:
  1.  ; .DIINDEX(indexName,index#) = "" : if an index is not set
  1.  ; .DIKEY(file#,keyName,uiNumber) = null : if a key field is null
  1.  ;                                  uniq : if a key not unique
  1.  ;
  1. VINDEX(DIFILE,DIREC,DIFLD,DIFLAG,DIINDEX,DIKEY) ;
  1.  N DA,DIROOT,DIVCTMP,DIVERR
  1.  ;
  1.  ;Initialization
  1.  S DIFLAG=$G(DIFLAG),DIVERR=0
  1.  I DIFLAG["D",'$D(DIQUIET) N DIQUIET S DIQUIET=1
  1.  I DIFLAG["D",'$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1.  ;
  1.  ;Check and convert input paramaters
  1.  D CHK Q:DIVERR
  1.  ;
  1.  ;Load xref info
  1.  S DIVCTMP=$$GETTMP^DIKC1("DIVC")
  1.  D LOADVER(DIFILE,DIFLD,DIVCTMP)
  1.  ;
  1.  D VER(DIFILE,DIROOT,.DA,DIVCTMP,.DIINDEX,.DIKEY)
  1.  K @DIVCTMP
  1.  Q
  1.  ;
  1.  ;=========================================
  1.  ; VER(file#,fileRoot,.DA,tmp,.index,.key)
  1.  ;=========================================
  1.  ;Check that index is set. If index is a uniqueness index also
  1.  ;check that key is unique, and that key fields are non-null.
  1.  ;Called from INDEX^DIVR.
  1.  ;In:
  1.  ;  DIFILE  = [sub]file #
  1.  ;  DIROOT  = closed [sub]file root
  1.  ; .DA      = DA array
  1.  ;  DIVCTMP = root where xref info and verification logic is stored
  1.  ;Out:
  1.  ; .DIINDEX = see VINDEX above
  1.  ; .DIKEY   = see VINDEX above
  1.  ;
  1. VER(DIFILE,DIROOT,DA,DIVCTMP,DIINDEX,DIKEY) ;
  1.  N DICHECK,DINULL,DIXR,DIXRNAM,X,X1,X2
  1.  N KEY,KFIL,KNAM,UNIQ
  1.  ;
  1.  ;Loop through the xrefs loaded in @DIVCTMP
  1.  S DIXR=0 F  S DIXR=$O(@DIVCTMP@(DIFILE,DIXR)) Q:DIXR'=+DIXR  D
  1.  . S DIXRNAM=$P(@DIVCTMP@(DIFILE,DIXR),U)
  1.  . D SETXARR^DIKC(DIFILE,DIXR,DIVCTMP,.DINULL) M X1=X,X2=X
  1.  . ;
  1.  . ;If no X values are null, but no index, set DIINDEX(name,xref#)
  1.  . I 'DINULL D
  1.  .. S DICHECK=$G(@DIVCTMP@(DIFILE,DIXR,"V"))
  1.  .. I DICHECK]"" X DICHECK E  S DIINDEX(DIXRNAM,DIXR)=""
  1.  . ;
  1.  . ;If the xref is a uniqueness index for a key, set DIKEY() if
  1.  . ;key is not unique, or a key field is null.
  1.  . I $D(^DD("KEY","AU",DIXR)) D
  1.  .. S UNIQ=$S(DINULL:0,1:$$UNIQUE^DIKK2(DIFILE,DIXR,.X,.DA,DIVCTMP))
  1.  .. I 'UNIQ S KEY=0 F  S KEY=$O(^DD("KEY","AU",DIXR,KEY)) Q:'KEY  D
  1.  ... Q:$D(^DD("KEY",KEY,0))[0  S KFIL=$P(^(0),U),KNAM=$P(^(0),U,2)
  1.  ... S DIKEY(KFIL,KNAM,DIXRNAM)=$S(DINULL:"null",1:"uniq")
  1.  Q
  1.  ;
  1.  ;=============================
  1.  ; CHK: Check input parameters
  1.  ;=============================
  1.  ;Out:
  1.  ; DA     = DA array
  1.  ; DIFILE = File #
  1.  ; DIROOT = Closed file root
  1.  ; DIVERR = 1 : if there's a problem
  1.  ;
  1. CHK ;File is a required input parameter
  1.  I $G(DIFILE)="" D:DIFLAG["D" ERR^DIKCU2(202,"","","","FILE") D ERR Q
  1.  I $G(DIFLD)="" D:DIFLAG["D" ERR^DIKCU2(202,"","","","FIELD") D ERR Q
  1.  ;
  1.  ;Check DIREC and set DA array
  1.  N DIIENS
  1.  I $G(DIREC)'["," M DA=DIREC S DIIENS=$$IENS^DILF(.DA)
  1.  E  S:DIREC'?.E1"," DIREC=DIREC_"," D DA^DILF(DIREC,.DA) S DIIENS=DIREC
  1.  I '$$VDA^DIKCU1(.DA,DIFLAG_"R") D ERR Q
  1.  ;
  1.  ;Check DIFLD
  1.  I '$$VFLD^DIKCU1(DIFILE,DIFLD,DIFLAG) D ERR Q
  1.  ;
  1.  ;Set DIFILE and DIROOT
  1.  N DILEV
  1.  I DIFILE=+$P(DIFILE,"E") D
  1.  . S DIROOT=$$FROOTDA^DIKCU(DIFILE,DIFLAG,.DILEV) I DIROOT="" D ERR Q
  1.  . I DILEV,$D(DA(DILEV))[0 D  Q
  1.  .. D:DIFLAG["D" ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE) D ERR
  1.  . S:DILEV DIROOT=$NA(@DIROOT)
  1.  . S DIFILE=$$FNUM^DIKCU(DIROOT,DIFLAG) I DIFILE="" D ERR
  1.  E  D
  1.  . S DIROOT=DIFILE
  1.  . S:"(,"[$E(DIROOT,$L(DIROOT)) DIROOT=$$CREF^DILF(DIFILE)
  1.  . S DIFILE=$$FNUM^DIKCU(DIROOT,DIFLAG) I DIFILE="" D ERR Q
  1.  . S DILEV=$$FLEV^DIKCU(DIFILE,DIFLAG) I DILEV="" D ERR Q
  1.  . I DILEV,$D(DA(DILEV))[0 D  Q
  1.  .. D:DIFLAG["D" ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE) D ERR
  1.  Q
  1.  ;
  1. ERR ;Set error flag
  1.  S DIVERR=1
  1.  Q
  1.  ;
  1.  ;============================
  1.  ; LOADVER(file#,field#,tmp)
  1.  ;============================
  1.  ;Load xref info and verification logic for file/field into @TMP.
  1.  ;Also, for each regular xref with no set condition, set
  1.  ;  @TMP@(rootFile#,xref#,"V")=I $D(^index),^index=indexVal
  1.  ; where,
  1.  ;  index    = something like DIZ(9999,"BB",X(1),X(2),DA)
  1.  ;  indexVal = value of index, usually ""
  1.  ;
  1.  ;In:
  1.  ; FILE  = File #
  1.  ; FIELD = Field #
  1.  ; TMP   = Root to store logic
  1.  ;
  1. LOADVER(FILE,FIELD,TMP) ;Load indexes into TMP array
  1.  N FIL,KL,SL,XR
  1.  ;
  1.  ;Load xref info for file/field into @TMP
  1.  D LOADFLD^DIKC1(FILE,FIELD,"KS","","",TMP,TMP)
  1.  ;
  1.  ;Set the "V" nodes, kill the "S" and "K" nodes
  1.  S FIL=0 F  S FIL=$O(@TMP@(FIL)) Q:'FIL  D
  1.  . S XR=0 F  S XR=$O(@TMP@(FIL,XR)) Q:'XR  D
  1.  .. I $P(@TMP@(FIL,XR),U,4)'="R"!$D(@TMP@(FIL,XR,"SC")) K @TMP@(FIL,XR) Q
  1.  .. S SL=$G(@TMP@(FIL,XR,"S")),KL=$G(@TMP@(FIL,XR,"K"))
  1.  .. I SL?1"S ^"1.E,KL?1"K ^"1.E D
  1.  ... S @TMP@(FIL,XR,"V")="I $D("_$E(KL,3,999)_")#2,"_$E(SL,3,999)
  1.  .. K @TMP@(FIL,XR,"S"),@TMP@(FIL,XR,"K")
  1.  Q
  1.  ;
  1.  ;#202  The input parameter that identifies the |1| is missing or invalid.
  1.  ;#601  The entry does not exist.