| 1 | TMGFMUT ;TMG/kst/Fileman utility functions ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;07/12/05
|
|---|
| 3 |
|
|---|
| 4 | ;"TMG FILEMAN-UTILITY FUNCTIONS
|
|---|
| 5 | ;"Kevin Toppenberg MD
|
|---|
| 6 | ;"GNU General Public License (GPL) applies
|
|---|
| 7 | ;"7-12-2005
|
|---|
| 8 |
|
|---|
| 9 | ;"=======================================================================
|
|---|
| 10 | ;" API -- Public Functions.
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 | ;"$$PTRLINKS
|
|---|
| 13 | ;"$$FilePtrs(File,OutVarP)
|
|---|
| 14 | ;"DispArray(ArrayP,DispdList,indentDepth,MaxDepth)
|
|---|
| 15 | ;"ASKPTRIN
|
|---|
| 16 | ;"ASKMVPTR
|
|---|
| 17 | ;"QTMVPTR(Info,PFn) --quietly redirect pointers.
|
|---|
| 18 | ;"QTMMVPTR(Info,ShowProgress) --quietly redirect multiple pointers at once.
|
|---|
| 19 | ;"$$PtrsIn(File,IEN,Array)
|
|---|
| 20 | ;"$$PtrsMIn(IENArray,Array,ShowProgress)
|
|---|
| 21 | ;"$$PossPtrs(File,Array)
|
|---|
| 22 | ;"$$FMDate(DateStr) -- convert string to FM date, with extended syntax handing
|
|---|
| 23 |
|
|---|
| 24 | ;"=======================================================================
|
|---|
| 25 | ;"PRIVATE API FUNCTIONS
|
|---|
| 26 | ;"=======================================================================
|
|---|
| 27 | ;"ScanFile(FInfo,IEN,Array)
|
|---|
| 28 | ;"ScanMFile(FInfoArray,IENArray,Array,ShowProgress)
|
|---|
| 29 | ;"HandleSubFile(SearchValue,FileArray,Array,IENS,Ref)
|
|---|
| 30 | ;"HandleMSubFile(IENArray,FileArray,Array,IENS,Ref)
|
|---|
| 31 |
|
|---|
| 32 | ;"=======================================================================
|
|---|
| 33 | ;"DEPENDENCIES
|
|---|
| 34 | ;"=======================================================================
|
|---|
| 35 | ;"TMGDBAPI
|
|---|
| 36 | ;"=======================================================================
|
|---|
| 37 |
|
|---|
| 38 |
|
|---|
| 39 | PTRLINKS
|
|---|
| 40 | ;"Purpose: To examine the Fileman data dictionary for a specified file
|
|---|
| 41 | ;" Then tell any pointers out to other files. If found, then display
|
|---|
| 42 | ;" this 'dependency'. Then follow trail to that file, and show it's
|
|---|
| 43 | ;" 'dependency'. Trail will be followed up to N levels deep (set=6 here)
|
|---|
| 44 | ;"Results: 1=OKToContinue, 0=failure
|
|---|
| 45 |
|
|---|
| 46 | new File,Info,DispdList
|
|---|
| 47 | new result
|
|---|
| 48 |
|
|---|
| 49 | write "Display pointer dependencies between files.",!!
|
|---|
| 50 | read "Enter file name or number to explore (^ to abort): ",File,!
|
|---|
| 51 | if File="^" goto PTDone
|
|---|
| 52 | set result=$$FilePtrs(File,"Info")
|
|---|
| 53 | if result=0 write "Error. Aborting. Sorry about that...",!! goto PTDone
|
|---|
| 54 |
|
|---|
| 55 | do DispArray("Info",.DispdList,0,6) ;"force max depth=6
|
|---|
| 56 |
|
|---|
| 57 | PTDone
|
|---|
| 58 | quit result
|
|---|
| 59 |
|
|---|
| 60 |
|
|---|
| 61 | FilePtrs(File,OutVarP)
|
|---|
| 62 | ;"For File, create array listing those fields with pointers to other files
|
|---|
| 63 | ;"Input: File -- can be file name or number to explore
|
|---|
| 64 | ;" OutVarP -- the name of array to put results into
|
|---|
| 65 | ;"Output: Values are put into @OutVarP as follows:
|
|---|
| 66 | ;" @OutVarP@(FileNum,"FILE NAME")=File Name
|
|---|
| 67 | ;" @OutVarP@(FileNum,FieldNum)=Field Number
|
|---|
| 68 | ;" @OutVarP@(FileNum,FieldNum,"FIELD NAME")=Field Name
|
|---|
| 69 | ;" @OutVarP@(FileNum,FieldNum,"POINTS TO","GREF")=Open format global reference
|
|---|
| 70 | ;" @OutVarP@(FileNum,FieldNum,"POINTS TO","FILE NAME")=File name pointed to
|
|---|
| 71 | ;" @OutVarP@(FileNum,FieldNum,"POINTS TO","FILE NUMBER")=File number pointed to
|
|---|
| 72 | ;" @OutVarP@(FileNum,FieldNum,"X GET")=Code to xecute to get value
|
|---|
| 73 | ;" e.g. SET TMGVALUE=$PIECE($GET(^VA(200,TMGIEN,.11),"^",5))"
|
|---|
| 74 | ;" note: TMGIEN is IEN to lookup, and result is in TMGVALUE
|
|---|
| 75 | ;" @OutVarP@(FileNum,FieldNum,"X SET")=Code to xecute to set value
|
|---|
| 76 | ;" e.g. SET TMGVALUE=$PIECE(^VA(200,TMGIEN,.11),"^",5)=TMGVALUE"
|
|---|
| 77 | ;" ** For subfiles ** ...
|
|---|
| 78 | ;" @OutVarP@(FileNum,FieldNum,"SUBFILE",FileNum,FieldNum,"FIELD NAME")=Field Name
|
|---|
| 79 | ;" @OutVarP@(FileNum,FieldNum,"SUBFILE",FileNum,FieldNum,"POINTS TO","GREF")=Open format global reference
|
|---|
| 80 | ;" @OutVarP@(FileNum,FieldNum,"SUBFILE",FileNum,FieldNum,"POINTS TO","FILE NAME")=File name pointed to
|
|---|
| 81 | ;" @OutVarP@(FileNum,FieldNum,"SUBFILE",FileNum,FieldNum,"POINTS TO","FILE NUMBER")=File number pointed to
|
|---|
| 82 | ;" @OutVarP@(FileNum,FieldNum,"SUBFILE",FileNum,FieldNum,"X GET")=Code to xecute to get value
|
|---|
| 83 | ;" e.g. SET TMGVALUE=$PIECE($GET(^VA(200,TMGIEN,TMGIEN(1),.11),"^",5))"
|
|---|
| 84 | ;" note: TMGIEN is IEN to lookup, and result is in TMGVALUE
|
|---|
| 85 | ;" @OutVarP@(FileNum,FieldNum,"X SET")=Code to xecute to set value
|
|---|
| 86 | ;" e.g. SET TMGVALUE=$PIECE(^VA(200,TMGIEN,TMGIEN(1),.11),"^",5)=TMGVALUE"
|
|---|
| 87 | ;" ... etc.
|
|---|
| 88 | ;"Results: 1=OKToContinue, 0=failure
|
|---|
| 89 |
|
|---|
| 90 | new TMGptrArray
|
|---|
| 91 | new result
|
|---|
| 92 | new index
|
|---|
| 93 | new FileNum,FileName
|
|---|
| 94 |
|
|---|
| 95 | set result=$$GetFldList^TMGDBAPI(.File,"TMGptrArray")
|
|---|
| 96 | if result=0 goto FPtrDone
|
|---|
| 97 | set result=($get(OutVarP)'="")
|
|---|
| 98 | if result=0 goto FPtrDone
|
|---|
| 99 | if +$get(File)=0 do
|
|---|
| 100 | . set FileNum=$$GetFileNum^TMGDBAPI(.File)
|
|---|
| 101 | . set FileName=$get(File)
|
|---|
| 102 | else do
|
|---|
| 103 | . set FileNum=+File
|
|---|
| 104 | . set FileName=$$GetFName^TMGDBAPI(FileNum)
|
|---|
| 105 | set result=(FileNum'=0)
|
|---|
| 106 | if result=0 goto FPtrDone
|
|---|
| 107 |
|
|---|
| 108 | set index=$order(TMGptrArray(""))
|
|---|
| 109 | for do quit:(result=0)!(index="")
|
|---|
| 110 | . new fieldnum,TMGFldInfo
|
|---|
| 111 | . set fieldnum=index
|
|---|
| 112 | . if +fieldnum=0 set result=0 quit
|
|---|
| 113 | . do FIELD^DID(FileNum,fieldnum,,"POINTER;MULTIPLE-VALUED","TMGFldInfo","TMGMsg")
|
|---|
| 114 | . if $data(TMGMsg) do set result=0 quit
|
|---|
| 115 | . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMsg")
|
|---|
| 116 | . . if $data(TMGMsg("DIERR"))'=0 do quit
|
|---|
| 117 | . . . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound)
|
|---|
| 118 | . if $get(TMGFldInfo("MULTIPLE-VALUED"))=1 do
|
|---|
| 119 | . . ;" handle subfiles via a recursive call
|
|---|
| 120 | . . new subfile,subArrayP
|
|---|
| 121 | . . set subfile=$$GetSubFileNumber^TMGDBAPI(FileNum,fieldnum)
|
|---|
| 122 | . . if subfile=0 quit
|
|---|
| 123 | . . set subArrayP=$name(@OutVarP@(FileNum,fieldnum,"SUBFILE"))
|
|---|
| 124 | . . ;"set subArrayP=OutVarP
|
|---|
| 125 | . . set result=$$FilePtrs(subfile,subArrayP)
|
|---|
| 126 | . if $get(TMGFldInfo("POINTER"))'="" do
|
|---|
| 127 | . . if +TMGFldInfo("POINTER")>0 quit ;"screen out computed nodes.
|
|---|
| 128 | . . if TMGFldInfo("POINTER")[":" quit ;"screen out set type fields
|
|---|
| 129 | . . new gref,node0
|
|---|
| 130 | . . set gref=TMGFldInfo("POINTER")
|
|---|
| 131 | . . set @OutVarP@(FileNum,"FILE NAME")=FileName
|
|---|
| 132 | . . set @OutVarP@(FileNum,fieldnum,"FIELD NAME")=$$GetFldName^TMGDBAPI(FileNum,fieldnum)
|
|---|
| 133 | . . set @OutVarP@(FileNum,fieldnum,"POINTS TO","GREF")=gref
|
|---|
| 134 | . . set gref="^"_gref_"0)"
|
|---|
| 135 | . . ;"write "index=",index," gref=",gref,!
|
|---|
| 136 | . . set node0=$get(@gref)
|
|---|
| 137 | . . set @OutVarP@(FileNum,fieldnum,"POINTS TO","FILE NAME")=$piece(node0,"^",1)
|
|---|
| 138 | . . set @OutVarP@(FileNum,fieldnum,"POINTS TO","FILE NUMBER")=+$piece(node0,"^",2)
|
|---|
| 139 | . . new DD set DD=$get(^DD(FileNum,fieldnum,0)) quit:(DD="")
|
|---|
| 140 | . . new nodepce set nodepce=$piece(DD,"^",4) quit:(nodepce="")
|
|---|
| 141 | . . new node set node=+$piece(nodepce,";",1) quit:(node="")
|
|---|
| 142 | . . new pce set pce=+$piece(nodepce,";",2) quit:(pce'>0)
|
|---|
| 143 | . . new thisGL set thisGL=$get(^DIC(FileNum,0,"GL"))
|
|---|
| 144 | . . new getCode,setCode
|
|---|
| 145 | . . if thisGL="" do quit:(thisGL="")
|
|---|
| 146 | . . . ;"Note: I am only going to support 1 sub level. More--> brain hurts!
|
|---|
| 147 | . . . new upNum set upNum=$get(^DD(FileNum,0,"UP"))
|
|---|
| 148 | . . . if upNum="" quit
|
|---|
| 149 | . . . set thisGL=$get(^DIC(upNum,0,"GL"))
|
|---|
| 150 | . . . if thisGL="" quit ;"happens with sub-sub.. nodes.
|
|---|
| 151 | . . . set getCode="SET TMGVALUE=$PIECE($GET("_thisGL_"TMGIEN,TMGIEN(1),"_node_")),""^"","_pce_")"
|
|---|
| 152 | . . . set setCode="SET $PIECE("_thisGL_"TMGIEN,TMGIEN(1),"_node_"),""^"","_pce_")=TMGVALUE"
|
|---|
| 153 | . . else do
|
|---|
| 154 | . . . set getCode="SET TMGVALUE=$PIECE($GET("_thisGL_"TMGIEN,"_node_")),""^"","_pce_")"
|
|---|
| 155 | . . . set setCode="SET $PIECE("_thisGL_"TMGIEN,"_node_"),""^"","_pce_")=TMGVALUE"
|
|---|
| 156 | . . set @OutVarP@(FileNum,fieldnum,"X GET")=getCode
|
|---|
| 157 | . . set @OutVarP@(FileNum,fieldnum,"X SET")=setCode
|
|---|
| 158 | . set index=$order(TMGptrArray(index))
|
|---|
| 159 |
|
|---|
| 160 | FPtrDone
|
|---|
| 161 | quit result
|
|---|
| 162 |
|
|---|
| 163 | DispArray(ArrayP,DispdList,indentDepth,MaxDepth)
|
|---|
| 164 | ;"Purpose: Display array created by FilePtrs (see format there)
|
|---|
| 165 | ;"Input: ArrayP : name of array containing information
|
|---|
| 166 | ;" DispdList : array (pass by reference) contining list of files already displayed
|
|---|
| 167 | ;" DispdList("TIU DOCUMENT")=""
|
|---|
| 168 | ;" DispdList("PATIENT")="" etc.
|
|---|
| 169 | ;" indentDepth : Number of indents deep this function is. Default=0
|
|---|
| 170 | ;" MaxDepth : maximum number of indents deep allowed.
|
|---|
| 171 |
|
|---|
| 172 | new i,fieldnum,file,FileName
|
|---|
| 173 | set indentDepth=+$get(indentDepth,0)
|
|---|
| 174 | new indentS set indentS=""
|
|---|
| 175 | for i=1:1:(indentDepth) s indentS=indentS_". "
|
|---|
| 176 |
|
|---|
| 177 | set file=$order(@ArrayP@(""))
|
|---|
| 178 | set FileName=$get(@ArrayP@(file,"FILE NAME"))
|
|---|
| 179 | set DispdList(FileName)=""
|
|---|
| 180 | if FileName'="" write indentS,"FILE: ",FileName,!
|
|---|
| 181 | set fieldnum=$order(@ArrayP@(file,""))
|
|---|
| 182 | for do quit:(+fieldnum=0)
|
|---|
| 183 | . if +fieldnum=0 quit
|
|---|
| 184 | . new p2FName
|
|---|
| 185 | . set p2FName=$get(@ArrayP@(file,fieldnum,"POINTS TO","FILE NAME"))
|
|---|
| 186 | . write indentS,"field: ",$get(@ArrayP@(file,fieldnum,"FIELD NAME")),"--> file: ",p2FName
|
|---|
| 187 | . if $data(DispdList(p2FName))=0 do
|
|---|
| 188 | . . set DispdList(p2FName)=""
|
|---|
| 189 | . . if indentDepth<MaxDepth do
|
|---|
| 190 | . . . new p2Array
|
|---|
| 191 | . . . if $$FilePtrs(p2FName,"p2Array")=0 do quit
|
|---|
| 192 | . . . . write " (?)",!
|
|---|
| 193 | . . . write !
|
|---|
| 194 | . . . do DispArray("p2Array",.DispdList,indentDepth+1,.MaxDepth)
|
|---|
| 195 | . . else write " (...)",!
|
|---|
| 196 | . else do
|
|---|
| 197 | . . write " (above)",!
|
|---|
| 198 | . set fieldnum=$order(@ArrayP@(file,fieldnum))
|
|---|
| 199 |
|
|---|
| 200 | quit
|
|---|
| 201 |
|
|---|
| 202 |
|
|---|
| 203 | ASKPTRIN
|
|---|
| 204 | ;"Purpose: An interface shell to PtrsIn.
|
|---|
| 205 | ;" Will ask for name of a file, and then a record in that file.
|
|---|
| 206 | ;" Will then show all pointers to that particular record.
|
|---|
| 207 |
|
|---|
| 208 | new File,IEN,Array,PFn,result
|
|---|
| 209 |
|
|---|
| 210 | write !!,"Pointer Scanner.",!
|
|---|
| 211 | write "Will look for all pointers (references) to specified record.",!!
|
|---|
| 212 | set DIC="^DIC("
|
|---|
| 213 | set DIC(0)="MAQE"
|
|---|
| 214 | d ^DIC
|
|---|
| 215 | set File=+Y
|
|---|
| 216 | if File'>0 goto APTDone
|
|---|
| 217 | set DIC=File
|
|---|
| 218 | do ^DIC
|
|---|
| 219 | set IEN=+Y
|
|---|
| 220 | if IEN'>0 goto APTDone
|
|---|
| 221 | new TMGTIME set TMGTIME=$H
|
|---|
| 222 | ;"set PFn="w TMGCODE,"" "",((TMGCUR/TMGTOTAL)*100)\1,""%"",!"
|
|---|
| 223 | set PFn="do ProgressBar^TMGUSRIF(TMGCUR,""File: ""_$P(TMGCODE,""^"",1),1,TMGTOTAL)"
|
|---|
| 224 | write !!,"Starting File Scan for instances of pointers (references) to this record.",!!
|
|---|
| 225 | set result=$$PtrsIn(File,IEN,.Array,PFn)
|
|---|
| 226 | if result=0 write !,"There was some problem. Sorry.",!! goto APTDone
|
|---|
| 227 |
|
|---|
| 228 | if $data(Array) do
|
|---|
| 229 | . write !,"Done. Here are results:",!
|
|---|
| 230 | . write "Format is: ",!
|
|---|
| 231 | . write " Array(File#,IEN,0)=LastCount",!
|
|---|
| 232 | . write " Array(File#,IEN,count)=FullRef;piece;IENS;TopGlobalRef",!
|
|---|
| 233 | . write " Description of parts:",!
|
|---|
| 234 | . write " ----------------------",!
|
|---|
| 235 | . write " File# -- the file the found entry exists it (may be a subfile number)",!
|
|---|
| 236 | . write " IEN -- the record number in file",!
|
|---|
| 237 | . write " Note: IEN here is different from the IEN passed in as a parameter",!
|
|---|
| 238 | . write " FullRef -- the is the full reference to the found value. e.g.",!
|
|---|
| 239 | . write " set value=$piece(@FullRef,""^"",piece)",!
|
|---|
| 240 | . write " piece -- piece where value is stored in the node that is specified by FullRef",!
|
|---|
| 241 | . write " IENS -- this is provided only for matches in subfiles. ",!
|
|---|
| 242 | . write " It is the IENS that may be used in database calls",!
|
|---|
| 243 | . write " TopGlobalRef -- this is the global reference for file. If the match is in a",!
|
|---|
| 244 | . write " subfile, then this is the global reference of the parent file ",!
|
|---|
| 245 | . write " (or the highest grandparent file if the parent file itself is",!
|
|---|
| 246 | . write " a subfile)",!
|
|---|
| 247 | . zwr Array(*)
|
|---|
| 248 | . write "---------------------------",!
|
|---|
| 249 | . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),!
|
|---|
| 250 | else write !,"No pointers to that record found.",!
|
|---|
| 251 |
|
|---|
| 252 | APTDone
|
|---|
| 253 | quit
|
|---|
| 254 |
|
|---|
| 255 | SCRLPTRIN
|
|---|
| 256 | ;"Purpose: An scrolling interface shell to PtrsIn.
|
|---|
| 257 | ;" Will ask for name of a file, and then a record in that file.
|
|---|
| 258 | ;" Will then show all pointers to that particular record.
|
|---|
| 259 | ;" Will then allow one to trace along pointer path (in or out)
|
|---|
| 260 |
|
|---|
| 261 | new File,IEN,Array,PFn,result
|
|---|
| 262 | new AFile,AIEN,ACount
|
|---|
| 263 | new ShowArray,ShowResults,Header,Count
|
|---|
| 264 | new PickStr,PickInfo,Abort,Menu,UsrSlct
|
|---|
| 265 | new DIC,X,Y
|
|---|
| 266 |
|
|---|
| 267 | write !!,"Pointer Scanner/Browser.",!
|
|---|
| 268 | write "Will look for all pointers (references) to specified record.",!!
|
|---|
| 269 | set DIC="^DIC("
|
|---|
| 270 | set DIC(0)="MAQE"
|
|---|
| 271 | DO ^DIC
|
|---|
| 272 | set File=+Y
|
|---|
| 273 | if File'>0 goto SCPTDone
|
|---|
| 274 | set DIC=File
|
|---|
| 275 | do ^DIC
|
|---|
| 276 | set IEN=+Y
|
|---|
| 277 | if IEN'>0 goto SCPTDone
|
|---|
| 278 | new TMGTIME set TMGTIME=$H
|
|---|
| 279 | set PFn="do ProgressBar^TMGUSRIF(TMGCUR,""File: ""_$P(TMGCODE,""^"",1),1,TMGTOTAL)"
|
|---|
| 280 | SCPT1 ;
|
|---|
| 281 | write !!,"Scanning files for instances of pointers (references) to this record.",!!
|
|---|
| 282 | set result=$$PtrsIn(File,IEN,.Array,PFn)
|
|---|
| 283 | if result=0 do goto APTDone
|
|---|
| 284 | . write !,"There was some problem. Sorry.",!!
|
|---|
| 285 | . do PressToCont^TMGUSRIF
|
|---|
| 286 | ;"Returned format is: ",!
|
|---|
| 287 | ;" Array(File#,IEN,0)=LastCount",!
|
|---|
| 288 | ;" Array(File#,IEN,count)=FullRef;piece;IENS;TopGlobalRef",!
|
|---|
| 289 | ;" Description of parts:",!
|
|---|
| 290 |
|
|---|
| 291 | set File=0,Abort=0
|
|---|
| 292 | for set File=$order(Array(File)) quit:(+File'>0) do
|
|---|
| 293 | . new FName set FName=$piece($get(^DIC(File,0)),"^",1)
|
|---|
| 294 | . new IEN set IEN=0;
|
|---|
| 295 | . for set IEN=$order(Array(File,IEN)) quit:(+IEN'>0) do
|
|---|
| 296 | . . new Value01 set Value01=$$GET1^DIQ(File,IEN,.01)
|
|---|
| 297 | . . set Count=0
|
|---|
| 298 | . . for set Count=$order(Array(File,IEN,Count)) quit:(+Count'>0) do
|
|---|
| 299 | . . . new Str set Str=FName_"; #"_IEN_"; "_Value01
|
|---|
| 300 | . . . if Count>1 set Str=Str_" ("_Count_")"
|
|---|
| 301 | . . . set ShowArray(Str,File_"^"_IEN_"^"_Count)=""
|
|---|
| 302 | . . .
|
|---|
| 303 | set Header="Pick ONE (and only ONE) record to explore. Press ESC ESC when done."
|
|---|
| 304 | SCPT2 kill ShowResults
|
|---|
| 305 | if $get(TMGPTCABORT)=1 goto SCPTDone
|
|---|
| 306 | do Slctor2^TMGUSRIF("ShowArray","ShowResults",Header)
|
|---|
| 307 |
|
|---|
| 308 | set Count=$$ListCt^TMGMISC("ShowResults")
|
|---|
| 309 | if Count>1 do goto SCPT2
|
|---|
| 310 | . write "Please pick ONE (and only ONE) record to explore.",!
|
|---|
| 311 | . write "You selected at least ",Count,!
|
|---|
| 312 | . write "Enter ^ to quit",!
|
|---|
| 313 | . do PressToCont^TMGUSRIF
|
|---|
| 314 |
|
|---|
| 315 | set PickStr=""
|
|---|
| 316 | set PickStr=$order(ShowResults(PickStr))
|
|---|
| 317 | if PickStr="" do goto SCPTDone
|
|---|
| 318 | . write "No selected record. Goodbye.",!
|
|---|
| 319 | . do PressToCont^TMGUSRIF
|
|---|
| 320 |
|
|---|
| 321 | set Count=$$ListCt^TMGMISC("ShowArray("_PickStr_")")
|
|---|
| 322 | if Count>0 do goto SCPTDone
|
|---|
| 323 | . set Abort=1
|
|---|
| 324 | . write "Please pick ONE (and only ONE) record to explore.",!
|
|---|
| 325 | . write "You selected at least ",Count,!
|
|---|
| 326 | . do PressToCont^TMGUSRIF
|
|---|
| 327 |
|
|---|
| 328 | set PickInfo=$order(ShowResults(PickStr,""))
|
|---|
| 329 | set AFile=$piece(PickInfo,"^",1)
|
|---|
| 330 | set AIEN=$piece(PickInfo,"^",2)
|
|---|
| 331 | set ACount=$piece(PickInfo,"^",3)
|
|---|
| 332 |
|
|---|
| 333 | set Menu(0)="Pick Option."
|
|---|
| 334 | set Menu(1)="Show info for this selected record"_$C(9)_"ShowInfo"
|
|---|
| 335 | set Menu(2)="DUMP this record"_$C(9)_"DumpRec"
|
|---|
| 336 | set Menu(3)="Show pointers INTO selected record"_$C(9)_"ShowPtrIN"
|
|---|
| 337 | set Menu(4)="Browse to other records pointed OUT from this record."_$C(9)_"BrowseOUT"
|
|---|
| 338 |
|
|---|
| 339 | MC1 write #
|
|---|
| 340 | set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
|
|---|
| 341 | if UsrSlct="^" do goto SCPTDone
|
|---|
| 342 | . write "Goodbye.",!
|
|---|
| 343 | if UsrSlct=0 set UsrSlct=""
|
|---|
| 344 |
|
|---|
| 345 | if UsrSlct="ShowInfo" do goto MC1
|
|---|
| 346 | . if $data(Array(AFile,AIEN,ACount))=0 quit
|
|---|
| 347 | . zwr Array(AFile,AIEN,ACount,*)
|
|---|
| 348 | . do PressToCont^TMGUSRIF
|
|---|
| 349 | if UsrSlct="DumpRec" do goto MC1
|
|---|
| 350 | . do DumpRec2^TMGDEBUG(AFile,AIEN,0)
|
|---|
| 351 | . do PressToCont^TMGUSRIF
|
|---|
| 352 | if UsrSlct="ShowPtrIN" do goto SCPT1
|
|---|
| 353 | . set File=AFile
|
|---|
| 354 | . set IEN=AIEN
|
|---|
| 355 | . set Count=ACount
|
|---|
| 356 | if UsrSlct="BrowseOUT" do goto MC1
|
|---|
| 357 | . do Browse^TMGBROWS(AFile,AIEN,0)
|
|---|
| 358 | . do PressToCont^TMGUSRIF
|
|---|
| 359 | goto MC1
|
|---|
| 360 | SCPTDone
|
|---|
| 361 | quit
|
|---|
| 362 |
|
|---|
| 363 |
|
|---|
| 364 | ASKMVPTR
|
|---|
| 365 | ;"Purpose: An interface shell toRedirect any pointer.
|
|---|
| 366 | ;" Will ask for name of a file, and then a record in that file.
|
|---|
| 367 | ;" Will then pass information to fileman function to move pointers.
|
|---|
| 368 |
|
|---|
| 369 | ;"Note: Example of array passed to P^DITP
|
|---|
| 370 | ;" 23510 is $J
|
|---|
| 371 | ;" 47 is IEN to be deleted in file 50 (stored at ^PSDRUG(*))
|
|---|
| 372 | ;" 1646 is IEN to be substituted for all 47's
|
|---|
| 373 | ;"
|
|---|
| 374 | ;" First part of array is list of all files & fields that point to file
|
|---|
| 375 | ;" ----------------
|
|---|
| 376 | ;" ^UTILITY("DIT",23510,0,1)="727.819^67^P50'"
|
|---|
| 377 | ;" ...
|
|---|
| 378 | ;" ^UTILITY("DIT",23510,0,54)="801.43^.02^RV"
|
|---|
| 379 | ;" ^UTILITY("DIT",23510,0,55)="810.31^.04^V"
|
|---|
| 380 | ;" ^UTILITY("DIT",23510,0,56)="810.32^.01^V"
|
|---|
| 381 | ;" ^UTILITY("DIT",23510,0,57)="811.52^.01^MVX"
|
|---|
| 382 | ;" ^UTILITY("DIT",23510,0,58)="811.902^.01^MVX"
|
|---|
| 383 | ;" ^UTILITY("DIT",23510,0,59)="9009032.4^.05^P50'"
|
|---|
| 384 | ;"
|
|---|
| 385 | ;" Second part of array is list of changes that should be made. Only 1 change shown here.
|
|---|
| 386 | ;" ----------------
|
|---|
| 387 | ;" ^UTILITY("DIT",23510,47)="1646;PSDRUG("
|
|---|
| 388 | ;" ^UTILITY("DIT",23510,"47;PSDRUG(")="1646;PSDRUG("
|
|---|
| 389 |
|
|---|
| 390 | new File,fromIEN,toIEN,Array,PFn,result
|
|---|
| 391 | new PossPtrs
|
|---|
| 392 |
|
|---|
| 393 | write !,"Pointer Redirection Utility",!
|
|---|
| 394 | write "Will change pointers to FROM to TO value",!
|
|---|
| 395 |
|
|---|
| 396 | kill DIC
|
|---|
| 397 | set DIC("A")="Select File holding records being pointed to: "
|
|---|
| 398 | set DIC="^DIC("
|
|---|
| 399 | set DIC(0)="MAQE"
|
|---|
| 400 | d ^DIC ;"Get File to search
|
|---|
| 401 | set File=+Y
|
|---|
| 402 | if File'>0 goto AMPTDone
|
|---|
| 403 |
|
|---|
| 404 | ;"Get list of files/fields with pointers in
|
|---|
| 405 | set result=$$PossPtrs(File,.PossPtrs) if result=0 goto AMPTDone
|
|---|
| 406 | if $data(PossPtrs)'>0 goto AMPTDone
|
|---|
| 407 |
|
|---|
| 408 | set DIC=File
|
|---|
| 409 | set DIC("A")="Select Original (i.e OLD) Record: "
|
|---|
| 410 | do ^DIC ;"get FROM record in File
|
|---|
| 411 | set fromIEN=+Y
|
|---|
| 412 | if fromIEN'>0 goto AMPTDone
|
|---|
| 413 |
|
|---|
| 414 | set DIC("A")="Select New Record: "
|
|---|
| 415 | do ^DIC ;"get FROM record in File
|
|---|
| 416 | set toIEN=+Y
|
|---|
| 417 | if toIEN'>0 goto AMPTDone
|
|---|
| 418 |
|
|---|
| 419 | ;"set PFn="w TMGCODE,"" "",((TMGCUR/TMGTOTAL)*100)\1,""%"",!"
|
|---|
| 420 | ;"new TMGTIME set TMGTIME=$H
|
|---|
| 421 | set PFn="do ProgressBar^TMGUSRIF(TMGCUR,""Scanning File: ""_$P(TMGCODE,""^"",1),1,TMGTOTAL)"
|
|---|
| 422 | write !!,"Starting File Scan for instances of pointers (references) to this record.",!!
|
|---|
| 423 | set result=$$PtrsIn(File,fromIEN,.Array,PFn) if result=0 goto AMPTDone
|
|---|
| 424 |
|
|---|
| 425 | ;" write !,"Here are possible pointers in (file level)",!
|
|---|
| 426 | ;" if $data(PossPtrs) zwr PossPtrs(*)
|
|---|
| 427 |
|
|---|
| 428 | ;" write !,"Here are actual pointers in",!
|
|---|
| 429 | ;" if $data(Array) zwr Array(*)
|
|---|
| 430 |
|
|---|
| 431 | ;"Now convert to FileMan Format.
|
|---|
| 432 | kill ^UTILITY("DIT",$J)
|
|---|
| 433 | do Prep4FM(.Array)
|
|---|
| 434 |
|
|---|
| 435 | if $data(^UTILITY("DIT",$J)) do
|
|---|
| 436 | . merge ^UTILITY("DIT",$J,0)=PossPtrs
|
|---|
| 437 | . ;"write !,"here are results",!
|
|---|
| 438 | . ;" zwr ^UTILITY("DIT",$J,*)
|
|---|
| 439 | . set DIR(0)="Y",DIR("B")="YES"
|
|---|
| 440 | . set DIR("A")="Ask Fileman to redirect pointers?"
|
|---|
| 441 | . set DIR("?")="Enter YES if you want Fileman to change all instances of the FROM record into the TO record."
|
|---|
| 442 | . do ^DIR ;"get user response
|
|---|
| 443 | . if +Y'=1 quit
|
|---|
| 444 | . write "YES",!
|
|---|
| 445 | . do PTS^DITP
|
|---|
| 446 | else do
|
|---|
| 447 | . write "No matches found...",!!
|
|---|
| 448 |
|
|---|
| 449 | AMPTDone
|
|---|
| 450 | quit
|
|---|
| 451 |
|
|---|
| 452 |
|
|---|
| 453 | QTMVPTR(Info,PFn) ;"NOTE: this function hasn't been debugged/tested yet
|
|---|
| 454 | ;"Purpose: An interface to quietly redirect any pointer.
|
|---|
| 455 | ;"Input: Info, an array containing info for redirecting pointers.
|
|---|
| 456 | ;" Format: Note: File can be file name or number.
|
|---|
| 457 | ;" Info(File,OldIEN)=newIEN
|
|---|
| 458 | ;" Info(File,OldIEN)=newIEN1
|
|---|
| 459 | ;" Info(File,OldIEN)=newIEN
|
|---|
| 460 | ;" PFn: OPTIONAL, a progress function (must be a complete M expression)
|
|---|
| 461 | ;"Output: all pointers in linked files to OldIEN will be changed to newIEN
|
|---|
| 462 | ;"Results: none
|
|---|
| 463 |
|
|---|
| 464 | ;"Note: Example of array passed to P^DITP
|
|---|
| 465 | ;" 23510 is $J
|
|---|
| 466 | ;" 47 is IEN to be deleted in file 50 (stored at ^PSDRUG(*))
|
|---|
| 467 | ;" 1646 is IEN to be substituted for all 47's
|
|---|
| 468 | ;"
|
|---|
| 469 | ;" First part of array is list of all files & fields that point to file
|
|---|
| 470 | ;" ----------------
|
|---|
| 471 | ;" ^UTILITY("DIT",23510,0,1)="727.819^67^P50'"
|
|---|
| 472 | ;" ...
|
|---|
| 473 | ;" ^UTILITY("DIT",23510,0,54)="801.43^.02^RV"
|
|---|
| 474 | ;" ^UTILITY("DIT",23510,0,55)="810.31^.04^V"
|
|---|
| 475 | ;" ^UTILITY("DIT",23510,0,56)="810.32^.01^V"
|
|---|
| 476 | ;" ^UTILITY("DIT",23510,0,57)="811.52^.01^MVX"
|
|---|
| 477 | ;" ^UTILITY("DIT",23510,0,58)="811.902^.01^MVX"
|
|---|
| 478 | ;" ^UTILITY("DIT",23510,0,59)="9009032.4^.05^P50'"
|
|---|
| 479 | ;"
|
|---|
| 480 | ;" Second part of array is list of changes that should be made. Only 1 change shown here.
|
|---|
| 481 | ;" ----------------
|
|---|
| 482 | ;" ^UTILITY("DIT",23510,47)="1646;PSDRUG("
|
|---|
| 483 | ;" ^UTILITY("DIT",23510,"47;PSDRUG(")="1646;PSDRUG("
|
|---|
| 484 |
|
|---|
| 485 | new File,Array,result
|
|---|
| 486 | set PFn=$get(PFn)
|
|---|
| 487 | new Itr,File
|
|---|
| 488 |
|
|---|
| 489 | ;"Cycle through all files to be changed.
|
|---|
| 490 | set File=$$ItrAInit^TMGITR("Info",.Itr)
|
|---|
| 491 | if File'="" for do quit:($$ItrANext^TMGITR(.Itr,.File)="")
|
|---|
| 492 | . new PossPtrs
|
|---|
| 493 | . if +File'=File set File=$$GetFileNum^TMGDBAPI(File) ;Convert File Name to File Number
|
|---|
| 494 | . ;"Get list of files/fields with pointers in
|
|---|
| 495 | . set result=$$PossPtrs(File,.PossPtrs) if result=0 quit
|
|---|
| 496 | . if $data(PossPtrs)'>0 quit
|
|---|
| 497 | . kill ^UTILITY("DIT",$J)
|
|---|
| 498 | . new fromIEN,toIEN,fromItr
|
|---|
| 499 | . set fromIEN=+$$ItrAInit^TMGITR($name(Info(File)),.fromItr)
|
|---|
| 500 | . new done2 set done2=0
|
|---|
| 501 | . ;"Cycle through all records to be changed.
|
|---|
| 502 | . if fromIEN'=0 for do quit:(+$$ItrANext^TMGITR(.fromItr,.fromIEN)=0)!(done2=1)
|
|---|
| 503 | . . set toIEN=$get(Info(File,fromIEN))
|
|---|
| 504 | . . set result=$$PtrsIn(File,fromIEN,.Array,PFn) if result=0 set done2=1
|
|---|
| 505 | . . do Prep4FM(.Array)
|
|---|
| 506 | . if $data(^UTILITY("DIT",$J))=0 quit
|
|---|
| 507 | . merge ^UTILITY("DIT",$J,0)=PossPtrs
|
|---|
| 508 | . do PTS^DITP ;"Note: call separately for each file specified.
|
|---|
| 509 |
|
|---|
| 510 | QMPTDone
|
|---|
| 511 | quit
|
|---|
| 512 |
|
|---|
| 513 |
|
|---|
| 514 | QTMMVPTR(Info,ShowProgress) ;"NOTE: this function hasn't been debugged/tested yet
|
|---|
| 515 | ;"Purpose: An interface to quietly redirect multiple pointer.
|
|---|
| 516 | ;"NOTE: This functions differes from QTMVPTR in that it can look for all IEN's
|
|---|
| 517 | ;" for a given file at once, speeding database access.
|
|---|
| 518 | ;"Input: Info, an array containing info for redirecting pointers.
|
|---|
| 519 | ;" Format: Note: File can be file name or number.
|
|---|
| 520 | ;" Info(File,OldIEN)=newIEN
|
|---|
| 521 | ;" Info(File,OldIEN)=newIEN1
|
|---|
| 522 | ;" Info(File,OldIEN)=newIEN
|
|---|
| 523 | ;" ShowProgress: if 1, progress bar shown
|
|---|
| 524 | ;"Output: all pointers in linked files to OldIEN will be changed to newIEN
|
|---|
| 525 | ;"Results: none
|
|---|
| 526 |
|
|---|
| 527 | ;"Note: Example of array passed to P^DITP
|
|---|
| 528 | ;" 23510 is $J
|
|---|
| 529 | ;" 47 is IEN to be deleted in file 50 (stored at ^PSDRUG(*))
|
|---|
| 530 | ;" 1646 is IEN to be substituted for all 47's
|
|---|
| 531 | ;"
|
|---|
| 532 | ;" First part of array is list of all files & fields that point to file
|
|---|
| 533 | ;" ----------------
|
|---|
| 534 | ;" ^UTILITY("DIT",23510,0,1)="727.819^67^P50'"
|
|---|
| 535 | ;" ...
|
|---|
| 536 | ;" ^UTILITY("DIT",23510,0,54)="801.43^.02^RV"
|
|---|
| 537 | ;" ^UTILITY("DIT",23510,0,55)="810.31^.04^V"
|
|---|
| 538 | ;" ^UTILITY("DIT",23510,0,56)="810.32^.01^V"
|
|---|
| 539 | ;" ^UTILITY("DIT",23510,0,57)="811.52^.01^MVX"
|
|---|
| 540 | ;" ^UTILITY("DIT",23510,0,58)="811.902^.01^MVX"
|
|---|
| 541 | ;" ^UTILITY("DIT",23510,0,59)="9009032.4^.05^P50'"
|
|---|
| 542 | ;"
|
|---|
| 543 | ;" Second part of array is list of changes that should be made. Only 1 change shown here.
|
|---|
| 544 | ;" ----------------
|
|---|
| 545 | ;" ^UTILITY("DIT",23510,47)="1646;PSDRUG("
|
|---|
| 546 | ;" ^UTILITY("DIT",23510,"47;PSDRUG(")="1646;PSDRUG("
|
|---|
| 547 |
|
|---|
| 548 | new ToFile,Array,result
|
|---|
| 549 | set PFn=$get(PFn)
|
|---|
| 550 | new Itr
|
|---|
| 551 |
|
|---|
| 552 | ;"Cycle through all files to be changed.
|
|---|
| 553 | set ToFile=$$ItrAInit^TMGITR("Info",.Itr)
|
|---|
| 554 | if ToFile'="" for do quit:($$ItrANext^TMGITR(.Itr,.ToFile)="")
|
|---|
| 555 | . new PossPtrs
|
|---|
| 556 | . if +ToFile'=ToFile set ToFile=$$GetFileNum^TMGDBAPI(ToFile) ;"Convert File Name to File Number
|
|---|
| 557 | . ;"Get list of files/fields with pointers in
|
|---|
| 558 | . set result=$$PossPtrs(ToFile,.PossPtrs) if result=0 quit
|
|---|
| 559 | . if $data(PossPtrs)'>0 quit
|
|---|
| 560 | . kill ^UTILITY("DIT",$J)
|
|---|
| 561 | . ;"new fromIEN,toIEN,fromItr
|
|---|
| 562 | . ;"set fromIEN=+$$ItrAInit^TMGITR($name(Info(ToFile)),.fromItr)
|
|---|
| 563 | . new IENArray set IENArray=ToFile
|
|---|
| 564 | . merge IENArray=Info(ToFile)
|
|---|
| 565 | . set IENArray=ToFile
|
|---|
| 566 | . set result=$$PtrsMIn(.IENArray,.Array,.ShowProgress)
|
|---|
| 567 | . new toFile2,toIEN,fromFile,fromIEN,Array2
|
|---|
| 568 | . set toFile2=""
|
|---|
| 569 | . for set toFile2=$order(Array(toFile2)) quit:(toFile2="") do
|
|---|
| 570 | . . set toIEN=""
|
|---|
| 571 | . . for set toIEN=$order(Array(toFile2,toIEN)) quit:(toIEN="") do
|
|---|
| 572 | . . . set fromFile=""
|
|---|
| 573 | . . . for set fromFile=$order(Array(toFile2,toIEN,fromFile)) quit:(fromFile="") do
|
|---|
| 574 | . . . . set fromIEN=""
|
|---|
| 575 | . . . . for set fromIEN=$order(Array(toFile2,toIEN,fromFile,fromIEN)) quit:(fromIEN="") do
|
|---|
| 576 | . . . . . merge Array2(fromFile,fromIEN)=Array(toFile2,toIEN,fromFile,fromIEN)
|
|---|
| 577 | . set toFile2=""
|
|---|
| 578 | . for set toFile2=$order(Array2(toFile2)) quit:(toFile2="") do
|
|---|
| 579 | . . do MPrep4FM(toFile2,.Array2)
|
|---|
| 580 | . . if $data(^UTILITY("DIT",$J))=0 quit
|
|---|
| 581 | . . merge ^UTILITY("DIT",$J,0)=PossPtrs
|
|---|
| 582 | . . do PTS^DITP ;"Note: call separately for each file specified.
|
|---|
| 583 |
|
|---|
| 584 | QMMPTDone
|
|---|
| 585 | quit
|
|---|
| 586 |
|
|---|
| 587 |
|
|---|
| 588 | Prep4FM(Array)
|
|---|
| 589 | ;"Purpose: to convert Array with redirection info into format for Fileman
|
|---|
| 590 | ;"Input: Array -- PASS BY REFERENCE. An array as created by PtrsIn()
|
|---|
| 591 | ;"Output: Data will be put into ^UTILITY('DIT',$J)
|
|---|
| 592 | ;"Results: none
|
|---|
| 593 |
|
|---|
| 594 | ;"Now convert to FileMan Format.
|
|---|
| 595 | new iFile,iIEN,count,index,toRef
|
|---|
| 596 | set iFile=$order(Array(""))
|
|---|
| 597 | if +iFile'=0 for do quit:(+iFile=0)
|
|---|
| 598 | . set iIEN=$order(Array(iFile,""))
|
|---|
| 599 | . if +iIEN'=0 for do quit:(+iIEN=0)
|
|---|
| 600 | . . set count=+$get(Array(iFile,iIEN,0))
|
|---|
| 601 | . . for index=1:1:count do
|
|---|
| 602 | . . . set toRef=$piece($get(Array(iFile,iIEN,count)),";",4)
|
|---|
| 603 | . . . set toRef=$extract(toRef,2,999)
|
|---|
| 604 | . . . set ^UTILITY("DIT",$J,fromIEN)=toIEN_";"_toRef
|
|---|
| 605 | . . . set ^UTILITY("DIT",$J,""_fromIEN_";"_toRef_"")=""_toIEN_";"_toRef_""
|
|---|
| 606 | . . set iIEN=$order(Array(iFile,iIEN))
|
|---|
| 607 | . set iFile=$order(Array(iFile))
|
|---|
| 608 |
|
|---|
| 609 | quit
|
|---|
| 610 |
|
|---|
| 611 |
|
|---|
| 612 | MPrep4FM(fromFile,Array)
|
|---|
| 613 | ;"Purpose: to convert Array with redirection info into format for Fileman
|
|---|
| 614 | ;"Input: fromFile -- the FromFileNum -- Note: should be called once for
|
|---|
| 615 | ;" each File number
|
|---|
| 616 | ;" Array -- PASS BY REFERENCE. An array as created by PtrsMIn()
|
|---|
| 617 | ;" Array(FromFile#,fromIEN,0)=LastCount
|
|---|
| 618 | ;" Array(FromFile#,fromIEN,count)=FullRef;piece;IENS;TopGlobalRef
|
|---|
| 619 | ;"Output: Data will be put into ^UTILITY('DIT',$J)
|
|---|
| 620 | ;"Results: none
|
|---|
| 621 |
|
|---|
| 622 | ;"Now convert to FileMan Format.
|
|---|
| 623 | new fromIEN set fromIEN=""
|
|---|
| 624 | for set fromIEN=$order(Array(fromFile,fromIEN)) quit:(+fromIEN'>0) do
|
|---|
| 625 | . new count
|
|---|
| 626 | . set count=+$get(Array(fromFile,fromIEN,0))
|
|---|
| 627 | . new index for index=1:1:count do
|
|---|
| 628 | . . new toRef
|
|---|
| 629 | . . set toRef=$piece($get(Array(fromFile,fromIEN,count)),";",4)
|
|---|
| 630 | . . set toRef=$extract(toRef,2,999)
|
|---|
| 631 | . . set ^UTILITY("DIT",$J,fromIEN)=toIEN_";"_toRef
|
|---|
| 632 | . . set ^UTILITY("DIT",$J,""_fromIEN_";"_toRef_"")=""_toIEN_";"_toRef_""
|
|---|
| 633 |
|
|---|
| 634 | quit
|
|---|
| 635 |
|
|---|
| 636 |
|
|---|
| 637 | PtrsIn(File,IEN,Array,PrgsFn)
|
|---|
| 638 | ;"SCOPE: PUBLIC
|
|---|
| 639 | ;"Purpose: Create a list of incoming pointers to a given record in given file
|
|---|
| 640 | ;"Input: File: The file to investigate (Number or Name)
|
|---|
| 641 | ;" IEN: IEN of record to
|
|---|
| 642 | ;" Array -- PASS BY REFERENCE. An array to receive results back.
|
|---|
| 643 | ;" any prexisting data in Array is killed before filling
|
|---|
| 644 | ;" PrgsFn: OPTIONAL -- <Progress Function Code>
|
|---|
| 645 | ;" because this search process can be quite lengthy,
|
|---|
| 646 | ;" an optional line of M code may be given here that will be executed
|
|---|
| 647 | ;" before each file is scanned. The following variables will be defined:
|
|---|
| 648 | ;" TMGCODE -- will hold code of current file being scanned.
|
|---|
| 649 | ;" TMGTOTAL -- will hold total number of records to scan
|
|---|
| 650 | ;" TMGCUR -- will hold count of current record being scanned.
|
|---|
| 651 | ;"Output: Array is filled with format as follows:
|
|---|
| 652 | ;" Array(File#,IEN,0)=LastCount
|
|---|
| 653 | ;" Array(File#,IEN,count)=FullRef;piece;IENS;TopGlobalRef
|
|---|
| 654 | ;" Description of parts:
|
|---|
| 655 | ;" ----------------------
|
|---|
| 656 | ;" File# -- the file the found entry exists it (may be a subfile number)
|
|---|
| 657 | ;" IEN -- the record number in file
|
|---|
| 658 | ;" Note: IEN here is different from the IEN passed in as a parameter
|
|---|
| 659 | ;" FullRef -- the is the full reference to the found value. e.g.
|
|---|
| 660 | ;" set value=$piece(@FullRef,"^",piece)
|
|---|
| 661 | ;" piece -- the piece where value is stored in the node that is specified by FullRef
|
|---|
| 662 | ;" IENS -- this is provided only for matches in subfiles. It is the IENS that may be used in database calls
|
|---|
| 663 | ;" TopGlobalRef -- this is the global reference for file. If the match is in a subfile, then
|
|---|
| 664 | ;" this is the global reference of the parent file (or the highest grandparent file if
|
|---|
| 665 | ;" the parent file itself is a subfile, etc.)
|
|---|
| 666 | ;"
|
|---|
| 667 | ;"Result: 1 if results found, 0 if error occurred.
|
|---|
| 668 | ;"NOTE: This function manually scans through potentially HUGE numbers of records-->BE PATIENT!
|
|---|
| 669 |
|
|---|
| 670 | kill Array
|
|---|
| 671 | new result set result=0
|
|---|
| 672 | new FileNum
|
|---|
| 673 | set IEN=+$get(IEN)
|
|---|
| 674 | if IEN=0 goto FPIDone ;"NOTE: IEN doesn't have to point to a valid record.
|
|---|
| 675 | if $data(File)#10=0 goto FPIDone
|
|---|
| 676 | if +File=0 set FileNum=$$GetFileNum^TMGDBAPI(File) ;"Convert File Name to File Number
|
|---|
| 677 | else set FileNum=File
|
|---|
| 678 | if +FileNum=0 goto FPIDone
|
|---|
| 679 |
|
|---|
| 680 | new PossArray,TMGCODE
|
|---|
| 681 | if $$PossPtrs(File,.PossArray)=0 goto FPIDone
|
|---|
| 682 |
|
|---|
| 683 | ;"Count number of records to scan
|
|---|
| 684 | new TMGCUR set TMGCUR=0
|
|---|
| 685 | new TMGTOTAL set TMGTOTAL=0
|
|---|
| 686 | do
|
|---|
| 687 | . new temp set temp=$order(PossArray(""))
|
|---|
| 688 | . if temp'="" for do quit:(temp="")
|
|---|
| 689 | . . new code set code=PossArray(temp)
|
|---|
| 690 | . . new ref set ref=$get(^DIC(+code,0,"GL"))
|
|---|
| 691 | . . set ref=$$CREF^DILF(ref) ;"convert open to closed format
|
|---|
| 692 | . . new NumRecs
|
|---|
| 693 | . . if ref'="" set NumRecs=+$piece(@ref@(0),"^",4)
|
|---|
| 694 | . . else set NumRecs=10000 ;"some arbitrary guess of #recs in a subfile
|
|---|
| 695 | . . set TMGTOTAL=TMGTOTAL+1
|
|---|
| 696 | . . set TMGTOTAL(TMGTOTAL)=NumRecs
|
|---|
| 697 | . . set temp=$order(PossArray(temp))
|
|---|
| 698 | . set temp=$order(TMGTOTAL(""))
|
|---|
| 699 | . set TMGTOTAL=1
|
|---|
| 700 | . if temp'="" for do quit:(temp="")
|
|---|
| 701 | . . set TMGTOTAL=TMGTOTAL+TMGTOTAL(temp)
|
|---|
| 702 | . . set temp=$order(TMGTOTAL(temp))
|
|---|
| 703 | . if TMGTOTAL=0 set TMGTOTAL=1 ;"avoid div by zero issues.
|
|---|
| 704 |
|
|---|
| 705 | new count set count=1
|
|---|
| 706 | new index set index=$order(PossArray(""))
|
|---|
| 707 | if index'="" for do quit:(index="")
|
|---|
| 708 | . set TMGCUR=TMGCUR+TMGTOTAL(count)
|
|---|
| 709 | . set count=count+1
|
|---|
| 710 | . set TMGCODE=PossArray(index)
|
|---|
| 711 | . if $get(PrgsFn)'="" do
|
|---|
| 712 | . . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"" set $etrap="""",$ecode="""""
|
|---|
| 713 | . . xecute PrgsFn
|
|---|
| 714 | . do ScanFile(TMGCODE,IEN,.Array)
|
|---|
| 715 | . set index=$order(PossArray(index))
|
|---|
| 716 |
|
|---|
| 717 | set result=1
|
|---|
| 718 | FPIDone
|
|---|
| 719 | quit result
|
|---|
| 720 |
|
|---|
| 721 |
|
|---|
| 722 | PtrsMIn(IENArray,Array,ShowProgress)
|
|---|
| 723 | ;"SCOPE: PUBLIC
|
|---|
| 724 | ;"Purpose: Create a list of incoming pointers to an array of records in given file
|
|---|
| 725 | ;"NOTE: this function differes from PtrsIn because is allows multiple input IEN's
|
|---|
| 726 | ;"Input: IENArray: PASS BY REFERENCE. Array of IENs of record in ToFile. Format:
|
|---|
| 727 | ;" IENArray=SourceFile#
|
|---|
| 728 | ;" IENArray(IEN)=""
|
|---|
| 729 | ;" IENArray(IEN)=""
|
|---|
| 730 | ;" Array -- PASS BY REFERENCE. An array to receive results back. Format below.
|
|---|
| 731 | ;" any prexisting data in Array is killed before filling
|
|---|
| 732 | ;" ShowProgress: if 1, progress bar shown
|
|---|
| 733 | ;"Output: Array is filled with format as follows:
|
|---|
| 734 | ;" Array(ToFile#,ToIEN,FromFile#,fromIEN,0)=LastCount
|
|---|
| 735 | ;" Array(ToFile#,ToIEN,FromFile#,fromIEN,count)=FullRef;piece;IENS;TopGlobalRef
|
|---|
| 736 | ;" Description of parts:
|
|---|
| 737 | ;" ----------------------
|
|---|
| 738 | ;" ToFile# -- the file containing the target IEN record
|
|---|
| 739 | ;" ToIEN --the IEN in ToFile
|
|---|
| 740 | ;" FromFile# -- the file the found entry exists it (may be a subfile number)
|
|---|
| 741 | ;" fromIEN -- the record number in file
|
|---|
| 742 | ;" Note: IEN here is different from the IEN passed in as a parameter
|
|---|
| 743 | ;" FullRef -- the is the full reference to the found value. e.g.
|
|---|
| 744 | ;" set value=$piece(@FullRef,"^",piece)
|
|---|
| 745 | ;" piece -- the piece where value is stored in the node that is specified by FullRef
|
|---|
| 746 | ;" IENS -- this is provided only for matches in subfiles. It is the IENS that may be used in database calls
|
|---|
| 747 | ;" TopGlobalRef -- this is the global reference for file. If the match is in a subfile, then
|
|---|
| 748 | ;" this is the global reference of the parent file (or the highest grandparent file if
|
|---|
| 749 | ;" the parent file itself is a subfile, etc.)
|
|---|
| 750 | ;"
|
|---|
| 751 | ;"Result: 1 if results found, 0 if error occurred.
|
|---|
| 752 | ;"NOTE: This function manually scans through potentially HUGE numbers of records-->BE PATIENT!
|
|---|
| 753 |
|
|---|
| 754 | kill Array
|
|---|
| 755 | new result set result=0
|
|---|
| 756 | new FileNum
|
|---|
| 757 | set ToFile=$get(IENArray) if ToFile="" goto FMPIDone
|
|---|
| 758 | if +ToFile=0 set FileNum=$$GetFileNum^TMGDBAPI(File) ;"Convert File Name to File Number
|
|---|
| 759 | else set FileNum=ToFile
|
|---|
| 760 | if +FileNum=0 goto FMPIDone
|
|---|
| 761 |
|
|---|
| 762 | new PossArray
|
|---|
| 763 | if $$PossPtrs(FileNum,.PossArray)=0 goto FMPIDone
|
|---|
| 764 |
|
|---|
| 765 | new FInfoArray
|
|---|
| 766 | new index set index=""
|
|---|
| 767 | for set index=$order(PossArray(index)) quit:(index="") do
|
|---|
| 768 | . new tempS set tempS=$get(PossArray(index))
|
|---|
| 769 | . new fromFile set fromFile=$piece(tempS,"^",1)
|
|---|
| 770 | . new fromField set fromField=$piece(tempS,"^",2)
|
|---|
| 771 | . new fldCode set fldCode=$piece(tempS,"^",3)
|
|---|
| 772 | . set FInfoArray(fromFile,fromField)=fldCode
|
|---|
| 773 |
|
|---|
| 774 | do ScanMFile(.FInfoArray,.IENArray,.Array,.ShowProgress)
|
|---|
| 775 |
|
|---|
| 776 | set result=1
|
|---|
| 777 | FMPIDone
|
|---|
| 778 | quit result
|
|---|
| 779 |
|
|---|
| 780 |
|
|---|
| 781 | ScanFile(FInfo,IEN,Array)
|
|---|
| 782 | ;"SCOPE: PUBLIC
|
|---|
| 783 | ;"Purpose: To scan one file (from array setup by PossPtrs) for actual pointers to IEN
|
|---|
| 784 | ;"Input: FInfo : OtherFile#^Field#^FieldCode(piece#2 of 0 node of ^DD entry for field)
|
|---|
| 785 | ;"Examples of possible inputs follow:
|
|---|
| 786 | ;"50^62.05^*P50'"
|
|---|
| 787 | ;"695^.01^RP50'"
|
|---|
| 788 | ;"801.43^.02^RV"
|
|---|
| 789 | ;"810.31^.04^V"
|
|---|
| 790 | ;"811.902^.01^MVX"
|
|---|
| 791 |
|
|---|
| 792 | ;"NOTE: Idea for future enhancement: Allow FInfo to hold a list rather than just one value.
|
|---|
| 793 | ;" This would be for instances where multiple fields in given record need to be searched
|
|---|
| 794 | ;" This might speed up database access times.
|
|---|
| 795 |
|
|---|
| 796 | ;" IEN : the IEN that pointers should point to, to be considered a match.
|
|---|
| 797 | ;" Array : PASS BY REFERENCE. An array to receive results.
|
|---|
| 798 | ;"Output: Format of Array output:
|
|---|
| 799 | ;" Array(File#,IEN,0)=LastCount
|
|---|
| 800 | ;" Array(File#,IEN,count)=FullRef;piece;IENS;TopGlobalRef
|
|---|
| 801 | ;" Description of parts:
|
|---|
| 802 | ;" ----------------------
|
|---|
| 803 | ;" File# -- the file the found entry exists it (may be a subfile number)
|
|---|
| 804 | ;" IEN -- the record number in file
|
|---|
| 805 | ;" Note: IEN here is different from the IEN passed in as a parameter
|
|---|
| 806 | ;" FullRef -- the is the full reference to the found value. e.g.
|
|---|
| 807 | ;" set value=$piece(@FullRef,"^",piece)
|
|---|
| 808 | ;" piece -- the piece where value is stored in the node that is specified by FullRef
|
|---|
| 809 | ;" IENS -- this is provided only for matches in subfiles. It is the IENS that may be used in database calls
|
|---|
| 810 | ;" TopGlobalRef -- this is the global reference for file. If the match is in a subfile, then
|
|---|
| 811 | ;" this is the global reference of the parent file (or the highest grandparent file if
|
|---|
| 812 | ;" the parent file itself is a subfile, etc.)
|
|---|
| 813 | ;"
|
|---|
| 814 | ;"result : none
|
|---|
| 815 |
|
|---|
| 816 | new File set File=$piece(FInfo,"^",1) if File="" goto SFDone
|
|---|
| 817 | new Field set Field=$piece(FInfo,"^",2) if Field="" goto SFDone
|
|---|
| 818 | new Code set Code=$piece(FInfo,"^",3) if Code="" goto SFDone
|
|---|
| 819 | new count
|
|---|
| 820 | if '((Code["P")!(Code["V")) goto SFDone
|
|---|
| 821 | new GRef
|
|---|
| 822 | new znode set znode=$get(^DD(File,Field,0))
|
|---|
| 823 | new loc set loc=$piece(znode,"^",4)
|
|---|
| 824 | new node set node=$piece(loc,";",1)
|
|---|
| 825 | new pce set pce=$piece(loc,";",2)
|
|---|
| 826 | if +$$IsSubFile^TMGDBAPI(File) do
|
|---|
| 827 | . new FileArray,i,k,FNum,SubInfo
|
|---|
| 828 | . set i=0
|
|---|
| 829 | . set FileArray(0)=0
|
|---|
| 830 | . set FileArray(i,"PARENT","LOC")=loc
|
|---|
| 831 | . set FNum=File
|
|---|
| 832 | . for do quit:(+FNum=0) ;"setup array describing subfile's inheritence
|
|---|
| 833 | . . set i=i+1
|
|---|
| 834 | . . set FileArray(i)=FNum
|
|---|
| 835 | . . if i=1 set FileArray(0,"FILE")=FNum
|
|---|
| 836 | . . if $$GetSubFInfo^TMGDBAPI(FNum,.SubInfo) do
|
|---|
| 837 | . . . set FileArray(i,"PARENT","LOC")=SubInfo("FIELD IN PARENT","LOC")
|
|---|
| 838 | . . . set GRef=$get(SubInfo("PARENT","GL")) ;"<-- only valid for highest ancestor
|
|---|
| 839 | . . else do
|
|---|
| 840 | . . . set (FileArray(0,"TOP GL"),FileArray(i,"PARENT","GL"))=$get(^DIC(FNum,0,"GL"))
|
|---|
| 841 | . . set FNum=$$IsSubFile^TMGDBAPI(FNum)
|
|---|
| 842 | . do HandleSubFile(IEN,.FileArray,.Array)
|
|---|
| 843 | else do
|
|---|
| 844 | . set GRef=$get(^DIC(File,0,"GL"))
|
|---|
| 845 | . new ORef set ORef=GRef
|
|---|
| 846 | . set GRef=$$CREF^DILF(GRef) ;"convert open to closed format
|
|---|
| 847 | . new index set index=$order(@GRef@(0))
|
|---|
| 848 | . if index'="" for do quit:(index="")
|
|---|
| 849 | . . new value set value=$get(@GRef@(index,node))
|
|---|
| 850 | . . if $piece(value,"^",pce)=IEN do
|
|---|
| 851 | . . . set Array(File,index,0)=1
|
|---|
| 852 | . . . set Array(File,index,1)=$name(@GRef@(index,node))_";"_pce_";"_""_";"_ORef
|
|---|
| 853 | . . set index=$order(@GRef@(index))
|
|---|
| 854 |
|
|---|
| 855 | SFDone
|
|---|
| 856 | quit
|
|---|
| 857 |
|
|---|
| 858 |
|
|---|
| 859 | ScanMFile(FInfoArray,IENArray,Array,ShowProgress)
|
|---|
| 860 | ;"SCOPE: PUBLIC
|
|---|
| 861 | ;"Purpose: To scan multiple file (from array setup by PossPtrs) for actual pointers to IENs
|
|---|
| 862 | ;"Input: FInfoArray : PASS BY REFERENCE. Format:
|
|---|
| 863 | ;" FInfoArray(OtherFile,Field)=FieldCode(piece#2 of 0 node of ^DD entry for field)
|
|---|
| 864 | ;" Examples of possible inputs follow:
|
|---|
| 865 | ;" FInfoArray(50,62.05)="*P50'"
|
|---|
| 866 | ;" FInfoArray(695,.01)="RP50'"
|
|---|
| 867 | ;" FInfoArray(801.43,.02)="RV"
|
|---|
| 868 | ;" FInfoArray(810.31,.04)="V"
|
|---|
| 869 | ;" FInfoArray(811.902,.01)="MVX"
|
|---|
| 870 | ;" IENArray : PASS BY REFERENCE. IEN's that pointers should point TO, to be considered a match.
|
|---|
| 871 | ;" Format: IENArray=SourceFile
|
|---|
| 872 | ;" IENArray(IEN)=""
|
|---|
| 873 | ;" IENArray(IEN)=""
|
|---|
| 874 | ;" Array : PASS BY REFERENCE. AN OUT PARAMETER. Format:
|
|---|
| 875 | ;" Array(ToFile#,ToIEN,fromFile#,fromIEN,0)=LastCount
|
|---|
| 876 | ;" Array(ToFile#,ToIEN,fromFile#,fromIEN,count)=FullRef;piece;IENS;TopGlobalRef
|
|---|
| 877 | ;" Description of parts:
|
|---|
| 878 | ;" ----------------------
|
|---|
| 879 | ;" ToFile# -- the file containing the target IEN record
|
|---|
| 880 | ;" ToIEN --the IEN in ToFile
|
|---|
| 881 | ;" fromFile# -- the file the found entry exists it (may be a subfile number)
|
|---|
| 882 | ;" fromIEN -- the record number in file
|
|---|
| 883 | ;" Note: IEN here is different from the IEN passed in as a parameter
|
|---|
| 884 | ;" FullRef -- the is the full reference to the found value. e.g.
|
|---|
| 885 | ;" set value=$piece(@FullRef,"^",piece)
|
|---|
| 886 | ;" piece -- the piece where value is stored in the node that is specified by FullRef
|
|---|
| 887 | ;" IENS -- this is provided only for matches in subfiles. It is the IENS that may be used in database calls
|
|---|
| 888 | ;" TopGlobalRef -- this is the global reference for file. If the match is in a subfile, then
|
|---|
| 889 | ;" this is the global reference of the parent file (or the highest grandparent file if
|
|---|
| 890 | ;" the parent file itself is a subfile, etc.)
|
|---|
| 891 | ;" ShowProgress: if 1, progress bar shown
|
|---|
| 892 | ;"
|
|---|
| 893 | ;"result : none
|
|---|
| 894 |
|
|---|
| 895 | new ToFile set ToFile=+$get(IENArray)
|
|---|
| 896 | set ShowProgress=$get(ShowProgress,0)
|
|---|
| 897 | new abort set abort=0
|
|---|
| 898 | set fromFile=""
|
|---|
| 899 | for set fromFile=$order(FInfoArray(fromFile)) quit:(fromFile="")!abort do
|
|---|
| 900 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 901 | . write !,"Processing File#: ",fromFile,!
|
|---|
| 902 | . new Field set Field=""
|
|---|
| 903 | . for set Field=$order(FInfoArray(fromFile,Field)) quit:(Field="") do
|
|---|
| 904 | . . write " Field#: ",Field,!
|
|---|
| 905 | . . new Code set Code=$get(FInfoArray(fromFile,Field)) if Code="" quit
|
|---|
| 906 | . . new count
|
|---|
| 907 | . . if '((Code["P")!(Code["V")) goto SFDone
|
|---|
| 908 | . . new GRef
|
|---|
| 909 | . . new znode set znode=$get(^DD(fromFile,Field,0))
|
|---|
| 910 | . . new loc set loc=$piece(znode,"^",4)
|
|---|
| 911 | . . new node set node=$piece(loc,";",1)
|
|---|
| 912 | . . new pce set pce=$piece(loc,";",2)
|
|---|
| 913 | . . if +$$IsSubFile^TMGDBAPI(fromFile) do
|
|---|
| 914 | . . . new FileArray,i,k,FNum,SubInfo
|
|---|
| 915 | . . . set i=0
|
|---|
| 916 | . . . set FileArray(0)=0
|
|---|
| 917 | . . . set FileArray(i,"PARENT","LOC")=loc
|
|---|
| 918 | . . . set FNum=fromFile
|
|---|
| 919 | . . . for do quit:(+FNum=0) ;"setup array describing subfile's inheritence
|
|---|
| 920 | . . . . set i=i+1
|
|---|
| 921 | . . . . set FileArray(i)=FNum
|
|---|
| 922 | . . . . if i=1 set FileArray(0,"FILE")=FNum
|
|---|
| 923 | . . . . if $$GetSubFInfo^TMGDBAPI(FNum,.SubInfo) do
|
|---|
| 924 | . . . . . set FileArray(i,"PARENT","LOC")=SubInfo("FIELD IN PARENT","LOC")
|
|---|
| 925 | . . . . . set GRef=$get(SubInfo("PARENT","GL")) ;"<-- only valid for highest ancestor
|
|---|
| 926 | . . . . else do
|
|---|
| 927 | . . . . . set (FileArray(0,"TOP GL"),FileArray(i,"PARENT","GL"))=$get(^DIC(FNum,0,"GL"))
|
|---|
| 928 | . . . . set FNum=$$IsSubFile^TMGDBAPI(FNum)
|
|---|
| 929 | . . . do HandleMSubFile(.IENArray,.FileArray,.Array)
|
|---|
| 930 | . . else do
|
|---|
| 931 | . . . set GRef=$get(^DIC(fromFile,0,"GL"))
|
|---|
| 932 | . . . new ORef set ORef=GRef
|
|---|
| 933 | . . . set GRef=$$CREF^DILF(GRef) ;"convert open to closed format
|
|---|
| 934 | . . . new Itr,fromIEN
|
|---|
| 935 | . . . set fromIEN=$$ItrAInit^TMGITR(GRef,.Itr)
|
|---|
| 936 | . . . if ShowProgress=1 do PrepProgress^TMGITR(.Itr,20,1,"fromIEN")
|
|---|
| 937 | . . . if fromIEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.fromIEN)="")!abort
|
|---|
| 938 | . . . . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 939 | . . . . ;"for set fromIEN=$order(@GRef@(fromIEN)) quit:(fromIEN="") do
|
|---|
| 940 | . . . . new valueS set valueS=$get(@GRef@(fromIEN,node))
|
|---|
| 941 | . . . . new ToIEN set ToIEN=$piece(valueS,"^",pce)
|
|---|
| 942 | . . . . if $data(IENArray(ToIEN))>0 do
|
|---|
| 943 | . . . . . new lastCount set lastCount=+$get(Array(ToFile,ToIEN,fromFile,fromIEN,0))+1
|
|---|
| 944 | . . . . . set Array(ToFile,ToIEN,fromFile,fromIEN,0)=lastCount
|
|---|
| 945 | . . . . . set Array(ToFile,ToIEN,fromFile,fromIEN,lastCount)=$name(@GRef@(fromIEN,node))_";"_pce_";"_""_";"_ORef
|
|---|
| 946 |
|
|---|
| 947 | SMFDone
|
|---|
| 948 | quit
|
|---|
| 949 |
|
|---|
| 950 |
|
|---|
| 951 | HandleSubFile(SearchValue,FileArray,Array,IENS,Ref)
|
|---|
| 952 | ;"Purpose: To provide a means of recursively handling subfiles, searching for SearchValue.
|
|---|
| 953 | ;"Input: SearchValue -- the value to be searched for, in INTERNAL format.
|
|---|
| 954 | ;" File Array -- PASS BY REFERENCE An array that describes the parent file numbers
|
|---|
| 955 | ;" and storage locations. Example:
|
|---|
| 956 | ;" FileArra(0,"TOP GL")="^XTV(8989.3,"
|
|---|
| 957 | ;" FileArra(0,"FILE")=8989.33211
|
|---|
| 958 | ;" FileArra(0)=0
|
|---|
| 959 | ;" FileArra(0,"PARENT","LOC")="0;1" <-- for FileArray(0) node, stores node;piece
|
|---|
| 960 | ;" FileArra(1)=8989.33211
|
|---|
| 961 | ;" FileArra(1,"PARENT","LOC")="1;0" <--- 1 is storage node
|
|---|
| 962 | ;" FileArra(2)=8989.3321
|
|---|
| 963 | ;" FileArra(2,"PARENT","LOC")="1;0" <--- 1 is storage node
|
|---|
| 964 | ;" FileArra(3)=8989.332
|
|---|
| 965 | ;" FileArra(3,"PARENT","LOC")="ABPKG;0" <--- "ABPKG" is storage node
|
|---|
| 966 | ;" FileArra(4)=8989.3
|
|---|
| 967 | ;" FileArra(4,"PARENT","GL")="^XTV(8989.3,"
|
|---|
| 968 | ;" Array -- PASS BY REFERENCE. An array the receives any search matches.
|
|---|
| 969 | ;" Format is as follows
|
|---|
| 970 | ;" Array(File#,IEN,0)=LastCount
|
|---|
| 971 | ;" Array(File#,IEN,count)=FullRef;piece;IENS;TopGlobalRef
|
|---|
| 972 | ;"
|
|---|
| 973 | ;" IENS -- OPTIONAL -- used by this function internally during recursive calls
|
|---|
| 974 | ;" Ref -- OPTIONAL -- used by this function internally during recursive calls
|
|---|
| 975 |
|
|---|
| 976 | new index,s,IEN,CRef,pce,node
|
|---|
| 977 | set index=$order(FileArray(""),-1)
|
|---|
| 978 | set s=$get(FileArray(index,"PARENT","LOC"))
|
|---|
| 979 | set node=$piece(s,";",1)
|
|---|
| 980 | set pce=+$piece(s,";",2)
|
|---|
| 981 | if s'="" do
|
|---|
| 982 | . if +node'=node set node=""""_node_""""
|
|---|
| 983 | . set s=node_","
|
|---|
| 984 | else do
|
|---|
| 985 | . set s=$get(FileArray(index,"PARENT","GL"))
|
|---|
| 986 | . set node=""
|
|---|
| 987 | set Ref=$get(Ref)_s
|
|---|
| 988 | if Ref="" goto HSFDone
|
|---|
| 989 | set CRef=$$CREF^DILF(Ref)
|
|---|
| 990 | new subFArray
|
|---|
| 991 | merge subFArray=FileArray
|
|---|
| 992 | kill subFArray(index) ;"trim top entry from list/array
|
|---|
| 993 | if index>0 do
|
|---|
| 994 | . set IEN=$order(@CRef@(0))
|
|---|
| 995 | . if +IEN>0 for do quit:(+IEN=0)
|
|---|
| 996 | . . new subRef,subIENS
|
|---|
| 997 | . . set subRef=Ref_IEN_","
|
|---|
| 998 | . . set subIENS=IEN_","_$get(IENS)
|
|---|
| 999 | . . do HandleSubFile(SearchValue,.subFArray,.Array,.subIENS,subRef)
|
|---|
| 1000 | . . set IEN=$order(@CRef@(IEN))
|
|---|
| 1001 | else do
|
|---|
| 1002 | . if (pce>0) do ;"Here is were the actual comparison to SearchValue occurs
|
|---|
| 1003 | . . set subRef=$$CREF^DILF(subRef)
|
|---|
| 1004 | . . new p,t set (p,t)=0
|
|---|
| 1005 | . . for set t=$find(subRef,",",t) set:(t>0) p=t quit:(t=0) ;"find pos of last parameter
|
|---|
| 1006 | . . ;"new ORef set ORef=$extract(subRef,1,p-1)
|
|---|
| 1007 | . . set IEN=$piece($extract(subRef,p,99),")",1)
|
|---|
| 1008 | . . new value set value=$get(@subRef@(node))
|
|---|
| 1009 | . . set value=$piece(value,"^",pce)
|
|---|
| 1010 | . . set value=$piece(value,";",1) ;"I think VARIABLE pointers format is: IEN;file#
|
|---|
| 1011 | . . if value=SearchValue do
|
|---|
| 1012 | . . . new tFile set tFile=$get(FileArray(0,"FILE"),"?")
|
|---|
| 1013 | . . . new count set count=$get(Array(tFile,IEN,0))+1
|
|---|
| 1014 | . . . set Array(tFile,IEN,0)=count
|
|---|
| 1015 | . . . set Array(tFile,IEN,count)=$name(@subRef@(node))_";"_pce_";"_""_$get(IENS)_""_";"_$get(FileArray(0,"TOP GL"))
|
|---|
| 1016 |
|
|---|
| 1017 | HSFDone
|
|---|
| 1018 | quit
|
|---|
| 1019 |
|
|---|
| 1020 |
|
|---|
| 1021 | HandleMSubFile(IENArray,FileArray,Array,IENS,Ref)
|
|---|
| 1022 | ;"Purpose: To provide a means of recursively handling subfiles, searching for SearchValue.
|
|---|
| 1023 | ;"Input: IENArray : PASS BY REFERENCE. IEN's to search for in INTERNAL format.
|
|---|
| 1024 | ;" Format: IENArray=SourceFile
|
|---|
| 1025 | ;" IENArray(IEN)=""
|
|---|
| 1026 | ;" IENArray(IEN)=""
|
|---|
| 1027 | ;" File Array -- PASS BY REFERENCE An array that describes the parent file numbers
|
|---|
| 1028 | ;" and storage locations. Example:
|
|---|
| 1029 | ;" FileArray(0,"TOP GL")="^XTV(8989.3,"
|
|---|
| 1030 | ;" FileArray(0,"FILE")=8989.33211
|
|---|
| 1031 | ;" FileArray(0)=0
|
|---|
| 1032 | ;" FileArray(0,"PARENT","LOC")="0;1" <-- for FileArray(0) node, stores node;piece
|
|---|
| 1033 | ;" FileArray(1)=8989.33211
|
|---|
| 1034 | ;" FileArray(1,"PARENT","LOC")="1;0" <--- 1 is storage node
|
|---|
| 1035 | ;" FileArray(2)=8989.3321
|
|---|
| 1036 | ;" FileArray(2,"PARENT","LOC")="1;0" <--- 1 is storage node
|
|---|
| 1037 | ;" FileArray(3)=8989.332
|
|---|
| 1038 | ;" FileArray(3,"PARENT","LOC")="ABPKG;0" <--- "ABPKG" is storage node
|
|---|
| 1039 | ;" FileArray(4)=8989.3
|
|---|
| 1040 | ;" FileArray(4,"PARENT","GL")="^XTV(8989.3,"
|
|---|
| 1041 | ;" Array : PASS BY REFERENCE. AN OUT PARAMETER. Format:
|
|---|
| 1042 | ;" Array(ToFile#,ToIEN,fromFile#,fromIEN,0)=LastCount
|
|---|
| 1043 | ;" Array(ToFile#,ToIEN,fromFile#,fromIEN,count)=FullRef;piece;IENS;TopGlobalRef
|
|---|
| 1044 | ;" Description of parts:
|
|---|
| 1045 | ;" ----------------------
|
|---|
| 1046 | ;" ToFile# -- the file containing the target IEN record
|
|---|
| 1047 | ;" ToIEN --the IEN in ToFile
|
|---|
| 1048 | ;" fromFile# -- the file the found entry exists it (may be a subfile number)
|
|---|
| 1049 | ;" fromIEN -- the record number in file
|
|---|
| 1050 | ;" Note: IEN here is different from the IEN passed in as a parameter
|
|---|
| 1051 | ;" FullRef -- the is the full reference to the found value. e.g.
|
|---|
| 1052 | ;" set value=$piece(@FullRef,"^",piece)
|
|---|
| 1053 | ;" piece -- the piece where value is stored in the node that is specified by FullRef
|
|---|
| 1054 | ;" IENS -- this is provided only for matches in subfiles. It is the IENS that may be used in database calls
|
|---|
| 1055 | ;" TopGlobalRef -- this is the global reference for file. If the match is in a subfile, then
|
|---|
| 1056 | ;" this is the global reference of the parent file (or the highest grandparent file if
|
|---|
| 1057 | ;" the parent file itself is a subfile, etc.)
|
|---|
| 1058 | ;"
|
|---|
| 1059 | ;" IENS -- OPTIONAL -- used by this function internally during recursive calls
|
|---|
| 1060 | ;" Ref -- OPTIONAL -- used by this function internally during recursive calls
|
|---|
| 1061 |
|
|---|
| 1062 | new ToFile set ToFile=$get(IENArray)
|
|---|
| 1063 | new index,s,IEN,CRef,pce,node
|
|---|
| 1064 | set index=$order(FileArray(""),-1)
|
|---|
| 1065 | set s=$get(FileArray(index,"PARENT","LOC"))
|
|---|
| 1066 | set node=$piece(s,";",1)
|
|---|
| 1067 | set pce=+$piece(s,";",2)
|
|---|
| 1068 | if s'="" do
|
|---|
| 1069 | . if +node'=node set node=""""_node_""""
|
|---|
| 1070 | . set s=node_","
|
|---|
| 1071 | else do
|
|---|
| 1072 | . set s=$get(FileArray(index,"PARENT","GL"))
|
|---|
| 1073 | . set node=""
|
|---|
| 1074 | set Ref=$get(Ref)_s
|
|---|
| 1075 | if Ref="" goto HSFDone
|
|---|
| 1076 | set CRef=$$CREF^DILF(Ref)
|
|---|
| 1077 | new subFArray
|
|---|
| 1078 | merge subFArray=FileArray
|
|---|
| 1079 | kill subFArray(index) ;"trim top entry from list/array
|
|---|
| 1080 | if index>0 do
|
|---|
| 1081 | . set fromIEN=0
|
|---|
| 1082 | . for set fromIEN=$order(@CRef@(fromIEN)) quit:(+fromIEN=0) do
|
|---|
| 1083 | . . new subRef,subIENS
|
|---|
| 1084 | . . set subRef=Ref_fromIEN_","
|
|---|
| 1085 | . . set subIENS=fromIEN_","_$get(IENS)
|
|---|
| 1086 | . . do HandleMSubFile(.IENArray,.subFArray,.Array,.subIENS,subRef)
|
|---|
| 1087 | else do
|
|---|
| 1088 | . if (pce>0) do ;"Here is were the actual comparison to SearchValue occurs
|
|---|
| 1089 | . . set subRef=$$CREF^DILF(subRef)
|
|---|
| 1090 | . . new p,t set (p,t)=0
|
|---|
| 1091 | . . for set t=$find(subRef,",",t) set:(t>0) p=t quit:(t=0) ;"find pos of last parameter
|
|---|
| 1092 | . . ;"new ORef set ORef=$extract(subRef,1,p-1)
|
|---|
| 1093 | . . set fromIEN=$piece($extract(subRef,p,99),")",1)
|
|---|
| 1094 | . . new valueS set valueS=$get(@subRef@(node))
|
|---|
| 1095 | . . set valueS=$piece(valueS,"^",pce)
|
|---|
| 1096 | . . new ToIEN set ToIEN=$piece(valueS,";",1) ;"I think VARIABLE pointers format is: IEN;file#
|
|---|
| 1097 | . . if $data(IENArray(ToIEN))>0 do
|
|---|
| 1098 | . . . new fromFile set fromFile=$get(FileArray(0,"FILE"),"?")
|
|---|
| 1099 | . . . new count set count=$get(Array(ToFile,ToIEN,fromFile,fromIEN,0))+1
|
|---|
| 1100 | . . . set Array(ToFile,ToIEN,fromFile,fromIEN,0)=count
|
|---|
| 1101 | . . . set Array(ToFile,ToIEN,fromFile,fromIEN,count)=$name(@subRef@(node))_";"_pce_";"_""_$get(IENS)_""_";"_$get(FileArray(0,"TOP GL"))
|
|---|
| 1102 |
|
|---|
| 1103 | HMSFDone
|
|---|
| 1104 | quit
|
|---|
| 1105 |
|
|---|
| 1106 |
|
|---|
| 1107 | PossPtrs(File,Array)
|
|---|
| 1108 | ;"SCOPE: PUBLIC
|
|---|
| 1109 | ;"Purpose: to create a list of all possible pointers to a specified file, i.e. all other fields/fields
|
|---|
| 1110 | ;" that point to the specified file.
|
|---|
| 1111 | ;"Input: File: The file to investigate (Number or Name)
|
|---|
| 1112 | ;" Array -- PASS BY REFERENCE. An array to receive results back.
|
|---|
| 1113 | ;" any prexisting data in Array is killed before filling
|
|---|
| 1114 | ;"Output: Array is filled with format as follows:
|
|---|
| 1115 | ;" Array(1)=OtherFile#^Field#^FieldCode(piece#2 of 0 node of ^DD entry for field)
|
|---|
| 1116 | ;" Array(2)=OtherFile#^Field#^FieldCode
|
|---|
| 1117 | ;"Result: 1 if results found, 0 if error occurred.
|
|---|
| 1118 |
|
|---|
| 1119 | kill Array
|
|---|
| 1120 | new result set result=0
|
|---|
| 1121 | new FileNum
|
|---|
| 1122 | if $data(File)#10=0 goto PPtrsDone
|
|---|
| 1123 | if +File=0 set FileNum=$$GetFileNum^TMGDBAPI(File) ;"Convert File Name to File Number
|
|---|
| 1124 | else set FileNum=File
|
|---|
| 1125 | if +FileNum=0 goto PPtrsDone
|
|---|
| 1126 |
|
|---|
| 1127 | new count set count=1
|
|---|
| 1128 | new PtrFile set PtrFile=$order(^DD(FileNum,0,"PT",""))
|
|---|
| 1129 | if PtrFile'="" for do quit:(PtrFile="")
|
|---|
| 1130 | . new PtrField set PtrField=$order(^DD(FileNum,0,"PT",PtrFile,""))
|
|---|
| 1131 | . if PtrField'="" for do quit:(PtrField="")
|
|---|
| 1132 | . . new s set s=PtrFile_"^"_PtrField
|
|---|
| 1133 | . . set s=s_"^"_$piece($get(^DD(PtrFile,PtrField,0)),"^",2)
|
|---|
| 1134 | . . set Array(count)=s
|
|---|
| 1135 | . . set count=count+1
|
|---|
| 1136 | . . set PtrField=$order(^DD(FileNum,0,"PT",PtrFile,PtrField))
|
|---|
| 1137 | . set PtrFile=$order(^DD(FileNum,0,"PT",PtrFile))
|
|---|
| 1138 |
|
|---|
| 1139 | set result=1
|
|---|
| 1140 | PPtrsDone
|
|---|
| 1141 | quit result
|
|---|
| 1142 |
|
|---|
| 1143 |
|
|---|
| 1144 | ;"Note: Not fully debugged yet..."
|
|---|
| 1145 | SAFEKILL(Array,ShowProgress)
|
|---|
| 1146 | ;"Purpose: to safely kill records, including removing any pointers TO them
|
|---|
| 1147 | ;"input: pArray -- PASS BY REFERENCE. Expected input Format:
|
|---|
| 1148 | ;" Array(File,IEN)=0
|
|---|
| 1149 | ;" Array(File,IEN)=0
|
|---|
| 1150 | ;" ShowProgress: if 1, progress bar shown
|
|---|
| 1151 | ;"Output: all pointers in linked files to OldIEN will be changed to newIEN
|
|---|
| 1152 | ;"Results: none
|
|---|
| 1153 |
|
|---|
| 1154 | do QTMMVPTR(.Array,.ShowProgress)
|
|---|
| 1155 | quit
|
|---|
| 1156 |
|
|---|
| 1157 |
|
|---|
| 1158 | ASKKILL
|
|---|
| 1159 | ;"Purpose: to interact with user and safely kill records
|
|---|
| 1160 | ;"Input: none.
|
|---|
| 1161 | ;"Output: Records and pointers may be deleted
|
|---|
| 1162 | ;"Results: none
|
|---|
| 1163 |
|
|---|
| 1164 | new DIC,File,X,Y
|
|---|
| 1165 | new fromIEN,toIEN
|
|---|
| 1166 | new delArray
|
|---|
| 1167 |
|
|---|
| 1168 | kill DIC
|
|---|
| 1169 | set DIC("A")="Select file to delete from: "
|
|---|
| 1170 | set DIC="^DIC("
|
|---|
| 1171 | set DIC(0)="MAQE"
|
|---|
| 1172 | d ^DIC ;"Get File to search
|
|---|
| 1173 | set File=+Y
|
|---|
| 1174 | if File'>0 goto ASKKDone
|
|---|
| 1175 |
|
|---|
| 1176 | new Menu,UsrSlct
|
|---|
| 1177 | set Menu(0)="Pick Option for Selecting Record(s) to Safely Delete"
|
|---|
| 1178 | set Menu(1)="Manually pick Record(s)"_$char(9)_"ManualPick"
|
|---|
| 1179 | set Menu(2)="Select a SET (aka SORT TEMPLATE) Contianing Many Records"_$char(9)_"PickSet"
|
|---|
| 1180 |
|
|---|
| 1181 | M1 write #
|
|---|
| 1182 | set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
|
|---|
| 1183 |
|
|---|
| 1184 | if UsrSlct="ManualPick" goto ManualPick
|
|---|
| 1185 | if UsrSlct="PickSet" goto PickSet
|
|---|
| 1186 | if UsrSlct="^" goto ASKKDone
|
|---|
| 1187 | if UsrSlct=0 set UsrSlct=""
|
|---|
| 1188 | goto M1
|
|---|
| 1189 |
|
|---|
| 1190 | ManualPick
|
|---|
| 1191 | set DIC=File
|
|---|
| 1192 | set DIC("A")="Select record to delete: "
|
|---|
| 1193 | do ^DIC ;"get FROM record in File
|
|---|
| 1194 | write !
|
|---|
| 1195 | set fromIEN=+Y
|
|---|
| 1196 | if fromIEN'>0 goto ASKGo
|
|---|
| 1197 | set delArray(File,fromIEN)=0
|
|---|
| 1198 | new % set %=2
|
|---|
| 1199 | write "Pick another record" do YN^DICN write !
|
|---|
| 1200 | if %=1 goto ManualPick
|
|---|
| 1201 | if %=-1 goto ASKKDone
|
|---|
| 1202 | goto ASKGo
|
|---|
| 1203 |
|
|---|
| 1204 | PickSet new IENArray
|
|---|
| 1205 | if $$GetTemplateRecs^TMGXMLUI(File,"IENArray","",1)=0 goto ASKKDone
|
|---|
| 1206 | ;"Output: Data is put into pRecs like this: @pRecs@(IEN)=""
|
|---|
| 1207 |
|
|---|
| 1208 | new IEN set IEN=""
|
|---|
| 1209 | for set IEN=$order(IENArray(IEN)) quit:(IEN="") do
|
|---|
| 1210 | . set delArray(File,IEN)=0
|
|---|
| 1211 |
|
|---|
| 1212 | ASKGo
|
|---|
| 1213 | if $data(delArray)=0 goto ASKKDone
|
|---|
| 1214 |
|
|---|
| 1215 | ;"Get list of files/fields with pointers in
|
|---|
| 1216 | set result=$$PossPtrs(File,.PossPtrs) if result=0 goto ASKKDone
|
|---|
| 1217 | if $data(PossPtrs)'>0 goto DelRecs
|
|---|
| 1218 |
|
|---|
| 1219 | do SAFEKILL(.delArray,1)
|
|---|
| 1220 |
|
|---|
| 1221 | DelRecs ;"Now that pointers to records are deleted, it is safe to remove records themselves
|
|---|
| 1222 |
|
|---|
| 1223 | set IEN=""
|
|---|
| 1224 | new abort set abort=0
|
|---|
| 1225 | for set IEN=$order(IENArray(IEN)) quit:(IEN="")!(abort=1) do
|
|---|
| 1226 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 1227 | . new TMGFDA,TMGMSG
|
|---|
| 1228 | . set TMGFDA(File,IEN_",",.01)="@"
|
|---|
| 1229 | . do FILE^DIE("EK","TMGFDA","TMGMSG")
|
|---|
| 1230 | . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
|
|---|
| 1231 |
|
|---|
| 1232 | ASKKDone
|
|---|
| 1233 | quit
|
|---|
| 1234 |
|
|---|
| 1235 |
|
|---|
| 1236 |
|
|---|
| 1237 | VerifyPtrs(File,pArray,Verbose,AutoFix)
|
|---|
| 1238 | ;"Purpose: to scan a file for pointers OUT that are bad/invalid
|
|---|
| 1239 | ;"Input: File : file Name or Number to scan
|
|---|
| 1240 | ;" pArray : PASS BY NAME, an OUT PARAMETER. Format:
|
|---|
| 1241 | ;" @pArray@(FileNum,IEN,FieldNum)=ValueOfBadPtr
|
|---|
| 1242 | ;" @pArray@(FileNum,IEN,FieldNum)=ValueOfBadPtr
|
|---|
| 1243 | ;" Verbose: OPTIONAL. If 1, then errors immediately written out.
|
|---|
| 1244 | ;" AutoFix: OPTIONAL. If 1, then bad pointers are deleted.
|
|---|
| 1245 | ;"Results: None
|
|---|
| 1246 |
|
|---|
| 1247 | new PtrsOUT
|
|---|
| 1248 | new pPtrsOUT set pPtrsOUT="PtrsOUT"
|
|---|
| 1249 | new fileNum
|
|---|
| 1250 | if +File=File set fileNum=+File
|
|---|
| 1251 | else set fileNum=$$GetFileNum^TMGDBAPI(File)
|
|---|
| 1252 | set Verbose=+$get(Verbose)
|
|---|
| 1253 | set AutoFix=+$get(AutoFix)
|
|---|
| 1254 |
|
|---|
| 1255 | if $$FilePtrs(fileNum,pPtrsOUT)=0 goto VPtrDone
|
|---|
| 1256 |
|
|---|
| 1257 | new Itr,Itr2,TMGIEN,fieldNum
|
|---|
| 1258 | new TMGVALUE,code
|
|---|
| 1259 | new abort set abort=0
|
|---|
| 1260 | new $etrap set $etrap="set Y=""(Invalid M code!. Error Trapped.)"" set $etrap="""",$ecode="""""
|
|---|
| 1261 |
|
|---|
| 1262 | do DoVerify(File,pArray,Verbose,AutoFix) ;" Split out code to call it to call itself reentrantly
|
|---|
| 1263 |
|
|---|
| 1264 | VPtrDone
|
|---|
| 1265 | quit
|
|---|
| 1266 |
|
|---|
| 1267 |
|
|---|
| 1268 | DoVerify(fileNum,pArray,Verbose,AutoFix,IENS,pTMGIEN)
|
|---|
| 1269 | ;"Purpose: Function allow VerifyPtrs to call reentrantly
|
|---|
| 1270 | ;"Input: File : file Name or Number to scan
|
|---|
| 1271 | ;" pArray : PASS BY NAME, an OUT PARAMETER. Format:
|
|---|
| 1272 | ;" @pArray@(FileNum,IEN,FieldNum)=ValueOfBadPtr
|
|---|
| 1273 | ;" @pArray@(FileNum,IEN,FieldNum)=ValueOfBadPtr
|
|---|
| 1274 | ;" Verbose: OPTIONAL. If 1, then errors immediately written out.
|
|---|
| 1275 | ;" AutoFix: OPTIONAL. If 1, then bad pointers are deleted.
|
|---|
| 1276 | ;" IENS: OPTIONAL. If fileNum is a sub-file, then must supply
|
|---|
| 1277 | ;" to give location of subfile in parent file.
|
|---|
| 1278 | ;" pTMGIEN: "TMGIEN", or "TMGIEN(1)" etc.
|
|---|
| 1279 | ;"Results: None
|
|---|
| 1280 | ;"NOTICE: right now this MUST first be called from VerifyPtrs because
|
|---|
| 1281 | ;" I have not moved some NEW commandes etc from there to here.
|
|---|
| 1282 | ;" So this function depends on it's variables with global scope.
|
|---|
| 1283 |
|
|---|
| 1284 | set IENS=$get(IENS)
|
|---|
| 1285 | set pTMGIEN=$get(pTMGIEN,"TMGIEN")
|
|---|
| 1286 | set @pTMGIEN=$$ItrInit^TMGITR(fileNum,.Itr,.IENS)
|
|---|
| 1287 | if IENS="" do PrepProgress^TMGITR(.Itr,20,0,pTMGIEN) ;" no bar for subfiles
|
|---|
| 1288 | if @pTMGIEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.@pTMGIEN)'>0)!abort
|
|---|
| 1289 | . set fieldNum=$$ItrAInit^TMGITR($name(@pPtrsOUT@(fileNum)),.Itr2)
|
|---|
| 1290 | . if fieldNum'="" for do quit:(+$$ItrANext^TMGITR(.Itr2,.fieldNum)'>0)!abort
|
|---|
| 1291 | . . if (@pTMGIEN#10=0),$$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 1292 | . . ;"Line below handles subfiles
|
|---|
| 1293 | . . if $data(@pPtrsOUT@(fileNum,fieldNum,"SUBFILE")) do quit
|
|---|
| 1294 | . . . new subFile set subFile=$order(@pPtrsOUT@(fileNum,fieldNum,"SUBFILE",""))
|
|---|
| 1295 | . . . set IENS=IENS_@pTMGIEN_","
|
|---|
| 1296 | . . . do DoVerify(subFile,$name(@pArray@("SUBFILE")),.Verbose,.AutoFix,IENS,$name(@pTMGIEN@(1)))
|
|---|
| 1297 | . . ;"Otherwise, the usual case....
|
|---|
| 1298 | . . set code=$get(PtrsOUT(fileNum,fieldNum,"X GET"))
|
|---|
| 1299 | . . if code="" quit
|
|---|
| 1300 | . . xecute code
|
|---|
| 1301 | . . if TMGVALUE="" quit
|
|---|
| 1302 | . . set TMGVALUE=+TMGVALUE
|
|---|
| 1303 | . . if TMGVALUE'>0 do quit
|
|---|
| 1304 | . . . set @pArray@(fileNum,@pTMGIEN,fieldNum)=TMGVALUE
|
|---|
| 1305 | . . . new setCode set setCode=$get(PtrsOUT(fileNum,fieldNum,"X SET")) quit:(setCode="")
|
|---|
| 1306 | . . . new priorValue set priorValue=TMGVALUE
|
|---|
| 1307 | . . . set TMGVALUE=""
|
|---|
| 1308 | . . . if 'AutoFix quit
|
|---|
| 1309 | . . . xecute setCode
|
|---|
| 1310 | . . . if 'Verbose quit
|
|---|
| 1311 | . . . write !,"File=",fileNum,"; IEN=",@pTMGIEN,"; Field=",fieldNum,"; Bad Pointer value=[",priorValue,"]",!
|
|---|
| 1312 | . . . write " fixed...",!
|
|---|
| 1313 | . . ;"if (fileNum=2)&(TMGVALUE=777) do quit ;"TEMP!!!!
|
|---|
| 1314 | . . ;". set code=$get(PtrsOUT(fileNum,fieldNum,"X SET")) quit:(code="")
|
|---|
| 1315 | . . ;". set TMGVALUE=69
|
|---|
| 1316 | . . ;". xecute code
|
|---|
| 1317 | . . new PtToGref set PtToGref="^"_$get(PtrsOUT(fileNum,fieldNum,"POINTS TO","GREF"))
|
|---|
| 1318 | . . if PtToGref="" do quit
|
|---|
| 1319 | . . . set @pArray@(fileNum,@pTMGIEN,fieldNum)="??No reference for pointed to file??"
|
|---|
| 1320 | . . . if 'Verbose quit
|
|---|
| 1321 | . . . write !,"File=",fileNum,"; IEN=",@pTMGIEN,"; Field=",fieldNum,"; Pointer value=[",TMGVALUE,"] but 'No reference for pointed to file (??)'",!
|
|---|
| 1322 | . . set PtToGref=PtToGref_TMGVALUE_")"
|
|---|
| 1323 | . . if $data(@PtToGref)'>0 do quit
|
|---|
| 1324 | . . . set @pArray@(fileNum,@pTMGIEN,fieldNum)=TMGVALUE
|
|---|
| 1325 | . . . new setCode set setCode=$get(PtrsOUT(fileNum,fieldNum,"X SET")) quit:(setCode="")
|
|---|
| 1326 | . . . new priorValue set priorValue=TMGVALUE
|
|---|
| 1327 | . . . set TMGVALUE=""
|
|---|
| 1328 | . . . if 'AutoFix quit
|
|---|
| 1329 | . . . xecute setCode
|
|---|
| 1330 | . . . if 'Verbose quit
|
|---|
| 1331 | . . . write !,"File=",fileNum,"; IEN=",@pTMGIEN,"; Field=",fieldNum,"; Bad Pointer value=[",priorValue,"]",!
|
|---|
| 1332 | . . . write " fixed...",!
|
|---|
| 1333 | if IENS="" do ProgressDone^TMGITR(.Itr)
|
|---|
| 1334 | quit
|
|---|
| 1335 |
|
|---|
| 1336 |
|
|---|
| 1337 | ASKVFYPT ;"ASK VERIFY POINTERS
|
|---|
| 1338 | ;"Ask user to pick file, then verify pointers for that file.
|
|---|
| 1339 |
|
|---|
| 1340 | write "NOTICE: this function caused corruption of the database from",!
|
|---|
| 1341 | write " deletion of pointers incorrectly. Until this function",!
|
|---|
| 1342 | write " (ASKVFYPT^TMGFMUT) is fixed, it may not be used.",!,!
|
|---|
| 1343 | do PressToCont^TMGUSRIF
|
|---|
| 1344 | goto ASKDone
|
|---|
| 1345 |
|
|---|
| 1346 |
|
|---|
| 1347 | new DIC,X,Y
|
|---|
| 1348 | new FileNum,IEN
|
|---|
| 1349 | new UseDefault set UseDefault=1
|
|---|
| 1350 |
|
|---|
| 1351 | ;"Pick file to dump from
|
|---|
| 1352 | ASK1 set DIC=1
|
|---|
| 1353 | set DIC(0)="AEQM"
|
|---|
| 1354 | set DIC("A")="SELECT FILE TO VERIFY POINTERS IN: "
|
|---|
| 1355 | if UseDefault do ;"leave the redundant do loop, it protects $T, so second do ^DIC isn't called
|
|---|
| 1356 | . do ^DICRW ;" has default value of user's last response
|
|---|
| 1357 | else do ^DIC ;doesn't have default value...
|
|---|
| 1358 | write !
|
|---|
| 1359 | if +Y'>0 write ! goto ASKDone
|
|---|
| 1360 | set FileNum=+Y
|
|---|
| 1361 |
|
|---|
| 1362 | new BadPtrs
|
|---|
| 1363 | new AutoFix,Verbose,%
|
|---|
| 1364 | set %=2
|
|---|
| 1365 | write "View details of scan" do YN^DICN write !
|
|---|
| 1366 | if %=-1 goto ASKDone
|
|---|
| 1367 | set Verbose=(%=1)
|
|---|
| 1368 |
|
|---|
| 1369 | set %=2
|
|---|
| 1370 | write "Auto-delete bad pointers (i.e. 0 value, or pointers to empty records)"
|
|---|
| 1371 | do YN^DICN write !
|
|---|
| 1372 | if %=-1 goto ASKDone
|
|---|
| 1373 | set AutoFix=(%=1)
|
|---|
| 1374 |
|
|---|
| 1375 | do VerifyPtrs(FileNum,"BadPtrs",Verbose,AutoFix)
|
|---|
| 1376 |
|
|---|
| 1377 | if $data(BadPtrs) do
|
|---|
| 1378 | . new % set %=2
|
|---|
| 1379 | . write "View array of bad pointers" do YN^DICN write !
|
|---|
| 1380 | . if %'=1 quit
|
|---|
| 1381 | . do ArrayDump^TMGDEBUG("BadPtrs")
|
|---|
| 1382 | else write "No bad pointers. Great!",!
|
|---|
| 1383 |
|
|---|
| 1384 | do PressToCont^TMGUSRIF
|
|---|
| 1385 |
|
|---|
| 1386 | ASKDone
|
|---|
| 1387 | quit
|
|---|
| 1388 |
|
|---|
| 1389 | GREP(FIELD,S)
|
|---|
| 1390 | ;"The is a stub function, called by a Fileman Function (entry in file .5)
|
|---|
| 1391 | new result
|
|---|
| 1392 | set result="X1="_$get(FIELD)_" X2="_$get(S)_" D0="_$get(D0)_" DCC="_$get(DCC)
|
|---|
| 1393 | merge ^TMG("TMP","KILL","DIQGEY")=DIQGEY
|
|---|
| 1394 | set ^TMG("TMP","KILL","DA")=$get(DA)
|
|---|
| 1395 | set ^TMG("TMP","KILL","DR")=$get(DR)
|
|---|
| 1396 | set ^TMG("TMP","KILL","D0")=$get(D0)
|
|---|
| 1397 | set ^TMG("TMP","KILL","DCC")=$get(DCC)
|
|---|
| 1398 | QUIT result
|
|---|
| 1399 |
|
|---|
| 1400 | GETAPPT(TMGIEN)
|
|---|
| 1401 | QUIT 0
|
|---|
| 1402 |
|
|---|
| 1403 | FMDate(DateStr)
|
|---|
| 1404 | ;"Purpose: convert string to FM date, with extended syntax handling
|
|---|
| 1405 | ;"Results: returns FM date, or -1 if error
|
|---|
| 1406 | new result set result=-1
|
|---|
| 1407 | ;"First try direct conversion
|
|---|
| 1408 | new X,Y
|
|---|
| 1409 | set DateStr=$$TRIM^XLFSTR($get(DateStr))
|
|---|
| 1410 | if DateStr="" goto FMDDone
|
|---|
| 1411 | for quit:(DateStr'[" ") set DateStr=$$Substitute^TMGSTUTL(DateStr," "," ")
|
|---|
| 1412 | if (DateStr'["@")&($length(DateStr," ")>3) do
|
|---|
| 1413 | . set DateStr=$piece(DateStr," ",1,3)_"@"_$piece(DateStr," ",4,99)
|
|---|
| 1414 | for quit:(DateStr'["@ ") set DateStr=$$Substitute^TMGSTUTL(DateStr,"@ ","@")
|
|---|
| 1415 | for quit:(DateStr'[" @") set DateStr=$$Substitute^TMGSTUTL(DateStr," @","@")
|
|---|
| 1416 | set %DT="T",X=DateStr
|
|---|
| 1417 | do ^%DT
|
|---|
| 1418 | set result=Y
|
|---|
| 1419 | FMDDone quit result
|
|---|
