| [896] | 1 | TMGSIPH ;TMG/kst/SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCES ;11/27/09
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;11/27/09
|
|---|
| 3 | ;
|
|---|
| 4 | ;"TMG SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCE
|
|---|
| 5 | ;"UTILITY FUNCTIONS
|
|---|
| 6 | ;"Kevin Toppenberg MD
|
|---|
| 7 | ;"GNU General Public License (GPL) applies
|
|---|
| 8 | ;"11/27/09
|
|---|
| 9 | ;
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;" API -- Public Functions.
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 | ;"ORDREF(REF) -- return a $ORDER on a reference
|
|---|
| 14 | ;"QLASTSUB(REF) -- Returns the LAST subscript of reference
|
|---|
| 15 | ;"QSUBS(REF,ENDNUM,STARTNUM) -- Return subscripts from START to END ***NOTE ORDER OF PARAMETERS.
|
|---|
| 16 | ;"QSETSUB(REF,POS,VALUE) -- Set the subscript in REF as position POS to be VALUE
|
|---|
| 17 | ;"GETREF0(FILENUM) -- Returns reference to 0 node for file.
|
|---|
| 18 | ;"GETNUMREC(FILENUM) -- Return the highest record number in given file.
|
|---|
| 19 | ;"STOREDATA(ARRAY) -- store data from array into local globals, making backup of overwritten records
|
|---|
| 20 | ;"IENOFARRAY(FILENUM,ARRAY,IENS) --return the IEN record number of the array.
|
|---|
| 21 | ;"APPENDIEN(FILENUM,IENS) --return an IEN number that is +1 from the last one in the file.
|
|---|
| 22 | ;"RLOCARRAY(FILENUM,NEWIEN,ARRAY,NARRAY) --Relocate array (change IEN)
|
|---|
| 23 | ;"STOREDAS(FILENUM,IEN,ARRAY) -- Store data from array into local globals, making backup of
|
|---|
| 24 | ;" overwritten records. AND ALSO translate record number to input-specified IEN
|
|---|
| 25 | ;"GETFLD(FILENUM,LOC,PCE) -Return field number cooresponding to File number, node, and piece.
|
|---|
| 26 | ;"
|
|---|
| 27 | ;"=======================================================================
|
|---|
| 28 | ;" API -- Private Functions.
|
|---|
| 29 | ;"=======================================================================
|
|---|
| 30 | ;"UNNEEDPTR(FILENUM,RPTR,LPTR,INOUT,TALLY) -- satisfy all the places that were wanting a remote record to be downloaded
|
|---|
| 31 | ;"ISDIFF(ARRAY) -- determine if record stored in ARRAY is different from that stored in local ^Global
|
|---|
| 32 | ;"RECSHOW(FILENUM,RPTR,ARRAY) -- Show remote and local data, to allow user to see differences
|
|---|
| 33 | ;"GET01FIELD(FILENUM,ARRAY,RVALUE,LVALUE,IENS) -- Extract .01 field name from data array
|
|---|
| 34 | ;"GETTARGETIEN(FILENUM,ARRAY,TARGETIEN) --determine if a local record should be overwritten with record from server.
|
|---|
| 35 | ;" Ask user directly if not able to automically determine.
|
|---|
| 36 | ;"=======================================================================
|
|---|
| 37 | ;"Dependancies
|
|---|
| 38 | ;"=======================================================================
|
|---|
| 39 | ;"TMGUSRIF
|
|---|
| 40 | ;"=======================================================================
|
|---|
| 41 | ;
|
|---|
| 42 | ORDREF(REF)
|
|---|
| 43 | ;"Purpose: to return a $ORDER on a reference
|
|---|
| 44 | ;" e.g. ^TIU(8925,"") --> returns ^TIU(8925,0)
|
|---|
| 45 | ;" ^TIU(8925) --> returns ^TIU(8925.1)
|
|---|
| 46 | ;"NOTE: If there is no further nodes AT THE LEVEL OF THE LAST PARAMETER, then "" is returned.
|
|---|
| 47 | ;" e.g. A("Fruits","Citrus","Orange")
|
|---|
| 48 | ;" A("Fruits","Citrus","Green")
|
|---|
| 49 | ;" A("Fruits","Non-Citrus","Red","Hard")
|
|---|
| 50 | ;" A("Fruits","Non-Citrus","Red","Soft")
|
|---|
| 51 | ;" A("Fruits","Tropic","Yellow")
|
|---|
| 52 | ;" A("Fruits","Tropic","Blue")
|
|---|
| 53 | ;" In this example, $ORDREF(A("Fruits","Non-Citrus","Red","Soft")), would return ""
|
|---|
| 54 | ;" This is difference from $QUERY, which would return A("Fruits","Tropic","Yellow")
|
|---|
| 55 | ;"Input --REF -- reference to a global. Must be in Closed format
|
|---|
| 56 | ;"Results: Returns new reference.
|
|---|
| 57 | NEW RESULT,SUB
|
|---|
| 58 | SET SUB=$ORDER(@REF)
|
|---|
| 59 | IF SUB'="" DO
|
|---|
| 60 | . SET RESULT=REF
|
|---|
| 61 | . DO QSETSUB(.RESULT,$QLENGTH(REF),SUB)
|
|---|
| 62 | ELSE SET RESULT=""
|
|---|
| 63 | QUIT RESULT
|
|---|
| 64 | ;
|
|---|
| 65 | ;
|
|---|
| 66 | QLASTSUB(REF) ;
|
|---|
| 67 | ;"Returns the LAST subscript of reference
|
|---|
| 68 | ;"Input: REF -- The reference to work on, e.g. ^TIU(8925,3,0) MUST be in closed form
|
|---|
| 69 | QUIT $QSUBSCRIPT(REF,$QLENGTH(REF))
|
|---|
| 70 | ;
|
|---|
| 71 | ;
|
|---|
| 72 | QSUBS(REF,ENDNUM,STARTNUM) ;"***NOTE ORDER OF PARAMETERS. IT IS 'BACKWARDS', so STARTNUM can be optional
|
|---|
| 73 | ;"Purpose: Return subscripts from START to END
|
|---|
| 74 | ;"Input: REF -- The reference to work on, e.g. ^TIU(8925,3,0) MUST be in closed form
|
|---|
| 75 | ;" ENDNUM -- The ending subscript to return.
|
|---|
| 76 | ;" STARTNUM -- The starting subscript to return. OPTIONAL. Default is 0
|
|---|
| 77 | ;"Returns the reference, in closed for.
|
|---|
| 78 | NEW I,RESULT SET RESULT=""
|
|---|
| 79 | SET STARTNUM=+$GET(STARTNUM)
|
|---|
| 80 | SET ENDNUM=+$GET(ENDNUM)
|
|---|
| 81 | IF ENDNUM>$QLENGTH(REF) SET ENDNUM=$QLENGTH(REF)
|
|---|
| 82 | FOR I=STARTNUM:1:ENDNUM DO
|
|---|
| 83 | . NEW ONENODE SET ONENODE=$QSUBSCRIPT(REF,I)
|
|---|
| 84 | . IF (+ONENODE'=ONENODE),(I>0) SET ONENODE=""""_ONENODE_""""
|
|---|
| 85 | . SET RESULT=RESULT_ONENODE
|
|---|
| 86 | . IF I=0 SET RESULT=RESULT_"("
|
|---|
| 87 | . ELSE SET RESULT=RESULT_","
|
|---|
| 88 | SET RESULT=$$CREF^DILF(RESULT)
|
|---|
| 89 | IF (RESULT'["("),($EXTRACT(RESULT,$LENGTH(RESULT))=",") DO
|
|---|
| 90 | . SET RESULT=$EXTRACT(RESULT,1,$LENGTH(RESULT)-1)_")"
|
|---|
| 91 | QUIT RESULT
|
|---|
| 92 | ;
|
|---|
| 93 | ;
|
|---|
| 94 | QSETSUB(REF,POS,VALUE) ;
|
|---|
| 95 | ;"Purpose: Set the subscript in REF as position POS to be VALUE
|
|---|
| 96 | ;"Input: REF -- The reference to modify. PASS BY REFERENCE
|
|---|
| 97 | ;" POS -- The position of the subscript to change. POS=1 means first subscript
|
|---|
| 98 | ;" VALUE -- The new subscript number or name
|
|---|
| 99 | ;"Output: REF is modified
|
|---|
| 100 | ;"Results: none
|
|---|
| 101 | IF (POS>$QLENGTH(REF))!(POS<1) QUIT
|
|---|
| 102 | NEW REFA SET REFA=$$QSUBS(REF,POS-1)
|
|---|
| 103 | SET REFA=$$OREF^DILF(REFA)
|
|---|
| 104 | NEW REFB SET REFB=$$QSUBS(REF,999,POS+1)
|
|---|
| 105 | IF REFB="" SET REFB=")"
|
|---|
| 106 | ELSE SET REFB=","_REFB
|
|---|
| 107 | IF (+VALUE'=VALUE),($EXTRACT(VALUE,1)'="""") SET VALUE=""""_VALUE_""""
|
|---|
| 108 | SET REF=REFA_VALUE_REFB
|
|---|
| 109 | QUIT
|
|---|
| 110 | ;
|
|---|
| 111 | ;
|
|---|
| 112 | GETREF0(FILENUM)
|
|---|
| 113 | ;"Purpose: Returns reference to 0 node for file.
|
|---|
| 114 | ;"Input: FILENUM -- The fileman number of the file to return info for.
|
|---|
| 115 | ;"Result: RETURNS REF, OR "" if problem.
|
|---|
| 116 | NEW REF SET REF=$GET(^DIC(FILENUM,0,"GL"))
|
|---|
| 117 | IF REF'="" SET REF=REF_"0)"
|
|---|
| 118 | QUIT REF
|
|---|
| 119 | ;
|
|---|
| 120 | ;
|
|---|
| 121 | GETNUMREC(FILENUM)
|
|---|
| 122 | ;"Purpose: Return the highest record number in given file.
|
|---|
| 123 | ;"Input: FILENUM -- The fileman number of the file to return info for.
|
|---|
| 124 | ;"Results: returns number, or -1 if problem.
|
|---|
| 125 | ;"write "Here in GETNUMRECS",!
|
|---|
| 126 | NEW RESULT,REF,NODE
|
|---|
| 127 | SET RESULT=-1
|
|---|
| 128 | SET REF=$$GETREF0(FILENUM)
|
|---|
| 129 | IF REF'="" SET RESULT=$PIECE($GET(@REF),"^",4)
|
|---|
| 130 | IF RESULT="" SET RESULT=-1
|
|---|
| 131 | QUIT RESULT
|
|---|
| 132 | ;
|
|---|
| 133 | ;
|
|---|
| 134 | STOREDATA(ARRAY)
|
|---|
| 135 | ;"Purpose: To store data from array into local globals, making backup of
|
|---|
| 136 | ;" overwritten records
|
|---|
| 137 | ;"Input: ARRAY -- Pass by REFERENCE. Format
|
|---|
| 138 | ;" ARRAY(1)=ARef_"="
|
|---|
| 139 | ;" ARRAY(2)="="_AValue
|
|---|
| 140 | ;" ARRAY(3)=ARef_"="
|
|---|
| 141 | ;" ARRAY(4)="="_AValue
|
|---|
| 142 | ;" ...
|
|---|
| 143 | ;"Results: none
|
|---|
| 144 | NEW STIME SET STIME=$H
|
|---|
| 145 | NEW TMGI SET TMGI=1
|
|---|
| 146 | NEW TMGCT SET TMGCT=0
|
|---|
| 147 | NEW SHOWPROG SET SHOWPROG=0
|
|---|
| 148 | NEW SHOWREF SET SHOWREF=0
|
|---|
| 149 | NEW REF,VALUE
|
|---|
| 150 | FOR DO QUIT:(TMGI="")
|
|---|
| 151 | . SET REF=$GET(ARRAY(TMGI))
|
|---|
| 152 | . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)
|
|---|
| 153 | . IF REF="" SET TMGI="" QUIT
|
|---|
| 154 | . SET TMGI=TMGI+1
|
|---|
| 155 | . SET VALUE=$GET(ARRAY(TMGI))
|
|---|
| 156 | . SET VALUE=$EXTRACT(VALUE,2,10000)
|
|---|
| 157 | . IF $DATA(@REF) DO
|
|---|
| 158 | . . MERGE ^TMG("TMGSIPH","OVERWRITTEN",REF)=@REF
|
|---|
| 159 | . . KILL @REF
|
|---|
| 160 | . SET @REF=VALUE
|
|---|
| 161 | . SET TMGI=$ORDER(ARRAY(TMGI))
|
|---|
| 162 | . SET TMGCT=TMGCT+1
|
|---|
| 163 | . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>15) DO ;"Turn on progress bar after 15 seconds.
|
|---|
| 164 | . . SET SHOWPROG=1
|
|---|
| 165 | . . SET TMGMIN=$ORDER(ARRAY(0))
|
|---|
| 166 | . . SET TMGMAX=$ORDER(ARRAY(""),-1)
|
|---|
| 167 | . IF (SHOWPROG=1),(TMGCT>500) DO
|
|---|
| 168 | . . IF (SHOWREF=0),($$HDIFF^XLFDT($H,STIME,2)>120) DO ;"Turn on showing referecences after 2 min.
|
|---|
| 169 | . . NEW SREF SET SREF=""
|
|---|
| 170 | . . IF SHOWREF DO
|
|---|
| 171 | . . . SET SREF=REF QUIT:($LENGTH(REF)'>20)
|
|---|
| 172 | . . . SET SREF=$EXTRACT(REF,1,17)_"..."
|
|---|
| 173 | . . DO ProgressBar^TMGUSRIF(TMGI,"Storing Data: "_SREF,TMGMIN,TMGMAX,70,STIME)
|
|---|
| 174 | . . SET TMGCT=0
|
|---|
| 175 | ;
|
|---|
| 176 | QUIT
|
|---|
| 177 | ;
|
|---|
| 178 | ;
|
|---|
| 179 | IENOFARRAY(FILENUM,ARRAY,IENS) ;"
|
|---|
| 180 | ;"Purpose: return the IEN record number of the array.
|
|---|
| 181 | ;"Input: FILENUM -- The file number of the data passed in array. MUST MATCH
|
|---|
| 182 | ;" ARRAY -- Pass by REFERENCE. Format
|
|---|
| 183 | ;" ARRAY(1)=ARef_"=" <---- Expected to hold the .01 field.
|
|---|
| 184 | ;" ARRAY(2)="="_AValue
|
|---|
| 185 | ;" ARRAY(3)=ARef_"="
|
|---|
| 186 | ;" ARRAY(4)="="_AValue
|
|---|
| 187 | ;" IENS -- OPTIONAL (needed If FILENUM is a subfile) -- A standard IENS for subfile.
|
|---|
| 188 | ;"Result: IEN if found, or 0 if error.
|
|---|
| 189 | ;" NOTE: Even if FILENUM is a subfile, IEN is a single number, i.e. IEN of subrecord
|
|---|
| 190 | ;" e.g. '3' not '3,23456,'
|
|---|
| 191 | ;"
|
|---|
| 192 | NEW RESULT SET RESULT=0
|
|---|
| 193 | SET FILENUM=+$GET(FILENUM) IF FILENUM'>0 GOTO IOADN
|
|---|
| 194 | ;"NEW GREF SET GREF=$GET(^DIC(FILENUM,0,"GL"))
|
|---|
| 195 | NEW GREF SET GREF=$$GETGREF^TMGFMUT2(FILENUM,.IENS) ;"IENS not used if not subfile.
|
|---|
| 196 | NEW CGREF SET CGREF=$$CREF^DILF(GREF)
|
|---|
| 197 | IF GREF="" GOTO IOADN
|
|---|
| 198 | NEW GREFLEN SET GREFLEN=$QLENGTH(CGREF)
|
|---|
| 199 | NEW REF SET REF=$GET(ARRAY(1)) IF (REF="") GOTO IOADN
|
|---|
| 200 | SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1) IF (REF="") GOTO IOADN
|
|---|
| 201 | IF $$QSUBS(REF,GREFLEN)'=CGREF GOTO IOADN
|
|---|
| 202 | SET RESULT=$QSUBSCRIPT(REF,GREFLEN+1)
|
|---|
| 203 | IOADN QUIT RESULT
|
|---|
| 204 | ;
|
|---|
| 205 | ;
|
|---|
| 206 | APPENDIEN(FILENUM,IENS) ;
|
|---|
| 207 | ;"Purpose: to return an IEN number that is +1 from the last one in the file.
|
|---|
| 208 | ;"Return : the new IEN, or 0 if problem
|
|---|
| 209 | NEW RESULT SET RESULT=0
|
|---|
| 210 | ;"NEW GREF SET GREF=$GET(^DIC(FILENUM,0,"GL")) IF GREF="" GOTO AIEDN
|
|---|
| 211 | NEW GREF SET GREF=$$GETGREF^TMGFMUT2(FILENUM,.IENS) ;"IENS not used if not subfile.
|
|---|
| 212 | NEW CGREF SET CGREF=$$CREF^DILF(GREF)
|
|---|
| 213 | NEW LASTIEN SET LASTIEN="%"
|
|---|
| 214 | FOR SET LASTIEN=$ORDER(@CGREF@(LASTIEN),-1) QUIT:(LASTIEN="")!(+LASTIEN=LASTIEN)
|
|---|
| 215 | SET RESULT=LASTIEN+1
|
|---|
| 216 | IF $GET(IENS)["," DO
|
|---|
| 217 | . SET $PIECE(IENS,",",1)=RESULT
|
|---|
| 218 | . SET RESULT=IENS
|
|---|
| 219 | AIEDN QUIT RESULT
|
|---|
| 220 | ;
|
|---|
| 221 | ;
|
|---|
| 222 | RLOCARRAY(FILENUM,NEWIEN,ARRAY,NARRAY) ;"Relocate array (change IEN)
|
|---|
| 223 | ;"Purpose: To take array, and change IEN values to NEWIEN
|
|---|
| 224 | ;"NOTE: It is assumed that ALL data in ARRAY represents ONE record (not multiple!)
|
|---|
| 225 | ;" The array MAY contain cross-references data
|
|---|
| 226 | ;"Input: FILENUM -- The file (or subfile) number of the data passed in array. MUST MATCH
|
|---|
| 227 | ;" NEWIEN -- The IEN that the data in ARRAY should be changed to.
|
|---|
| 228 | ;" If FILENUM is a subfile, then NEWIEN should be in standard IENS format (e.g. '7,345,')
|
|---|
| 229 | ;" ARRAY -- Pass by REFERENCE. Format
|
|---|
| 230 | ;" ARRAY(1)=ARef_"="
|
|---|
| 231 | ;" ARRAY(2)="="_AValue
|
|---|
| 232 | ;" ARRAY(3)=ARef_"="
|
|---|
| 233 | ;" ARRAY(4)="="_AValue
|
|---|
| 234 | ;" ...
|
|---|
| 235 | ;" NARRAY -- PASS BY REFERENCE, an OUT PARAMETER. Format same as ARRAY
|
|---|
| 236 | ;" NARRAY(1)=ARef_"="
|
|---|
| 237 | ;" NARRAY(2)="="_AValue
|
|---|
| 238 | ;" ...
|
|---|
| 239 | ;"Results: 1 if OK, -1 if error
|
|---|
| 240 | ;
|
|---|
| 241 | KILL NARRAY
|
|---|
| 242 | NEW RESULT SET RESULT=-1
|
|---|
| 243 | NEW SHOWPROG SET SHOWPROG=0
|
|---|
| 244 | NEW STIME SET STIME=$H
|
|---|
| 245 | SET FILENUM=+$GET(FILENUM) IF FILENUM'>0 GOTO RLAD
|
|---|
| 246 | SET NEWIEN=$GET(NEWIEN) IF +NEWIEN'>0 GOTO RLAD
|
|---|
| 247 | NEW GREF SET GREF=$$GETGREF^TMGFMUT2(FILENUM,NEWIEN)
|
|---|
| 248 | ;"NEW GREF SET GREF=$GET(^DIC(FILENUM,0,"GL"))
|
|---|
| 249 | NEW CGREF SET CGREF=$$CREF^DILF(GREF)
|
|---|
| 250 | IF GREF="" GOTO SDAD
|
|---|
| 251 | ;"Check to see that the ARRAY data is referenced to same place as FILENUM
|
|---|
| 252 | NEW GREFLEN SET GREFLEN=$QL(CGREF)
|
|---|
| 253 | NEW REF SET REF=$GET(ARRAY(1)) IF (REF="") GOTO RLAD
|
|---|
| 254 | SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1) IF (REF="") GOTO RLAD
|
|---|
| 255 | IF $$QSUBS(REF,GREFLEN)'=CGREF GOTO RLAD
|
|---|
| 256 | NEW VALUE,RECNUM
|
|---|
| 257 | NEW OLDIEN SET OLDIEN=""
|
|---|
| 258 | NEW DONE SET DONE=0
|
|---|
| 259 | NEW TMGCT SET TMGCT=0
|
|---|
| 260 | NEW TMGI SET TMGI=0
|
|---|
| 261 | FOR SET TMGI=$ORDER(ARRAY(TMGI)) QUIT:(TMGI="")!DONE DO
|
|---|
| 262 | . SET REF=$GET(ARRAY(TMGI))
|
|---|
| 263 | . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)
|
|---|
| 264 | . SET TMGI=TMGI+1
|
|---|
| 265 | . IF REF="" SET DONE=1 QUIT
|
|---|
| 266 | . SET REC=$QSUBSCRIPT(REF,GREFLEN+1) ;"Get IEN of ARRAY data
|
|---|
| 267 | . IF OLDIEN="",(+REC=REC) SET OLDIEN=REC
|
|---|
| 268 | . IF REC'=+NEWIEN DO
|
|---|
| 269 | . . IF (+REC=REC) DO ;"Change record number in reference
|
|---|
| 270 | . . . SET REF=GREF_+NEWIEN_","_$$QSUBS(REF,99,GREFLEN+2)
|
|---|
| 271 | . . ELSE DO ;"Redirect XREF value.
|
|---|
| 272 | . . . NEW PT2 SET PT2=$QSUBSCRIPT(REF,$QLENGTH(REF))
|
|---|
| 273 | . . . IF PT2'=OLDIEN QUIT ;"Unexpected format of xref
|
|---|
| 274 | . . . DO QSETSUB(.REF,$QLENGTH(REF),+NEWIEN) ;"Change pointer in last position.
|
|---|
| 275 | . SET VALUE=$EXTRACT($GET(ARRAY(TMGI)),2,10000)
|
|---|
| 276 | . SET NARRAY(TMGI-1)=REF_"="
|
|---|
| 277 | . SET NARRAY(TMGI)="="_VALUE
|
|---|
| 278 | . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>15) DO ;"Turn on progress bar after 15 seconds.
|
|---|
| 279 | . . SET SHOWPROG=1
|
|---|
| 280 | . . SET TMGMIN=$ORDER(ARRAY(0))
|
|---|
| 281 | . . SET TMGMAX=$ORDER(ARRAY(""),-1)
|
|---|
| 282 | . SET TMGCT=TMGCT+1
|
|---|
| 283 | . IF (SHOWPROG=1),(TMGCT>500) DO
|
|---|
| 284 | . . DO ProgressBar^TMGUSRIF(TMGI,"Shifting Data: ",TMGMIN,TMGMAX,70,STIME)
|
|---|
| 285 | . . SET TMGCT=0
|
|---|
| 286 | SET RESULT=1
|
|---|
| 287 | RLAD QUIT RESULT
|
|---|
| 288 | ;
|
|---|
| 289 | ;
|
|---|
| 290 | STOREDAS(FILENUM,IEN,ARRAY) ;"'STORE DATA AS'
|
|---|
| 291 | ;"Purpose: To store data from array into local globals, making backup of
|
|---|
| 292 | ;" overwritten records. AND ALSO translate record number to input-specified IEN
|
|---|
| 293 | ;"NOTE: It is assumed that ALL data in ARRAY represents ONE record (not multiple!)
|
|---|
| 294 | ;" The array MAY contain cross-references data
|
|---|
| 295 | ;"Input: FILENUM -- The file number of the data passed in array. MUST MATCH
|
|---|
| 296 | ;" IEN -- The IEN that the data in ARRAY should be changed to.
|
|---|
| 297 | ;" If FILENUM is a subfile, then pass a standard IENS string in IEN
|
|---|
| 298 | ;" ARRAY -- Pass by REFERENCE. Format
|
|---|
| 299 | ;" ARRAY(1)=ARef_"="
|
|---|
| 300 | ;" ARRAY(2)="="_AValue
|
|---|
| 301 | ;" ARRAY(3)=ARef_"="
|
|---|
| 302 | ;" ARRAY(4)="="_AValue
|
|---|
| 303 | ;" ...
|
|---|
| 304 | ;"Also -- Makes use of Globally-scoped variable TMGOWSAVE. If =0, overwritten records are NOT saved
|
|---|
| 305 | ;"Results: 1 if OK, -1 if error
|
|---|
| 306 | ;"NOTE: Subfile support not completed yet...
|
|---|
| 307 | NEW RESULT SET RESULT=-1
|
|---|
| 308 | NEW NARRAY
|
|---|
| 309 | NEW SHOWPROG SET SHOWPROG=0
|
|---|
| 310 | NEW SHOWREF SET SHOWREF=0
|
|---|
| 311 | NEW TMGCT SET TMGCT=0
|
|---|
| 312 | NEW STIME SET STIME=$H
|
|---|
| 313 | IF $$IENOFARRAY(FILENUM,.ARRAY,IEN)=+NEWIEN GOTO SDA2
|
|---|
| 314 | IF $$RLOCARRAY(FILENUM,NEWIEN,.ARRAY,.NARRAY)'=1 GOTO SDAD ;"Relocate array (change IEN)
|
|---|
| 315 | KILL ARRAY MERGE ARRAY=NARRAY
|
|---|
| 316 | SDA2 NEW TMGI SET TMGI=0
|
|---|
| 317 | NEW DONE SET DONE=0
|
|---|
| 318 | FOR SET TMGI=$ORDER(ARRAY(TMGI)) QUIT:(TMGI="")!DONE DO
|
|---|
| 319 | . SET REF=$GET(ARRAY(TMGI))
|
|---|
| 320 | . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)
|
|---|
| 321 | . SET TMGI=TMGI+1
|
|---|
| 322 | . IF REF="" SET DONE=1 QUIT
|
|---|
| 323 | . NEW VALUE SET VALUE=$EXTRACT($GET(ARRAY(TMGI)),2,10000)
|
|---|
| 324 | . ;"write REF,!
|
|---|
| 325 | . IF $DATA(@REF) DO
|
|---|
| 326 | . . IF +$GET(TMGOWSAVE)=0 QUIT
|
|---|
| 327 | . . MERGE ^TMG("TMGSIPH","OVERWRITTEN",REF)=@REF
|
|---|
| 328 | . . KILL @REF
|
|---|
| 329 | . SET @REF=VALUE
|
|---|
| 330 | . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>15) DO ;"Turn on progress bar after 15 seconds.
|
|---|
| 331 | . . SET SHOWPROG=1
|
|---|
| 332 | . . SET TMGMIN=$ORDER(ARRAY(0))
|
|---|
| 333 | . . SET TMGMAX=$ORDER(ARRAY(""),-1)
|
|---|
| 334 | . SET TMGCT=TMGCT+1
|
|---|
| 335 | . IF (SHOWPROG=1),(TMGCT>500) DO
|
|---|
| 336 | . . IF (SHOWREF=0),($$HDIFF^XLFDT($H,STIME,2)>120) DO ;"Turn on showing referecences after 2 min.
|
|---|
| 337 | . . NEW SREF SET SREF=""
|
|---|
| 338 | . . IF SHOWREF DO
|
|---|
| 339 | . . . SET SREF=REF QUIT:($LENGTH(REF)'>20)
|
|---|
| 340 | . . . SET SREF=$EXTRACT(REF,1,17)_"..."
|
|---|
| 341 | . . DO ProgressBar^TMGUSRIF(TMGI,"Storing Data: "_SREF,TMGMIN,TMGMAX,70,STIME)
|
|---|
| 342 | . . SET TMGCT=0
|
|---|
| 343 | SET RESULT=1
|
|---|
| 344 | SDAD QUIT RESULT
|
|---|
| 345 | ;
|
|---|
| 346 | ;
|
|---|
| 347 | UNNEEDPTR(FILENUM,RPTR,LPTR,INOUT,TALLY) ;
|
|---|
| 348 | ;"Purpose: To satisfy all the places that were wanting a remote record to be downloaded
|
|---|
| 349 | ;"Input: FILENUM -- the fileman number of file (or subfile) to get from remote server
|
|---|
| 350 | ;" If FILENUM is a subfile, then can be passed as just subfilenumber, OR
|
|---|
| 351 | ;" in format: SubFileNum{ParentFileNum...
|
|---|
| 352 | ;" RPTR -- The IEN of the record that was wanted from the server.
|
|---|
| 353 | ;" If dealing with subfiles, pass in standard IENS format (e.g. '7,2345,')
|
|---|
| 354 | ;" LPTR -- OPTIONAL. This can specify if the desired REMOTE record has been
|
|---|
| 355 | ;" stored at a different IEN locally.
|
|---|
| 356 | ;" If dealing with subfiles, pass in standard IENS format (e.g. '7,2345,')
|
|---|
| 357 | ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
|
|---|
| 358 | ;" TALLY -- OPTIONAL. PASS BY REFERENCE. An array to keep progress stats. Format:
|
|---|
| 359 | ;" TALLY("UNNEEDED RECORDS")=#
|
|---|
| 360 | ;"NOTE: Gobal ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT") used, with format as below:
|
|---|
| 361 | ;" ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,RefToNodeToBeCorrected,INFO)=""
|
|---|
| 362 | ;" INFO=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
|
|---|
| 363 | ;" As pointers are resolved, the entries will be KILLED from the above global
|
|---|
| 364 | ;"Results: none
|
|---|
| 365 | ;"
|
|---|
| 366 | SET FILENUM=$GET(FILENUM) QUIT:(+FILENUM'>0)
|
|---|
| 367 | IF $$ISSUBFIL^TMGFMUT2(FILENUM),FILENUM'["{" DO
|
|---|
| 368 | . SET FILENUM=$$GETSPFN^TMGFMUT2(FILENUM) ;"convert 123.02 --> '123.02{123'
|
|---|
| 369 | SET RPTR=$GET(RPTR)
|
|---|
| 370 | SET LPTR=$GET(LPTR)
|
|---|
| 371 | SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
|
|---|
| 372 | IF INOUT="PTIN" GOTO UN2
|
|---|
| 373 | NEW NODE SET NODE=""
|
|---|
| 374 | FOR SET NODE=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RPTR,NODE)) QUIT:(NODE="") DO
|
|---|
| 375 | . NEW INFO SET INFO=""
|
|---|
| 376 | . FOR SET INFO=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RPTR,NODE,INFO)) QUIT:(INFO="") DO
|
|---|
| 377 | . . NEW PCE SET PCE=+INFO
|
|---|
| 378 | . . NEW P2FILE SET P2FILE=$PIECE(INFO,"^",2)
|
|---|
| 379 | . . IF LPTR'=RPTR DO
|
|---|
| 380 | . . . IF $PIECE(INFO,"^",5)="V" SET LPTR=LPTR_";"_$PIECE(INFO,"^",3) ;"VPTR stored as 'IEN;OREF'
|
|---|
| 381 | . . . SET $PIECE(@NODE,"^",PCE)=LPTR
|
|---|
| 382 | . . IF 0=1 DO ;"Build up map array to store history of connections. DON'T USE.....
|
|---|
| 383 | . . . IF P2FILE=2 DO ;"2=PATIENT file.
|
|---|
| 384 | . . . . SET ^TMG("TMGSIPH","MAP IN","F"_2,"F"_FILENUM,LPTR)=""
|
|---|
| 385 | . . . . SET ^TMG("TMGSIPH","MAP IN","XREF",FILENUM)=$NAME(^TMG("TMGSIPH","MAP IN","F"_2,"F"_FILENUM))
|
|---|
| 386 | . . . IF $DATA(^TMG("TMGSIPH","MAP IN","XREF","F"_P2FILE)) DO
|
|---|
| 387 | . . . . NEW REF SET REF=$GET(^TMG("TMGSIPH","MAP IN","XREF","F"_P2FILE))
|
|---|
| 388 | . . . . QUIT:(REF="")!($QLENGTH(REF)>15)
|
|---|
| 389 | . . . . SET @REF@("F"_FILENUM,LPTR)=""
|
|---|
| 390 | . . . . SET ^TMG("TMGSIPH","MAP IN","XREF","F"_FILENUM)=$NAME(@REF@("F"_FILENUM))
|
|---|
| 391 | . . KILL ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RPTR,NODE,INFO)
|
|---|
| 392 | . . SET TALLY("UNNEEDED RECORDS")=+$GET(TALLY("UNNEEDED RECORDS"))+1
|
|---|
| 393 | UN2 KILL ^TMG("TMGSIPH","NEEDED RECORDS",INOUT,FILENUM,RPTR) ;"TEMP
|
|---|
| 394 | ;
|
|---|
| 395 | QUIT
|
|---|
| 396 | ;
|
|---|
| 397 | ;
|
|---|
| 398 | ISDIFF(ARRAY) ;
|
|---|
| 399 | ;"Purpose:to determine if record stored in ARRAY is different from that stored in local ^Global
|
|---|
| 400 | ;"Input: ARRAY -- Pass by REFERENCE. This is actual remote record from server. Format:
|
|---|
| 401 | ;" ARRAY(1)=ARef_"="
|
|---|
| 402 | ;" ARRAY(2)="="_AValue
|
|---|
| 403 | ;" ARRAY(3)=ARef_"="
|
|---|
| 404 | ;" ARRAY(4)="="_AValue
|
|---|
| 405 | ;"Result: 0 -- no difference
|
|---|
| 406 | ;" 1 -- ARRAY has extra information
|
|---|
| 407 | ;" 2 -- ARRAY has conflicting information
|
|---|
| 408 | ;
|
|---|
| 409 | NEW RESULT SET RESULT=0
|
|---|
| 410 | NEW TMGI SET TMGI=0
|
|---|
| 411 | NEW STIME SET STIME=$H
|
|---|
| 412 | NEW SHOWPROG SET SHOWPROG=0
|
|---|
| 413 | NEW TMGMAX,TMGMIN
|
|---|
| 414 | NEW TMGCT SET TMGCT=0
|
|---|
| 415 | NEW REF,VALUE
|
|---|
| 416 | FOR SET TMGI=$ORDER(ARRAY(TMGI)) QUIT:(TMGI="")!(RESULT=2) DO
|
|---|
| 417 | . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>15) DO ;"Turn on progress bar after 15 seconds.
|
|---|
| 418 | . . SET SHOWPROG=1
|
|---|
| 419 | . . SET TMGMIN=$ORDER(ARRAY(0))
|
|---|
| 420 | . . SET TMGMAX=$ORDER(ARRAY(""),-1)
|
|---|
| 421 | . IF (SHOWPROG=1),(TMGCT>500) DO
|
|---|
| 422 | . . DO ProgressBar^TMGUSRIF(TMGI,"Comparing server data to local ",TMGMIN,TMGMAX,70,STIME)
|
|---|
| 423 | . . SET TMGCT=0
|
|---|
| 424 | . SET REF=$GET(ARRAY(TMGI))
|
|---|
| 425 | . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)
|
|---|
| 426 | . SET TMGI=TMGI+1
|
|---|
| 427 | . SET TMGCT=TMGCT+1
|
|---|
| 428 | . IF REF="" SET RESULT=2 QUIT
|
|---|
| 429 | . SET VALUE=$EXTRACT($GET(ARRAY(TMGI)),2,10000)
|
|---|
| 430 | . IF $DATA(@REF)=0 SET RESULT=1 ;"ARRAY has extra info
|
|---|
| 431 | . IF $GET(@REF)=VALUE QUIT
|
|---|
| 432 | . SET RESULT=2 ;"ARRAY conflicts with local value.
|
|---|
| 433 | QUIT RESULT
|
|---|
| 434 | ;
|
|---|
| 435 | ;
|
|---|
| 436 | GETFLD(FILENUM,LOC,PCE)
|
|---|
| 437 | ;"Purpose: Return field number cooresponding to File number, node, and piece.
|
|---|
| 438 | ;"Input: FILENUM -- Fileman file number to work with.
|
|---|
| 439 | ;" LOC -- the subscript location
|
|---|
| 440 | ;" PCE -- the piece for the field in question
|
|---|
| 441 | ;"Results: field number^field name, or 0 if not found
|
|---|
| 442 | NEW RESULT SET RESULT=0
|
|---|
| 443 | NEW FOUND SET FOUND=0
|
|---|
| 444 | NEW FLD SET FLD=0
|
|---|
| 445 | FOR SET FLD=$ORDER(^DD(FILENUM,FLD)) QUIT:(+FLD'>0)!(FOUND=1) DO
|
|---|
| 446 | . NEW INFO SET INFO=$PIECE($GET(^DD(FILENUM,FLD,0)),"^",4)
|
|---|
| 447 | . IF $PIECE(INFO,";",1)'=LOC QUIT
|
|---|
| 448 | . IF $PIECE(INFO,";",2)'=PCE QUIT
|
|---|
| 449 | . SET FOUND=1
|
|---|
| 450 | . SET RESULT=FLD_"^"_$PIECE($GET(^DD(FILENUM,FLD,0)),"^",1)
|
|---|
| 451 | QUIT RESULT
|
|---|
| 452 | ;
|
|---|
| 453 | ;
|
|---|
| 454 | RECSHOW(FILENUM,RPTR,ARRAY) ;
|
|---|
| 455 | ;"Purpose: to show remote and local data, to allow user to see differences
|
|---|
| 456 | ;"Input: FILENUM -- Fileman file (or subfile) number to work with.
|
|---|
| 457 | ;" RPTR -- The record number (IEN) on the server of the record downloaded.
|
|---|
| 458 | ;" If FILENUM is a subfile, then pass RPTR in standard IENS format (e.g. '4,6787,')
|
|---|
| 459 | ;" ARRAY -- Pass by REFERENCE. This is actual remote record from server.
|
|---|
| 460 | ;" Format as per OVERWRITE
|
|---|
| 461 | ;"
|
|---|
| 462 | WRITE "NOTE: ONLY DIFFERENCE WILL BE SHOWN",!,!
|
|---|
| 463 | WRITE "LEGEND: REFERENCE",!
|
|---|
| 464 | WRITE " L -- Local data value",!
|
|---|
| 465 | WRITE " R -- Remote data value",!!
|
|---|
| 466 | NEW LINECT SET LINECT=6
|
|---|
| 467 | NEW TMGI SET TMGI=0
|
|---|
| 468 | SET IOSL=$GET(IOSL,24)
|
|---|
| 469 | ;"NEW GREF SET GREF=$GET(^DIC(FILENUM,0,"GL")) QUIT:(GREF="")
|
|---|
| 470 | NEW GREF SET GREF=$$GETGREF^TMGFMUT2(FILENUM,RPTR) QUIT:(GREF="")
|
|---|
| 471 | NEW SL SET SL=$QLENGTH($$CREF^DILF(GREF))
|
|---|
| 472 | NEW REF,VALUE,LVALUE
|
|---|
| 473 | NEW DONE SET DONE=0
|
|---|
| 474 | FOR SET TMGI=$ORDER(ARRAY(TMGI)) QUIT:(TMGI="")!(DONE=1) DO
|
|---|
| 475 | . SET REF=$GET(ARRAY(TMGI))
|
|---|
| 476 | . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)
|
|---|
| 477 | . SET TMGI=TMGI+1
|
|---|
| 478 | . IF REF="" SET DONE=1 QUIT
|
|---|
| 479 | . SET VALUE=$EXTRACT($GET(ARRAY(TMGI)),2,10000)
|
|---|
| 480 | . SET LVALUE=$GET(@REF)
|
|---|
| 481 | . IF LVALUE=VALUE QUIT
|
|---|
| 482 | . ;"Later, I will format raw nodes into readable fileman fields and values...
|
|---|
| 483 | . IF $QLENGTH(REF)=(SL+2) DO
|
|---|
| 484 | . . NEW LOC SET LOC=$QSUBSCRIPT(REF,SL+2)
|
|---|
| 485 | . . NEW PCE,FLD
|
|---|
| 486 | . . FOR PCE=1:1:$LENGTH(VALUE,"^") DO
|
|---|
| 487 | . . . NEW V1,LV1,EV1,ELV1,INFO
|
|---|
| 488 | . . . SET (EV1,V1)=$PIECE(VALUE,"^",PCE)
|
|---|
| 489 | . . . SET (ELV1,LV1)=$PIECE(LVALUE,"^",PCE)
|
|---|
| 490 | . . . IF V1=LV1 QUIT
|
|---|
| 491 | . . . SET FLD=$$GETFLD(FILENUM,LOC,PCE)
|
|---|
| 492 | . . . IF +FLD=0 WRITE "?? FIELD",! QUIT
|
|---|
| 493 | . . . IF $DATA(^DD(FILENUM,+FLD,2))#10=1 DO
|
|---|
| 494 | . . . . NEW XFRM SET XFRM=$GET(^DD(FILENUM,+FLD,2))
|
|---|
| 495 | . . . . IF XFRM="" QUIT
|
|---|
| 496 | . . . . NEW Y
|
|---|
| 497 | . . . . SET Y=V1 XECUTE XFRM SET EV1=Y
|
|---|
| 498 | . . . . SET Y=LV1 XECUTE XFRM SET ELV1=Y
|
|---|
| 499 | . . . WRITE "Field -- ",$PIECE(FLD,"^",2)," (",+FLD,"):",!
|
|---|
| 500 | . . . WRITE " L = ",ELV1,!
|
|---|
| 501 | . . . WRITE " R = ",EV1,!
|
|---|
| 502 | . . . SET LINECT=LINECT+3
|
|---|
| 503 | . . . IF LINECT>(IOSL-5) DO
|
|---|
| 504 | . . . . DO PressToCont^TMGUSRIF
|
|---|
| 505 | . . . . SET LINECT=0
|
|---|
| 506 | . ELSE DO
|
|---|
| 507 | . . WRITE REF,!
|
|---|
| 508 | . . WRITE " L = ",$GET(@REF),!
|
|---|
| 509 | . . WRITE " R = ",VALUE,!
|
|---|
| 510 | . . SET LINECT=LINECT+3
|
|---|
| 511 | . . IF LINECT>(IOSL-5) DO
|
|---|
| 512 | . . . DO PressToCont^TMGUSRIF
|
|---|
| 513 | . . . SET LINECT=0
|
|---|
| 514 | ;
|
|---|
| 515 | IF LINECT>0 DO PressToCont^TMGUSRIF
|
|---|
| 516 | QUIT
|
|---|
| 517 | ;
|
|---|
| 518 | ;
|
|---|
| 519 | GET01FIELD(FILENUM,ARRAY,RVALUE,LVALUE,IENS) ;
|
|---|
| 520 | ;"Purpose: Extract .01 field name from data array
|
|---|
| 521 | ;"Input: FILENUM -- Fileman file (of subfile) number to work with.
|
|---|
| 522 | ;" ARRAY -- Pass by REFERENCE. This is actual remote record from server.
|
|---|
| 523 | ;" Format as per OVERWRITE
|
|---|
| 524 | ;" RVALUE -- Pass by REFERENCE. An OUT PARAMETER. Filled with .01 field from server
|
|---|
| 525 | ;" LVALUE -- Pass by REFERENCE. An OUT PARAMETER Filled with .01 field from local database
|
|---|
| 526 | ;" IENS -- OPTIONAL. Only needed if FILENUM is a subfile.
|
|---|
| 527 | ;"Results: none
|
|---|
| 528 | ;"Output: RVALUE and LVALUE are filled with the INTERNAL values of the .01 field, or "" if null
|
|---|
| 529 | ;"
|
|---|
| 530 | SET (RVALUE,LVALUE)=""
|
|---|
| 531 | ;"NEW GREF SET GREF=$GET(^DIC(FILENUM,0,"GL")) QUIT:(GREF="")
|
|---|
| 532 | NEW GREF SET GREF=$$GETGREF^TMGFMUT2(FILENUM,.IENS) QUIT:(GREF="")
|
|---|
| 533 | NEW SL SET SL=$QLENGTH($$CREF^DILF(GREF))
|
|---|
| 534 | NEW REF,RNODE,LNODE
|
|---|
| 535 | NEW DONE SET DONE=0
|
|---|
| 536 | NEW TMGI SET TMGI=0
|
|---|
| 537 | FOR SET TMGI=$ORDER(ARRAY(TMGI)) QUIT:(TMGI="")!(DONE=1) DO
|
|---|
| 538 | . SET REF=$GET(ARRAY(TMGI))
|
|---|
| 539 | . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)
|
|---|
| 540 | . SET TMGI=TMGI+1
|
|---|
| 541 | . IF REF="" SET DONE=1 QUIT
|
|---|
| 542 | . SET RNODE=$EXTRACT($GET(ARRAY(TMGI)),2,10000)
|
|---|
| 543 | . SET LNODE=$GET(@REF)
|
|---|
| 544 | . ;"Later, I will format raw nodes into readable fileman fields and values...
|
|---|
| 545 | . IF $QLENGTH(REF)=(SL+2) DO
|
|---|
| 546 | . . NEW LOC SET LOC=$QSUBSCRIPT(REF,SL+2)
|
|---|
| 547 | . . IF LOC'=0 QUIT
|
|---|
| 548 | . . SET RVALUE=$PIECE(RNODE,"^",1)
|
|---|
| 549 | . . SET LVALUE=$PIECE(LNODE,"^",1)
|
|---|
| 550 | . . SET DONE=1
|
|---|
| 551 | ;
|
|---|
| 552 | QUIT
|
|---|
| 553 | ;
|
|---|
| 554 | ;
|
|---|
| 555 | GETTARGETIEN(FILENUM,ARRAY,TARGETIEN) ;
|
|---|
| 556 | ;"Purpose: To determine if a local record should be overwritten with record from server.
|
|---|
| 557 | ;" Ask user directly if not able to automically determine.
|
|---|
| 558 | ;"Input: FILENUM -- Fileman file (or subfile) number to work with.
|
|---|
| 559 | ;" ARRAY -- Pass by REFERENCE. This is actual remote record from server. Format:
|
|---|
| 560 | ;" ARRAY(1)=ARef_"="
|
|---|
| 561 | ;" ARRAY(2)="="_AValue
|
|---|
| 562 | ;" ARRAY(3)=ARef_"="
|
|---|
| 563 | ;" ARRAY(4)="="_AValue
|
|---|
| 564 | ;" NOTE: IEN of array doesn't match input TARGETIEN, then IEN of array will be changed to it.
|
|---|
| 565 | ;" TARGETIEN -- Required. PASS BY REFERENCE. an IN & OUT PARAMETER.
|
|---|
| 566 | ;" If FILENUM is a subfile, then pass TARGETIEN in standard IENS format.
|
|---|
| 567 | ;" INPUT: The initially planned location for storing the array
|
|---|
| 568 | ;" OUTPUT: This is the pointer of where the record should be stored locally
|
|---|
| 569 | ;"Result: "OVERWRITE" = OVERWRITE record currently stored at TARGETIEN
|
|---|
| 570 | ;" "ABORT" = User abort or error occurred.
|
|---|
| 571 | ;" "USELOCAL" = Dump server data, and just use record already at TARGETIEN
|
|---|
| 572 | ;"TARGETIEN pointer may be changed to new target record location.
|
|---|
| 573 | NEW Y,NARRAY,%
|
|---|
| 574 | NEW R01VALUE,L01VALUE
|
|---|
| 575 | NEW RESULT SET RESULT="OVERWRITE" ;"default to overwriting
|
|---|
| 576 | SET TARGETIEN=$GET(TARGETIEN)
|
|---|
| 577 | IF +TARGETIEN'>0 DO GOTO OVWDN
|
|---|
| 578 | . SET RESULT="ABORT"
|
|---|
| 579 | SET FILENUM=+$GET(FILENUM)
|
|---|
| 580 | NEW RPTR SET RPTR=+$$IENOFARRAY(FILENUM,.ARRAY,TARGETIEN)
|
|---|
| 581 | IF TARGETIEN["," DO ;"i.e. is an IENS
|
|---|
| 582 | . NEW TEMP SET TEMP=TARGETIEN
|
|---|
| 583 | . SET $PIECE(TEMP,",",1)=RPTR
|
|---|
| 584 | . SET RPTR=TEMP ;"convert RPTR into an IENS
|
|---|
| 585 | IF +RPTR'>0 DO GOTO OVWDN
|
|---|
| 586 | . SET RESULT="ABORT"
|
|---|
| 587 | IF $GET(^TMG("TMGSIPH",".01 VALUE",FILENUM,RPTR))="" DO
|
|---|
| 588 | . DO GET01FIELD(FILENUM,.ARRAY,.R01VALUE,,RPTR) ;"Extract .01 field name from data array, before relocated
|
|---|
| 589 | . SET ^TMG("TMGSIPH",".01 VALUE",FILENUM,RPTR)=R01VALUE ;"Needed elsewhere for faster processing of future records.
|
|---|
| 590 | IF TARGETIEN'=RPTR DO GOTO:(RESULT="ABORT") OVWDN
|
|---|
| 591 | . NEW TEMP SET TEMP=$$RLOCARRAY(FILENUM,TARGETIEN,.ARRAY,.NARRAY) ;"Relocate array (change IEN)
|
|---|
| 592 | . IF TEMP=-1 SET RESULT="ABORT" QUIT
|
|---|
| 593 | . KILL ARRAY
|
|---|
| 594 | . MERGE ARRAY=NARRAY
|
|---|
| 595 | NEW DIFF SET DIFF=$$ISDIFF(.ARRAY) ;" 0=no diff, 1=ARRAY has extra info, 2=ARRAY has conflicting info
|
|---|
| 596 | IF DIFF=0 SET RESULT="USELOCAL" GOTO OVWDN
|
|---|
| 597 | IF DIFF=1 SET RESULT="OVERWRITE" GOTO OVWDN
|
|---|
| 598 | ;
|
|---|
| 599 | DO GET01FIELD(FILENUM,.ARRAY,.R01VALUE,.L01VALUE,RPTR) ;
|
|---|
| 600 | IF R01VALUE'=L01VALUE DO GOTO OVWDN ;"If .01 values are different, so move TARGETIEN to new location
|
|---|
| 601 | . SET TARGETIEN=$$APPENDIEN(FILENUM,RPTR) ;"RPTR not used unless dealing with subfile.
|
|---|
| 602 | . SET RESULT=$SELECT((TARGETIEN>0):"OVERWRITE",1:"ABORT")
|
|---|
| 603 | ;
|
|---|
| 604 | IF $GET(^DD(FILENUM,.01,0))["DINUM" SET RESULT="OVERWRITE" GOTO OVWDN ;"translation of pointer not allowed
|
|---|
| 605 | NEW MENU,USRSLCT
|
|---|
| 606 | SET USRSLCT=$GET(^TMG("TMGSIPH","CONFLICT HANDL",FILENUM))
|
|---|
| 607 | IF USRSLCT'="" GOTO OW3
|
|---|
| 608 | ;
|
|---|
| 609 | OW2 WRITE #
|
|---|
| 610 | NEW FNAME SET FNAME=$$FILENAME^TMGFMUT2(FILENUM)
|
|---|
| 611 | KILL MENU
|
|---|
| 612 | set MENU(0)="<<!!CONFLICT FOUND!!>> OVERWRITE LOCAL DATA IN FILE ["_FNAME_"] ?"
|
|---|
| 613 | set MENU(1)="VIEW local and remote raw data"_$char(9)_"View"
|
|---|
| 614 | set MENU(2)="OVERWRITE local data."_$char(9)_"Overwrite1"
|
|---|
| 615 | set MENU(3)="Store record in NEW location."_$char(9)_"ChangeIEN"
|
|---|
| 616 | set MENU(4)="Use LOCAL data, not remote data from server."_$char(9)_"UseLocal"
|
|---|
| 617 | set MENU(5)="FIND a local record to use instead."_$char(9)_"FindLocal"
|
|---|
| 618 | set MENU(6)="Abort"_$char(9)_"Abort"
|
|---|
| 619 | ;
|
|---|
| 620 | WRITE "File = ",FNAME,"; Record .01 field = "_R01VALUE,!
|
|---|
| 621 | SET USRSLCT=$$Menu^TMGUSRIF(.MENU,"")
|
|---|
| 622 | IF USRSLCT="^" SET USRSLCT="Abort"
|
|---|
| 623 | IF USRSLCT=0 set USRSLCT=""
|
|---|
| 624 | IF USRSLCT="FindLocal" DO GOTO:(+Y>0) OVWDN
|
|---|
| 625 | . NEW X,DIC
|
|---|
| 626 | . IF $$ISSUBFIL^TMGFMUT2(FILENUM) DO
|
|---|
| 627 | . . SET DIC=$$GETGREF^TMGFMUT2(FILENUM,TARGETIEN)
|
|---|
| 628 | . ELSE SET DIC=FILENUM
|
|---|
| 629 | . SET DIC(0)="MAEQ"
|
|---|
| 630 | . DO ^DIC WRITE !
|
|---|
| 631 | . IF +Y'>0 QUIT
|
|---|
| 632 | . SET RESULT="OVERWRITE"
|
|---|
| 633 | . SET $PIECE(TARGETIEN,",",1)=+Y
|
|---|
| 634 | IF USRSLCT="Abort" SET RESULT="ABORT" GOTO OVWDN
|
|---|
| 635 | IF USRSLCT="View" DO RECSHOW(FILENUM,RPTR,.ARRAY) GOTO OW2
|
|---|
| 636 | SET %=2
|
|---|
| 637 | WRITE "ALWAYS do this for file ["_FNAME_"]"
|
|---|
| 638 | DO YN^DICN WRITE !
|
|---|
| 639 | IF %=-1 SET RESULT="ABORT" GOTO OVWDN
|
|---|
| 640 | IF %=2 SET ^TMG("TMGSIPH","CONFLICT HANDL",FILENUM)=""
|
|---|
| 641 | ELSE SET ^TMG("TMGSIPH","CONFLICT HANDL",FILENUM)=USRSLCT
|
|---|
| 642 | OW3 IF USRSLCT="Overwrite1" DO GOTO OVWDN
|
|---|
| 643 | . SET RESULT="OVERWRITE"
|
|---|
| 644 | IF USRSLCT="ChangeIEN" DO GOTO OVWDN
|
|---|
| 645 | . SET TARGETIEN=$$APPENDIEN(FILENUM,RPTR) ;"RPTR not used unless dealing with subfile.
|
|---|
| 646 | . SET RESULT=$SELECT((TARGETIEN>0):"OVERWRITE",1:"ABORT")
|
|---|
| 647 | IF USRSLCT="UseLocal" DO GOTO OVWDN
|
|---|
| 648 | . SET RESULT="USELOCAL"
|
|---|
| 649 | GOTO OW2
|
|---|
| 650 | ;
|
|---|
| 651 | OVWDN QUIT RESULT
|
|---|
| 652 | ; |
|---|
