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

DDUCHK4.m

Go to the documentation of this file. 
  1. DDUCHK4 ;SFISC/MKO-CHECK INDEXES ON FILE ;6:36 AM  28 Dec 2004
  1.  ;;22.0;VA FileMan;*130*;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. INDEX(DDUCFI,DDUCFIX) ;Check and optionally fix structure of Index file entry
  1.  N DDUCIX
  1.  Q:'$G(DDUCFI)  S DDUCFIX=$G(DDUCFIX)
  1.  ;
  1.  ;Loop through "B" index to find INDEXes that reside on this file
  1.  D WCHK
  1.  S DDUCIX=""
  1.  F  S DDUCIX=$O(^DD("IX","B",DDUCFI,DDUCIX)) Q:DDUCIX=""  D CHKIX
  1.  ;
  1.  ;Check "AC","BB", and "F" indexes
  1.  D CHKAC,CHKBB,CHKF
  1.  Q
  1.  ;
  1. CHKIX ;Check Index DDUCIX found in "B" index
  1.  ;In:
  1.  ; DDUCIX  = index #
  1.  ; DDUCFI  = file #
  1.  ; DDUCFIX = flag to fix
  1.  N DDUCIX0,DDUCIXID,DDUCNM,DDUCRF,DDUCRV
  1.  S DDUCIXID=$$IXID(DDUCIX,"")
  1.  ;
  1.  ;Check that Index exists
  1.  I '$D(^DD("IX",DDUCIX)) D  Q
  1.  . D WNOIX
  1.  . D:DDUCFIX KILL($NA(^DD("IX","B",DDUCFI,DDUCIX)))
  1.  ;
  1.  ;Check that index has a FILE
  1.  S DDUCIX0=$G(^DD("IX",DDUCIX,0))
  1.  I $P(DDUCIX0,U)="" D
  1.  . D WMS("FILE (#.01) for "_DDUCIXID)
  1.  . D:DDUCFIX FFILE
  1.  ;
  1.  ;Get Name
  1.  S DDUCNM=$P(DDUCIX0,U,2)
  1.  I DDUCNM]"" S DDUCIXID=$$IXID(DDUCIX,DDUCNM)
  1.  E  D WMS("NAME for "_DDUCIXID)
  1.  ;
  1.  ;Check Root File not null, and "AC" index exists
  1.  S DDUCRF=$P(DDUCIX0,U,9)
  1.  I 'DDUCRF D
  1.  . D WMS("ROOT FILE for "_DDUCIXID)
  1.  . D:DDUCFIX FRF
  1.  ;
  1.  ;Check Cross-Reference Values multiple
  1.  S DDUCRV=0
  1.  F  S DDUCRV=$O(^DD("IX",DDUCIX,11.1,DDUCRV)) Q:'DDUCRV  D CRV
  1.  ;
  1.  ;Reindex Index file entry
  1.  I DDUCFIX D
  1.  . N DIC,DIK,DA,X
  1.  . S DIK="^DD(""IX"",",DA=DDUCIX
  1.  . D IX^DIK
  1.  Q
  1.  ;
  1. CRV ;Check a Cross-Reference Value
  1.  ;In:
  1.  ; DDUCIX   = Index #
  1.  ; DDUCRV   = CRV #
  1.  ; DDUCFIX  = Flag to fix
  1.  ; DDUCRF   = Root file #
  1.  ; DDUCIXID = String that identifies Index
  1.  N DDUCFIL,DDUCFLD,DDUCGL,DDUCOID,DDUCORD,DDUCRV0
  1.  ;
  1.  S DDUCRV0=$G(^DD("IX",DDUCIX,11.1,DDUCRV,0))
  1.  Q:$P(DDUCRV0,U,2)="C"
  1.  S DDUCORD=$P(DDUCRV0,U),DDUCFIL=$P(DDUCRV0,U,3),DDUCFLD=$P(DDUCRV0,U,4)
  1.  ;
  1.  ;Check .01 of CRV
  1.  I DDUCORD="" D
  1.  . D WMS("ORDER NUMBER of Cross-Reference Value #"_DDUCRV_" of "_DDUCIXID)
  1.  . D:DDUCFIX FON
  1.  S DDUCOID=$$OID(DDUCORD,"","",DDUCIXID)
  1.  ;
  1.  ;Make sure FILE is not null
  1.  I 'DDUCFIL D
  1.  . D WMS("FILE for "_DDUCOID,1)
  1.  ;
  1.  ;If there's a File, make sure it is equal to Root File
  1.  ;and that referenced field exists.
  1.  E  D
  1.  . D:DDUCFIL'=DDUCRF WNE
  1.  . D:$D(^DD(DDUCFIL,DDUCFLD,0))[0 WFMS
  1.  . I $D(^DD("IX","F",DDUCFIL,DDUCFLD,DDUCIX,DDUCRV))[0 S DDUCGL=$NA(^(DDUCRV)) D
  1.  .. D WMS(DDUCGL)
  1.  .. D:DDUCFIX SET(DDUCGL)
  1.  Q
  1.  ;
  1. CHKAC ;Check "AC index (In: DDUCFI = file; DDUCFIX = flag to fix)
  1.  N DDUCGL,DDUCIX
  1.  S DDUCIX=0 F  S DDUCIX=$O(^DD("IX","AC",DDUCFI,DDUCIX)) Q:'DDUCIX  D
  1.  . I $P($G(^DD("IX",DDUCIX,0)),U,9)]"",$P(^(0),U,9)'=DDUCFI D
  1.  .. S DDUCGL=$NA(^DD("IX","AC",DDUCFI,DDUCIX))
  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,DDUCIX,DDUCIX0,DDUCIXID,DDUCNM,DDUCNML
  1.  S DDUCNM=""
  1.  F  S DDUCNM=$O(^DD("IX","BB",DDUCFI,DDUCNM)) Q:DDUCNM=""  D
  1.  . S DDUCIX=0
  1.  . F DDUCIX=$O(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX)) Q:'DDUCIX  D
  1.  .. S DDUCIX0=$G(^DD("IX",DDUCIX,0))
  1.  .. I $D(^DD("IX",DDUCIX)),$P(DDUCIX0,U,2)="" S DDUCNML(DDUCIX,DDUCNM)=""
  1.  .. E  I $P(DDUCIX0,U)'=DDUCFI!($P(DDUCIX0,U,2)'=DDUCNM) D
  1.  ... S DDUCGL=$NA(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX))
  1.  ... D WEN(DDUCGL)
  1.  ... D:DDUCFIX KILL(DDUCGL)
  1.  ;
  1.  ;If any of the Indexes have null Names, check whether a single name
  1.  ;for it was found in the "BB" index.
  1.  I $D(DDUCNML) S DDUCIX=0 F  S DDUCIX=$O(DDUCNML(DDUCIX)) Q:'DDUCIX  D
  1.  . S DDUCNM=$O(DDUCNML(DDUCIX,""))
  1.  . I $O(DDUCNML(DDUCIX,DDUCNM))="" D
  1.  .. S DDUCIXID=$$IXID(DDUCIX,"")
  1.  .. D WNM
  1.  .. D:DDUCFIX FNM
  1.  . E  F  D  S DDUCNM=$O(DDUCNML(DDUCIX,DDUCNM)) Q:DDUCNM=""
  1.  .. S DDUCGL=$NA(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX))
  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,DDUCIX,DDUCRV
  1.  S DDUCFLD=0
  1.  F  S DDUCFLD=$O(^DD("IX","F",DDUCFI,DDUCFLD)) Q:'DDUCFLD  D
  1.  . S DDUCIX=0
  1.  . F  S DDUCIX=$O(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX)) Q:'DDUCIX  D
  1.  .. S DDUCRV=0
  1.  .. F  S DDUCRV=$O(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX,DDUCRV)) Q:'DDUCRV  D
  1.  ... I $P($G(^DD("IX",DDUCIX,11.1,DDUCRV,0)),U,3)'=DDUCFI!($P($G(^(0)),U,4)'=DDUCFLD) D
  1.  .... S DDUCGL=$NA(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX,DDUCRV))
  1.  .... D WEN(DDUCGL)
  1.  .... D:DDUCFIX KILL(DDUCGL)
  1.  Q
  1.  ;
  1.  ;---------------
  1. FFILE ;Set the .01 of index to DDUCFI
  1.  S $P(^DD("IX",DDUCIX,0),U)=DDUCFI
  1.  D WRITE("FILE (#.01) for "_DDUCIXID_" set to "_DDUCFI_".",10)
  1.  Q
  1.  ;
  1. FRF ;Set Root File equal to File and Root Type to 'INDEX FILE'
  1.  S $P(^DD("IX",DDUCIX,0),U,8)="I"
  1.  S $P(^DD("IX",DDUCIX,0),U,9)=DDUCFI
  1.  S DDUCRF=DDUCFI
  1.  D WRITE("ROOT FILE for "_DDUCIXID_" set to "_DDUCFI_".",10)
  1.  D WRITE("ROOT TYPE for "_DDUCIXID_" set to 'INDEX FILE'.",10)
  1.  Q
  1.  ;
  1. FON ;Determine Order Number
  1.  N DDUCI,DDUCO
  1.  ;
  1.  ;Look for Order Number in "B" index
  1.  S DDUCORD=0
  1.  F  S DDUCORD=$O(^DD("IX",DDUCIX,11.1,"B",DDUCORD)) Q:'DDUCORD  Q:$O(^DD("IX",DDUCIX,11.1,"B",DDUCORD,0))=DDUCRV
  1.  ;
  1.  ;If not found, just pick an unused Order Number
  1.  I 'DDUCORD D
  1.  . S DDUCI=0
  1.  . F  S DDUCI=$O(^DD("IX",DDUCIX,11.1,DDUCI)) Q:'DDUCI  S:$P($G(^(DDUCI,0)),U)]"" DDUCO($P(^(0),U))=""
  1.  . S DDUCORD=$O(DDUCO(""),-1)
  1.  . S:'DDUCORD DDUCORD=1
  1.  ;
  1.  S $P(^DD("IX",DDUCIX,11.1,DDUCRV,0),U)=DDUCORD
  1.  D WRITE("ORDER NUMBER for Cross-Reference Value #"_DDUCRV_" of "_DDUCIXID_" set to "_DDUCORD_".",10)
  1.  Q
  1.  ;
  1. FNM ;Set the NAME for the Index
  1.  S $P(^DD("IX",DDUCIX,0),U,2)=DDUCNM
  1.  D WRITE("NAME for "_DDUCIXID_" set to '"_DDUCNM_"'.",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 Indexes.",5) Q
  1. WNOIX D WRITE(DDUCIXID_" does not exist.",7) Q
  1. WMS(S,N) D WRITE("*"_S_" is missing."_$S($G(N):" ",1:""),7) Q
  1. WNE D WRITE("*FILE does not equal ROOT FILE in "_DDUCOID_".",7) Q  ;22*130
  1. WFMS D WRITE("*File/Sub-file #"_$S($G(FIL)'="":FIL,1:DDUCFIL)_", Field #"_$S($G(FLD)'="":FLD,1:DDUCFLD)_" referenced in "_DDUCOID_" is missing.",7) Q  ;22*130
  1. WEN(GL) D WRITE("Erroneous node "_GL_" is set.",7) Q
  1. WNM D WRITE("NAME for "_DDUCIXID_" looks like it should be '"_DDUCNM_"'.",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. IXID(IX,NM) ;Return string that identifies an Index
  1.  S:'$D(NM) NM=$P($G(^DD("IX",IX,0)),U,2)
  1.  Q $S(NM]"":"'"_NM_"' Index (#"_IX_")",1:"Index #"_IX)
  1.  ;
  1. OID(ORD,IX,NM,IXID) ;Return string that identifies Cross-Reference Value
  1.  I '$D(IXID),$G(IX) S IXID=$S($D(NM)#2:$$IXID(IX,NM),1:$$IXID(IX))
  1.  Q "Order #"_ORD_" of "_$S($G(IXID)]"":IXID,1:"")