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