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

DIKK.m

Go to the documentation of this file. 
  1. DIKK ;SFISC/MKO-CHECK KEY INTEGRITY ;9:14 AM  23 Feb 1999
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. INTEG(DIFILE,DIREC,DIFLD,DIKKEY,DICTRL,DIKPROC) ;
  1.  N DA,DIF,DIKERR,DIKFIL,DIKKQUIT,DIMF,DIROOT,DITAR
  1.  ;
  1.  ;If called as an extrinsic, manipulate DICTRL
  1.  S DIKPROC=$G(DIKPROC)
  1.  I 'DIKPROC N DICTRL1,DIKKTAR M DICTRL1=DICTRL S DICTRL("TAR")="DIKKTAR"
  1.  ;
  1.  S DIF=$E("D",$G(DICTRL)'["d")
  1.  I DIF["D",'$D(DIQUIET) N DIQUIET S DIQUIET=1
  1.  I DIF["D",'$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1.  ;
  1.  ;Check input params, initialize variables, clean output array
  1.  D INIT^DIKK2 G:$G(DIKERR)]"" MOVE
  1.  I 'DIKPROC S:$G(DICTRL)'["Q" DICTRL=$G(DICTRL)_"Q"
  1.  ;
  1.  ;Load key info into ^TMP("DIKK",$J), and multiple info into DIMF
  1.  K ^TMP("DIKK",$J)
  1.  I $G(DIKKEY)?."^" D
  1.  . I $G(DIFLD) D
  1.  .. D LOADFLD^DIKK1(DIKFIL,DIFLD)
  1.  . E  D LOADALL^DIKK1(DIKFIL,$E("s",$G(DICTRL)["s"),.DIMF)
  1.  E  D LOADKEY^DIKK1(DIKKEY)
  1.  G:'$O(^TMP("DIKK",$J,0)) EXIT
  1.  D:DIKFIL'=DIFILE SBINFO^DIKCU(DIKFIL,.DIMF)
  1.  ;
  1.  ;Check one or all records in file DIFILE
  1.  I DA D
  1.  . D CHECK(DIFILE,.DA,DIROOT,.DIMF,DITAR,.DIKKQUIT)
  1.  E  D CHECKALL(DIFILE,.DA,DIROOT,.DIMF,DITAR,.DIKKQUIT)
  1.  ;
  1. EXIT ;Cleanup ^TMP and quit
  1.  K ^TMP("DIKK",$J)
  1.  ;
  1. MOVE ;Move error messages if necessary
  1.  I DIF["D",$G(DIERR),$G(DICTRL("MSG"))]"" D CALLOUT^DIEFU(DICTRL("MSG"))
  1.  I 'DIKPROC K DICTRL M DICTRL=DICTRL1 Q $D(DIKKTAR)=0&($G(DIKERR)="")
  1.  Q
  1.  ;
  1. CHECK(DIFILE,DA,DIROOT,DIMF,DITAR,DIKKQUIT) ;Check one record
  1.  I $D(^TMP("DIKK",$J,"UIR",DIFILE)) D CHECK^DIKK2(DIFILE,.DA,DITAR,.DIKKQUIT) Q:$G(DIKKQUIT)
  1.  D:$D(DIMF(DIFILE)) CHECKSUB(DIFILE,.DA,DIROOT,.DIMF,DITAR,.DIKKQUIT)
  1.  Q
  1.  ;
  1. CHECKALL(DIFILE,DA,DIROOT,DIMF,DITAR,DIKKQUIT) ;Check all records
  1.  I $D(^TMP("DIKK",$J,"UI",DIFILE)) D UICHK(DIFILE,.DA,DITAR,.DIKKQUIT) Q:$G(DIKKQUIT)
  1.  I '$D(^TMP("DIKK",$J,DIFILE)),'$D(DIMF(DIFILE)) Q
  1.  ;
  1.  ;Loop through all records in file, check for null key fields
  1.  S DA=0 F  S DA=$O(@DIROOT@(DA)) Q:DA'=+DA  D  Q:$G(DIKKQUIT)
  1.  . I $D(^TMP("DIKK",$J,DIFILE)) D NULLCHK(DIFILE,.DA,DITAR,.DIKKQUIT) Q:$G(DIKKQUIT)
  1.  . D:$D(DIMF(DIFILE)) CHECKSUB(DIFILE,.DA,DIROOT,.DIMF,DITAR,.DIKKQUIT)
  1.  Q
  1.  ;
  1. CHECKSUB(DIFILE,DA,DIROOT,DIMF,DITAR,DIKKQUIT) ;Process all records in subfiles
  1.  N DIMULTF,DISBFILE,DISBROOT
  1.  D PUSHDA^DIKCU(.DA)
  1.  ;
  1.  ;Loop through the DIMF array and make recursive call to check all
  1.  ;subrecords
  1.  S DIMULTF=0 F  S DIMULTF=$O(DIMF(DIFILE,DIMULTF)) Q:'DIMULTF  D  Q:$G(DIKKQUIT)
  1.  . S DISBROOT=$NA(@DIROOT@(DA(1),DIMF(DIFILE,DIMULTF))) Q:'$D(@DISBROOT)
  1.  . S DISBFILE=DIMF(DIFILE,DIMULTF,0)
  1.  . D CHECKALL(DISBFILE,.DA,DISBROOT,.DIMF,DITAR,.DIKKQUIT)
  1.  ;
  1.  D POPDA^DIKCU(.DA)
  1.  Q
  1.  ;
  1. NULLCHK(KFIL,DA,DITAR,DIKKQUIT) ;Check whether any of the key fields at
  1.  ;KFIL file level are null for a given record.
  1.  N FIL,FLD,IENS,LDIF,X
  1.  ;
  1.  S FIL=0 F  S FIL=$O(^TMP("DIKK",$J,KFIL,FIL)) Q:'FIL  D  Q:$G(DIKKQUIT)
  1.  . S LDIF=+$G(^TMP("DIKK",$J,KFIL,FIL))
  1.  . S FLD=0 F  S FLD=$O(^TMP("DIKK",$J,KFIL,FIL,FLD)) Q:'FLD  D  Q:$G(DIKKQUIT)
  1.  .. X ^TMP("DIKK",$J,KFIL,FIL,FLD) Q:X]""
  1.  .. S IENS=$$IENS(.DA)
  1.  .. S:LDIF IENS=$P(IENS,",",LDIF+1,999)
  1.  .. D SETN(FIL,IENS,FLD,DITAR,.DIKKQUIT)
  1.  Q
  1.  ;
  1. UICHK(FILE,DA,OUT,DIKKQUIT) ;Walk through uniqueness index and check for duplicates
  1.  N IX0,IX1,IX2,IXV1,IXV2,KEY,KFIL,LDIF,NS,S,SS,UI
  1.  ;
  1.  S UI=0 F  S UI=$O(^TMP("DIKK",$J,"UI",FILE,UI)) Q:'UI  D  Q:$G(DIKKQUIT)
  1.  . ;Get info about uniqueness index
  1.  . S KEY=$G(^TMP("DIKK",$J,"UI",FILE,UI))
  1.  . I $P(KEY,U,2)]"" D
  1.  .. S KFIL=$P(KEY,U,2),LDIF=$P(KEY,U,3),KEY=$P(KEY,U)
  1.  .. S IX0=^TMP("DIKK",$J,"UI",FILE,UI,"UIR") M SS=^("SS")
  1.  . E  D
  1.  .. D XRINFO^DIKCU2(UI,"",.LDIF,"",.KFIL,.IX0,.SS)
  1.  .. ;
  1.  .. ;Remove elements from the SS array that have no max length.
  1.  .. ;For those that have max length, set SS(S)=data extraction code
  1.  .. S S=0 F  S S=$O(SS(S)) Q:'S  D
  1.  ... I '$P(SS(S),U,3) K SS(S) Q
  1.  ... S SS(S)=^TMP("DIKK",$J,KFIL,$P(SS(S),U),$P(SS(S),U,2))
  1.  .. ;
  1.  .. ;Remember info for next time
  1.  . S KEY=+KEY
  1.  . S ^TMP("DIKK",$J,"UI",FILE,UI)=KEY_U_KFIL_U_LDIF,^(UI,"UIR")=IX0
  1.  . M ^TMP("DIKK",$J,"UI",FILE,UI,"SS")=SS
  1.  . ;
  1.  . ;If necessary, push the DA array
  1.  . D:LDIF PUSHDA^DIKCU(.DA,LDIF)
  1.  . ;
  1.  . ;Walk down the uniqueness index and look for duplicates
  1.  . S (IX0,IX1,IX2)=$NA(@IX0),NS=$QL(IX0)
  1.  . F  S IX2=$Q(@IX2) Q:IX2=""  Q:$NA(@IX2,NS)'=IX0  D  Q:$G(DIKKQUIT)
  1.  .. S IXV1=$NA(@IX1,NS+SS),IXV2=$NA(@IX2,NS+SS)
  1.  .. I IXV1'=IXV2 S IX1=IX2 Q
  1.  .. D DUPL(KEY,UI,FILE,KFIL,.DA,IX1,IX2,IXV1,NS,.SS,.DIKKQUIT)
  1.  .. S (IX1,IX2)=$NA(@IXV1@("~"))
  1.  . ;
  1.  . ;Pop the DA array
  1.  . D:LDIF POPDA^DIKCU(.DA,LDIF)
  1.  Q
  1.  ;
  1. DUPL(KEY,UI,UIFIL,UIRFIL,DA,IX1,IX2,IXV,NS,SS,DIKKQUIT) ;Process duplicate
  1.  ;indexes
  1.  N DUPL,IENSDONE,I,IENS1,IENS2,L,ML,NEXTIX1,S,V1,X
  1.  ;
  1.  ;Set ML(subsc)=SS(subsc) for those subscripts that are >= maxlength
  1.  S S=0
  1.  F  S S=$O(SS(S)) Q:'S  S:$L($QS(IXV,NS+S))'<$P(SS(S),U,3) ML(S)=SS(S)
  1.  ;
  1. DLOOP ;Compare IX1 with IX2 and subsequent indexes
  1.  K NEXTIX1
  1.  ;
  1.  ;Set iens and DA array for 1st index
  1.  S IENS1=$E(IX1,$L(IXV)+1,$L(IX1)-1),L=$L(IENS1,",")
  1.  S DA=$P(IENS1,",",L) F I=1:1:L-1 S DA(I)=$P(IENS1,",",L-I)
  1.  S IENS1=$$IENS(.DA)
  1.  ;
  1.  ;If any subsc >= maxlen, set V1(subsc) = value array for 1st index
  1.  I $D(ML) K V1 S S=0 F  S S=$O(ML(S)) Q:'S  X ML(S) S V1(S)=X
  1.  ;
  1.  F  D  S IX2=$Q(@IX2) Q:IX2=""  Q:$NA(@IX2,NS+SS)'=IXV!$G(DIKKQUIT)
  1.  . ;Set iens and DA array for the 2nd index
  1.  . S IENS2=$E(IX2,$L(IXV)+1,$L(IX2)-1),L=$L(IENS2,",")
  1.  . S DA=$P(IENS2,",",L) F I=1:1:L-1 S DA(I)=$P(IENS2,",",L-I)
  1.  . S IENS2=$$IENS(.DA)
  1.  . ;
  1.  . ;If no subsc >= maxlen, there's a duplicate
  1.  . I '$D(ML) D SETK(UIRFIL,IENS2,KEY,DITAR,.DIKKQUIT) S DUPL=1 Q
  1.  . ;
  1.  . ;Otherwise, compare with actual data
  1.  . Q:$D(IENSDONE(IENS2))
  1.  . S S=0 F  S S=$O(ML(S)) Q:'S  X ML(S) I X'=V1(S) Q
  1.  . I S S:'$D(NEXTIX1) NEXTIX1=IX2
  1.  . E  D SETK(UIRFIL,IENS2,KEY,DITAR,.DIKKQUIT) S DUPL=1,IENSDONE(IENS2)=""
  1.  ;
  1.  D:$G(DUPL) SETK(UIRFIL,IENS1,KEY,DITAR,.DIKKQUIT)
  1.  Q:'$D(NEXTIX1)
  1.  ;
  1.  S IX1=NEXTIX1,IX2=$Q(@IX1) Q:IX2=""
  1.  G:$NA(@IX1,NS+SS)=$NA(@IX2,NS+SS) DLOOP
  1.  Q
  1.  ;
  1. SETN(DIFIL,DIIENS,DIFLD,DITAR,DIKKQUIT) ;
  1.  S @DITAR@(DIFIL,DIIENS,DIFLD)=""
  1.  ;S @DITAR@("N",DIFIL,DIIENS,DIFLD)=""
  1.  S:$G(DIKKQUIT)]"" DIKKQUIT=1
  1.  Q
  1.  ;
  1. SETK(DIRFIL,DIIENS,DIKEY,DITAR,DIKKQUIT) ;
  1.  S @DITAR@(DIRFIL,DIIENS,"K",DIKEY)=""
  1.  ;S @DITAR@("K",DIRFIL,DIIENS,DIKEY)=""
  1.  S:$G(DIKKQUIT)]"" DIKKQUIT=1
  1.  Q
  1.  ;
  1. IENS(DA) ;Return IENS from DA array
  1.  N I,IENS
  1.  S IENS=$G(DA)_"," F I=1:1:$O(DA(" "),-1) S IENS=IENS_DA(I)_","
  1.  Q IENS