source: cprs/branches/tmg-cprs/m_files/TMGITR.m@ 1099

Last change on this file since 1099 was 796, checked in by Kevin Toppenberg, 15 years ago

Initial upload
File size: 16.6 KB
Line 
1TMGITR ;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
38ItrInit(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
83IIDone
84 quit Index
85
86
87ItrFInit(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
122ItrAInit(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
146IAIDone
147 quit Index
148
149
150MakeRef(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
195ItrFNext(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
223ItrNext(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
245ItrANext(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
257PrepProgress(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
293ProgressDone(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
319Test
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
336Test2
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
352Test3
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
Note: See TracBrowser for help on using the repository browser.