| 1 | TMGDBAPI ;TMG/kst/Database API library ;03/25/06, 5/24,10
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;07/12/05
|
|---|
| 3 |
|
|---|
| 4 | ;"TMG DATABASE API FUNCTIONS
|
|---|
| 5 | ;"Kevin Toppenberg MD
|
|---|
| 6 | ;"GNU General Public License (GPL) applies
|
|---|
| 7 | ;"7-12-2005
|
|---|
| 8 |
|
|---|
| 9 | ;"=======================================================================
|
|---|
| 10 | ;" API -- Public Functions.
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 | ;"$$GetNumField^TMGDBAPI(FileNumber,FieldName) ;Convert Field Name to Field Number
|
|---|
| 13 | ;"$$GetFileNum^TMGDBAPI(FileName) ;Convert File Name to File Number
|
|---|
| 14 | ;"$$SetFileFldNums^TMGDBAPI(File,Field,FileNumber,FieldNumber) ;do both functions above at once.
|
|---|
| 15 | ;"$$GetFName^TMGDBAPI(FileNumber) ;Convert File Number to File Name
|
|---|
| 16 | ;"$$GetFldName^TMGDBAPI(File,FieldNumber) ;Convert Field Number to Field Name
|
|---|
| 17 | ;"$$GetFldList^TMGDBAPI(File,pArray) ;Get list of all fields for a file.
|
|---|
| 18 | ;"FieldExists^TMGDBAPI(FileNumber,Field)
|
|---|
| 19 | ;"SetFieldInfo^TMGDBAPI(File,Field,Array)
|
|---|
| 20 | ;"GetFieldInfo^TMGDBAPI(FileNumber,Field,VarOutP)
|
|---|
| 21 | ;"GetSubFileNumber^TMGDBAPI(FileNumber,Field)
|
|---|
| 22 | ;"$$IsSubFile^TMGDBAPI(File)
|
|---|
| 23 | ;"$$ISWPFLD(FILE,FLD)
|
|---|
| 24 | ;"GetSubFInfo^TMGDBAPI(SubFileNum,Array)
|
|---|
| 25 | ;"GetRecMatch^TMGDBAPI(Data,RecNumIEN)
|
|---|
| 26 | ;"CompRec^TMGDBAPI(FileNumber,dbRec,TestRec)
|
|---|
| 27 | ;"UploadData^TMGDBAPI(DaDIta,RecNumIEN)
|
|---|
| 28 | ;"ValueLookup^TMGDBAPI(Params)
|
|---|
| 29 | ;"FileUtility^TMGDBAPI(Params)
|
|---|
| 30 | ;"AddRec^TMGDBAPI(Data)
|
|---|
| 31 | ;"OverwriteRec^TMGDBAPI(RecNum,Data)
|
|---|
| 32 | ;"SetupFileNum^TMGDBAPI(Data)
|
|---|
| 33 | ;"RecFind^TMGDBAPI(Params)
|
|---|
| 34 | ;"FieldCompare^TMGDBAPI(TestField,dbField,Type)
|
|---|
| 35 | ;"$$dbWrite^TMGDBAPI(FDA,Overwrite,TMGIDE,Flags,ErrArray)
|
|---|
| 36 | ;"$$DelIEN^TMGDBAPI(File,RecNumIEN,ErrArray)
|
|---|
| 37 | ;"$$WriteWP^TMGDBAPI(File,RecNumIEN,Field,Array)
|
|---|
| 38 | ;"$$ReadWP^TMGDBAPI(File,IENS,Field,Array)
|
|---|
| 39 | ;"$$ShowIfError^TMGDBAPI(TMGMsg,PriorErrorFund)
|
|---|
| 40 | ;"$$GetValidInput^TMGDBAPI(File,Field) -- Get a valid input for field in file, asking user
|
|---|
| 41 | ;"$$AskFIENS^TMGDBAPI() -- pick a (sub)file number, then pick a record from that file.
|
|---|
| 42 | ;"$$AskIENS^TMGDBAPI(FileNum) -- return IENS for File (or subfile) number
|
|---|
| 43 | ;"GetRef^TMGDBAPI(file,IENS,field) -- to return the global reference for a given record
|
|---|
| 44 | ;"GetPtrsOUT^TMGDBAPI(FileNum,Info) -- get a list of pointers out from the file.
|
|---|
| 45 | ;"$$TrimFDA^TMGDBAPI(FDA,Quiet) -- Trim FDA of any data already present in the database
|
|---|
| 46 |
|
|---|
| 47 | ;"=======================================================================
|
|---|
| 48 | ;"PRIVATE API FUNCTIONS
|
|---|
| 49 | ;"=======================================================================
|
|---|
| 50 | ;"ConvertFDA(FDA,MarkerArray)
|
|---|
| 51 | ;"ConvertIENS(IENS,MarkerArray)
|
|---|
| 52 | ;"SetupFDA(Data,FDA,IENS,SrchType,MarkNum,MsgArray,Minimal,RecNum)
|
|---|
| 53 | ;"HackWrite(GlobalP,FileNumber,IENS,FieldNum,Data)
|
|---|
| 54 | ;"HandleHacksArray(MsgArray)
|
|---|
| 55 | ;"GetRefArray(FileNum,array)
|
|---|
| 56 |
|
|---|
| 57 | ;"=======================================================================
|
|---|
| 58 | ;"DEPENDENCIES
|
|---|
| 59 | ;"TMGDEBUG
|
|---|
| 60 | ;"TMGUSRIF
|
|---|
| 61 | ;"TMGSTUTL
|
|---|
| 62 | ;"=======================================================================
|
|---|
| 63 |
|
|---|
| 64 | ;"=======================================================================
|
|---|
| 65 |
|
|---|
| 66 | ;"FORMAT OF DATA ARRAY
|
|---|
| 67 |
|
|---|
| 68 | ;" cNull="(none)"
|
|---|
| 69 | ;" cRecNum="RECNUM"
|
|---|
| 70 | ;" cOutput="OUTVAR"
|
|---|
| 71 | ;" cGlobal="GLOBAL"
|
|---|
| 72 | ;" cEntries="Entries"
|
|---|
| 73 | ;" cFlags="FLAGS"
|
|---|
| 74 | ;" cParentIENS="ParentIENS"
|
|---|
| 75 |
|
|---|
| 76 | ;"The Data array will be filed with data. (An example)
|
|---|
| 77 | ;" Data(0,"FILE")="1234.1" <-- "NEW PERSON" Note conversion
|
|---|
| 78 | ;" Data(0,"FILE",cGlobal)="^DIC(200)" <-- note, NOT "^DIC(200,"
|
|---|
| 79 | ;" Data(0,cRecNum)=2 <-- only if user-specified.
|
|---|
| 80 | ;" Data(0,cEntries)=1
|
|---|
| 81 | ;" Data(1,".01")="MyData1"
|
|---|
| 82 | ;" Data(1,".01","MATCHVALUE")="MyData1"
|
|---|
| 83 | ;" Data(1,".01",cFlags)=any flags given (only present if user specified)
|
|---|
| 84 | ;" Data(1,".02")="Bill"
|
|---|
| 85 | ;" Data(1,".02","MATCHVALUE")="John"
|
|---|
| 86 | ;" Data(1,".03")="MyData3"
|
|---|
| 87 | ;" Data(1,".03",cFlags)=any flags given (only present if user specified)
|
|---|
| 88 | ;" Data(1,".04")="MyData4"
|
|---|
| 89 | ;" Data(1,".06")="MyData5" <-- note "NAME" was converted to ".06"
|
|---|
| 90 | ;" Data(1,".07",0,cEntries)=2 <-- "ITEM" converted to ".07"
|
|---|
| 91 | ;" Data(1,".07",0,cParentIENS)=",10033,"
|
|---|
| 92 | ;" Data(1,".07",1,".01")="SubEntry1"
|
|---|
| 93 | ;" Data(1,".07",1,".02")="SE1"
|
|---|
| 94 | ;" Data(1,".07",1,".03")="'Some Info'"
|
|---|
| 95 | ;" Data(1,".07",2,".01")="SubEntry2"
|
|---|
| 96 | ;" Data(1,".07",2,".02")="SE2"
|
|---|
| 97 | ;" Data(1,".07",2,".04",0,cEntries)=1 ;"TEXT converted to .04
|
|---|
| 98 | ;" Data(1,".07",2,".04",0,cParentIENS)=",3,10033,"
|
|---|
| 99 | ;" Data(1,".07",2,".04",1,".01")="JD"
|
|---|
| 100 | ;" Data(1,".07",2,".04",1,".02")="DOE,JOHN"
|
|---|
| 101 |
|
|---|
| 102 | ;"=======================================================================
|
|---|
| 103 | ;"=======================================================================
|
|---|
| 104 |
|
|---|
| 105 | GetNumField(FileNumber,FieldName)
|
|---|
| 106 | ;"PUBLIC FUNCTION
|
|---|
| 107 | ;"Purpose: Given file and the name of a field, this will return the field NUMBER
|
|---|
| 108 | ;"Input: FileNumber. Number of file, i.e. "4.11"
|
|---|
| 109 | ;" FieldName: the name of a field, i.e. "NAME" spelling must exactly match
|
|---|
| 110 | ;"Output: Returns field number, i.e. ".01" or 0 if not found
|
|---|
| 111 |
|
|---|
| 112 | new cOKToCont set cOKToCont=1
|
|---|
| 113 | new cAbort set cAbort=0
|
|---|
| 114 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 115 |
|
|---|
| 116 | new result
|
|---|
| 117 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetNumField^TMGDBAPI")
|
|---|
| 118 |
|
|---|
| 119 | set result=$$FLDNUM^DILFD(FileNumber,FieldName)
|
|---|
| 120 |
|
|---|
| 121 | if result'=0 goto GNMFDone
|
|---|
| 122 |
|
|---|
| 123 | ;"--------------------------
|
|---|
| 124 | ;"The below is a manual method
|
|---|
| 125 |
|
|---|
| 126 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Having difficulty finding field name (? due to security ?). Doing Manual Check.")
|
|---|
| 127 |
|
|---|
| 128 | new FoundField
|
|---|
| 129 | new Index
|
|---|
| 130 | new result set result=cAbort
|
|---|
| 131 | set U=$get(U,"^") ;"Setup up U if doesn't yet exist
|
|---|
| 132 |
|
|---|
| 133 | if $$VFILE^DILFD(FileNumber)=0 do goto GNMFDone
|
|---|
| 134 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, #"_FileNumber_", doesn't exist.")
|
|---|
| 135 |
|
|---|
| 136 | set Index=""
|
|---|
| 137 | GNmLoop set Index=$order(^DD(FileNumber,Index))
|
|---|
| 138 | if Index="" goto GNMFDone
|
|---|
| 139 | if $data(^DD(FileNumber,Index,0))=0 goto GNMFDone
|
|---|
| 140 | set FoundField=$piece(^DD(FileNumber,Index,0),"^",1)
|
|---|
| 141 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Comparing fields: '",FoundField,"' vs. '",FieldName,"'")
|
|---|
| 142 | if FieldName=FoundField do goto GNMFDone
|
|---|
| 143 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Match!")
|
|---|
| 144 | . set result=Index
|
|---|
| 145 | goto GNmLoop
|
|---|
| 146 |
|
|---|
| 147 | GNMFDone
|
|---|
| 148 | if result=cAbort do
|
|---|
| 149 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Unable to convert '",FieldName,"' in file '",FileNumber,"' to a field number. Check for Field name typo")
|
|---|
| 150 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetNumField^TMGDBAPI")
|
|---|
| 151 |
|
|---|
| 152 | quit result
|
|---|
| 153 |
|
|---|
| 154 | SetFileFldNums(File,Field,FileNumber,FieldNumber)
|
|---|
| 155 | ;"Purpose: To provide a generic shell to ensure that File and Field numbers are in place
|
|---|
| 156 | ;"Input: File -- File number or name
|
|---|
| 157 | ;" Field -- field number or name
|
|---|
| 158 | ;" FileNumber -- PASS BY REFERENCE -- an out parameter
|
|---|
| 159 | ;" FieldNum -- PASS BY REFERENCE -- an out parameter
|
|---|
| 160 | ;"Results: cOKToCont(1) if ok, otherwise cAbort(0) if error
|
|---|
| 161 | ;"Output -- FileNumber and FieldNumber are filled in.
|
|---|
| 162 |
|
|---|
| 163 | new cOKToCont set cOKToCont=1
|
|---|
| 164 | new cAbort set cAbort=0
|
|---|
| 165 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 166 |
|
|---|
| 167 | new result set result=cOKToCont
|
|---|
| 168 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SetFileFldNums^TMGDBAPI")
|
|---|
| 169 |
|
|---|
| 170 | set FileNumber=+$get(File)
|
|---|
| 171 | if FileNumber=0 set FileNumber=$$GetFileNum(.File)
|
|---|
| 172 | if FileNumber=0 do goto SFFNDone
|
|---|
| 173 | . set result=cAbort
|
|---|
| 174 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.")
|
|---|
| 175 |
|
|---|
| 176 | set FieldNumber=$get(Field)
|
|---|
| 177 | if FieldNumber=0 set FieldNumber=$$GetNumField(FileNumber,.Field)
|
|---|
| 178 | if FieldNumber=0 do goto SFFNDone
|
|---|
| 179 | . set result=cAbort
|
|---|
| 180 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert field '"_$get(Field)_", to a number.")
|
|---|
| 181 |
|
|---|
| 182 | SFFNDone
|
|---|
| 183 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SetFileFldNums^TMGDBAPI")
|
|---|
| 184 | quit result
|
|---|
| 185 |
|
|---|
| 186 |
|
|---|
| 187 | FieldExists(FileNumber,Field)
|
|---|
| 188 | ;"PUBLIC FUNCTION
|
|---|
| 189 | ;"Purpose: To ensure that a field exists -- even if hidden by security measures
|
|---|
| 190 | ;"Input: FileNumber: File to check
|
|---|
| 191 | ;" Field: the field number (or name) to check
|
|---|
| 192 | ;"Result: 1 if field exists, 0 if doesn't, 2 if exists but is hidden to user
|
|---|
| 193 |
|
|---|
| 194 | new result,FieldNumber
|
|---|
| 195 | if +Field=0 set FieldNumber=$$GetNumField(FileNumber,Field)
|
|---|
| 196 | else set FieldNumber=Field
|
|---|
| 197 |
|
|---|
| 198 | set result=$$VFIELD^DILFD(FileNumber,FieldNumber)
|
|---|
| 199 | if result=1 goto FExsDone
|
|---|
| 200 |
|
|---|
| 201 | ;"Try a low-level data dictionary eval to see if really does exist, but is hidden
|
|---|
| 202 | if $data(^DD(FileNumber,FieldNumber,0))'=0 set result=2
|
|---|
| 203 |
|
|---|
| 204 | FExsDone
|
|---|
| 205 | quit result
|
|---|
| 206 |
|
|---|
| 207 |
|
|---|
| 208 |
|
|---|
| 209 | GetSubFileNumber(FileNumber,Field)
|
|---|
| 210 | ;"PUBLIC FUNCTION
|
|---|
| 211 | ;"Purpose: If FieldNumber is a 'multiple' field, then this function should return 'subfile'
|
|---|
| 212 | ;" number of the sub file.
|
|---|
| 213 | ;"Input:FileNumber-- the file number (or sub file number) that field exists in
|
|---|
| 214 | ;" Field-- the field number (or name) in file to lookup
|
|---|
| 215 | ;"Result: Returns sub file number, or 0 if not found or invalid
|
|---|
| 216 |
|
|---|
| 217 | new cOKToCont set cOKToCont=1
|
|---|
| 218 | new cAbort set cAbort=0
|
|---|
| 219 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 220 |
|
|---|
| 221 | new Info
|
|---|
| 222 | new result set result=cAbort
|
|---|
| 223 | new Output
|
|---|
| 224 |
|
|---|
| 225 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetSubFileNumber^TMGDBAPI")
|
|---|
| 226 |
|
|---|
| 227 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FileNumber=",FileNumber)
|
|---|
| 228 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Field=",Field)
|
|---|
| 229 |
|
|---|
| 230 | ;"First, verify file (or subfile) exists
|
|---|
| 231 | if $$VFILE^DILFD(FileNumber)=0 do goto GSFDone ;"abort
|
|---|
| 232 | . do ShowError^TMGDEBUG(.PriorErrorFound,"File number '"_FileNumber_"' is not valid.")
|
|---|
| 233 |
|
|---|
| 234 | ;"Next, ensure Field exists in file
|
|---|
| 235 | if $$FieldExists(FileNumber,Field)=0 do goto GSFDone ;"abort
|
|---|
| 236 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Field number '"_Field_"' is not valid.")
|
|---|
| 237 |
|
|---|
| 238 | ;"Next, ensure field is a multiple and get field info.
|
|---|
| 239 | do GetFieldInfo(FileNumber,Field,"Output")
|
|---|
| 240 | if $data(Output("MULTIPLE-VALUED"))=0 do goto GSFDone ;"abort
|
|---|
| 241 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Field '"_Field_"' in File '"_FileNumber_"' is not a subfile.")
|
|---|
| 242 |
|
|---|
| 243 | ;"Now actually get subfile number
|
|---|
| 244 | if $data(Output("SPECIFIER"))=0 do goto GSFDone ;"abort
|
|---|
| 245 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to find 'Specifier' (subfile number)")
|
|---|
| 246 | set result=+Output("SPECIFIER")
|
|---|
| 247 |
|
|---|
| 248 | ;"Now actually get subfile number
|
|---|
| 249 | ;"set Info=$get(^DD(FileNumber,Field,0),0)
|
|---|
| 250 | ;"if Info=0 do goto GSFDone
|
|---|
| 251 | ;". do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to get information from data dictionary.")
|
|---|
| 252 | ;"set result=+$piece(Info,"^",2)
|
|---|
| 253 |
|
|---|
| 254 | GSFDone
|
|---|
| 255 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"SubFile number is: ",result)
|
|---|
| 256 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetSubFileNumber^TMGDBAPI")
|
|---|
| 257 | quit result
|
|---|
| 258 |
|
|---|
| 259 | ISWPFLD(FILE,FLD) ;
|
|---|
| 260 | ;"Purpose: return if field FLD is a WP field
|
|---|
| 261 | ;"Input: FILE -- file NUMBER
|
|---|
| 262 | ;" FLD -- field NUMBER
|
|---|
| 263 | ;"Result: 1 if WP field, 0 if not
|
|---|
| 264 | new result set result=0
|
|---|
| 265 | new info
|
|---|
| 266 | set info=$piece($get(^DD(FILE,FLD,0)),"^",2)
|
|---|
| 267 | if +info'=info goto IWPDN
|
|---|
| 268 | new subFile set subFile=+info
|
|---|
| 269 | set info=$piece($get(^DD(subFile,.01,0)),"^",2)
|
|---|
| 270 | set result=(info["W")
|
|---|
| 271 | IWPDN quit result
|
|---|
| 272 |
|
|---|
| 273 | IsSubFile(File)
|
|---|
| 274 | ;"Purpose: to return if file is actually a subfile
|
|---|
| 275 | ;"Input: File -- File name or number
|
|---|
| 276 | ;"Results: Parent file number^Field in Parent File
|
|---|
| 277 | ;" or 0 if not a subfile.
|
|---|
| 278 |
|
|---|
| 279 | new result
|
|---|
| 280 | if +File'=File set File=$$GetFileNum(File)
|
|---|
| 281 | set result=+$get(^DD(File,0,"UP"))
|
|---|
| 282 | if result'>0 goto ISFDone
|
|---|
| 283 |
|
|---|
| 284 | ;"Now find which field this sub file is in its parent
|
|---|
| 285 | new fldInParent set fldInParent=0
|
|---|
| 286 | new field set field=0
|
|---|
| 287 | new done set done=0
|
|---|
| 288 | for set field=$order(^DD(result,field)) quit:(+field'>0)!(done=1) do
|
|---|
| 289 | . new fldInfo set fldInfo=$piece($get(^DD(result,field,0)),"^",2)
|
|---|
| 290 | . if +fldInfo=File set fldInParent=field set done=1
|
|---|
| 291 | if fldInParent>0 set result=result_"^"_fldInParent
|
|---|
| 292 | ISFDone
|
|---|
| 293 | quit result
|
|---|
| 294 |
|
|---|
| 295 |
|
|---|
| 296 | GetSubFInfo(SubFileNum,Array)
|
|---|
| 297 | ;"PUBLIC FUNCTION
|
|---|
| 298 | ;"Purpose: To take a subfile NUMBER, and return information about it.
|
|---|
| 299 | ;"Input: SubFileNum-- the sub file number
|
|---|
| 300 | ;" Array -- PASS BY REFERENCE. An array to receive results.
|
|---|
| 301 | ;" any preexisting data is deleted.
|
|---|
| 302 | ;"Output Array is formated as follows:
|
|---|
| 303 | ;" Array("SUBFILE","NUMBER")=file number of this sub file.
|
|---|
| 304 | ;" Array("SUBFILE","NAME")=file name of this sub file.
|
|---|
| 305 | ;" Array("PARENT","NUMBER")=parent file number
|
|---|
| 306 | ;" Array("PARENT","NAME")=parent file name
|
|---|
| 307 | ;" Array("PARENT","GL")=global reference of parent, in open format<-- only valid if parent isn't also a subfile
|
|---|
| 308 | ;" Array("FIELD IN PARENT","NUMBER")=field number of subfile in parent
|
|---|
| 309 | ;" Array("FIELD IN PARENT","NAME")=filed name of subfile in parent
|
|---|
| 310 | ;" Array("FIELD IN PARENT","LOC")=node and piece where subfile is stored
|
|---|
| 311 | ;" Array("FIELD IN PARENT","CODE")=code giving subfile's attributes.
|
|---|
| 312 | ;"Result: 1 if found info, or 0 if not found or invalid
|
|---|
| 313 |
|
|---|
| 314 | new result set result=0
|
|---|
| 315 | if '$get(SubFileNum) goto GSPDone
|
|---|
| 316 | kill Array
|
|---|
| 317 | set Array("SUBFILE","NUMBER")=SubFileNum
|
|---|
| 318 | set Array("SUBFILE","NAME")=$piece($get(^DD(SubFileNum,0)),"^",1)
|
|---|
| 319 | new parent
|
|---|
| 320 | set parent=+$get(^DD(SubFileNum,0,"UP"))
|
|---|
| 321 | if parent=0 goto GSPDone
|
|---|
| 322 | set Array("PARENT","NUMBER")=parent
|
|---|
| 323 | set Array("PARENT","NAME")=$order(^DD(parent,0,"NM",""))
|
|---|
| 324 | set Array("PARENT","GL")=$get(^DIC(parent,0,"GL"))
|
|---|
| 325 | new i set i=$order(^DD(parent,""))
|
|---|
| 326 | for do quit:(i="")!(result=1) ;"scan all fields for a match
|
|---|
| 327 | . quit:(i="")
|
|---|
| 328 | . new node,num
|
|---|
| 329 | . set node=$get(^DD(parent,i,0))
|
|---|
| 330 | . if +$piece(node,"^",2)=SubFileNum do quit
|
|---|
| 331 | . . set Array("FIELD IN PARENT","NUMBER")=i
|
|---|
| 332 | . . set Array("FIELD IN PARENT","NAME")=$piece(node,"^",1)
|
|---|
| 333 | . . set Array("FIELD IN PARENT","LOC")=$piece(node,"^",4)
|
|---|
| 334 | . . set Array("FIELD IN PARENT","CODE")=$piece(node,"^",2)
|
|---|
| 335 | . . set result=1
|
|---|
| 336 | . set i=$order(^DD(parent,i))
|
|---|
| 337 |
|
|---|
| 338 | GSPDone
|
|---|
| 339 | quit result
|
|---|
| 340 |
|
|---|
| 341 |
|
|---|
| 342 |
|
|---|
| 343 | GetFieldInfo(FileNumber,Field,VarOutP,InfoS)
|
|---|
| 344 | ;"PUBLIC FUNCTION
|
|---|
| 345 | ;"Purpose: To get Field info,
|
|---|
| 346 | ;"Input: FileNumber: File or subfile number
|
|---|
| 347 | ;" Field: Field name or number
|
|---|
| 348 | ;" VarOutP -- the NAME of the variable to put result into.
|
|---|
| 349 | ;" InfoS -- [OPTIONAL] -- additional attributes of field info to be looked up
|
|---|
| 350 | ;" (as allowed by FIELD^DID). Multiple items should be
|
|---|
| 351 | ;" separated by a semicolon (';')
|
|---|
| 352 | ;" e.g. "TITLE;LABEL;POINTER"
|
|---|
| 353 | ;"Output: Data is put into VarOutP (any thing in VarOutP is erased first
|
|---|
| 354 | ;" i.e. @VarOutP@("MULTIPLE-VALUED")=X
|
|---|
| 355 | ;" i.e. @VarOutP@("SPECIFIER")=Y
|
|---|
| 356 | ;" i.e. @VarOutP@("TYPE")=Z
|
|---|
| 357 | ;" i.e. @VarOutP@("StoreLoc")="0;1" <-- not from fileman output (i.e. extra info)
|
|---|
| 358 | ;" (if additional attributes were specified, they will also be in array)
|
|---|
| 359 | ;"Result: none
|
|---|
| 360 |
|
|---|
| 361 | kill @VarOutP ;"erase any old information
|
|---|
| 362 |
|
|---|
| 363 | if +Field=0 set Field=$$GetNumField(FileNumber,Field)
|
|---|
| 364 | set @VarOutP@("StoreLoc")=$piece($get(^DD(FileNumber,Field,0)),"^",4)
|
|---|
| 365 |
|
|---|
| 366 | new Attribs set Attribs="MULTIPLE-VALUED;SPECIFIER;TYPE"
|
|---|
| 367 | if $data(InfoS) set Attribs=Attribs_";"_InfoS
|
|---|
| 368 | ;"Next, check if field is a multiple and get field info.
|
|---|
| 369 | do FIELD^DID(FileNumber,Field,,Attribs,VarOutP,"TMGMsg")
|
|---|
| 370 | if $data(TMGMsg) do
|
|---|
| 371 | . if $data(TMGMsg("DIERR"))'=0 do quit
|
|---|
| 372 | . . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound)
|
|---|
| 373 |
|
|---|
| 374 | GFIDone
|
|---|
| 375 | quit
|
|---|
| 376 |
|
|---|
| 377 |
|
|---|
| 378 |
|
|---|
| 379 | HackWrite(GlobalP,FileNumber,IENS,FieldNum,Data)
|
|---|
| 380 | ;"PUBLIC FUNCTION
|
|---|
| 381 | ;"Purpse: To force data into a field -- using low level 'hack' method
|
|---|
| 382 | ;"Input: GlobalP -- the NAME of the global to put this into, i.e. "^VA(200,"
|
|---|
| 383 | ;" FileNumber- the file number
|
|---|
| 384 | ;" IENS -- the standard API IENS
|
|---|
| 385 | ;" FieldNum the field to put this into
|
|---|
| 386 | ;" Data -- the value to put in
|
|---|
| 387 | ;"Note: This can be used to put a value of "@" into a field
|
|---|
| 388 | ;"Result: 1 if ok to continue, 0=abort
|
|---|
| 389 | ;"!!!NOTICE: This is a very low level means of accessing the database.
|
|---|
| 390 | ;" The built in data verifiers, indexers etc etc will not be made aware of
|
|---|
| 391 | ;" changes made to the database through this method. USE ONLY WITH CAUTION.
|
|---|
| 392 |
|
|---|
| 393 | new cOKToCont set cOKToCont=1
|
|---|
| 394 | new cAbort set cAbort=0
|
|---|
| 395 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 396 |
|
|---|
| 397 | new result set result=cAbort
|
|---|
| 398 |
|
|---|
| 399 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"HackWrite^TMGDBAPI")
|
|---|
| 400 |
|
|---|
| 401 | if '$data(GlobalP) goto HWDone
|
|---|
| 402 | if '$data(FileNumber) goto HWDone
|
|---|
| 403 | if '$data(IENS) goto HWDone
|
|---|
| 404 | if '$data(FieldNum) goto HWDone
|
|---|
| 405 | if '$data(Data) goto HWDone
|
|---|
| 406 |
|
|---|
| 407 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"GlobalP: ",GlobalP)
|
|---|
| 408 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"File:",FileNumber)
|
|---|
| 409 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"IENS:",IENS)
|
|---|
| 410 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldNum:",FieldNum)
|
|---|
| 411 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Data:",Data)
|
|---|
| 412 |
|
|---|
| 413 | new DDInfo
|
|---|
| 414 | new FieldInfo
|
|---|
| 415 | new Index,Part
|
|---|
| 416 | new OldData
|
|---|
| 417 | new RecNum
|
|---|
| 418 |
|
|---|
| 419 | ;"Get info from data dictionary r.e. where actual fields are stored in files.
|
|---|
| 420 | set DDInfo=$get(^DD(FileNumber,FieldNum,0))
|
|---|
| 421 | if '$data(DDInfo) goto HWDone
|
|---|
| 422 | set FieldInfo=$piece(DDInfo,"^",4)
|
|---|
| 423 | if '$data(FieldInfo),(FieldInfo="") goto HWDone
|
|---|
| 424 | set Index=$piece(FieldInfo,";",1)
|
|---|
| 425 | set Part=$piece(FieldInfo,";",2)
|
|---|
| 426 |
|
|---|
| 427 | ;"Convert global form of ^VA(200, into ^VA(200)
|
|---|
| 428 | new Len
|
|---|
| 429 | set Len=$length(GlobalP)
|
|---|
| 430 | if $extract(GlobalP,Len)="," do
|
|---|
| 431 | . set $extract(GlobalP,Len)=")"
|
|---|
| 432 |
|
|---|
| 433 | set RecNum=$piece(IENS,",",1)
|
|---|
| 434 | if $piece(IENS,",",2)'="" do goto HWDone
|
|---|
| 435 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Hack writing to subfiles not supported")
|
|---|
| 436 | if $data(@GlobalP@(RecNum,Index))=0 goto HWDone
|
|---|
| 437 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"I think the correct data place is: ",GlobalP,"(",RecNum,",",Index,") at piece: ",Part)
|
|---|
| 438 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"That line is now: ",@GlobalP@(RecNum,Index))
|
|---|
| 439 | set OldData=$piece(@GlobalP@(RecNum,Index),"^",Part)
|
|---|
| 440 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"And that data item is now: '",OldData,"'")
|
|---|
| 441 | if Data'=OldData do
|
|---|
| 442 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Performing hack write")
|
|---|
| 443 | . set $piece(@GlobalP@(RecNum,Index),"^",Part)=Data
|
|---|
| 444 | . ;"Give Message
|
|---|
| 445 | . new Text
|
|---|
| 446 | . set Text(0)="<!> Caution"
|
|---|
| 447 | . set Text(1)="Yikes!"
|
|---|
| 448 | . set Text(2)=" "
|
|---|
| 449 | . set Text(3)="We just bypassed all safety measures, "
|
|---|
| 450 | . set Text(4)="and wrote directly to the database."
|
|---|
| 451 | . set Text(5)="Make sure you know what you are doing!!"
|
|---|
| 452 | . set Text(6)=" "
|
|---|
| 453 | . set Text(7)="File: "_FileNumber
|
|---|
| 454 | . set Text(8)="Field: "_FieldNum
|
|---|
| 455 | . set Text(9)="Prior value: '"_OldData_"'"
|
|---|
| 456 | . set Text(10)="New value: '"_Data_"'"
|
|---|
| 457 | . set Text(11)=" "
|
|---|
| 458 | . set Text(12)="(This was caused by using Flags='H' in"
|
|---|
| 459 | . set Text(13)="the XML script.)"
|
|---|
| 460 | . do PopupArray^TMGUSRIF(5,45,.Text)
|
|---|
| 461 | else do
|
|---|
| 462 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"No need for hackwrite... the data is already what we want.")
|
|---|
| 463 |
|
|---|
| 464 | HWDone
|
|---|
| 465 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"HackWrite^TMGDBAPI")
|
|---|
| 466 | quit
|
|---|
| 467 |
|
|---|
| 468 |
|
|---|
| 469 | HandleHacksArray(MsgArray)
|
|---|
| 470 | ;"PUBLIC FUNCTION
|
|---|
| 471 | ;"Purpose: To cycle through an array of hackwrites and process each one.
|
|---|
| 472 | ;"Input: HacksArray. Best if passed by reference
|
|---|
| 473 | ;" Expected format of array:
|
|---|
| 474 | ;" MsgArray(cHack,0,cEntries)=Number of Entries
|
|---|
| 475 | ;" MsgArray(cHack,n) = Global;FileNumber;IENS;FieldNum;Data
|
|---|
| 476 | ;" MsgArray(cHack,n,cFlags)=User specified Flags for field.
|
|---|
| 477 | ;"Output: database is changed
|
|---|
| 478 | ;"Result: 1 if ok to continue, 0=abort
|
|---|
| 479 | ;"!!!NOTICE: This is a very low level means of accessing the database.
|
|---|
| 480 | ;" The built in data verifiers, indexers etc etc will not be made aware of
|
|---|
| 481 | ;" changes made to the database through this method. USE ONLY WITH CAUTION.
|
|---|
| 482 |
|
|---|
| 483 | new cOKToCont set cOKToCont=1
|
|---|
| 484 | new cAbort set cAbort=0
|
|---|
| 485 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 486 | new cHack set cHack="H"
|
|---|
| 487 | new cEntries set cEntries="Entries"
|
|---|
| 488 |
|
|---|
| 489 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"HandleHacksArray^TMGDBAPI")
|
|---|
| 490 |
|
|---|
| 491 | new result set result=cOKToCont
|
|---|
| 492 | new index set index=1
|
|---|
| 493 | new GlobalP,FileNum,IENS,FieldNum,Data
|
|---|
| 494 | new s
|
|---|
| 495 |
|
|---|
| 496 | for index=1:1:$get(MsgArray(cHack,0,cEntries)) do quit:(s="")!(result=cAbort)
|
|---|
| 497 | . set s=$get(MsgArray(cHack,index)) if s="" quit
|
|---|
| 498 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Processing: ",s)
|
|---|
| 499 | . set GlobalP=$piece(s,";",1)
|
|---|
| 500 | . set FileNum=$piece(s,";",2)
|
|---|
| 501 | . set IENS=$piece(s,";",3)
|
|---|
| 502 | . set FieldNum=$piece(s,";",4)
|
|---|
| 503 | . set Data=$piece(s,";",5)
|
|---|
| 504 | . set result=$$HackWrite(GlobalP,FileNum,IENS,FieldNum,Data)
|
|---|
| 505 |
|
|---|
| 506 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"HandleHacksArray^TMGDBAPI")
|
|---|
| 507 | quit result
|
|---|
| 508 |
|
|---|
| 509 |
|
|---|
| 510 | GetRecMatch(Data,RecNumIEN)
|
|---|
| 511 | ;"PUBLIC FUNCTION
|
|---|
| 512 | ;"Purpose: Take Data array from DoUpload, and search in database
|
|---|
| 513 | ;" for a prior matching record
|
|---|
| 514 | ;"Input: Data - Data array will contain all the information that is to be uploaded
|
|---|
| 515 | ;" Fields that should be specifically matched will have "MATCHTHIS" fields.
|
|---|
| 516 | ;" A field may have a "MATCHTHIS" node meaning that the value
|
|---|
| 517 | ;" specified should be searched for.
|
|---|
| 518 | ;" Or, rarely, one may want to specifically search for a different
|
|---|
| 519 | ;" search value. This is stored in a "MATCHVALUE" node. This
|
|---|
| 520 | ;" node is ignored if "MATCHTHIS" node is present.
|
|---|
| 521 | ;" The .01 field always is used for searching. If not present, then
|
|---|
| 522 | ;" a "MATCHTHIS" node is assumed.
|
|---|
| 523 | ;" Example array:
|
|---|
| 524 | ;" Data(0,"FILE")="1234.1" <-- "NEW PERSON" Note conversion
|
|---|
| 525 | ;" Data(1,".01")="BILL"
|
|---|
| 526 | ;" Data(1,".01","MATCHVALUE")="JOHN" <-- optional search value
|
|---|
| 527 | ;" Data(1,".01","MATCHTHIS")=1
|
|---|
| 528 | ;" Data(1,".02")="Sue"
|
|---|
| 529 | ;" Data(1,".03")="MyData3"
|
|---|
| 530 | ;" Data(1,".03",cFlags)=any flags given (only present if user specified)
|
|---|
| 531 | ;" RecNumIEN -- MUST PASS BY REFERENCE. An OUT parameter to receive results
|
|---|
| 532 | ;"Output: Returns answer in RecNumIEN (record number in file) if found, or 0 otherwise
|
|---|
| 533 | ;"Result: 1=OKToContinue, 0=Abort
|
|---|
| 534 | ;"Note:
|
|---|
| 535 | ;" * Data in Multiple fields are NOT used for matching.
|
|---|
| 536 | ;" * I am not going to support matching for subrecords (i.e. SubEntry stuff above)
|
|---|
| 537 | ;" * If data passed is a subset of a larger data group (i.e. when this function
|
|---|
| 538 | ;" is called recursively to handle a subfile), then an entry will be placed
|
|---|
| 539 | ;" in the Data(0,cParentIENS) that will specify the RecNumIEN of the parent record
|
|---|
| 540 | ;" holding this subfile.
|
|---|
| 541 |
|
|---|
| 542 | new cOKToCont set cOKToCont=1
|
|---|
| 543 | new cAbort set cAbort=0
|
|---|
| 544 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 545 | new cParentIENS set cParentIENS="ParentIENS"
|
|---|
| 546 |
|
|---|
| 547 | new FileNumber,FieldNum
|
|---|
| 548 | set RecNumIEN=0
|
|---|
| 549 | new IENS,Fields,Flags
|
|---|
| 550 | new MatchValue set MatchValue=""
|
|---|
| 551 | new FieldMatch set FieldMatch=""
|
|---|
| 552 | new ScreenCode
|
|---|
| 553 | new Matches,NumMatches
|
|---|
| 554 | new TMGMsg
|
|---|
| 555 | new result set result=cOKToCont
|
|---|
| 556 | new index
|
|---|
| 557 | new SlimData ;"Will hold just those fields that should be matched against
|
|---|
| 558 | new OneMatch
|
|---|
| 559 |
|
|---|
| 560 | set IENS=$get(Data(0,cParentIENS))
|
|---|
| 561 | if IENS'="" if $extract(IENS,1)'="," do
|
|---|
| 562 | . set IENS=","_IENS
|
|---|
| 563 |
|
|---|
| 564 | set Fields="@"
|
|---|
| 565 | ;"Setup specifier to tell which fields to return info on
|
|---|
| 566 | new done set done=0
|
|---|
| 567 | set index=0
|
|---|
| 568 | for set index=$order(Data(index)) quit:(index="")!done do
|
|---|
| 569 | . set FieldNum=""
|
|---|
| 570 | . for set FieldNum=$order(Data(index,FieldNum)) quit:(+FieldNum=0) do
|
|---|
| 571 | . . if $get(Data(index,FieldNum,"MATCHTHIS"))=1 do
|
|---|
| 572 | . . . set FieldMatch=$get(Data(index,FieldNum))
|
|---|
| 573 | . . else set FieldMatch=$get(Data(index,FieldNum,"MATCHVALUE"))
|
|---|
| 574 | . . if FieldNum=".01" do
|
|---|
| 575 | . . . if FieldMatch="" set FieldMatch=$get(Data(index,.01))
|
|---|
| 576 | . . . set MatchValue=FieldMatch
|
|---|
| 577 | . . if FieldMatch'="" do
|
|---|
| 578 | . . . set Fields=Fields_";"_FieldNum
|
|---|
| 579 | . . . set SlimData(FieldNum)=FieldMatch
|
|---|
| 580 | . . . set FieldMatch=""
|
|---|
| 581 | . set done=1 ;"Force handling only 1 entry (i.e. #1), then quit after first cycle.
|
|---|
| 582 |
|
|---|
| 583 | set FileNumber=$get(Data(0,"FILE"))
|
|---|
| 584 | set ScreenCode=""
|
|---|
| 585 | set Flags=""
|
|---|
| 586 |
|
|---|
| 587 | ;"======================================================
|
|---|
| 588 | ;"Call FIND^DIC
|
|---|
| 589 | ;"======================================================
|
|---|
| 590 | ;"Params:
|
|---|
| 591 | ;"FILE,IENS,FIELDS,FLAGS,VALUE,NUMBER,INDEXES,SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOTS
|
|---|
| 592 | do FIND^DIC(FileNumber,$get(IENS),Fields,Flags,MatchValue,"*",,ScreenCode,,"Matches","TMGMsg")
|
|---|
| 593 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"TMGDBAPI::FIND^DIC")
|
|---|
| 594 | ;"======================================================
|
|---|
| 595 | ;"======================================================
|
|---|
| 596 |
|
|---|
| 597 | if $data(TMGMsg) do
|
|---|
| 598 | . if $data(TMGMsg("DIERR"))'=0 do quit
|
|---|
| 599 | . . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound)
|
|---|
| 600 | . . set result=cAbort
|
|---|
| 601 | if result=cAbort goto GRMQuit
|
|---|
| 602 |
|
|---|
| 603 | if $data(Matches("DILIST"))=0 goto GRMQuit ;"keep RecNumIEN default of 0
|
|---|
| 604 | set NumMatches=$piece(Matches("DILIST",0),"^",1)
|
|---|
| 605 | if NumMatches=0 goto GRMQuit ;"keep RecNumIEN default of 0
|
|---|
| 606 |
|
|---|
| 607 | for index=1:1:NumMatches do quit:RecNumIEN'=0 ;"Note: FIRST match returned.
|
|---|
| 608 | . kill OneMatch
|
|---|
| 609 | . merge OneMatch=Matches("DILIST","ID",index)
|
|---|
| 610 | . if $$CompRec(FileNumber,.OneMatch,.SlimData) set RecNumIEN=Matches("DILIST",2,index)
|
|---|
| 611 |
|
|---|
| 612 | GRMQuit
|
|---|
| 613 | quit result
|
|---|
| 614 |
|
|---|
| 615 |
|
|---|
| 616 | CompRec(FileNumber,dbRec,TestRec)
|
|---|
| 617 | ;"PUBLIC FUNCTION
|
|---|
| 618 | ;"Purpose: To compare data from the database against a test match
|
|---|
| 619 | ;"Input: FileNumber: the file data is from
|
|---|
| 620 | ;" dbRec, an array of data from the database in the following format
|
|---|
| 621 | ;" dbRec(.01)="JOHNS,BILL"
|
|---|
| 622 | ;" dbRec(.02)="MALE"
|
|---|
| 623 | ;" dbRec(.03)="01/20/1957"
|
|---|
| 624 | ;" dbRec(.07)="(123) 555-1212"
|
|---|
| 625 | ;" TestRec, an array of data to test for match with, in same format
|
|---|
| 626 | ;" as above. Note: there may well be less entries in this array
|
|---|
| 627 | ;" than in the dbRec
|
|---|
| 628 | ;" TestRec(.01)="JOHNS,BILL"
|
|---|
| 629 | ;" TestRec(.03)="01/20/1957"
|
|---|
| 630 | ;"Output: 1 if all values in TestRec=dbRec. 0=conflict
|
|---|
| 631 | ;" Note: values in dbRec that don't have a corresponding entry in TestRec
|
|---|
| 632 | ;" are ignored.
|
|---|
| 633 |
|
|---|
| 634 | new cOKToCont set cOKToCont=1
|
|---|
| 635 | new cAbort set cAbort=0
|
|---|
| 636 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 637 |
|
|---|
| 638 | new result set result=cOKToCont
|
|---|
| 639 | new index set index=""
|
|---|
| 640 | new FieldType,TMGFDA,TMGMsg
|
|---|
| 641 | new dbIDT,testIDT ;" IDT = internal form of date/time
|
|---|
| 642 |
|
|---|
| 643 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"CompRec^TMGDBAPI")
|
|---|
| 644 |
|
|---|
| 645 | if TMGDEBUG do
|
|---|
| 646 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is records to be compared")
|
|---|
| 647 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"dbRec:")
|
|---|
| 648 | . do ArrayDump^TMGDEBUG("dbRec") ;"zwr dbRec(*)
|
|---|
| 649 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"TestRec:")
|
|---|
| 650 | . do ArrayDump^TMGDEBUG("TestRec") ;"zwr TestRec(*)
|
|---|
| 651 |
|
|---|
| 652 | CRLoop
|
|---|
| 653 | set index=$order(TestRec(index))
|
|---|
| 654 | if index="" goto CRDone
|
|---|
| 655 | if $data(dbRec(index))=0 goto CRLoop
|
|---|
| 656 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Comparing field ",index)
|
|---|
| 657 | kill TMGFDA,TMGMsg
|
|---|
| 658 | do FIELD^DID(FileNumber,index,,"TYPE","TMGFDA","TMGMsg")
|
|---|
| 659 | if $get(TMGFDA("TYPE"))="DATE/TIME" do goto CRDone:'result
|
|---|
| 660 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Doing special date comparison")
|
|---|
| 661 | . set X=TestRec(index)
|
|---|
| 662 | . do ^%DT ;"convert date/time into internal format
|
|---|
| 663 | . set testIDT=Y
|
|---|
| 664 | . set X=dbRec(index)
|
|---|
| 665 | . do ^%DT ;"convert date/time into internal format
|
|---|
| 666 | . set dbIDT=Y
|
|---|
| 667 | . if testIDT'=dbIDT do
|
|---|
| 668 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Dates not equal: ",TestRec(index)," vs, ",dbRec(index))
|
|---|
| 669 | . . set result=cAbort
|
|---|
| 670 | else if TestRec(index)'=dbRec(index) do goto CRDone ;"Note: simple '=' compare
|
|---|
| 671 | . set result=cAbort
|
|---|
| 672 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Fields are equal")
|
|---|
| 673 | goto CRLoop
|
|---|
| 674 | CRDone
|
|---|
| 675 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Leaving CompRec. Result=",result," (0 if conflict)")
|
|---|
| 676 |
|
|---|
| 677 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"CompRec^TMGDBAPI")
|
|---|
| 678 | quit result
|
|---|
| 679 |
|
|---|
| 680 |
|
|---|
| 681 | UploadData(Data,RecNumIEN)
|
|---|
| 682 | ;"PUBLIC FUNCTION
|
|---|
| 683 | ;"Purpose: Do actual upload of Data, given in specific format
|
|---|
| 684 | ;"Note: This function may be called recursively by subfiles
|
|---|
| 685 | ;"Input: Data -- data in format show at TOP OF THIS FILE
|
|---|
| 686 | ;" Note: If this function is being passed recursively, then the data
|
|---|
| 687 | ;" passed is probably just a subpart that corresponds to the subfile
|
|---|
| 688 | ;" RecNumIEN -- OPTIONAL pameter. May be used to specify the
|
|---|
| 689 | ;" record to force data into. If passed by reference, then
|
|---|
| 690 | ;" record number (IEN) where data was placed is passed back.
|
|---|
| 691 | ;" Use of this parameter only makes sense when filing the highest
|
|---|
| 692 | ;" level file. (When filing subfiles recursively, then the parent
|
|---|
| 693 | ;" record number is stored in (0,cParentIENS)=",10033," e.g.)
|
|---|
| 694 | ;"Output: Information will be put into global database, based on
|
|---|
| 695 | ;" entries in Data.
|
|---|
| 696 | ;" Record number (IEN) of record will be put into RecNumIEN (or 0 if error)
|
|---|
| 697 | ;"Result: Returns success 1=OK to continue. 0=Abort
|
|---|
| 698 |
|
|---|
| 699 | new cOKToCont set cOKToCont=1
|
|---|
| 700 | new cAbort set cAbort=0
|
|---|
| 701 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 702 | new cEntries set cEntries="Entries"
|
|---|
| 703 |
|
|---|
| 704 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"UploadData^TMGDBAPI")
|
|---|
| 705 |
|
|---|
| 706 | new result set result=cOKToCont
|
|---|
| 707 | new NumEntries
|
|---|
| 708 | new index
|
|---|
| 709 |
|
|---|
| 710 | set RecNumIEN=$get(RecNumIEN,0) ;"See if user-specified IEN was given.
|
|---|
| 711 |
|
|---|
| 712 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"RecNumIEN=",RecNumIEN)
|
|---|
| 713 |
|
|---|
| 714 | if RecNumIEN'=0 do goto UDDone:(result=cAbort)
|
|---|
| 715 | . new Params,MyOutVar
|
|---|
| 716 | . set Params("FILE")=$get(Data(0,"FILE"))
|
|---|
| 717 | . set Params(cRecNum)=RecNumIEN
|
|---|
| 718 | . set Params(cField)=".01"
|
|---|
| 719 | . set Params(cOutput)="MyOutVar"
|
|---|
| 720 | . set result=$$ValueLookup(.Params) ;"result=0 (cAbort) if unsuccessful lookup
|
|---|
| 721 | . if result=cAbort do
|
|---|
| 722 | . . if $data(PriorErrorFound)=0 new PriorErrorFound
|
|---|
| 723 | . . new s set s="Unable to overwrite data into record#"_RecNumIEN_" because that record does not already exist.\n"
|
|---|
| 724 | . . set s=s_"Will try to put data into a new record, which may not be record#"_RecNumIEN
|
|---|
| 725 | . . do ShowError^TMGDEBUG(.PriorErrorFound,s)
|
|---|
| 726 | . . set result=cOKToCont
|
|---|
| 727 | . . set PriorErrorFound=0 ;"clear errors and continue program.
|
|---|
| 728 | . . set RecNumIEN=0
|
|---|
| 729 |
|
|---|
| 730 | set NumEntries=$get(Data(0,cEntries))
|
|---|
| 731 | for index=1:1:NumEntries do quit:(result=cAbort)
|
|---|
| 732 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Starting loop to process all uploadData entries. Entry=",index)
|
|---|
| 733 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"RecNumIEN=",RecNumIEN)
|
|---|
| 734 | . new tData ;"Create a tData array that has only 1 entry in it.
|
|---|
| 735 | . merge tData(0)=Data(0)
|
|---|
| 736 | . set tData(0,cEntries)=1
|
|---|
| 737 | . merge tData(1)=Data(index)
|
|---|
| 738 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"This is entry to process")
|
|---|
| 739 | . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("tData")
|
|---|
| 740 | . if RecNumIEN=0 set result=$$GetRecMatch(.tData,.RecNumIEN) ;"if no prior record, returns 0
|
|---|
| 741 | . if result=cAbort quit ;//kt added 1/6/05
|
|---|
| 742 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Using RecNumIEN=",RecNumIEN)
|
|---|
| 743 | . ;
|
|---|
| 744 | . if RecNumIEN=0 do quit:(result=cAbort)
|
|---|
| 745 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"calling AddRec")
|
|---|
| 746 | . . new AddRecNum
|
|---|
| 747 | . . set AddRecNum=$$AddRec(.tData)
|
|---|
| 748 | . . if AddRecNum=0 do quit
|
|---|
| 749 | . . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error adding a record.")
|
|---|
| 750 | . . . set result=cAbort
|
|---|
| 751 | . else do quit:(result=cAbort)
|
|---|
| 752 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"calling Overwriterec")
|
|---|
| 753 | . . set result=$$OverwriteRec(RecNumIEN,.tData)
|
|---|
| 754 | . . set RecNumIEN=0 ;"We won't to file any more into that record num, force search next cycle.
|
|---|
| 755 | . . if result=cAbort do quit
|
|---|
| 756 | . . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error modifying an existing record.")
|
|---|
| 757 |
|
|---|
| 758 | UDDone
|
|---|
| 759 | ;"if (result'=cAbort) set result=(RecNumIEN>0)
|
|---|
| 760 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Result = ",result)
|
|---|
| 761 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"UploadData^TMGDBAPI")
|
|---|
| 762 | quit result
|
|---|
| 763 |
|
|---|
| 764 |
|
|---|
| 765 |
|
|---|
| 766 | ValueLookup(Params)
|
|---|
| 767 | ;"PUBLIC FUNCTION
|
|---|
| 768 | ;"Purpose: To look for a value of a given value in a given record in given file.
|
|---|
| 769 | ;"Input: Params -- an array loaded with expected parameters. I.e.:
|
|---|
| 770 | ;" Params("FILE")="NEW PERSON" in our example
|
|---|
| 771 | ;" Params(cRecNum)="1" in example
|
|---|
| 772 | ;" Params(cField)=".01" in our example (could be Name of field)
|
|---|
| 773 | ;" Params(cOutput)="MyVar"
|
|---|
| 774 | ;"Output: MyVar is loaded with data, i.e.:
|
|---|
| 775 | ;" MyVar("FILE")=200
|
|---|
| 776 | ;" MyVar(cGlobal)="^VA(200)"
|
|---|
| 777 | ;" MyVar(cGlobal,cOpen)="^VA(200,"
|
|---|
| 778 | ;" MyVar(cRecNum)=1
|
|---|
| 779 | ;" MyVar(cField)=.01
|
|---|
| 780 | ;" MyVar(cValue)=xxx <-- the looked-up value
|
|---|
| 781 | ;"Returns: If should continue execution: 1=OK to continue. 0=unsuccessful lookup
|
|---|
| 782 | ;"Note: I am getting values by directly looking into database, rather than use
|
|---|
| 783 | ;" the usual lookup commands. I am doing this so that there will be no
|
|---|
| 784 | ;" 'hidden' data, based on security etc.
|
|---|
| 785 | ;" **I need to check, but this probably means that the data returned will be
|
|---|
| 786 | ;" in INTERNAL FILEMAN FORMAT (i.e. time values are encoded etc.)
|
|---|
| 787 |
|
|---|
| 788 | new cOKToCont set cOKToCont=1
|
|---|
| 789 | new cAbort set cAbort=0
|
|---|
| 790 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 791 | new cField set cField="FIELD" ;"Field"
|
|---|
| 792 | new cNull set cNull="(none)"
|
|---|
| 793 | new cRecNum set cRecNum="RECNUM" ;"RecNum
|
|---|
| 794 | new cOutput set cOutput="OUTVAR" ;"OutVar"
|
|---|
| 795 | new cGlobal set cGlobal="GLOBAL"
|
|---|
| 796 | new cValueLookup set cValueLookup="LOOKUPFIELDVALUE" ;"LookupFieldValue"
|
|---|
| 797 | new cOpen set cOpen="OPEN"
|
|---|
| 798 |
|
|---|
| 799 |
|
|---|
| 800 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ValueLookup^TMGDBAPI")
|
|---|
| 801 | new result set result=cAbort
|
|---|
| 802 |
|
|---|
| 803 | new Data
|
|---|
| 804 | new DDInfo
|
|---|
| 805 | new FieldInfo
|
|---|
| 806 | new Index,Part
|
|---|
| 807 |
|
|---|
| 808 | new Field set Field=$get(Params(cField),cNull)
|
|---|
| 809 | new RecNum set RecNum=$get(Params(cRecNum),cNull)
|
|---|
| 810 | new OutVarP set OutVarP=$get(Params(cOutput),cNull)
|
|---|
| 811 | if (RecNum=cNull),(OutVarP=cNull) goto DVLUDone
|
|---|
| 812 | kill @OutVarP ;"--ensure old variables in output variable are removed.
|
|---|
| 813 |
|
|---|
| 814 | set Data(0,"FILE")=$get(Params("FILE"))
|
|---|
| 815 | set result=$$SetupFileNum(.Data)
|
|---|
| 816 | if result=cAbort goto DVLUDone
|
|---|
| 817 | new FileNum set FileNum=$get(Data(0,"FILE"),cNull)
|
|---|
| 818 | new GlobalP set GlobalP=$get(Data(0,"FILE",cGlobal),cNull)
|
|---|
| 819 | if (FileNum=cNull),(GlobalP=cNull) goto DVLUDone
|
|---|
| 820 | new FieldNum set FieldNum=$$GetNumField(FileNum,Field)
|
|---|
| 821 | if FieldNum=0 goto DVLUDone
|
|---|
| 822 |
|
|---|
| 823 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"GlobalP: ",GlobalP)
|
|---|
| 824 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"File: ",FileNum)
|
|---|
| 825 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Rec#: ",RecNum)
|
|---|
| 826 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldNum: ",FieldNum)
|
|---|
| 827 |
|
|---|
| 828 | ;"Get info from data dictionary r.e. where actual fields are stored in files.
|
|---|
| 829 | set DDInfo=$get(^DD(FileNum,FieldNum,0))
|
|---|
| 830 | if $data(DDInfo)=0 goto HWDone
|
|---|
| 831 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"DDInfo='",DDInfo,"', $data(DDInfo)=",$data(DDinfo))
|
|---|
| 832 | set FieldInfo=$piece(DDInfo,"^",4)
|
|---|
| 833 | if '$data(FieldInfo),(FieldInfo="") goto DVLUDone
|
|---|
| 834 | set Index=$piece(FieldInfo,";",1)
|
|---|
| 835 | set Part=$piece(FieldInfo,";",2)
|
|---|
| 836 |
|
|---|
| 837 | if $data(@GlobalP@(RecNum,Index))=0 goto DVLUDone
|
|---|
| 838 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"I think the correct data place is: ",GlobalP,"(",RecNum,",",Index,") at piece: ",Part)
|
|---|
| 839 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"That line is now: ",@GlobalP@(RecNum,Index))
|
|---|
| 840 | set Data=$piece(@GlobalP@(RecNum,Index),"^",Part)
|
|---|
| 841 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"And our value is: ",Data)
|
|---|
| 842 |
|
|---|
| 843 | kill @OutVarP
|
|---|
| 844 | set @OutVarP@("FILE")=FileNum
|
|---|
| 845 | set @OutVarP@(cRecNum)=RecNum
|
|---|
| 846 | set @OutVarP@(cField)=FieldNum
|
|---|
| 847 | set @OutVarP@(cValue)=Data
|
|---|
| 848 | set @OutVarP@(cGlobal)=GlobalP
|
|---|
| 849 | set @OutVarP@(cGlobal,cOpen)=$get(Data(0,"FILE",cGlobal,cOpen))
|
|---|
| 850 |
|
|---|
| 851 | set result=cOKToCont
|
|---|
| 852 |
|
|---|
| 853 | DVLUDone
|
|---|
| 854 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ValueLookup^TMGDBAPI")
|
|---|
| 855 | quit result
|
|---|
| 856 |
|
|---|
| 857 |
|
|---|
| 858 | FileUtility(Params)
|
|---|
| 859 | ;"PUBLIC FUNCTION
|
|---|
| 860 | ;"Purpose: To provide file access/manipulation utilities to script user
|
|---|
| 861 | ;"syntax:
|
|---|
| 862 | ;" <FileUtility File="NEW PERSON" Fn="xxx" RecNum="1" Field=".01" OutVar"MyOutVar" Value="xx" >
|
|---|
| 863 | ;"Input: Params -- an array loaded with expected parameters. I.e.:
|
|---|
| 864 | ;" Params("FILE")="NEW PERSON" for example
|
|---|
| 865 | ;" File: The name of the file to act upon.
|
|---|
| 866 | ;" File may have subnodes (i.e. "NEW PERSON|ALIAS|TITLE")
|
|---|
| 867 | ;" **BUT**, any deletion or set values will only work on top level (i.e. "NEW PERSON")
|
|---|
| 868 | ;" Params(cFn)="info" or "delete", or "set" [OPTIONAL]
|
|---|
| 869 | ;" Fn="delete" If Field is not specified:
|
|---|
| 870 | ;" Will cause record RecNum to be deleted.
|
|---|
| 871 | ;" MyOutVar("DELETED")=RecNum of deleted record, or
|
|---|
| 872 | ;" 0 if not found.
|
|---|
| 873 | ;" If Field IS specified:
|
|---|
| 874 | ;" Will delete the value in field, in record RecNum
|
|---|
| 875 | ;" Note: delete is intended only for the highest-level records
|
|---|
| 876 | ;" (i.e. not subfiels, or multiple fields)
|
|---|
| 877 | ;" Note: delete method uses ^DIK to delete the record
|
|---|
| 878 | ;" Fn="info" Will just fill in info below.
|
|---|
| 879 | ;" If Fn not specified, this is default
|
|---|
| 880 | ;" Fn="set" Will put Value into Field, in RecNum, in File (all required)
|
|---|
| 881 | ;" Params(cRecNum)="1" for example
|
|---|
| 882 | ;" RecNum: [OPTIONAL] Specifies which record to act on. If not
|
|---|
| 883 | ;" specified, then just file info is returned.
|
|---|
| 884 | ;" Params(cField)=".01" for example (could be Name of field)
|
|---|
| 885 | ;" Field: [OPTIONAL] Specifies which field to act on.
|
|---|
| 886 | ;" Params(cOutput)="MyVar"
|
|---|
| 887 | ;" OutVar: Needed to get information back from function (but still Optional)
|
|---|
| 888 | ;" Gives name of variable to put info into.
|
|---|
| 889 | ;"Output: MyVar is loaded with data, i.e.
|
|---|
| 890 | ;" i.e. MyOutVar("FILE")=Filenumber
|
|---|
| 891 | ;" MyOutVar("FILE","FILE")=SubFilenumber <-- only if subnodes input in File name (e.g."ALIAS")
|
|---|
| 892 | ;" MyOutVar("FILE","FILE","FILE")=SubSubFilenumber <-- only if subnodes input in File name (e.g."TITLE")
|
|---|
| 893 | ;" MyOutVar("GLOBAL")="^VA(200)"
|
|---|
| 894 | ;" MyOutVar("GLOBAL, OPEN")="^VA(200,"
|
|---|
| 895 | ;" MyOutVar("RECNUM")=record number
|
|---|
| 896 | ;" MyOutVar("FIELD")=Filenumber
|
|---|
| 897 | ;" MyOutVar("VALUE")=xxxx <=== value of field (PRIOR TO deletion, if deleted)
|
|---|
| 898 | ;" MyOutVar("NEXTREC")=record number after RecNum, or "" if none
|
|---|
| 899 | ;" MyOutVar("PREVREC")=record number before RecNum, or "" if none
|
|---|
| 900 | ;" MyOutVar("FN")=the function executed
|
|---|
| 901 | ;" MyOutVar("NUMRECS")=Number of records in file PRIOR to any deletions
|
|---|
| 902 | ;" MyOutVar("FIRSTREC")=Rec number of first record in file
|
|---|
| 903 | ;" MyOutVar("LASTREC")=Rec number of last record in file
|
|---|
| 904 | ;"Returns: If should continue execution: 1=OK to continue. 0=abort
|
|---|
| 905 | ;"Note: I am getting values by directly looking into database, rather than use
|
|---|
| 906 | ;" the usual lookup commands. I am doing this so that there will be no
|
|---|
| 907 | ;" 'hidden' data, based on security etc.
|
|---|
| 908 |
|
|---|
| 909 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 910 | new cOKToCont set cOKToCont=1
|
|---|
| 911 | new cAbort set cAbort=0
|
|---|
| 912 | new cField set cField="FIELD" ;"Field"
|
|---|
| 913 | new cNull set cNull="(none)"
|
|---|
| 914 | new cRecNum set cRecNum="RECNUM" ;"RecNum
|
|---|
| 915 | new cRecord set cRecord="RECORD" ;"Record"
|
|---|
| 916 | new cOutput set cOutput="OUTVAR" ;"OutVar"
|
|---|
| 917 | new cGlobal set cGlobal="GLOBAL"
|
|---|
| 918 | new cValueLookup set cValueLookup="LOOKUPFIELDVALUE" ;"LookupFieldValue"
|
|---|
| 919 | new cOpen set cOpen="OPEN"
|
|---|
| 920 | new cInfo set cInfo="INFO" ;"Info
|
|---|
| 921 | if $data(cNodeDiv)#10=0 new cNodeDiv set cNodeDiv="|"
|
|---|
| 922 | new cDelete set cDelete="DELETE" ;"Delete
|
|---|
| 923 | new cNextRec set cNextRec="NEXTREC"
|
|---|
| 924 | new cPrev set cPrev="PREV"
|
|---|
| 925 | new cNumRecs set cNumRecs="NUMRECS"
|
|---|
| 926 | new cFirstRec set cFirstRec="FIRSTREC"
|
|---|
| 927 | new cLastRec set cLastRec="LASTREC"
|
|---|
| 928 |
|
|---|
| 929 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoFileUtility^TMGDBAPI")
|
|---|
| 930 | new result set result=cAbort
|
|---|
| 931 |
|
|---|
| 932 | new Data
|
|---|
| 933 | new DDInfo
|
|---|
| 934 | new FieldInfo
|
|---|
| 935 | new Index,Part
|
|---|
| 936 | new DummyOut
|
|---|
| 937 |
|
|---|
| 938 | new OutVarP set OutVarP=$get(Params(cOutput),cNull)
|
|---|
| 939 | ;"if (OutVarP=cNull) goto DFUTDone
|
|---|
| 940 | if (OutVarP=cNull) do
|
|---|
| 941 | . set OutVarP="DummyOut"
|
|---|
| 942 |
|
|---|
| 943 | kill @OutVarP ;"--ensure old variables in output variable are removed.
|
|---|
| 944 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Output variable=",OutVarP)
|
|---|
| 945 |
|
|---|
| 946 | new RecNum set RecNum=$get(Params(cRecNum))
|
|---|
| 947 | set @OutVarP@(cRecNum)=RecNum
|
|---|
| 948 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"RecNum=",RecNum)
|
|---|
| 949 |
|
|---|
| 950 | new Fn set Fn=$get(Params(cFn),cInfo)
|
|---|
| 951 | set Fn=$$UP^XLFSTR(Fn)
|
|---|
| 952 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Action Fn=",Fn)
|
|---|
| 953 |
|
|---|
| 954 | new Value set Value=$get(Params(cValue))
|
|---|
| 955 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Value=",Value)
|
|---|
| 956 |
|
|---|
| 957 | new FileN set FileN=$get(Params("FILE"))
|
|---|
| 958 |
|
|---|
| 959 | new SpliceArray
|
|---|
| 960 | if FileN[cNodeDiv do ;"Parse 'NEW PERSON|ALIAS|TITLE' into 'NEW PERSON', 'ALIAS', 'TITLE'
|
|---|
| 961 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Multiple nodes found for file name. Processing...")
|
|---|
| 962 | . do CleaveToArray^TMGSTUTL(FileN,cNodeDiv,.SpliceArray)
|
|---|
| 963 | . set FileN=$get(SpliceArray(1))
|
|---|
| 964 | set Data(0,"FILE")=FileN
|
|---|
| 965 | set result=$$SetupFileNum(.Data) if result=cAbort goto DFUTDone
|
|---|
| 966 | new FileNum set FileNum=$get(Data(0,"FILE"),cNull)
|
|---|
| 967 | set @OutVarP@("FILE")=FileNum
|
|---|
| 968 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FileNum=",FileNum)
|
|---|
| 969 |
|
|---|
| 970 | new index set index=2
|
|---|
| 971 | new GlobalP set GlobalP=$name(@OutVarP@("FILE"))
|
|---|
| 972 | if $data(SpliceArray(index)) do
|
|---|
| 973 | . for index=index:1 do quit:index=""
|
|---|
| 974 | . . set FileN=SpliceArray(index)
|
|---|
| 975 | . . set FileNum=$$GetSubFileNumber(FileNum,FileN)
|
|---|
| 976 | . . if +FileNum'=0 set @GlobalP@("FILE")=FileNum
|
|---|
| 977 | . . set GlobalP=$name(@GlobalP@("FILE"))
|
|---|
| 978 | . . set index=$order(SpliceArray(index))
|
|---|
| 979 |
|
|---|
| 980 | new GlobalP set GlobalP=$get(Data(0,"FILE",cGlobal),cNull)
|
|---|
| 981 | if (FileNum=cNull),(GlobalP=cNull) goto DFUTDone
|
|---|
| 982 | set @OutVarP@(cGlobal)=GlobalP
|
|---|
| 983 | set @OutVarP@(cGlobal,cOpen)=$get(Data(0,"FILE",cGlobal,cOpen))
|
|---|
| 984 |
|
|---|
| 985 | ;"If we've gotten this far, will consider the function a success
|
|---|
| 986 | set result=cOKToCont
|
|---|
| 987 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Setting fn result to success")
|
|---|
| 988 |
|
|---|
| 989 | new FieldN set FieldN=$get(Params(cField))
|
|---|
| 990 | new FieldNum
|
|---|
| 991 | if (+FieldN=0)&(FieldN'="") do
|
|---|
| 992 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldN=",FieldN)
|
|---|
| 993 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FileNum=",FileNum)
|
|---|
| 994 | . set FieldNum=$$GetNumField(FileNum,FieldN)
|
|---|
| 995 | else do
|
|---|
| 996 | . if FieldN
|
|---|
| 997 | . set FieldNum=FieldN
|
|---|
| 998 | set @OutVarP@(cField)=FieldNum
|
|---|
| 999 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldNum=",FieldNum)
|
|---|
| 1000 |
|
|---|
| 1001 | if $data(@GlobalP@(0))=0 goto DFUTDone
|
|---|
| 1002 | new NumRecs set NumRecs=$piece(@GlobalP@(0),"^",4)
|
|---|
| 1003 | new LastRec set LastRec=$piece(@GlobalP@(0),"^",3)
|
|---|
| 1004 | set @OutVarP@(cNumRecs)=NumRecs
|
|---|
| 1005 | set @OutVarP@(cLastRec)=LastRec
|
|---|
| 1006 | new RecI set RecI=LastRec
|
|---|
| 1007 | new PrevRec
|
|---|
| 1008 | for do quit:(RecI="")!(RecI=0) ;"Scan backwards to find first record
|
|---|
| 1009 | . set PrevRec=$order(@GlobalP@(RecI),-1)
|
|---|
| 1010 | . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"PrevRec=",PrevRec," RecI=",RecI)
|
|---|
| 1011 | . if (PrevRec="")!(PrevRec=0) do
|
|---|
| 1012 | . . set @OutVarP@(cFirstRec)=RecI
|
|---|
| 1013 | . set RecI=PrevRec
|
|---|
| 1014 |
|
|---|
| 1015 | if FieldNum="" do goto DFUTDone
|
|---|
| 1016 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"No field name specified")
|
|---|
| 1017 | . if (Fn=cDelete)&(RecNum'="") do
|
|---|
| 1018 | . . set DIK=$get(Data(0,"FILE",cGlobal,cOpen))
|
|---|
| 1019 | . . set DA=RecNum
|
|---|
| 1020 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Deleting one record (number: ",RecNum,") from File number",FileNum)
|
|---|
| 1021 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Notice: deleting record does not clear any pointers to deleted records")
|
|---|
| 1022 | . . do ^DIK
|
|---|
| 1023 |
|
|---|
| 1024 | ;"Get info from data dictionary r.e. where actual fields are stored in files.
|
|---|
| 1025 | set DDInfo=$get(^DD(FileNum,FieldNum,0))
|
|---|
| 1026 | if '$data(DDInfo) goto HWDone
|
|---|
| 1027 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"DDInfo=",DDInfo)
|
|---|
| 1028 | set FieldInfo=$piece(DDInfo,"^",4)
|
|---|
| 1029 | if '$data(FieldInfo),(FieldInfo="") goto DFUTDone
|
|---|
| 1030 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldInfo=",FieldInfo)
|
|---|
| 1031 | set Index=$piece(FieldInfo,";",1)
|
|---|
| 1032 | set Part=$piece(FieldInfo,";",2)
|
|---|
| 1033 |
|
|---|
| 1034 | if RecNum="" goto DFUTDone
|
|---|
| 1035 | if $data(@GlobalP@(RecNum,Index))=0 goto DFUTDone
|
|---|
| 1036 |
|
|---|
| 1037 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"I think the correct data place is: ",GlobalP,"(",RecNum,",",Index,") at piece: ",Part)
|
|---|
| 1038 | new Temp set Temp=@GlobalP@(RecNum,Index)
|
|---|
| 1039 | set @OutVarP@(cValue)=$piece(Temp,"^",Part)
|
|---|
| 1040 | kill Temp
|
|---|
| 1041 | set @OutVarP@(cNextRec)=$order(@GlobalP@(RecNum))
|
|---|
| 1042 | set @OutVarP@(cPrev)=$order(@GlobalP@(RecNum),-1)
|
|---|
| 1043 |
|
|---|
| 1044 | if Fn=cDelete do
|
|---|
| 1045 | . set $piece(@GlobalP@(RecNum,Index),"^",Part)=""
|
|---|
| 1046 |
|
|---|
| 1047 | if Fn=cSet do
|
|---|
| 1048 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Performing a hack write. CAUTION!")
|
|---|
| 1049 | . set $piece(@GlobalP@(RecNum,Index),"^",Part)=Value
|
|---|
| 1050 |
|
|---|
| 1051 | set result=cOKToCont
|
|---|
| 1052 |
|
|---|
| 1053 | DFUTDone
|
|---|
| 1054 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Fn result=",result)
|
|---|
| 1055 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"DoFileUtility^TMGDBAPI")
|
|---|
| 1056 | quit result
|
|---|
| 1057 |
|
|---|
| 1058 |
|
|---|
| 1059 |
|
|---|
| 1060 | AddRec(Data)
|
|---|
| 1061 | ;"Purpose: Use info from data array to create a MINIMAL new record in database
|
|---|
| 1062 | ;" This record will have only it's .01 field, and any multiple
|
|---|
| 1063 | ;" subfiles will have only their .01 fields also.
|
|---|
| 1064 | ;"Input: Data - Data array should be in format output from GetRInfo
|
|---|
| 1065 | ;"Output: data base will be modified by adding record
|
|---|
| 1066 | ;"Assumption: That a matching record does not already exist in database
|
|---|
| 1067 | ;"Returns: RecNum of added record, or 0 if error (0=abort)
|
|---|
| 1068 |
|
|---|
| 1069 | ;"NOTE!!! -- As I review this code, does it really return record number added???
|
|---|
| 1070 |
|
|---|
| 1071 | if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
|
|---|
| 1072 | new cOKToCont set cOKToCont=1
|
|---|
| 1073 | new cAbort set cAbort=0
|
|---|
| 1074 | new cParentIENS set cParentIENS="ParentIENS"
|
|---|
| 1075 |
|
|---|
| 1076 |
|
|---|
| 1077 | new tmgFDA,TMGFDA ;"Fileman Data Array
|
|---|
| 1078 | new IENS ;"Internal Entry Number String
|
|---|
| 1079 | new RecNum ;"Internal number entry array
|
|---|
| 1080 | new Flags
|
|---|
| 1081 | new TMGMsg
|
|---|
| 1082 | new FileNum
|
|---|
| 1083 | new result set result=cAbort
|
|---|
| 1084 | new FDAIndex
|
|---|
| 1085 | new MarkerArray
|
|---|
| 1086 | new MsgArray
|
|---|
| 1087 |
|
|---|
| 1088 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"AddRec^TMGDBAPI")
|
|---|
| 1089 |
|
|---|
| 1090 | set IENS=$get(Data(0,cParentIENS))
|
|---|
| 1091 |
|
|---|
| 1092 | new MarkNum set MarkNum=0
|
|---|
| 1093 | set result=$$SetupFDA(.Data,.tmgFDA,IENS,"+",.MarkNum,.MsgArray)
|
|---|
| 1094 | if result=cAbort goto SkRDone
|
|---|
| 1095 | set FileNum=$get(Data(0,"FILE"),0)
|
|---|
| 1096 | if FileNum=0 set result=cAbort goto SkRDone
|
|---|
| 1097 |
|
|---|
| 1098 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is master MsgArray")
|
|---|
| 1099 | if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("MsgArray")
|
|---|
| 1100 |
|
|---|
| 1101 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is master tmgFDA")
|
|---|
| 1102 | if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("tmgFDA") ;"zwr tmgFDA(*)
|
|---|
| 1103 |
|
|---|
| 1104 | set FDAIndex=FileNum
|
|---|
| 1105 | for do quit:(FDAIndex="")!(result=cAbort)
|
|---|
| 1106 | . kill TMGFDA
|
|---|
| 1107 | . merge TMGFDA(FDAIndex)=tmgFDA(FDAIndex)
|
|---|
| 1108 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Starting cycle with "_FDAIndex_" part.")
|
|---|
| 1109 | . ;
|
|---|
| 1110 | . set Flags="E" ;"E=External format values
|
|---|
| 1111 | . ;
|
|---|
| 1112 | . set result=$$ConvertFDA(.TMGFDA,.MarkerArray)
|
|---|
| 1113 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"AFTER CONVERSION, Here is the FDA to pass to UPDATE^DIE")
|
|---|
| 1114 | . if TMGDEBUG do ArrayDump^TMGDEBUG("TMGFDA") ;"zwr TMGFDA(*)
|
|---|
| 1115 | . ;
|
|---|
| 1116 | . ;"======================================================
|
|---|
| 1117 | . ;"Call UPDATE^DIE
|
|---|
| 1118 | . ;"======================================================
|
|---|
| 1119 | . if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"TMGDBAPI::UPDATE^DIE")
|
|---|
| 1120 | . if $data(TMGFDA)'=0 do
|
|---|
| 1121 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Flags=",Flags)
|
|---|
| 1122 | . . new $etrap set $etrap="do ErrTrp^TMGDBAPI"
|
|---|
| 1123 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Remember, UPDATE^DIE adds new entries in files or subfiles.")
|
|---|
| 1124 | . . set ^TMP("TMG",$J,"ErrorTrap")=result
|
|---|
| 1125 | . . set ^TMP("TMG",$J,"Caller")="UPDATE^DIE"
|
|---|
| 1126 | . . do UPDATE^DIE(Flags,"TMGFDA","RecNum","TMGMsg")
|
|---|
| 1127 | . . set result=^TMP("TMG",$J,"ErrorTrap")
|
|---|
| 1128 | . . kill ^TMP("TMG",$J,"ErrorTrap")
|
|---|
| 1129 | . . kill ^TMP("TMG",$J,"Caller")
|
|---|
| 1130 | . if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"TMGDBAPI::UPDATE^DIE")
|
|---|
| 1131 | . ;"======================================================
|
|---|
| 1132 | . ;"======================================================
|
|---|
| 1133 | . ;
|
|---|
| 1134 | . if $data(RecNum) do
|
|---|
| 1135 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is RecNum array after update/filing")
|
|---|
| 1136 | . . if TMGDEBUG do ArrayDump^TMGDEBUG("RecNum") ;"zwr RecNum(*)
|
|---|
| 1137 | . . merge MarkerArray=RecNum
|
|---|
| 1138 | . . if result=cAbort do
|
|---|
| 1139 | . . . new index
|
|---|
| 1140 | . . . set index=$order(RecNum(""))
|
|---|
| 1141 | . . . set result=$get(RecNum(index))
|
|---|
| 1142 | . . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Output Record#=",result)
|
|---|
| 1143 | . else do
|
|---|
| 1144 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"After update/filing, RecNum array is empty!")
|
|---|
| 1145 | . ;
|
|---|
| 1146 | . if $data(TMGMsg("DIERR")) do quit
|
|---|
| 1147 | . . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound)
|
|---|
| 1148 | . . if $data(RecNum(1)) do
|
|---|
| 1149 | . . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Trying to ignore error")
|
|---|
| 1150 | . . . set PriorErrorFound=0
|
|---|
| 1151 | . . else do
|
|---|
| 1152 | . . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Unable to ignore error")
|
|---|
| 1153 | . . . set result=cAbort
|
|---|
| 1154 | . do
|
|---|
| 1155 | . . new tI set tI=FDAIndex
|
|---|
| 1156 | . . set FDAIndex=$order(tmgFDA(FDAIndex))
|
|---|
| 1157 | . . kill tmgFDA(tI)
|
|---|
| 1158 |
|
|---|
| 1159 | if result=cAbort do goto SkRDone
|
|---|
| 1160 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Error encountered, dropping out.")
|
|---|
| 1161 |
|
|---|
| 1162 | set result=$$HandleHacksArray(.MsgArray)
|
|---|
| 1163 |
|
|---|
| 1164 | if result=cAbort goto SkRDone
|
|---|
| 1165 |
|
|---|
| 1166 | SkRDone
|
|---|
| 1167 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"AddRec^TMGDBAPI")
|
|---|
| 1168 | quit result
|
|---|
| 1169 |
|
|---|
| 1170 |
|
|---|
| 1171 |
|
|---|
| 1172 | ;"=========================================================
|
|---|
| 1173 | ;" Error trap routine
|
|---|
| 1174 | ;"=========================================================
|
|---|
| 1175 | ErrTrp
|
|---|
| 1176 | new cAbort set cAbort=0
|
|---|
| 1177 | set $etrap="",$ecode=""
|
|---|
| 1178 | new Caller
|
|---|
| 1179 | set Caller=$get(^TMP("TMG",$J,"Caller"),"?")
|
|---|
| 1180 | do ShowError^TMGDEBUG(.PriorErrorFound,"Error trapped. Caller was: ",Caller)
|
|---|
| 1181 | if $data(TMGMsg) do ShowDIERR^TMGDEBUG(TMGMsg)
|
|---|
| 1182 | set ^TMP("TMG",$J,"ErrorTrap")=cAbort
|
|---|
| 1183 | quit
|
|---|
| 1184 | ;"=========================================================
|
|---|
| 1185 | ;" End of Error trap routine
|
|---|
| 1186 | ;"=========================================================
|
|---|
| 1187 |
|
|---|
| 1188 | ;"========================================================
|
|---|
| 1189 | ;"The following routines were moved to shorten module length
|
|---|
| 1190 |
|
|---|
| 1191 | ConvertFDA(FDA,MarkerArray)
|
|---|
| 1192 | goto ConvertFDA+1^TMGDBAP2
|
|---|
| 1193 |
|
|---|
| 1194 | ConvertIENS(IENS,MarkerArray)
|
|---|
| 1195 | goto ConvertIENS+1^TMGDBAP2
|
|---|
| 1196 |
|
|---|
| 1197 | SetupFDA(Data,FDA,parentIENS,SrchType,MarkNum,MsgArray,Minimal,RecNum)
|
|---|
| 1198 | goto SetupFDA+1^TMGDBAP2
|
|---|
| 1199 |
|
|---|
| 1200 | OverwriteRec(RecNum,Data)
|
|---|
| 1201 | goto OverwriteRec+1^TMGDBAP2
|
|---|
| 1202 |
|
|---|
| 1203 | GetFileNum(FileName)
|
|---|
| 1204 | goto GetFileNum+1^TMGDBAP2
|
|---|
| 1205 |
|
|---|
| 1206 | GetFName(FileNumber)
|
|---|
| 1207 | goto GetFName+1^TMGDBAP2
|
|---|
| 1208 |
|
|---|
| 1209 | GetFldName(File,FieldNumber)
|
|---|
| 1210 | goto GetFldName+1^TMGDBAP2
|
|---|
| 1211 |
|
|---|
| 1212 | GetFldList(File,pArray)
|
|---|
| 1213 | goto GetFldList+1^TMGDBAP2
|
|---|
| 1214 |
|
|---|
| 1215 | SetupFileNum(Data)
|
|---|
| 1216 | goto SetupFileNum+1^TMGDBAP2
|
|---|
| 1217 |
|
|---|
| 1218 | RecFind(Params)
|
|---|
| 1219 | goto RecFind+1^TMGDBAP2
|
|---|
| 1220 |
|
|---|
| 1221 | FieldCompare(TestField,dbField,Type)
|
|---|
| 1222 | goto FieldCompare+1^TMGDBAP2
|
|---|
| 1223 |
|
|---|
| 1224 | EnsureWrite(File,Field,IENS,Value,Flags,MsgArray)
|
|---|
| 1225 | goto EnsureWrite+1^TMGDBAP2
|
|---|
| 1226 |
|
|---|
| 1227 | dbWrite(FDA,Overwrite,TMGIEN,Flags,ErrArray)
|
|---|
| 1228 | goto dbWrite+1^TMGDBAP2
|
|---|
| 1229 |
|
|---|
| 1230 | DelIEN(File,RecNumIEN,ErrArray)
|
|---|
| 1231 | goto DelIEN+1^TMGDBAP2
|
|---|
| 1232 |
|
|---|
| 1233 | WriteWP(File,RecNumIEN,Field,TMGArray)
|
|---|
| 1234 | goto WriteWP+1^TMGDBAP2
|
|---|
| 1235 |
|
|---|
| 1236 | ReadWP(File,IENS,Field,Array)
|
|---|
| 1237 | goto ReadWP+1^TMGDBAP2
|
|---|
| 1238 |
|
|---|
| 1239 | ShowIfError(TMGMsg,PriorErrorFound)
|
|---|
| 1240 | goto ShowIfError+1^TMGDBAP2
|
|---|
| 1241 |
|
|---|
| 1242 | DataImport(Info,ProgressFN)
|
|---|
| 1243 | goto DataImport+1^TMGDBAP2
|
|---|
| 1244 |
|
|---|
| 1245 | Set1(File,IEN,Field,Value,Flag)
|
|---|
| 1246 | goto Set1+1^TMGDBAP2
|
|---|
| 1247 |
|
|---|
| 1248 | GetValidInput(File,Field)
|
|---|
| 1249 | goto GetValidInput+1^TMGDBAP2
|
|---|
| 1250 |
|
|---|
| 1251 | AskFIENS()
|
|---|
| 1252 | goto AskFIENS+1^TMGDBAP2
|
|---|
| 1253 |
|
|---|
| 1254 | ASKSCRN
|
|---|
| 1255 | goto ASKSCRN+1^TMGDBAP2
|
|---|
| 1256 |
|
|---|
| 1257 | AskIENS(FileNum,IENS)
|
|---|
| 1258 | goto AskIENS+1^TMGDBAP2
|
|---|
| 1259 |
|
|---|
| 1260 | GetRefArray(FileNum,array)
|
|---|
| 1261 | goto GetRefArray+1^TMGDBAP2
|
|---|
| 1262 |
|
|---|
| 1263 | FIENS2Root(FIENS)
|
|---|
| 1264 | goto FIENS2Root+1^TMGDBAP2
|
|---|
| 1265 |
|
|---|
| 1266 | GetRef(file,IENS,field)
|
|---|
| 1267 | goto GetRef+1^TMGDBAP2
|
|---|
| 1268 |
|
|---|
| 1269 | TrimFDA(FDA,Quiet)
|
|---|
| 1270 | goto TrimFDA+1^TMGDBAP2
|
|---|
| 1271 |
|
|---|
| 1272 | GetPtrsOUT(File,Info)
|
|---|
| 1273 | goto GetPtrsOUT+1^TMGDBAP2
|
|---|
| 1274 |
|
|---|
