1 | TMGITR ;TMG/kst/Array and Files Iterater code ;03/25/06
|
---|
2 | ;;1.0;TMG-LIB;**1**;08/12/06
|
---|
3 |
|
---|
4 | ;"TMG MISCELLANEOUS FUNCTIONS
|
---|
5 | ;"Kevin Toppenberg MD
|
---|
6 | ;"GNU General Public License (GPL) applies
|
---|
7 | ;"8-12-06
|
---|
8 |
|
---|
9 | ;"=======================================================================
|
---|
10 | ;" API -- Public Functions.
|
---|
11 | ;"=======================================================================
|
---|
12 | ;"firstIndex=$$ItrInit^TMGITR(File,.Iterater,[IENS],[direction],[PriorIndex]) -- set up an iterater for a given fileman file
|
---|
13 | ;"nextIndex=$$ItrNext^TMGITR(.Iterater,[.]CurIndex,[direction])
|
---|
14 |
|
---|
15 | ;"firstfieldValue=$$ItrFInit^TMGITR(File,.Iterater,.Index,[Field],[IENS],[Flags]) -- set up an iterater for a given Fileman file, with FIELD return
|
---|
16 | ;"nextFieldValue=$$ItrFNext^TMGITR(.Iterater,[.]CurIndex,.CurField,[direction]) -- return next $order using iterater, returning FIELD
|
---|
17 |
|
---|
18 | ;"firstIndex=$$ItrAInit^TMGITR(pArray,.Iterater,[direction],[PriorIndex]) -- set up an iterater for a given Array
|
---|
19 | ;"nextIndex=$$ItrANext^TMGITR(.Iterater,[.]CurIndex,[direction]) -- return next $order using iterater
|
---|
20 |
|
---|
21 | ;"PrepProgress^TMGITR(.Iterater,Interval,ByCt,pIndex)
|
---|
22 | ;"ProgressDone^TMGITR(.Iterater)
|
---|
23 |
|
---|
24 | ;"=======================================================================
|
---|
25 | ;"PRIVATE API FUNCTIONS
|
---|
26 | ;"=======================================================================
|
---|
27 | ;"MakeRef(FileNum,IENS) -- make an global reference from a subfile
|
---|
28 |
|
---|
29 | ;"=======================================================================
|
---|
30 | ;"DEPENDENCIES
|
---|
31 | ;" DIQ,DILF
|
---|
32 | ;"=======================================================================
|
---|
33 | ;"=======================================================================
|
---|
34 |
|
---|
35 | ;"Note: This code has not been tested/debugged with subfiles yet.
|
---|
36 |
|
---|
37 |
|
---|
38 | ItrInit(File,Iterater,IENS,Direction)
|
---|
39 | ;"Purpose: To set up an iterater for a given fileman file
|
---|
40 | ;"Input: File -- name or number of a Fileman File
|
---|
41 | ;" Iterater -- PASS BY REFERENCE, an OUT PARAMETER.
|
---|
42 | ;" loaded with a reference that can be used with $order
|
---|
43 | ;" e.g. Index=$order(@Iterater@(Index))
|
---|
44 | ;" Iterater also stores other info as an array:
|
---|
45 | ;" Iterater("FILENUM")=FileNum
|
---|
46 | ;" Iterater("IENS"=IENS used to create iterater (if supplied)
|
---|
47 | ;" Iterater("COUNT")=number of records
|
---|
48 | ;" IENS -- OPTIONAL, if File is a subfile, then must supply
|
---|
49 | ;" the IENS to specify its location, e.g.
|
---|
50 | ;" IEN,parent-IEN,grandparent-IEN, etc.
|
---|
51 | ;" Function will add terminal ',' for user if needed.
|
---|
52 | ;" Direction -- the Direction from "" to go for first record (-1 --> get last record)
|
---|
53 | ;"Results: IEN of the first record in file, or "" if error
|
---|
54 |
|
---|
55 | ;"Note: This is designed to work with Fileman files, with numeric
|
---|
56 | ;" nodes. It is designed to NOT return alpha nodes (indices)
|
---|
57 |
|
---|
58 | kill Iterater ;"Clear any prior entries
|
---|
59 | set File=$get(File)
|
---|
60 | if +File'=File set File=$$GetFileNum^TMGDBAPI(File)
|
---|
61 | new Index set Index="" ;"default to error
|
---|
62 | set Iterater("FILENUM")=File
|
---|
63 | set Iterater("COUNT")=0
|
---|
64 | set Iterater("MAX")=0
|
---|
65 | if $get(IENS)'="" do
|
---|
66 | . if $extract(IENS,$length(IENS))'="," set IENS=IENS_","
|
---|
67 | . set Iterater("IENS")=IENS
|
---|
68 |
|
---|
69 | new ParentFile set ParentFile=+$get(^DD(File,0,"UP"))
|
---|
70 | if ParentFile=0 do
|
---|
71 | . set Iterater=$get(^DIC(File,0,"GL"))
|
---|
72 | . set Iterater=$$CREF^DILF(Iterater)
|
---|
73 | else set Iterater=$$MakeRef(File,IENS)
|
---|
74 |
|
---|
75 | set Direction=$get(Direction,1)
|
---|
76 | if Iterater'="" do
|
---|
77 | . set Index=$order(@Iterater@(0),Direction)
|
---|
78 | . set Iterater("COUNT")=$piece($get(@Iterater@(0)),"^",4)
|
---|
79 | . new index set index=":"
|
---|
80 | . for set index=$order(@Iterater@(index),-1) quit:(+index>0)!(index="")
|
---|
81 | . set Iterater("MAX")=index
|
---|
82 |
|
---|
83 | IIDone
|
---|
84 | quit Index
|
---|
85 |
|
---|
86 |
|
---|
87 | ItrFInit(File,Iterater,Index,Field,IENS,Flags,Direction)
|
---|
88 | ;"Purpose: To set up an iterater for a given Fileman file, with FIELD return
|
---|
89 | ;"Input: File -- name or number of a Fileman File
|
---|
90 | ;" Iterater -- PASS BY REFERENCE, an OUT PARAMETER.
|
---|
91 | ;" loaded with a reference that can be used with $order
|
---|
92 | ;" e.g. Index=$order(@Iterater@(Index))
|
---|
93 | ;" Iterater also stores other info as an array:
|
---|
94 | ;" Iterater("FILENUM")=FileNum
|
---|
95 | ;" Iterater("FIELD")=Field
|
---|
96 | ;" Iterater("FLAGS")=Flags
|
---|
97 | ;" Iterater("IENS"=IENS used to create iterater
|
---|
98 | ;" Index -- PASS BY REFERENCE, and OUT PARAMETER
|
---|
99 | ;" returns the first IEN in the file.
|
---|
100 | ;" Field -- optional. Field Name or Number. If supplied,
|
---|
101 | ;" value of field will be returned (rather than
|
---|
102 | ;" IENS -- optional, if File is a subfile, then must supply
|
---|
103 | ;" the IENS to specify its location, e.g.
|
---|
104 | ;" NOTE: MUST end in ","
|
---|
105 | ;" IEN,parent-IEN,grandparent-IEN, etc.
|
---|
106 | ;" Flags -- OPTIONAL -- Determines how value is returned. Same Flags as used
|
---|
107 | ;" by GET1^DIQ. "I"=Internal value returned (default is external form)
|
---|
108 | ;" Direction -- OPTIONAL -- the Direction from "" to go for first record (-1 --> get last record)
|
---|
109 | ;"Results: Value of field for IEN of the first record in file, or "" if error
|
---|
110 | new result set result=""
|
---|
111 | set IENS=$get(IENS)
|
---|
112 | set Index=$$ItrInit(.File,.Iterater,.IENS,.Direction)
|
---|
113 | set Field=$get(Field)
|
---|
114 | if +Field'=Field set Field=$$GetNumField^TMGDBAPI(.File,Field)
|
---|
115 | set Iterater("FIELD")=Field
|
---|
116 | set Iterater("FLAGS")=$get(Flags)
|
---|
117 | set IENS=Index_","_IENS
|
---|
118 | if Index'="" set result=$$GET1^DIQ(File,.IENS,.Field,.Flags)
|
---|
119 |
|
---|
120 | quit result
|
---|
121 |
|
---|
122 | ItrAInit(pArray,Iterater,Direction,PriorIndex)
|
---|
123 | ;"Purpose: To set up an iterater for a given Array
|
---|
124 | ;"Input: Array -- PASS BY NAME, the Array to be iterated.
|
---|
125 | ;" Iterater -- PASS BY REFERENCE, an OUT PARAMETER.
|
---|
126 | ;" loaded with a reference that can be used with $order
|
---|
127 | ;" e.g. Index=$order(@Iterater@(Index))
|
---|
128 | ;" Iterater also stores other info as an array:
|
---|
129 | ;" Iterater("COUNT")=number of top level nodes in the Array
|
---|
130 | ;" Direction -- OPTIONAL -- the Direction from "" (or PriorIndex) to go for first record (-1 --> get last record)
|
---|
131 | ;" PriorIndex -- OPTIONAL -- the prior index to start from. Default=""
|
---|
132 | ;"Results: first node in the Array, or "" if error
|
---|
133 |
|
---|
134 | kill Iterater ;"Clear any prior entries
|
---|
135 | set Iterater=pArray
|
---|
136 | new Index set Index="" ;"default to error
|
---|
137 | if $get(pArray)="" goto IAIDone
|
---|
138 | set Direction=$get(Direction,1)
|
---|
139 | set PriorIndex=$get(PriorIndex,"")
|
---|
140 | ;"Will count later, if needed (avoid delay otherwise)
|
---|
141 | ;"set Iterater("COUNT")=$$ListCt^TMGMISC(pArray)
|
---|
142 | set Iterater("COUNT")=0 ;"override later
|
---|
143 | set Iterater("MAX")=$order(@Iterater@(":"),-1)
|
---|
144 | set Index=$order(@Iterater@(PriorIndex),Direction)
|
---|
145 |
|
---|
146 | IAIDone
|
---|
147 | quit Index
|
---|
148 |
|
---|
149 |
|
---|
150 | MakeRef(FileNum,IENS)
|
---|
151 | ;"Purpose: to make an global reference from a subfile
|
---|
152 | ;"Input: FileNum -- must be filenumber
|
---|
153 | ;" IENS -- a standard Fileman IENS of subfile. DON'T pass by reference
|
---|
154 | ;" Array("SUBFILE","NUMBER")=file number of this sub file.
|
---|
155 | ;" Array("SUBFILE","NAME")=file name of this sub file.
|
---|
156 | ;" Array("PARENT","NUMBER")=parent file number
|
---|
157 | ;" Array("PARENT","NAME")=parent file name
|
---|
158 | ;" Array("PARENT","GL")=global reference of parent, in open format<-- only valid if parent isn't also a subfile
|
---|
159 | ;" Array("FIELD IN PARENT","NUMBER")=field number of subfile in parent
|
---|
160 | ;" Array("FIELD IN PARENT","NAME")=filed name of subfile in parent
|
---|
161 | ;" Array("FIELD IN PARENT","LOC")=node and piece where subfile is stored
|
---|
162 | ;" Array("FIELD IN PARENT","CODE")=code giving subfile's attributes.
|
---|
163 | ;"Result: returns reference
|
---|
164 |
|
---|
165 | new i
|
---|
166 | new temp,IEN,parentFile
|
---|
167 | new ref set ref=""
|
---|
168 | new Info
|
---|
169 |
|
---|
170 | for i=1:1 do quit:(FileNum=0)
|
---|
171 | . ;"new NumIENs set NumIENs=$length(IENS,",")
|
---|
172 | . ;"set IEN=$piece(IENS,",",NumIENs)
|
---|
173 | . ;"set IENS=$piece(IENS,",",1,NumIENs-1)
|
---|
174 | . set IEN=$piece(IENS,",",1)
|
---|
175 | . set IENS=$piece(IENS,",",2,999)
|
---|
176 | . if IEN'="" set temp(i+1,"IEN")=IEN
|
---|
177 | . if $$GetSubFInfo^TMGDBAPI(FileNum,.Info)=0 set FileNum=0 quit
|
---|
178 | . set FileNum=$get(Info("PARENT","NUMBER"))
|
---|
179 | . set temp(i,"LOC IN PARENT")=$get(Info("FIELD IN PARENT","LOC"))
|
---|
180 | . set temp(i+1,"REF")=$$CREF^DILF($get(Info("PARENT","GL")))
|
---|
181 |
|
---|
182 | set i=$order(temp(""),-1)
|
---|
183 | if i'="" for do quit:(i="")
|
---|
184 | . if $get(temp(i,"REF"))'="" set ref=temp(i,"REF")
|
---|
185 | . new IEN set IEN=$get(temp(i,"IEN"))
|
---|
186 | . new LOC set LOC=$piece($get(temp(i,"LOC IN PARENT")),";",1)
|
---|
187 | . if LOC'="" set ref=$name(@ref@(LOC))
|
---|
188 | . if IEN'="" set ref=$name(@ref@(IEN))
|
---|
189 | . set i=$order(temp(i),-1)
|
---|
190 |
|
---|
191 | quit ref
|
---|
192 |
|
---|
193 |
|
---|
194 |
|
---|
195 | ItrFNext(Iterater,CurIndex,CurField,direction)
|
---|
196 | ;"Purpose: to return next $order using iterater, returning FIELD
|
---|
197 | ;"Input: Iterater -- PASS BY REFERENCE. an iterater reference, as created by ItrInit
|
---|
198 | ;" Iterater also stores other info as an array:
|
---|
199 | ;" Iterater("FILENUM")=FileNum
|
---|
200 | ;" Iterater("FIELD")=Field
|
---|
201 | ;" Iterater("FLAGS")=Flags
|
---|
202 | ;" Iterater("IENS"=IENS used to create iterater
|
---|
203 | ;" Iterater("PROGRESS FN")=a PROGRESS FUNCTION <-- OPTIONAL
|
---|
204 | ;" CurIndex -- The current value of the index
|
---|
205 | ;" IF PASSED BY REF, WILL BE CHANGED
|
---|
206 | ;" CurField -- OPTIONAL, PASS BY REFERENCE, an OUT PARAMETER -- not used to find next.
|
---|
207 | ;" direction -- OPTIONAL, 1 (default) for forward, -1 for backwards
|
---|
208 | ;"Results: returns the next value by $order, or "" if none
|
---|
209 | ;"NOTE: won't currently work for subfiles--would require passing a IENS
|
---|
210 |
|
---|
211 | set CurIndex=$$ItrNext(.Iterater,.CurIndex,.direction)
|
---|
212 | new File,Field,Flags
|
---|
213 | set CurField=""
|
---|
214 | if CurIndex'="" do
|
---|
215 | . set File=$get(Iterater("FILENUM"))
|
---|
216 | . set Field=$get(Iterater("FIELD"))
|
---|
217 | . set Flags=$get(Iterater("FLAGS"))
|
---|
218 | . set CurField=$$GET1^DIQ(File,CurIndex,Field,Flags)
|
---|
219 |
|
---|
220 | quit CurField
|
---|
221 |
|
---|
222 |
|
---|
223 | ItrNext(Iterater,CurIndex,direction)
|
---|
224 | ;"Purpose: to return next $order using iterater
|
---|
225 | ;"Input: Iterater -- and iterater reference, as created by ItrInit
|
---|
226 | ;" Iterater("PROGRESS FN")=a PROGRESS FUNCTION <-- OPTIONAL
|
---|
227 | ;" CurIndex -- The current value of the index
|
---|
228 | ;" IF PASSED BY REF, WILL BE CHANGED
|
---|
229 | ;" direction -- OPTIONAL, 1 (default) for forward, -1 for backwards
|
---|
230 | ;"Results: returns the next value by $order, or "" if none
|
---|
231 |
|
---|
232 | set CurIndex=$order(@Iterater@(CurIndex),$get(direction,1))
|
---|
233 |
|
---|
234 | new ProgressFn set ProgressFn=$get(Iterater("PROGRESS FN"))
|
---|
235 | if ProgressFn'="" do
|
---|
236 | . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!"
|
---|
237 | . if CurIndex="" do ProgressDone(.Iterater)
|
---|
238 | . else do
|
---|
239 | . . set Iterater("PROGRESS FN","CURRENT")=Iterater("PROGRESS FN","CURRENT")+1
|
---|
240 | . . xecute ProgressFn
|
---|
241 |
|
---|
242 | quit CurIndex
|
---|
243 |
|
---|
244 |
|
---|
245 | ItrANext(Iterater,CurIndex,direction)
|
---|
246 | ;"Purpose: to return next $order using iterater
|
---|
247 | ;"Input: Iterater -- and iterater reference, as created by ItrAInit
|
---|
248 | ;" Iterater("PROGRESS FN")=a PROGRESS FUNCTION <-- OPTIONAL
|
---|
249 | ;" CurIndex -- The current value of the index
|
---|
250 | ;" IF PASSED BY REF, WILL BE CHANGED
|
---|
251 | ;" direction -- OPTIONAL, 1 (default) for forward, -1 for backwards
|
---|
252 | ;"Results: returns the next value by $order, or "" if none
|
---|
253 |
|
---|
254 | quit $$ItrNext(.Iterater,.CurIndex,.direction)
|
---|
255 |
|
---|
256 |
|
---|
257 | PrepProgress(Iterater,Interval,ByCt,pIndex)
|
---|
258 | ;"Purpose: to set up code so that ItrNext can easily show a progress function
|
---|
259 | ;"Input: Iterater -- PASS BY REFERENCE. Array as set up by ItrInit
|
---|
260 | ;" Interval -- OPTIONAL, default=10 The interval between showing progress bar
|
---|
261 | ;" ByCt -- OPTIONAL, default=1,
|
---|
262 | ;" if 0: range is 0..MaxIEN, index=IEN
|
---|
263 | ;" if 1: range is 0..Number of Records, index=record counter
|
---|
264 | ;" pIndex -- if ByCt=0, REQUIRED. NAME OF 'IEN' variable
|
---|
265 |
|
---|
266 | new pCurrent,pTotal,pStartTime,PrgFn
|
---|
267 | set Interval=$get(Interval,10)
|
---|
268 | if Interval=1 set Interval=2 ;" X#1 is always 0, so would never show.
|
---|
269 | set ByCt=$get(ByCt,1)
|
---|
270 | set Iterater("PROGRESS FN","BY-CT")=ByCt
|
---|
271 | set Iterater("PROGRESS FN","CURRENT")=0
|
---|
272 | set Iterater("PROGRESS FN","START TIME")=$H
|
---|
273 | set pStartTime=$name(Iterater("PROGRESS FN","START TIME"))
|
---|
274 | if ByCt=0 do
|
---|
275 | . set Iterater("PROGRESS FN","INDEX")=pIndex
|
---|
276 | . new pMax set pMax=$name(Iterater("MAX"))
|
---|
277 | . set PrgFn="if "_pIndex_"#"_Interval_"=1 "
|
---|
278 | . set PrgFn=PrgFn_"do ProgressBar^TMGUSRIF("_pIndex_",""Progress"",0,"_pMax_",,"_pStartTime_")"
|
---|
279 | else do
|
---|
280 | . set pCurrent=$name(Iterater("PROGRESS FN","CURRENT"))
|
---|
281 | . if +$get(Iterater("COUNT"))=0 do
|
---|
282 | . . set Iterater("COUNT")=$$ListCt^TMGMISC(Iterater)
|
---|
283 | . set pTotal=$name(Iterater("COUNT"))
|
---|
284 | . set PrgFn="if "_pCurrent_"#"_Interval_"=1 "
|
---|
285 | . set PrgFn=PrgFn_"do ProgressBar^TMGUSRIF("_pCurrent_",""Progress"",0,"_pTotal_",,"_pStartTime_")"
|
---|
286 |
|
---|
287 | set Iterater("PROGRESS DONE FN")="do ProgressBar^TMGUSRIF(100,""Progress"",0,100)"
|
---|
288 | set Iterater("PROGRESS FN")=PrgFn
|
---|
289 |
|
---|
290 | quit
|
---|
291 |
|
---|
292 |
|
---|
293 | ProgressDone(Iterater)
|
---|
294 | ;"Purpose: to allow user to call and ensure the progress bar is at 100% after
|
---|
295 | ;" loop is done. This is needed because the Iterater code has no way of
|
---|
296 | ;" knowing what criteria will be used to determine when loop is complete.
|
---|
297 |
|
---|
298 | ;"new ProgressFn set ProgressFn=$get(Iterater("PROGRESS FN"))
|
---|
299 | new ProgressFn set ProgressFn=$get(Iterater("PROGRESS DONE FN"))
|
---|
300 | if $get(ProgressFn)'="" do
|
---|
301 | . ;"new $etrap set $etrap="w ""??Progress function -- error trapped??"",!"
|
---|
302 | . ;"new ByCt set ByCt=$get(Iterater("PROGRESS FN","BY-CT"),1)
|
---|
303 | . ;"if ByCt=0 do
|
---|
304 | . ;". new pIndex set pIndex=$get(Iterater("PROGRESS FN","INDEX"))
|
---|
305 | . ;". new max set max=1
|
---|
306 | . ;". if pIndex'="" do
|
---|
307 | . ;". . set Iterater("MAX")=+$get(@pIndex)
|
---|
308 | . ;". . if Iterater("MAX")'>0 set Iterater("MAX")=1
|
---|
309 | . ;"else do
|
---|
310 | . ;". set Iterater("PROGRESS FN","CURRENT")=$get(Iterater("COUNT"))
|
---|
311 | . xecute ProgressFn
|
---|
312 | write !
|
---|
313 | quit
|
---|
314 |
|
---|
315 | ;"============================================================
|
---|
316 | ;"============================================================
|
---|
317 |
|
---|
318 |
|
---|
319 | Test
|
---|
320 | ;"Purpose: test functionality and usability
|
---|
321 | ;" of plain iterater functions
|
---|
322 |
|
---|
323 | new Itr,IEN
|
---|
324 | new abort set abort=0
|
---|
325 | set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
|
---|
326 | do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
---|
327 | if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
|
---|
328 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
---|
329 | . ;"write IEN,!
|
---|
330 | . ;"other code here...
|
---|
331 | do ProgressDone^TMGITR(.Itr)
|
---|
332 |
|
---|
333 | quit
|
---|
334 |
|
---|
335 |
|
---|
336 | Test2
|
---|
337 | ;"Purpose: test functionality and usability
|
---|
338 | ;" of iterater functions that return a given field
|
---|
339 |
|
---|
340 | new Itr,IEN,Name
|
---|
341 | new abort set abort=0
|
---|
342 | set Name=$$ItrFInit^TMGITR(22706.9,.Itr,.IEN,.05)
|
---|
343 | for do quit:(($$ItrFNext^TMGITR(.Itr,.IEN,.Name)="@@@")!(+IEN=0))!abort
|
---|
344 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
---|
345 | . ;"write Name,!
|
---|
346 | . ;"other code here...
|
---|
347 | do ProgressDone^TMGITR(.Itr)
|
---|
348 |
|
---|
349 | quit
|
---|
350 |
|
---|
351 |
|
---|
352 | Test3
|
---|
353 | ;"Purpose: test functionality and usability
|
---|
354 | ;" of iterater functions that work on an array
|
---|
355 |
|
---|
356 | new Itr,index
|
---|
357 | new abort set abort=0
|
---|
358 | set index=$$ItrAInit^TMGITR("^PSDRUG(""B"")",.Itr)
|
---|
359 | do PrepProgress^TMGITR(.Itr,20,1,"index")
|
---|
360 | if index'="" for do quit:($$ItrANext^TMGITR(.Itr,.index)="")!abort
|
---|
361 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
---|
362 | . ;"other code here...
|
---|
363 | . ;"write index,!
|
---|
364 | do ProgressDone^TMGITR(.Itr)
|
---|
365 |
|
---|
366 | quit
|
---|
367 |
|
---|