TMGITR ;TMG/kst/Array and Files Iterater code ;03/25/06 ;;1.0;TMG-LIB;**1**;08/12/06 ;"TMG MISCELLANEOUS FUNCTIONS ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"8-12-06 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"firstIndex=$$ItrInit^TMGITR(File,.Iterater,[IENS],[direction],[PriorIndex]) -- set up an iterater for a given fileman file ;"nextIndex=$$ItrNext^TMGITR(.Iterater,[.]CurIndex,[direction]) ;"firstfieldValue=$$ItrFInit^TMGITR(File,.Iterater,.Index,[Field],[IENS],[Flags]) -- set up an iterater for a given Fileman file, with FIELD return ;"nextFieldValue=$$ItrFNext^TMGITR(.Iterater,[.]CurIndex,.CurField,[direction]) -- return next $order using iterater, returning FIELD ;"firstIndex=$$ItrAInit^TMGITR(pArray,.Iterater,[direction],[PriorIndex]) -- set up an iterater for a given Array ;"nextIndex=$$ItrANext^TMGITR(.Iterater,[.]CurIndex,[direction]) -- return next $order using iterater ;"PrepProgress^TMGITR(.Iterater,Interval,ByCt,pIndex) ;"ProgressDone^TMGITR(.Iterater) ;"======================================================================= ;"PRIVATE API FUNCTIONS ;"======================================================================= ;"MakeRef(FileNum,IENS) -- make an global reference from a subfile ;"======================================================================= ;"DEPENDENCIES ;" DIQ,DILF ;"======================================================================= ;"======================================================================= ;"Note: This code has not been tested/debugged with subfiles yet. ItrInit(File,Iterater,IENS,Direction) ;"Purpose: To set up an iterater for a given fileman file ;"Input: File -- name or number of a Fileman File ;" Iterater -- PASS BY REFERENCE, an OUT PARAMETER. ;" loaded with a reference that can be used with $order ;" e.g. Index=$order(@Iterater@(Index)) ;" Iterater also stores other info as an array: ;" Iterater("FILENUM")=FileNum ;" Iterater("IENS"=IENS used to create iterater (if supplied) ;" Iterater("COUNT")=number of records ;" IENS -- OPTIONAL, if File is a subfile, then must supply ;" the IENS to specify its location, e.g. ;" IEN,parent-IEN,grandparent-IEN, etc. ;" Function will add terminal ',' for user if needed. ;" Direction -- the Direction from "" to go for first record (-1 --> get last record) ;"Results: IEN of the first record in file, or "" if error ;"Note: This is designed to work with Fileman files, with numeric ;" nodes. It is designed to NOT return alpha nodes (indices) kill Iterater ;"Clear any prior entries set File=$get(File) if +File'=File set File=$$GetFileNum^TMGDBAPI(File) new Index set Index="" ;"default to error set Iterater("FILENUM")=File set Iterater("COUNT")=0 set Iterater("MAX")=0 if $get(IENS)'="" do . if $extract(IENS,$length(IENS))'="," set IENS=IENS_"," . set Iterater("IENS")=IENS new ParentFile set ParentFile=+$get(^DD(File,0,"UP")) if ParentFile=0 do . set Iterater=$get(^DIC(File,0,"GL")) . set Iterater=$$CREF^DILF(Iterater) else set Iterater=$$MakeRef(File,IENS) set Direction=$get(Direction,1) if Iterater'="" do . set Index=$order(@Iterater@(0),Direction) . set Iterater("COUNT")=$piece($get(@Iterater@(0)),"^",4) . new index set index=":" . for set index=$order(@Iterater@(index),-1) quit:(+index>0)!(index="") . set Iterater("MAX")=index IIDone quit Index ItrFInit(File,Iterater,Index,Field,IENS,Flags,Direction) ;"Purpose: To set up an iterater for a given Fileman file, with FIELD return ;"Input: File -- name or number of a Fileman File ;" Iterater -- PASS BY REFERENCE, an OUT PARAMETER. ;" loaded with a reference that can be used with $order ;" e.g. Index=$order(@Iterater@(Index)) ;" Iterater also stores other info as an array: ;" Iterater("FILENUM")=FileNum ;" Iterater("FIELD")=Field ;" Iterater("FLAGS")=Flags ;" Iterater("IENS"=IENS used to create iterater ;" Index -- PASS BY REFERENCE, and OUT PARAMETER ;" returns the first IEN in the file. ;" Field -- optional. Field Name or Number. If supplied, ;" value of field will be returned (rather than ;" IENS -- optional, if File is a subfile, then must supply ;" the IENS to specify its location, e.g. ;" NOTE: MUST end in "," ;" IEN,parent-IEN,grandparent-IEN, etc. ;" Flags -- OPTIONAL -- Determines how value is returned. Same Flags as used ;" by GET1^DIQ. "I"=Internal value returned (default is external form) ;" Direction -- OPTIONAL -- the Direction from "" to go for first record (-1 --> get last record) ;"Results: Value of field for IEN of the first record in file, or "" if error new result set result="" set IENS=$get(IENS) set Index=$$ItrInit(.File,.Iterater,.IENS,.Direction) set Field=$get(Field) if +Field'=Field set Field=$$GetNumField^TMGDBAPI(.File,Field) set Iterater("FIELD")=Field set Iterater("FLAGS")=$get(Flags) set IENS=Index_","_IENS if Index'="" set result=$$GET1^DIQ(File,.IENS,.Field,.Flags) quit result ItrAInit(pArray,Iterater,Direction,PriorIndex) ;"Purpose: To set up an iterater for a given Array ;"Input: Array -- PASS BY NAME, the Array to be iterated. ;" Iterater -- PASS BY REFERENCE, an OUT PARAMETER. ;" loaded with a reference that can be used with $order ;" e.g. Index=$order(@Iterater@(Index)) ;" Iterater also stores other info as an array: ;" Iterater("COUNT")=number of top level nodes in the Array ;" Direction -- OPTIONAL -- the Direction from "" (or PriorIndex) to go for first record (-1 --> get last record) ;" PriorIndex -- OPTIONAL -- the prior index to start from. Default="" ;"Results: first node in the Array, or "" if error kill Iterater ;"Clear any prior entries set Iterater=pArray new Index set Index="" ;"default to error if $get(pArray)="" goto IAIDone set Direction=$get(Direction,1) set PriorIndex=$get(PriorIndex,"") ;"Will count later, if needed (avoid delay otherwise) ;"set Iterater("COUNT")=$$ListCt^TMGMISC(pArray) set Iterater("COUNT")=0 ;"override later set Iterater("MAX")=$order(@Iterater@(":"),-1) set Index=$order(@Iterater@(PriorIndex),Direction) IAIDone quit Index MakeRef(FileNum,IENS) ;"Purpose: to make an global reference from a subfile ;"Input: FileNum -- must be filenumber ;" IENS -- a standard Fileman IENS of subfile. DON'T pass by reference ;" Array("SUBFILE","NUMBER")=file number of this sub file. ;" Array("SUBFILE","NAME")=file name of this sub file. ;" Array("PARENT","NUMBER")=parent file number ;" Array("PARENT","NAME")=parent file name ;" Array("PARENT","GL")=global reference of parent, in open format<-- only valid if parent isn't also a subfile ;" Array("FIELD IN PARENT","NUMBER")=field number of subfile in parent ;" Array("FIELD IN PARENT","NAME")=filed name of subfile in parent ;" Array("FIELD IN PARENT","LOC")=node and piece where subfile is stored ;" Array("FIELD IN PARENT","CODE")=code giving subfile's attributes. ;"Result: returns reference new i new temp,IEN,parentFile new ref set ref="" new Info for i=1:1 do quit:(FileNum=0) . ;"new NumIENs set NumIENs=$length(IENS,",") . ;"set IEN=$piece(IENS,",",NumIENs) . ;"set IENS=$piece(IENS,",",1,NumIENs-1) . set IEN=$piece(IENS,",",1) . set IENS=$piece(IENS,",",2,999) . if IEN'="" set temp(i+1,"IEN")=IEN . if $$GetSubFInfo^TMGDBAPI(FileNum,.Info)=0 set FileNum=0 quit . set FileNum=$get(Info("PARENT","NUMBER")) . set temp(i,"LOC IN PARENT")=$get(Info("FIELD IN PARENT","LOC")) . set temp(i+1,"REF")=$$CREF^DILF($get(Info("PARENT","GL"))) set i=$order(temp(""),-1) if i'="" for do quit:(i="") . if $get(temp(i,"REF"))'="" set ref=temp(i,"REF") . new IEN set IEN=$get(temp(i,"IEN")) . new LOC set LOC=$piece($get(temp(i,"LOC IN PARENT")),";",1) . if LOC'="" set ref=$name(@ref@(LOC)) . if IEN'="" set ref=$name(@ref@(IEN)) . set i=$order(temp(i),-1) quit ref ItrFNext(Iterater,CurIndex,CurField,direction) ;"Purpose: to return next $order using iterater, returning FIELD ;"Input: Iterater -- PASS BY REFERENCE. an iterater reference, as created by ItrInit ;" Iterater also stores other info as an array: ;" Iterater("FILENUM")=FileNum ;" Iterater("FIELD")=Field ;" Iterater("FLAGS")=Flags ;" Iterater("IENS"=IENS used to create iterater ;" Iterater("PROGRESS FN")=a PROGRESS FUNCTION <-- OPTIONAL ;" CurIndex -- The current value of the index ;" IF PASSED BY REF, WILL BE CHANGED ;" CurField -- OPTIONAL, PASS BY REFERENCE, an OUT PARAMETER -- not used to find next. ;" direction -- OPTIONAL, 1 (default) for forward, -1 for backwards ;"Results: returns the next value by $order, or "" if none ;"NOTE: won't currently work for subfiles--would require passing a IENS set CurIndex=$$ItrNext(.Iterater,.CurIndex,.direction) new File,Field,Flags set CurField="" if CurIndex'="" do . set File=$get(Iterater("FILENUM")) . set Field=$get(Iterater("FIELD")) . set Flags=$get(Iterater("FLAGS")) . set CurField=$$GET1^DIQ(File,CurIndex,Field,Flags) quit CurField ItrNext(Iterater,CurIndex,direction) ;"Purpose: to return next $order using iterater ;"Input: Iterater -- and iterater reference, as created by ItrInit ;" Iterater("PROGRESS FN")=a PROGRESS FUNCTION <-- OPTIONAL ;" CurIndex -- The current value of the index ;" IF PASSED BY REF, WILL BE CHANGED ;" direction -- OPTIONAL, 1 (default) for forward, -1 for backwards ;"Results: returns the next value by $order, or "" if none set CurIndex=$order(@Iterater@(CurIndex),$get(direction,1)) new ProgressFn set ProgressFn=$get(Iterater("PROGRESS FN")) if ProgressFn'="" do . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" . if CurIndex="" do ProgressDone(.Iterater) . else do . . set Iterater("PROGRESS FN","CURRENT")=Iterater("PROGRESS FN","CURRENT")+1 . . xecute ProgressFn quit CurIndex ItrANext(Iterater,CurIndex,direction) ;"Purpose: to return next $order using iterater ;"Input: Iterater -- and iterater reference, as created by ItrAInit ;" Iterater("PROGRESS FN")=a PROGRESS FUNCTION <-- OPTIONAL ;" CurIndex -- The current value of the index ;" IF PASSED BY REF, WILL BE CHANGED ;" direction -- OPTIONAL, 1 (default) for forward, -1 for backwards ;"Results: returns the next value by $order, or "" if none quit $$ItrNext(.Iterater,.CurIndex,.direction) PrepProgress(Iterater,Interval,ByCt,pIndex) ;"Purpose: to set up code so that ItrNext can easily show a progress function ;"Input: Iterater -- PASS BY REFERENCE. Array as set up by ItrInit ;" Interval -- OPTIONAL, default=10 The interval between showing progress bar ;" ByCt -- OPTIONAL, default=1, ;" if 0: range is 0..MaxIEN, index=IEN ;" if 1: range is 0..Number of Records, index=record counter ;" pIndex -- if ByCt=0, REQUIRED. NAME OF 'IEN' variable new pCurrent,pTotal,pStartTime,PrgFn set Interval=$get(Interval,10) if Interval=1 set Interval=2 ;" X#1 is always 0, so would never show. set ByCt=$get(ByCt,1) set Iterater("PROGRESS FN","BY-CT")=ByCt set Iterater("PROGRESS FN","CURRENT")=0 set Iterater("PROGRESS FN","START TIME")=$H set pStartTime=$name(Iterater("PROGRESS FN","START TIME")) if ByCt=0 do . set Iterater("PROGRESS FN","INDEX")=pIndex . new pMax set pMax=$name(Iterater("MAX")) . set PrgFn="if "_pIndex_"#"_Interval_"=1 " . set PrgFn=PrgFn_"do ProgressBar^TMGUSRIF("_pIndex_",""Progress"",0,"_pMax_",,"_pStartTime_")" else do . set pCurrent=$name(Iterater("PROGRESS FN","CURRENT")) . if +$get(Iterater("COUNT"))=0 do . . set Iterater("COUNT")=$$ListCt^TMGMISC(Iterater) . set pTotal=$name(Iterater("COUNT")) . set PrgFn="if "_pCurrent_"#"_Interval_"=1 " . set PrgFn=PrgFn_"do ProgressBar^TMGUSRIF("_pCurrent_",""Progress"",0,"_pTotal_",,"_pStartTime_")" set Iterater("PROGRESS DONE FN")="do ProgressBar^TMGUSRIF(100,""Progress"",0,100)" set Iterater("PROGRESS FN")=PrgFn quit ProgressDone(Iterater) ;"Purpose: to allow user to call and ensure the progress bar is at 100% after ;" loop is done. This is needed because the Iterater code has no way of ;" knowing what criteria will be used to determine when loop is complete. ;"new ProgressFn set ProgressFn=$get(Iterater("PROGRESS FN")) new ProgressFn set ProgressFn=$get(Iterater("PROGRESS DONE FN")) if $get(ProgressFn)'="" do . ;"new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" . ;"new ByCt set ByCt=$get(Iterater("PROGRESS FN","BY-CT"),1) . ;"if ByCt=0 do . ;". new pIndex set pIndex=$get(Iterater("PROGRESS FN","INDEX")) . ;". new max set max=1 . ;". if pIndex'="" do . ;". . set Iterater("MAX")=+$get(@pIndex) . ;". . if Iterater("MAX")'>0 set Iterater("MAX")=1 . ;"else do . ;". set Iterater("PROGRESS FN","CURRENT")=$get(Iterater("COUNT")) . xecute ProgressFn write ! quit ;"============================================================ ;"============================================================ Test ;"Purpose: test functionality and usability ;" of plain iterater functions new Itr,IEN new abort set abort=0 set IEN=$$ItrInit^TMGITR(22706.9,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . ;"write IEN,! . ;"other code here... do ProgressDone^TMGITR(.Itr) quit Test2 ;"Purpose: test functionality and usability ;" of iterater functions that return a given field new Itr,IEN,Name new abort set abort=0 set Name=$$ItrFInit^TMGITR(22706.9,.Itr,.IEN,.05) for do quit:(($$ItrFNext^TMGITR(.Itr,.IEN,.Name)="@@@")!(+IEN=0))!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . ;"write Name,! . ;"other code here... do ProgressDone^TMGITR(.Itr) quit Test3 ;"Purpose: test functionality and usability ;" of iterater functions that work on an array new Itr,index new abort set abort=0 set index=$$ItrAInit^TMGITR("^PSDRUG(""B"")",.Itr) do PrepProgress^TMGITR(.Itr,20,1,"index") if index'="" for do quit:($$ItrANext^TMGITR(.Itr,.index)="")!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . ;"other code here... . ;"write index,! do ProgressDone^TMGITR(.Itr) quit