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

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

initial load of WorldVistAEHR
File size: 6.3 KB
RevLine 
[613]1DIKCU1 ;SFISC/MKO-FILE/RECORD INFO ;11:21 AM 20 Aug 1999
2 ;;22.0;VA FileMan;**12**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;===================
5 ; $$VDA([.]DA,Flag)
6 ;===================
7 ;Make sure elements DA array are positive canonic numbers.
8 ;In:
9 ; [.]DA = DA array
10 ; F [ R : DA can't be 0 or null
11 ; [ D : generate Dialog
12 ;Returns: 1 if valid; 0 if invalid
13 ;
14VDA(DA,F) ;
15 N I,ERR
16 Q:$D(DA)[0 0
17 I $G(F)["R" D:0[DA
18 . S ERR=1 D:$G(F)["D" ERR^DIKCU2(202,"","","","RECORD")
19 I DA]"",DA<0!(DA'=+$P(DA,"E")) D
20 . S ERR=1 D:$G(F)["D" ERR^DIKCU2(202,"","","","RECORD")
21 E F I=1:1 Q:'$D(DA(I)) I DA(I)'>0!(DA(I)'=+$P(DA(I),"E")) D Q
22 . S ERR=1 D:$G(F)["D" ERR^DIKCU2(202,"","","","RECORD")
23 Q '$G(ERR)
24 ;
25 ;====================================
26 ; $$VFLAG(InputFlags,GoodFlags,Flag)
27 ;====================================
28 ;Makes sure Flags contain only Good Flags.
29 ;In:
30 ; FLAG = flags
31 ; GDFLAG = good flags
32 ; F [ D : generate Dialog
33 ;Returns: 1 if valid; 0 if invalid
34 ;
35VFLAG(FLAG,GDFLAG,F) ;
36 S FLAG=$G(FLAG)
37 I $TR($G(FLAG),$G(GDFLAG),"")'?.NP D Q 0
38 . D:$G(F)["D" ERR^DIKCU2(301,"","","",FLAG)
39 Q 1
40 ;
41 ;=====================
42 ; $$VFNUM(File#,Flag)
43 ;=====================
44 ;Check that File# exists and has a non-wp .01 field
45 ;In:
46 ; FIL = File or subfile #
47 ; F [ D : generate Dialog
48 ;Returns: 1 if valid; 0 if invalid
49 ;
50VFNUM(FIL,F) ;
51 Q:$G(FIL)="" 0
52 I '$D(^DD(FIL)) D:$G(F)["D" ERR^DIKCU2(401,FIL) Q 0
53 I $P($G(^DD(FIL,.01,0)),U,2)="" D:$G(F)["D" ERR^DIKCU2(406,FIL) Q 0
54 I $P(^DD(FIL,.01,0),U,2)["W" D:$G(F)["D" ERR^DIKCU2(407,FIL) Q 0
55 Q 1
56 ;
57 ;===========================
58 ; $$VFLD(File#,Field#,Flag)
59 ;===========================
60 ;Check that the Fil/Fld exists in the ^DD
61 ;In:
62 ; FIL = File or subfile #
63 ; FLD = Field #
64 ; F [ D : generate Dialog
65 ;Returns: 1 if valid; 0 if invalid
66 ;
67VFLD(FIL,FLD,F) ;
68 Q:$G(FIL)="" 0 Q:$G(FLD)="" 0
69 I '$D(^DD(FIL,FLD)) D:$G(F)["D" ERR^DIKCU2(501,FIL,"",FLD,FLD) Q 0
70 Q 1
71 ;
72 ;================================================
73 ; FRNAME(File#,[.]Rec,FileText,RecordTxt,.Level)
74 ;================================================
75 ;Return string that identifies (sub)file and (sub)record.
76 ;In:
77 ; FIL = File or subfile #
78 ; .REC = DA array
79 ;Out:
80 ; .FTXT = Text that identifies file
81 ; .RTXT = Text that identifies record
82 ; .LEV = Level
83 ;
84FRNAME(FIL,REC,FTXT,RTXT,LEV) ;
85 K FTXT,RTXT,LEV
86 Q:'$G(FIL) Q:'$D(REC)
87 N FINFO
88 D FINFO(FIL,.FINFO) Q:'$D(FINFO)
89 D FILENAME("",.FTXT,.FINFO)
90 D RECNAME("",REC,.RTXT,.FINFO)
91 S LEV=FINFO
92 Q
93 ;
94 ;=================================
95 ; FILENAME(File#,.NameArr,.FINFO)
96 ;=================================
97 ;Get text that identifies the (sub)file
98 ;In:
99 ; FIL = File or subfile #
100 ;In/Out:
101 ; .FINFO = File info array (optional) (see FINFO below)
102 ;Out:
103 ; N = Text (undefined if error)
104 ; N(n) = Overflow text
105 ;
106FILENAME(FIL,N,FINFO) ;
107 K N
108 I '$D(FINFO) Q:'$G(FIL) D FINFO(FIL,.FINFO) Q:'$D(FINFO)
109 N I,L,T
110 ;
111 S L=FINFO,N=0,N(0)=""
112 F I=L:-1:0 D
113 . I I S T=$P(FINFO(I),U,3)_" (#"_$P(FINFO(I),U)_"), subfield #"_$P(FINFO(I),U,2)_" of "
114 . E S T=$S(L:"the ",1:"")_$P(FINFO(I),U,3)_" File (#"_$P(FINFO(I),U)_")"
115 . I $L(N(N))+$L(T)>240 S N=N+1,N(N)=""
116 . S N(N)=N(N)_T
117 S N=N(0) K N(0)
118 Q
119 ;
120 ;========================================
121 ; RECNAME(File#,.Record,.NameArr,.FINFO)
122 ;========================================
123 ;Get text that identifies the (sub)recird
124 ;In:
125 ; FIL = File or subfile #
126 ; [.]REC = DA array or IENS
127 ;In/Out:
128 ; .FINFO = File info array (optional) (see FINFO below)
129 ;Out:
130 ; NA = Text (undefined if error)
131 ; NA(n) = Overflow text
132 ;
133RECNAME(FIL,REC,NA,FINFO) ;Return string that identifies the (sub)record
134 K NA
135 Q:'$G(REC)
136 I '$D(FINFO) Q:'$G(FIL) D FINFO(FIL,.FINFO) Q:'$D(FINFO)
137 ;
138 N DA,DIERR,ERR,J,LV,LVI,MSG,NDA,ROOT,TX,V01
139 ;
140 ;Set DA array
141 I REC'["," M DA=REC
142 E D DA^DILF(REC,.DA)
143 ;
144 S LV=FINFO,NA=0,NA(0)=""
145 F LVI=LV:-1:0 D Q:$G(ERR)
146 . I LVI,$G(DA(LVI))'>0 S ERR=1 Q
147 . I 'LVI,$G(DA)'>0 S ERR=1 Q
148 . ;
149 . I '$D(DDS) D Q:$G(ERR)
150 .. S ROOT=$P(FINFO(LVI),U,4,999)
151 .. S V01=$P($G(@ROOT@(0)),U) I V01="" S ERR=1 Q
152 .. S TX=$$EXTERNAL^DILFD($P(FINFO(LVI),U),.01,"",V01,"MSG")
153 .. I $G(DIERR) S TX=V01 K MSG,DIERR
154 . ;
155 . E D
156 .. F J=LVI:-1:1 S NDA(J)=DA(J+LV-LVI)
157 .. S NDA=$S(LVI=LV:DA,1:DA(LV-LVI))
158 .. S TX=$$GET^DDSVAL($P(FINFO(LVI),U),.NDA,.01,"","E") K NDA
159 . ;
160 . I LV-LVI S TX="'"_TX_"' (#"_DA(LV-LVI)_")"
161 . E S TX="'"_TX_"' (#"_DA_")"
162 . I LVI S TX=TX_" of "
163 . I $L(NA(NA))+$L(TX)>240 S NA=NA+1,NA(NA)=""
164 . S NA(NA)=NA(NA)_TX
165 ;
166 I $G(ERR) K NA Q
167 S NA=NA(0) K NA(0)
168 Q
169 ;
170 ;========================
171 ; FINFO(File#,.FileInfo)
172 ;========================
173 ;Get (sub)file info
174 ;In:
175 ; FIL = File or subfile #
176 ;Out:
177 ; FINFO = n (level)
178 ; FINFO(0) = file#^^fileName^fileRootw/DA
179 ; FINFO(n) = subfile#^mfield#^mfieldName^^subfileRootw/DA
180 ;Example:
181 ; FINFO = 3
182 ; FINFO(0) = 1000^^My File^^DIZ(1000,DA(3))
183 ; FINFO(1) = 1000.01^100^Mult1^^DIZ(1000,DA(3),10,DA(2))
184 ; FINFO(2) = 1000.02^200^Mult2^^DIZ(1000,DA(3),10,DA(2),20,DA(1))
185 ; FINFO(3) = 1000.03^300^Mult3^^DIZ(1000,DA(3),10,DA(2),20,DA(1),30,DA)
186 ;
187FINFO(FIL,FINFO) ;
188 Q:'$G(FIL)
189 K FINFO
190 ;
191 ;If top level, set FINFO and quit
192 I $D(^DIC(FIL,0,"GL"))#2 D Q
193 . S FINFO=0,FINFO(0)=FIL_U_U_$P(^DIC(FIL,0),U)_U_^DIC(FIL,0,"GL")_"DA)"
194 ;
195 ;Must be a subfile level, get mult nodes, and level
196 N A,ERR,I,L,MFLD,ND,PAR,ROOT,SUB
197 S SUB=FIL
198 F L=0:1 S PAR=$G(^DD(SUB,0,"UP")) Q:'PAR D Q:$G(ERR)
199 . S MFLD=$O(^DD(PAR,"SB",SUB,"")) I 'MFLD S ERR=1 Q
200 . I $D(^DD(PAR,MFLD,0))[0 S ERR=1 Q
201 . S FINFO(L)=SUB_U_MFLD_U_$P(^DD(PAR,MFLD,0),U)
202 . ;
203 . S ND=$P($P(^DD(PAR,MFLD,0),U,4),";")
204 . S:ND'=+$P(ND,"E") ND=""""_ND_""""
205 . S ND(L+1)=ND
206 . S SUB=PAR
207 I $G(ERR) K FINFO,L Q
208 S FIL=SUB
209 I $D(^DIC(FIL,0))[0 K FINFO,L Q
210 S FINFO(L)=FIL_U_U_$P(^DIC(FIL,0),U)
211 ;
212 ;Build global roots
213 S ROOT=$G(^DIC(FIL,0,"GL")) I ROOT="" K FINFO,L Q
214 F I=L:-1:1 D
215 . S ROOT=ROOT_"DA("_I_")"
216 . S FINFO(I)=FINFO(I)_U_ROOT_")"
217 . S ROOT=ROOT_","_ND(I)_","
218 S FINFO(0)=FINFO(0)_U_ROOT_"DA)"
219 S FINFO=L
220 ;
221 ;Invert the FINFO array
222 K A M A=FINFO K FINFO S FINFO=A F A=0:1:FINFO S FINFO(A)=A(FINFO-A)
223 Q
224 ;
225 ;#202 The input parameter that identifies the |1| is missing or invalid.
226 ;#301 The passed flag(s) '|1|' are unknown or inconsistent.
227 ;#401 File #|FILE| does not exist.
228 ;#406 File #|FILE| has no .01 field definition.
229 ;#407 A word-processing field is not a file.
230 ;#501 File #|FILE| does not contain a field |1|.
Note: See TracBrowser for help on using the repository browser.