source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIKCU.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 6.2 KB
Line 
1DIKCU ;SFISC/MKO-LIBRARY OF GENERIC MODULES ;9:29 AM 22 Oct 1998
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;===============
5 ; PUSHDA(.DA,N)
6 ;===============
7 ;Push down the DA array, N times
8 ;
9PUSHDA(DA,N) ;
10 N I
11 S:'$G(N) N=1
12 F I=+$O(DA(""),-1):-1:1 S DA(I+N)=$G(DA(I))
13 S DA(N)=$G(DA)
14 S DA=0 F I=N-1:-1:1 S DA(I)=0
15 Q
16 ;
17 ;==============
18 ; POPDA(.DA,N)
19 ;==============
20 ;Pop the DA array
21 ;
22POPDA(DA,N) ;
23 N I,L
24 S:'$G(N) N=1
25 S L=+$O(DA(""),-1)
26 S DA=$G(DA(N))
27 F I=N+1:1:L S DA(I-N)=$G(DA(I))
28 F I=L-N+1:1:L K DA(I)
29 Q
30 ;
31 ;=================
32 ; $$IENS(File,DA)
33 ;=================
34 ;Return IENS given file# and DA array
35 ;In:
36 ; FIL = File or subfile #
37 ; DA = DA array (any unneeded elements in the DA array are ignored)
38 ;
39IENS(FIL,DA) ;
40 N LEV,I,IENS,ERR
41 Q:$G(FIL)="" ""
42 S LEV=$$FLEV(FIL) Q:LEV="" ""
43 ;
44 ;Build IENS
45 S IENS=$G(DA)_","
46 F I=1:1:LEV S IENS=IENS_$G(DA(I))_","
47 Q IENS
48 ;
49 ;=========================
50 ; $$FNUM(Root,Flag)
51 ;=========================
52 ;Given file root, return File # from 2nd piece of header node.
53 ;Also check that that file has a DD entry and a non-wp .01 field.
54 ;Return null if error.
55 ;In:
56 ; ROOT = file root
57 ; F [ D : generate dialog
58 ;
59FNUM(ROOT,F) ;
60 Q:$G(ROOT)="" ""
61 N FIL
62 S ROOT=$$CREF(ROOT)
63 I $D(@ROOT@(0))[0 D:$G(F)["D" ERR^DIKCU2(404,"","","",ROOT) Q ""
64 S FIL=+$P(@ROOT@(0),U,2)
65 I '$$VFNUM^DIKCU1(FIL,$G(F)) Q ""
66 Q FIL
67 ;
68 ;===============================
69 ; $$FROOTDA(File,Flag,.L,.TRoot
70 ;===============================
71 ;Return global root of File; may include DA(1), DA(2), ... for subfiles
72 ;Examples: ^DIZ(9999) and ^DIZ(9999,DA(1),"MULT1")
73 ;In:
74 ; FIL = file #
75 ; FLAG [ O : return open root
76 ; [ D : generate dialog
77 ; starts with number : indicates offset to use for DA array
78 ;Out:
79 ; .L = level of file
80 ; .TROOT = top level root
81 ;
82FROOTDA(FIL,F,L,TROOT) ;
83 I $G(FIL)="" S (L,TROOT)="" Q ""
84 S F=$G(F)
85 ;
86 ;If top level, return "GL"
87 I $D(^DIC(FIL,0,"GL"))#2 D Q TROOT
88 . S L=0,TROOT=$S(F["O":^("GL"),1:$$CREF(^("GL")))
89 ;
90 ;Must be a subfile level, get mult nodes, and level
91 N ERR,I,MFLD,ND,PAR,ROOT,SUB
92 S SUB=FIL
93 F L=0:1 S PAR=$G(^DD(SUB,0,"UP")) Q:'PAR D Q:$G(ERR)
94 . S MFLD=$O(^DD(PAR,"SB",SUB,""))
95 . S ND=$P($P($G(^DD(PAR,MFLD,0)),U,4),";")
96 . I ND?." " S ERR=1 D:F["D" ERR^DIKCU2(502,PAR,"",MFLD) Q
97 . S:ND'=+$P(ND,"E") ND=""""_ND_""""
98 . S ND(L+1)=ND
99 . S SUB=PAR
100 I $G(ERR) S (L,TROOT)="" Q ""
101 ;
102 ;Build global root for subfile
103 S (ROOT,TROOT)=$G(^DIC(SUB,0,"GL"))
104 I ROOT="" D:F["D" ERR^DIKCU2(402,SUB) S L="" Q ""
105 ;
106 F I=L:-1:1 S ROOT=ROOT_"DA("_(I+F)_"),"_ND(I)_","
107 S:F'["O" TROOT=$$CREF(TROOT)
108 Q $S(F["O":ROOT,1:$$CREF(ROOT))
109 ;
110CREF(X) ;Return closed root of X
111 N F,L
112 S L=$E(X,$L(X)),F=$E(X,1,$L(X)-1)
113 Q $S(L="(":F,L=",":F_")",1:X)
114 ;
115 ;================
116 ; $$FLEV(File,F)
117 ;================
118 ;Return the level of File
119 ;In:
120 ; FIL = file#
121 ; F [ "D" : generate Dialog
122 ;
123FLEV(FIL,F) ;
124 Q:$G(FIL)="" ""
125 ;
126 N LEV
127 F LEV=0:1 Q:$G(^DD(FIL,0,"UP"))="" S FIL=^("UP")
128 I '$D(^DD(FIL)) D:$G(F)["D" ERR^DIKCU2(402,FIL) Q ""
129 Q LEV
130 ;
131 ;=========================
132 ; $$FLEVDIFF(File1,File2)
133 ;=========================
134 ;Find the difference in levels between File1 and File2.
135 ;File1 is an ancestor of File2.
136 ;In:
137 ; FIL1 = File or subfile # of ancestor
138 ; FIL2 = File or subfile #
139 ;Returns: level difference; null if invalid input
140 ;
141FLEVDIFF(FIL1,FIL2) ;
142 Q:$G(FIL1)=""!($G(FIL2)="") ""
143 ;
144 N DIFF,FIL
145 S FIL=FIL2
146 F DIFF=0:1 Q:FIL=FIL1 S FIL=$G(^DD(FIL,0,"UP")) Q:FIL=""
147 Q $S(FIL=FIL1:DIFF,1:"")
148 ;
149 ;===============================================
150 ; SUBFILES(File,.Subfile#Array,.NodeArray,Flag)
151 ;===============================================
152 ;Build list of subfiles
153 ;In:
154 ; FIL = file #
155 ; FLG = 1 (if wp subfiles should be returned)
156 ;Out:
157 ; .SB(subfile#) = parentFile#
158 ; .MF(file#,multField#) = node
159 ; .MF(file#,multField#,0) = subfile#
160 ;
161SUBFILES(FIL,SB,MF,FLG) ;
162 Q:$G(FIL)=""
163 N SUB,MUL,ND
164 ;
165 ;Loop through "SB" nodes
166 S SUB="" F S SUB=$O(^DD(FIL,"SB",SUB)) Q:'SUB D
167 . S MUL=$O(^DD(FIL,"SB",SUB,0)) Q:'MUL
168 . Q:$D(^DD(SUB,.01,0))[0 Q:$P(^(0),U,2)["W"&'$G(FLG)
169 . ;
170 . S ND=$P($P(^DD(FIL,MUL,0),U,4),";") Q:ND=""
171 . S SB(SUB)=FIL,MF(FIL,MUL)=ND,MF(FIL,MUL,0)=SUB
172 . ;
173 . ;Make a recursive call to get all subfiles under file SUB
174 . D SUBFILES(SUB,.SB,.MF,$G(FLG))
175 Q
176 ;
177 ;============================
178 ; SBINFO(Subfile,.NodeArray)
179 ;============================
180 ;Get info for Subfile
181 ;In:
182 ; SUB = subfile #
183 ;Out:
184 ; .MF(file#,multField#) = node
185 ; .MF(file#,multField#,0) = subfile#
186 ;
187SBINFO(SUB,MF) ;
188 N ERR,MUL,ND,PAR
189 F S PAR=$G(^DD(SUB,0,"UP")) Q:'PAR D Q:$G(ERR)
190 . S MUL=$O(^DD(PAR,"SB",SUB,0)) I 'MUL S ERR=1 Q
191 . S ND=$P($P(^DD(PAR,MUL,0),U,4),";") I ND="" S ERR=1 Q
192 . S MF(PAR,MUL)=ND,MF(PAR,MUL,0)=SUB,SUB=PAR
193 Q
194 ;
195 ;============================
196 ; SELFILE(Root,TopFile,File)
197 ;============================
198 ;Prompt for file/subfile
199 ;Out:
200 ; .ROOT = open root of top level file
201 ; .TOP = top level file #
202 ; .FILE = (sub)file #
203 ;
204SELFILE(ROOT,TOP,FILE) ;
205 N %,C,D,DA,DDA,DI,DIAC,DIC,DICS,DIFILE,X,Y
206 S (ROOT,TOP,FILE)=""
207 D D^DICRW Q:Y<0
208 ;
209 ;Check if this is a new file
210 I '$D(DIC) D Q:'$D(DIC)
211 . N DG,DIE,DIK,DLAYGO,F,Z
212 . D DIE^DIB
213 . S:$D(DG) DIC=DG
214 ;
215 ;Check that file exists
216 S DI=+$P($G(@(DIC_"0)")),U,2)
217 I 'DI W $C(7),!,$$EZBLD^DIALOG(410,DIC_"0)"),! Q
218 ;
219 ;Get subfile, root, and top
220 S FILE=$$SUB^DIKCU(DI) Q:FILE=""
221 S ROOT=DIC,TOP=DI
222 Q
223 ;
224 ;==============
225 ; $$SUB(File#)
226 ;==============
227 ;Prompt for subfiles under file
228 ;Returns: file or subfile #
229 ; null : if user ^-out
230 ;
231SUB(FIL) ;
232 N D,DIC,DTOUT,DUOUT,QUIT,X,Y
233 ;
234 S DIC(0)="QEAI"
235 S DIC("A")="Select Subfile: "
236 S DIC("S")="N % S %=+$P(^(0),U,2) I %,$P($G(^DD(%,.01,0)),U,2)'[""W"""
237 ;
238 F Q:$O(^DD(+$G(FIL),"SB",0))'>0!$D(QUIT) D
239 . S DIC="^DD("_FIL_","
240 . D ^DIC
241 . I X="" S QUIT=1 Q
242 . I Y=-1 S QUIT=1 S FIL="" Q
243 . S FIL=+$P(^DD(FIL,+Y,0),U,2)
244 . W " (Subfile #"_FIL_")"
245 Q FIL
246 ;
247 ;#401 File #|FILE| does not exist.
248 ;#402 The global root of file #|FILE| is missing or not valid.
249 ;#404 The File Header node of the file stored at |1| lacks a file number.
250 ;#410 Missing or incomplete global node |1|.
251 ;#502 Field# |FIELD| in file# |FILE| has a corrupted definition.
Note: See TracBrowser for help on using the repository browser.