source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIKC1.m@ 1195

Last change on this file since 1195 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.6 KB
Line 
1DIKC1 ;SFISC/MKO-LOAD XREF INFO ;8:19 AM 2 Aug 1999
2 ;;22.0;VA FileMan;**11**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;============================================
6 ; LOADALL(File,Log,Activ,ValRt,Tmp,Flag,.MF)
7 ;============================================
8 ;Load all xrefs for a file. Uses the "AC" index on Root File.
9 ;In:
10 ; RFIL = Root File #
11 ; LOG [ K : load kill logic
12 ; [ S : load set logic
13 ; ACT = Codes: IR
14 ; If ACT '= null, a xref is picked up only if ACT
15 ; and the Activity field (#.41) have codes in common.
16 ; VALRT = Array Ref where old/new values are located
17 ; TMP = Root to store xref info
18 ; FLAG [ s : don't include subfiles under file
19 ; [ i : don't load index-type xrefs (only load whole file xrefs)
20 ; [ f : don't load field-type xrefs
21 ; [ r : don't load record-type xrefs
22 ;
23 ;Out:
24 ; MF(file#,mField#) = multiple node
25 ; MF(file#,mField#,0) = subfile#
26 ; Set only for those files/multiples that have xrefs
27 ; and only if FLAG '[ "s"
28 ;
29LOADALL(RFIL,LOG,ACT,VALRT,TMP,FLAG,MF) ;
30 N XR
31 ;
32 ;Loop through "AC" index
33 S XR=0 F S XR=$O(^DD("IX","AC",RFIL,XR)) Q:'XR D
34 . ;Skip if no .01, wrong Activity, wrong Type, or wrong Execution
35 . I $P($G(^DD("IX",XR,0)),U)="" K ^DD("IX","AC",RFIL,XR) Q
36 . I $G(ACT)]"",$TR(ACT,$P(^DD("IX",XR,0),U,7),$TR($J("",$L($P(^(0),U,7)))," ","*"))'["*" Q
37 . I $G(FLAG)["i",$P(^DD("IX",XR,0),U,8)="I" Q
38 . I $G(FLAG)["f",$P(^DD("IX",XR,0),U,6)="F" Q
39 . I $G(FLAG)["r",$P(^DD("IX",XR,0),U,6)="R" Q
40 . ;
41 . ;Load xref
42 . D CRV^DIKC2(XR,$G(VALRT),TMP)
43 . D:$G(LOG)]"" LOG^DIKC2(XR,LOG,TMP)
44 . D:$G(LOG)["K" KW^DIKC2(XR,TMP)
45 Q:$G(FLAG)["s"
46 ;
47 ;Build info for all subfiles under FILE into arrays SB and MF
48 N CHK,FIL,MFLD,PAR,SB
49 D SUBFILES^DIKCU(RFIL,.SB,.MF)
50 ;
51 ;Load xref for each subfile
52 S:$G(FLAG)'["s" FLAG=$G(FLAG)_"s"
53 S SB=0 F S SB=$O(SB(SB)) Q:'SB D
54 . D LOADALL(SB,$G(LOG),$G(ACT),$G(VALRT),TMP,FLAG)
55 . Q:'$D(@TMP@(SB))
56 . ;
57 . ;Set CHK(f)="" flag for subfile and its antecedents
58 . S PAR=SB F Q:$D(CHK(PAR)) S CHK(PAR)=1,PAR=$G(SB(PAR)) Q:PAR=""
59 ;
60 ;Use the CHK array to get rid of unneeded elements in MF
61 S FIL=0 F S FIL=$O(MF(FIL)) Q:'FIL D
62 . S MFLD=0 F S MFLD=$O(MF(FIL,MFLD)) Q:'MFLD D
63 .. K:'$D(CHK(MF(FIL,MFLD,0))) MF(FIL,MFLD)
64 Q
65 ;
66 ;========================================
67 ; LOADXREF(File,Fld,Log,.XRef,ValRt,Tmp)
68 ;========================================
69 ;Load specified xrefs. Uses the "AC" index on Root file if Index
70 ;Names are passed in. Also, uses the "F" index, if Field is passed in.
71 ;In:
72 ; RFIL = if FLD is not passed in : Root File or subfile#
73 ; (required if XREF contains names)
74 ; if FLD is passed in : The file of the field
75 ; (defaults to Root file of XREF)
76 ; FLD = Field # (optional) (if passed in, a specified index is
77 ; loaded only if FLD is one of the cross-reference values.
78 ; LOG [ K : load kill logic (incl. whole kill)
79 ; [ S : load set logic
80 ; .XREF = ^-delimited list of xref names or numbers;
81 ; (overflow in XREF(n) where n=1,2,...)
82 ; VALRT = Array Ref where old/new values are located
83 ; TMP = Root to store info
84 ;
85LOADXREF(RFIL,FLD,LOG,XREF,VALRT,TMP) ;
86 N I,N,PC,RF,XR,XRLIST
87 ;
88 ;Loop through XREF array
89 S N=0,XRLIST=$G(XREF) F Q:XRLIST="" D
90 . ;
91 . ;Loop through each xref in XRLIST
92 . F PC=1:1:$L(XRLIST,U) K XR S XR=$P(XRLIST,U,PC) D:XR]""
93 .. ;
94 .. ;Convert xref name to number, if necessary
95 .. I XR'=+$P(XR,"E") D Q:$D(XR)<2
96 ... S I=0 F S I=$O(^DD("IX","AC",RFIL,I)) Q:'I D
97 .... S:$P($G(^DD("IX",I,0)),U,2)=XR XR(I)=""
98 .. E Q:$P($G(^DD("IX",XR,0)),U)="" S XR(XR)=""
99 .. ;
100 .. ;Load code from Cross-Reference Values multiple
101 .. S XR=0 F S XR=$O(XR(XR)) Q:'XR D
102 ... S RF=$P(^DD("IX",XR,0),U,9)
103 ... I $G(FLD) Q:'$D(^DD("IX","F",$S($G(RFIL):RFIL,1:RF),FLD,XR))
104 ... E I $G(RFIL) Q:RFIL'=RF
105 ... D CRV^DIKC2(XR,$G(VALRT),TMP)
106 ... D:$G(LOG)]"" LOG^DIKC2(XR,LOG,TMP)
107 ... D:$G(LOG)["K" KW^DIKC2(XR,TMP)
108 . ;
109 . ;Process next overflow
110 . S N=$O(XREF(N)),XRLIST=$S(N:$G(XREF(N)),1:"")
111 Q
112 ;
113 ;================================================================
114 ; LOADFLD(File,Field,Log,Activ,ValRt,TmpF,TmpR,FList,RList,Flag)
115 ;================================================================
116 ;Get all xrefs for a field. Uses the "F" index on file/field.
117 ;In:
118 ; FIL = File #
119 ; FLD = Field #
120 ; LOG [ K : load kill logic
121 ; [ S : load set logic
122 ; [ W : load entire kill logic (if LOG also [ "K")
123 ; ACT = codes: IR
124 ; If ACT is not null, a xref is picked up only if ACT
125 ; and the Activity field (#.41) have codes in common.
126 ; VALRT = Array Ref where old/new values are located
127 ; TMPF = Root to store field-level xref info
128 ; TMPR = Root to store record-level xref info
129 ; FLAG [ i : don't load index-type xrefs (only load whole file xrefs)
130 ; [ f : don't load field-type xrefs
131 ; [ r : don't load record-type xrefs
132 ;Out:
133 ; .FLIST = ^-delimited list of field xrefs (overflow in FLIST(n))
134 ; .RLIST = ^-delimited list of record xrefs (overflow in RLIST(n))
135 ;
136LOADFLD(FIL,FLD,LOG,ACT,VALRT,TMPF,TMPR,FLIST,RLIST,FLAG) ;
137 N EXECFLD,TMP,XR
138 K FLIST,RLIST S (FLIST,RLIST)=0,(FLIST(0),RLIST(0))=""
139 S:$G(TMPR)="" TMPR=TMPF
140 ;
141 ;Loop through "F" index and pick up xrefs
142 S XR=0 F S XR=$O(^DD("IX","F",FIL,FLD,XR)) Q:'XR D
143 . I $P($G(^DD("IX",XR,0)),U)="" K ^DD("IX","F",FIL,FLD,XR) Q
144 . S EXECFLD=$P(^DD("IX",XR,0),U,6)
145 . I $G(ACT)]"",$TR(ACT,$P(^DD("IX",XR,0),U,7),$TR($J("",$L($P(^(0),U,7)))," ","*"))'["*" Q
146 . I $G(FLAG)["i",$P(^DD("IX",XR,0),U,8)="I" Q
147 . I $G(FLAG)["f",$P(^DD("IX",XR,0),U,6)="F" Q
148 . I $G(FLAG)["r",$P(^DD("IX",XR,0),U,6)="R" Q
149 . ;
150 . ;Set TMP, RLIST, and FLIST
151 . K TMP
152 . I EXECFLD="R" D
153 .. S TMP=$G(TMPR)
154 .. I $L(RLIST(RLIST))+$L(XR)+1>255 S RLIST=RLIST+1,RLIST(RLIST)=""
155 .. S RLIST(RLIST)=RLIST(RLIST)_$E(U,RLIST(RLIST)]"")_XR
156 . E D
157 .. S TMP=$G(TMPF)
158 .. I $L(FLIST(FLIST))+$L(XR)+1>255 S FLIST=FLIST+1,FLIST(FLIST)=""
159 .. S FLIST(FLIST)=FLIST(FLIST)_$E(U,FLIST(FLIST)]"")_XR
160 . ;
161 . ;Load xref
162 . Q:$G(TMP)="" Q:$D(@TMP@(FIL,XR))
163 . D CRV^DIKC2(XR,$G(VALRT),TMP)
164 . D:$G(LOG)]"" LOG^DIKC2(XR,LOG,TMP)
165 . I $G(LOG)["K",$G(LOG)["W" D KW^DIKC2(XR,TMP)
166 ;
167 I FLIST(0)]"" S FLIST=FLIST(0) K FLIST(0)
168 E K FLIST S FLIST=""
169 I RLIST(0)]"" S RLIST=RLIST(0) K RLIST(0)
170 E K RLIST S RLIST=""
171 Q
172 ;
173GETTMP(DIKC) ;Find next available root in ^TMP(DIKC)
174 ;Time stamp ^TMP(DIKC,J)
175 ;Out:
176 ; Name of available ^TMP root; e.g. ^TMP("DIKC",$J+.01)
177 ;
178 N DAY,FREE,J
179 S FREE=0 F J=$J:.01 D Q:FREE
180 . S DAY=$G(^TMP(DIKC,J))
181 . I DAY<($H-1) K ^TMP(DIKC,J) S ^TMP(DIKC,J)=$H,FREE=1
182 Q $NA(^TMP(DIKC,J))
Note: See TracBrowser for help on using the repository browser.