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

DIKC1.m

Go to the documentation of this file. 
  1. DIKC1 ;SFISC/MKO-LOAD XREF INFO ;19DEC2010
  1.  ;;22.0;VA FileMan;**11,167,1019**;Mar 30, 1999;Build 2
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;IHS/OIT/FBD - DI*22.0*1019 - 12/4/2015 - ATTEMPT TO REDUCE DISK BLOCK
  1.  ;   COLLISIONS BY REPLACING GETTMP SURBROUTINE'S UNCONDITIONAL KILL
  1.  ;   WITH CONDITIONAL PRE-CHECK
  1.  ;
  1.  ;============================================
  1.  ; LOADALL(File,Log,Activ,ValRt,Tmp,Flag,.MF)
  1.  ;============================================
  1.  ;Load all xrefs for a file. Uses the "AC" index on Root File.
  1.  ;In:
  1.  ; RFIL  = Root File #
  1.  ; LOG   [ K : load kill logic
  1.  ;       [ S : load set logic
  1.  ; ACT   = Codes: IR
  1.  ;          If ACT '= null, a xref is picked up only if ACT
  1.  ;          and the Activity field (#.41) have codes in common.
  1.  ; VALRT = Array Ref where old/new values are located
  1.  ; TMP   = Root to store xref info
  1.  ; FLAG  [ s : don't include subfiles under file
  1.  ;       [ i : don't load index-type xrefs (only load whole file xrefs)
  1.  ;       [ f : don't load field-type xrefs
  1.  ;       [ r : don't load record-type xrefs
  1.  ;       [ x : don't load "NOREINDEX" xrefs
  1.  ;
  1.  ;Out:
  1.  ; MF(file#,mField#)   = multiple node
  1.  ; MF(file#,mField#,0) = subfile#
  1.  ;   Set only for those files/multiples that have xrefs
  1.  ;   and only if FLAG '[ "s"
  1.  ;
  1. LOADALL(RFIL,LOG,ACT,VALRT,TMP,FLAG,MF) ;
  1.  N XR
  1.  ;
  1.  ;Loop through "AC" index
  1.  S XR=0 F  S XR=$O(^DD("IX","AC",RFIL,XR)) Q:'XR  D
  1.  . ;Skip if no .01, wrong Activity, wrong Type, or wrong Execution
  1.  . I $P($G(^DD("IX",XR,0)),U)="" K ^DD("IX","AC",RFIL,XR) Q
  1.  . I $G(ACT)]"",$TR(ACT,$P(^DD("IX",XR,0),U,7),$TR($J("",$L($P(^(0),U,7)))," ","*"))'["*" Q
  1.  . I $G(FLAG)["i",$P(^DD("IX",XR,0),U,8)="I" Q
  1.  . I $G(FLAG)["f",$P(^DD("IX",XR,0),U,6)="F" Q
  1.  . I $G(FLAG)["r",$P(^DD("IX",XR,0),U,6)="R" Q
  1. NOREIN .I $G(FLAG)["x",$G(^DD("IX",XR,"NOREINDEX")) Q  ;PATCH 167
  1.  . ;
  1.  . ;Load xref
  1.  . D CRV^DIKC2(XR,$G(VALRT),TMP)
  1.  . D:$G(LOG)]"" LOG^DIKC2(XR,LOG,TMP)
  1.  . D:$G(LOG)["K" KW^DIKC2(XR,TMP)
  1.  Q:$G(FLAG)["s"
  1.  ;
  1.  ;Build info for all subfiles under FILE into arrays SB and MF
  1.  N CHK,FIL,MFLD,PAR,SB
  1.  D SUBFILES^DIKCU(RFIL,.SB,.MF)
  1.  ;
  1.  ;Load xref for each subfile
  1.  S:$G(FLAG)'["s" FLAG=$G(FLAG)_"s"
  1.  S SB=0 F  S SB=$O(SB(SB)) Q:'SB  D
  1.  . D LOADALL(SB,$G(LOG),$G(ACT),$G(VALRT),TMP,FLAG)
  1.  . Q:'$D(@TMP@(SB))
  1.  . ;
  1.  . ;Set CHK(f)="" flag for subfile and its antecedents
  1.  . S PAR=SB F  Q:$D(CHK(PAR))  S CHK(PAR)=1,PAR=$G(SB(PAR)) Q:PAR=""
  1.  ;
  1.  ;Use the CHK array to get rid of unneeded elements in MF
  1.  S FIL=0 F  S FIL=$O(MF(FIL)) Q:'FIL  D
  1.  . S MFLD=0 F  S MFLD=$O(MF(FIL,MFLD)) Q:'MFLD  D
  1.  .. K:'$D(CHK(MF(FIL,MFLD,0))) MF(FIL,MFLD)
  1.  Q
  1.  ;
  1.  ;========================================
  1.  ; LOADXREF(File,Fld,Log,.XRef,ValRt,Tmp)
  1.  ;========================================
  1.  ;Load specified xrefs. Uses the "AC" index on Root file if Index
  1.  ;Names are passed in. Also, uses the "F" index, if Field is passed in.
  1.  ;In:
  1.  ;  RFIL  = if FLD is not passed in : Root File or subfile#
  1.  ;                                    (required if XREF contains names)
  1.  ;          if FLD is passed in : The file of the field
  1.  ;                                (defaults to Root file of XREF)
  1.  ;  FLD   = Field # (optional) (if passed in, a specified index is
  1.  ;          loaded only if FLD is one of the cross-reference values.
  1.  ;  LOG   [ K : load kill logic (incl. whole kill)
  1.  ;        [ S : load set logic
  1.  ; .XREF  = ^-delimited list of xref names or numbers;
  1.  ;          (overflow in XREF(n) where n=1,2,...)
  1.  ;  VALRT = Array Ref where old/new values are located
  1.  ;  TMP   = Root to store info
  1.  ;
  1. LOADXREF(RFIL,FLD,LOG,XREF,VALRT,TMP) ;
  1.  N I,N,PC,RF,XR,XRLIST
  1.  ;
  1.  ;Loop through XREF array
  1.  S N=0,XRLIST=$G(XREF) F  Q:XRLIST=""  D
  1.  . ;
  1.  . ;Loop through each xref in XRLIST
  1.  . F PC=1:1:$L(XRLIST,U) K XR S XR=$P(XRLIST,U,PC) D:XR]""
  1.  .. ;
  1.  .. ;Convert xref name to number, if necessary
  1.  .. I XR'=+$P(XR,"E") D  Q:$D(XR)<2
  1.  ... S I=0 F  S I=$O(^DD("IX","AC",RFIL,I)) Q:'I  D
  1.  .... S:$P($G(^DD("IX",I,0)),U,2)=XR XR(I)=""
  1.  .. E  Q:$P($G(^DD("IX",XR,0)),U)=""  S XR(XR)=""
  1.  .. ;
  1.  .. ;Load code from Cross-Reference Values multiple
  1.  .. S XR=0 F  S XR=$O(XR(XR)) Q:'XR  D
  1.  ... S RF=$P(^DD("IX",XR,0),U,9)
  1.  ... I $G(FLD) Q:'$D(^DD("IX","F",$S($G(RFIL):RFIL,1:RF),FLD,XR))
  1.  ... E  I $G(RFIL) Q:RFIL'=RF
  1.  ... D CRV^DIKC2(XR,$G(VALRT),TMP)
  1.  ... D:$G(LOG)]"" LOG^DIKC2(XR,LOG,TMP)
  1.  ... D:$G(LOG)["K" KW^DIKC2(XR,TMP)
  1.  . ;
  1.  . ;Process next overflow
  1.  . S N=$O(XREF(N)),XRLIST=$S(N:$G(XREF(N)),1:"")
  1.  Q
  1.  ;
  1.  ;================================================================
  1.  ; LOADFLD(File,Field,Log,Activ,ValRt,TmpF,TmpR,FList,RList,Flag)
  1.  ;================================================================
  1.  ;Get all xrefs for a field. Uses the "F" index on file/field.
  1.  ;In:
  1.  ; FIL   = File #
  1.  ; FLD   = Field #
  1.  ; LOG   [ K : load kill logic
  1.  ;       [ S : load set logic
  1.  ;       [ W : load entire kill logic (if LOG also [ "K")
  1.  ; ACT   = codes: IR
  1.  ;          If ACT is not null, a xref is picked up only if ACT
  1.  ;          and the Activity field (#.41) have codes in common.
  1.  ; VALRT = Array Ref where old/new values are located
  1.  ; TMPF  = Root to store field-level xref info
  1.  ; TMPR  = Root to store record-level xref info
  1.  ; FLAG  [ i : don't load index-type xrefs (only load whole file xrefs)
  1.  ;       [ f : don't load field-type xrefs
  1.  ;       [ r : don't load record-type xrefs
  1.  ;Out:
  1.  ; .FLIST = ^-delimited list of field xrefs (overflow in FLIST(n))
  1.  ; .RLIST = ^-delimited list of record xrefs (overflow in RLIST(n))
  1.  ;
  1. LOADFLD(FIL,FLD,LOG,ACT,VALRT,TMPF,TMPR,FLIST,RLIST,FLAG) ;
  1.  N EXECFLD,TMP,XR
  1.  K FLIST,RLIST S (FLIST,RLIST)=0,(FLIST(0),RLIST(0))=""
  1.  S:$G(TMPR)="" TMPR=TMPF
  1.  ;
  1.  ;Loop through "F" index and pick up xrefs
  1.  S XR=0 F  S XR=$O(^DD("IX","F",FIL,FLD,XR)) Q:'XR  D
  1.  . I $P($G(^DD("IX",XR,0)),U)="" K ^DD("IX","F",FIL,FLD,XR) Q
  1.  . S EXECFLD=$P(^DD("IX",XR,0),U,6)
  1.  . I $G(ACT)]"",$TR(ACT,$P(^DD("IX",XR,0),U,7),$TR($J("",$L($P(^(0),U,7)))," ","*"))'["*" Q
  1.  . I $G(FLAG)["i",$P(^DD("IX",XR,0),U,8)="I" Q
  1.  . I $G(FLAG)["f",$P(^DD("IX",XR,0),U,6)="F" Q
  1.  . I $G(FLAG)["r",$P(^DD("IX",XR,0),U,6)="R" Q
  1.  . I $G(FLAG)["x",$G(^DD("IX",XR,"NOREINDEX")) Q
  1.  . ;
  1.  . ;Set TMP, RLIST, and FLIST
  1.  . K TMP
  1.  . I EXECFLD="R" D
  1.  .. S TMP=$G(TMPR)
  1.  .. I $L(RLIST(RLIST))+$L(XR)+1>255 S RLIST=RLIST+1,RLIST(RLIST)=""
  1.  .. S RLIST(RLIST)=RLIST(RLIST)_$E(U,RLIST(RLIST)]"")_XR
  1.  . E  D
  1.  .. S TMP=$G(TMPF)
  1.  .. I $L(FLIST(FLIST))+$L(XR)+1>255 S FLIST=FLIST+1,FLIST(FLIST)=""
  1.  .. S FLIST(FLIST)=FLIST(FLIST)_$E(U,FLIST(FLIST)]"")_XR
  1.  . ;
  1.  . ;Load xref
  1.  . Q:$G(TMP)=""  Q:$D(@TMP@(FIL,XR))
  1.  . D CRV^DIKC2(XR,$G(VALRT),TMP)
  1.  . D:$G(LOG)]"" LOG^DIKC2(XR,LOG,TMP)
  1.  . I $G(LOG)["K",$G(LOG)["W" D KW^DIKC2(XR,TMP)
  1.  ;
  1.  I FLIST(0)]"" S FLIST=FLIST(0) K FLIST(0)
  1.  E  K FLIST S FLIST=""
  1.  I RLIST(0)]"" S RLIST=RLIST(0) K RLIST(0)
  1.  E  K RLIST S RLIST=""
  1.  Q
  1.  ;
  1. GETTMP(DIKC) ;Find next available root in ^TMP(DIKC)
  1.  ;Time stamp ^TMP(DIKC,J)
  1.  ;Out:
  1.  ; Name of available ^TMP root; e.g. ^TMP("DIKC",$J+.01)
  1.  ;
  1.  N DAY,FREE,J
  1.  S FREE=0 F J=$J:.01 D  Q:FREE
  1.  . S DAY=$G(^TMP(DIKC,J))
  1.  . ;I DAY<($H-1) K ^TMP(DIKC,J) S ^TMP(DIKC,J)=$H,FREE=1  ;DI*22.0*1019 - IHS/OIT/FBD - ORIGINAL LINE - COMMENTED OUT
  1.  . I DAY<($H-1) K:$D(^TMP(DIKC,J)) ^TMP(DIKC,J) S ^TMP(DIKC,J)=$H,FREE=1  ;DI*22.0*1019 - IHS/OIT/FBD - ADDED CONDITIONAL TO 'KILL'
  1.  Q $NA(^TMP(DIKC,J))