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

DDUCHK5.m

Go to the documentation of this file. 
  1. DDUCHK5 ;SFISC/MKO-CHECK KEYS ON FILE ;8/8/03  06:26
  1.  ;;22.0;VA FileMan;*130*;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. KEY(DDUCFI,DDUCFIX) ;Check and optionally fix structure of Key file entry
  1.  N DDUCKEY
  1.  Q:'$G(DDUCFI)  S DDUCFIX=$G(DDUCFIX)
  1.  ;
  1.  ;Loop through "B" index to find KEYs that reside on this file
  1.  D WCHK
  1.  S DDUCKEY=""
  1.  F  S DDUCKEY=$O(^DD("KEY","B",DDUCFI,DDUCKEY)) Q:DDUCKEY=""  D CHKKEY
  1.  ;
  1.  ;Check "AP","BB", and "F" indexes
  1.  D CHKAP,CHKBB,CHKF
  1.  Q
  1.  ;
  1. CHKKEY ;Check Key DDUCKEY found in "B" index
  1.  ;In:
  1.  ; DDUCKEY  = Key #
  1.  ; DDUCFI   = File #
  1.  ; DDUCFIX  = Flag to fix
  1.  N DDUCIEN,DDUCKEY0,DDUCKID,DDUCNM,DDUCUI
  1.  S DDUCKID=$$KEYID(DDUCKEY,"")
  1.  ;
  1.  ;Check that Key exists
  1.  I '$D(^DD("KEY",DDUCKEY)) D  Q
  1.  . D WNOKEY
  1.  . D:DDUCFIX KILL($NA(^DD("KEY","B",DDUCFI,DDUCKEY)))
  1.  ;
  1.  ;Check that Key has a FILE
  1.  S DDUCKEY0=$G(^DD("KEY",DDUCKEY,0))
  1.  I $P(DDUCKEY0,U)="" D
  1.  . D WMS("FILE (#.01) for "_DDUCKID)
  1.  . D:DDUCFIX FFILE
  1.  ;
  1.  ;Get Name
  1.  S DDUCNM=$P(DDUCKEY0,U,2)
  1.  I DDUCNM]"" S DDUCKID=$$KEYID(DDUCKEY,DDUCNM)
  1.  E  D WMS("NAME for "_DDUCKID)
  1.  ;
  1.  ;Check Priority
  1.  S DDUCPRI=$P(DDUCKEY0,U,3)
  1.  D:DDUCPRI="" WMS("PRIORITY for "_DDUCKID)
  1.  ;
  1.  ;Check Uniqueness Index
  1.  S DDUCUI=$P(DDUCKEY0,U,4)
  1.  I 'DDUCUI D
  1.  . D WMS("Uniqueness Index for "_DDUCKID,1)
  1.  E  D
  1.  . I '$D(^DD("IX",DDUCUI,0)) D  Q
  1.  .. D WMS("Dangling pointer. Uniqueness Index #"_DDUCUI_" pointed to by "_DDUCKID,1)
  1.  . D GETFLD^DIKKUTL2(DDUCKEY,DDUCUI,.DDUCKFLD,.DDUCUFLD)
  1.  . D:'$$GCMP^DIKCU2("DDUCKFLD","DDUCUFLD") WNE
  1.  ;
  1.  ;Check Field multiple
  1.  S DDUCIEN=0
  1.  F  S DDUCIEN=$O(^DD("KEY",DDUCKEY,2,DDUCIEN)) Q:'DDUCIEN  D FLD
  1.  ;
  1.  ;Reindex Key file entry
  1.  I DDUCFIX D
  1.  . N DIC,DIK,DA,X
  1.  . S DIK="^DD(""KEY"",",DA=DDUCKEY
  1.  . D IX^DIK
  1.  Q
  1.  ;
  1. FLD ;Check a Cross-Reference Value
  1.  ;In:
  1.  ; DDUCKEY = Key #
  1.  ; DDUCIEN = IEN in FIELD multiple
  1.  ; DDUCFIX = Flag to fix
  1.  ; DDUCKID = String that identifies Key
  1.  ; DDUCUI  = Uniqueness index #
  1.  N DDUCFIL,DDUCFLD,DDUCFLD0,DDUCKFLD,DDUCSEQ,DDUCUFLD
  1.  ;
  1.  S DDUCFLD0=$G(^DD("KEY",DDUCKEY,2,DDUCIEN,0))
  1.  S DDUCFLD=$P(DDUCFLD0,U),DDUCFIL=$P(DDUCFLD0,U,2)
  1.  S DDUCSEQ=$P(DDUCFLD0,U,3)
  1.  ;
  1.  ;Check that field, file, and sequence are filled in
  1.  D:'DDUCFLD!'DDUCFIL!'DDUCSEQ WINC
  1.  ;
  1.  ;Make sure file/field exists and is in the "F" index
  1.  I DDUCFLD,DDUCFIL D
  1.  . D:$D(^DD(DDUCFIL,DDUCFLD,0))[0 WFMS
  1.  . I $D(^DD("KEY","F",DDUCFIL,DDUCFLD,DDUCKEY,DDUCIEN))[0 S DDUCGL=$NA(^(DDUCIEN)) D
  1.  .. D WMS(DDUCGL)
  1.  .. D:DDUCFIX SET(DDUCGL)
  1.  Q
  1.  ;
  1. CHKAP ;Check "AP" index (In: DDUCFI = file; DDUCFIX = flag to fix)
  1.  N DDUCGL,DDUCKEY,DDUCKEY0,DDUCPRI,DDUCPRIL
  1.  ;
  1.  S DDUCPRI=""
  1.  F  S DDUCPRI=$O(^DD("KEY","AP",DDUCFI,DDUCPRI)) Q:DDUCPRI=""  D
  1.  . S DDUCKEY=0
  1.  . F  S DDUCKEY=$O(^DD("KEY","AP",DDUCFI,DDUCPRI,DDUCKEY)) Q:'DDUCKEY  D
  1.  .. S DDUCKEY0=$G(^DD("KEY",DDUCKEY,0))
  1.  .. I $D(^DD("KEY",DDUCKEY)),$P(DDUCKEY0,U,3)="" S DDUCPRIL(DDUCKEY,DDUCPRI)=""
  1.  .. E  I $P(DDUCKEY0,U)'=DDUCFI!($P(DDUCKEY0,U,3)'=DDUCPRI) D
  1.  ... S DDUCGL=$NA(^DD("KEY","AP",DDUCFI,DDUCPRI,DDUCKEY))
  1.  ... D WEN(DDUCGL)
  1.  ... D:DDUCFIX KILL(DDUCGL)
  1.  ;
  1.  ;If any of the Keys have null Priorities, check whether a single
  1.  ;priority for it was found in the "AP" index.
  1.  I $D(DDUCPRIL) S DDUCKEY=0 F  S DDUCKEY=$O(DDUCPRIL(DDUCKEY)) Q:'DDUCKEY  D
  1.  . S DDUCPRI=$O(DDUCPRIL(DDUCKEY,""))
  1.  . I $O(DDUCPRIL(DDUCKEY,DDUCPRI))="" D
  1.  .. S DDUCKID=$$KEYID(DDUCKEY)
  1.  .. D WPRI
  1.  .. D:DDUCFIX FPRI
  1.  . E  F  D  S DDUCPRI=$O(DDUCPRIL(DDUCKEY,DDUCPRI)) Q:DDUCPRI=""
  1.  .. S DDUCGL=$NA(^DD("KEY","AP",DDUCFI,DDUCPRI,DDUCKEY))
  1.  .. D WEN(DDUCGL)
  1.  .. D:DDUCFIX KILL(DDUCGL)
  1.  Q
  1.  ;
  1. CHKBB ;Check "BB" index (In: DDUCFI = file; DDUCFIX = flag to fix)
  1.  N DDUCGL,DDUCKEY,DDUCKEY0,DDUCKID,DDUCNM,DDUCNML
  1.  S DDUCNM=""
  1.  F  S DDUCNM=$O(^DD("KEY","BB",DDUCFI,DDUCNM)) Q:DDUCNM=""  D
  1.  . S DDUCKEY=0
  1.  . F DDUCKEY=$O(^DD("KEY","BB",DDUCFI,DDUCNM,DDUCKEY)) Q:'DDUCKEY  D
  1.  .. S DDUCKEY0=$G(^DD("KEY",DDUCKEY,0))
  1.  .. I $D(^DD("KEY",DDUCKEY)),$P(DDUCKEY0,U,2)="" S DDUCNML(DDUCKEY,DDUCNM)=""
  1.  .. E  I $P(DDUCKEY0,U)'=DDUCFI!($P(DDUCKEY0,U,2)'=DDUCNM) D
  1.  ... S DDUCGL=$NA(^DD("KEY","BB",DDUCFI,DDUCNM,DDUCKEY))
  1.  ... D WEN(DDUCGL)
  1.  ... D:DDUCFIX KILL(DDUCGL)
  1.  ;
  1.  ;If any of the Keys have null Names, check whether a single name
  1.  ;for it was found in the "BB" index.
  1.  I $D(DDUCNML) S DDUCKEY=0 F  S DDUCKEY=$O(DDUCNML(DDUCKEY)) Q:'DDUCKEY  D
  1.  . S DDUCNM=$O(DDUCNML(DDUCKEY,""))
  1.  . I $O(DDUCNML(DDUCKEY,DDUCNM))="" D
  1.  .. S DDUCKID=$$KEYID(DDUCKEY,"")
  1.  .. D WNM
  1.  .. D:DDUCFIX FNM
  1.  . E  F  D  S DDUCNM=$O(DDUCNML(DDUCKEY,DDUCNM)) Q:DDUCNM=""
  1.  .. S DDUCGL=$NA(^DD("KEY","BB",DDUCFI,DDUCNM,DDUCKEY))
  1.  .. D WEN(DDUCGL)
  1.  .. D:DDUCFIX KILL(DDUCGL)
  1.  Q
  1.  ;
  1. CHKF ;Check "F" index (In: DDUCFI = file; DDUCFIX = flag to fix)
  1.  N DDUCFLD,DDUCGL,DDUCKEY,DDUCIEN
  1.  S DDUCFLD=0
  1.  F  S DDUCFLD=$O(^DD("KEY","F",DDUCFI,DDUCFLD)) Q:'DDUCFLD  D
  1.  . S DDUCKEY=0
  1.  . F  S DDUCKEY=$O(^DD("KEY","F",DDUCFI,DDUCFLD,DDUCKEY)) Q:'DDUCKEY  D
  1.  .. S DDUCIEN=0
  1.  .. F  S DDUCIEN=$O(^DD("KEY","F",DDUCFI,DDUCFLD,DDUCKEY,DDUCIEN)) Q:'DDUCIEN  D
  1.  ... I $P($G(^DD("KEY",DDUCKEY,2,DDUCIEN,0)),U,2)'=DDUCFI!($P($G(^(0)),U)'=DDUCFLD) D
  1.  .... S DDUCGL=$NA(^DD("KEY","F",DDUCFI,DDUCFLD,DDUCKEY,DDUCIEN))
  1.  .... D WEN(DDUCGL)
  1.  .... D:DDUCFIX KILL(DDUCGL)
  1.  Q
  1.  ;
  1.  ;---------------
  1. FFILE ;Set the .01 of Key to DDUCFI
  1.  S $P(^DD("KEY",DDUCKEY,0),U)=DDUCFI
  1.  D WRITE("FILE (#.01) for "_DDUCKID_" set to "_DDUCFI_".",10)
  1.  Q
  1.  ;
  1. FNM ;Set the NAME for the Key
  1.  S $P(^DD("KEY",DDUCKEY,0),U,2)=DDUCNM
  1.  D WRITE("NAME for "_DDUCKID_" set to '"_DDUCNM_"'.",10)
  1.  Q
  1.  ;
  1. FPRI ;Set the PRIORITY for the Key
  1.  S $P(^DD("KEY",DDUCKEY,0),U,3)=DDUCPRI
  1.  D WRITE("PRIORITY for "_DDUCKID_" set to '"_DDUCPRI_"'.",10)
  1.  Q
  1.  ;
  1. KILL(GL) ;Kill a global and print a message
  1.  Q:'$D(@GL)
  1.  K @GL
  1.  W !?10,GL_" was killed."
  1.  Q
  1.  ;
  1. SET(GL,VAL) ;Set a global and print a message
  1.  Q:$D(@GL)
  1.  S VAL=$G(VAL),@GL=VAL
  1.  W !?10,GL_" was set"_$S(VAL]"":" to "_VAL,1:"")_"."
  1.  Q
  1.  ;
  1.  ;Write messages
  1. WCHK Q  ;D WRITE("Checking Keys.",5) Q
  1. WNOKEY D WRITE(DDUCKID_" does not exist.",7) Q
  1. WMS(S,N) D WRITE(S_" is missing."_$S($G(N):" Nothing done.",1:""),7) Q
  1. WINC D WRITE("Field information in "_DDUCKEY_" is incomplete. Nothing done.",7) Q
  1. WFMS D WRITE("*File #"_DDUCFIL_", Field #"_DDUCFLD_" referenced in "_DDUCKEY_" is missing.",7) Q  ;22*130
  1. WNE D WRITE("*Fields in "_DDUCKID_" don't match fields in Uniqueness Index.",7) Q  ;22*130
  1. WEN(GL) D WRITE("Erroneous node "_GL_" is set.",7) Q
  1. WNM D WRITE("NAME for "_DDUCKID_" looks like it should be '"_DDUCNM_"'.",7) Q
  1. WPRI D WRITE("PRIORITY for "_DDUCKID_" looks like it should be '"_DDUCPRI_"'.",7) Q
  1.  ;
  1. WRITE(TXT,TAB) ;Write text, wrap at word boundaries.
  1.  N I
  1.  D WRAP^DIKCU2(.TXT,-TAB-2,-TAB)
  1.  W !?TAB,$G(TXT,$G(TXT(0))) F I=1:1 Q:'$D(TXT(I))  W !?TAB+2,TXT(I)
  1.  Q
  1.  ;
  1. KEYID(KEY,NM) ;Return string that identifies a Key
  1.  S:'$D(NM) NM=$P($G(^DD("KEY",KEY,0)),U,2)
  1.  Q $S(NM]"":"Key '"_NM_"' (#"_KEY_")",1:"Key #"_KEY)