| 1 | TMGSIPH3 ;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 | ;"Support functions for transferring files from server
|
|---|
| 6 | ;"Kevin Toppenberg MD
|
|---|
| 7 | ;"GNU General Public License (GPL) applies
|
|---|
| 8 | ;"11/27/09
|
|---|
| 9 | ;
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;" API -- Public Functions.
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 | ;"TRANSFILE(JNUM) -- move a remote file to local machine, overwriting local entries.
|
|---|
| 14 | ;"GET01FLD(JNUM,FILENUM,IEN) -Get .01 field (internal format) from server.
|
|---|
| 15 | ;"TRANS1FIL(JNUM,FILENUM) -move a remote file to local machine, overwriting local entries.
|
|---|
| 16 | ;"QRYSERVER(JNUM) -- display a given reference from the server
|
|---|
| 17 | ;"TRANSREF(JUNUM) -- move an absolute reference from server to local
|
|---|
| 18 | ;"ASKNEEDED(JNUM,OUTARRAY,INOUT,OPTIONS) --review records of needed records, and
|
|---|
| 19 | ;" ask user which file, or
|
|---|
| 20 | ;" which records to get, and return results of selected in array.
|
|---|
| 21 | ;" This can handle either the list of needed pointers IN or OUT.
|
|---|
| 22 | ;"NUMNEEDED(JNUM,INOUT) -- count number of records needed from server.
|
|---|
| 23 | ;"CHCK4SIM(FILENUM,ARRAY,ANIEN,VALUE01,IENS) -- look at an array and see if there is similar record already on the client.
|
|---|
| 24 | ;"XTRACT01FLD(ARRAY) ; --remove .01 Field values from array returned from GET RECORD & XREF, and store
|
|---|
| 25 | ;"GETANDFIXREC(JNUM,FILENUM,IEN,OVERWRITE,TALLY,INOUT) -- request a record from server, and integrate into local vista,
|
|---|
| 26 | ;" resolving pointers locally to point to newly downloaded record.
|
|---|
| 27 | ;"HANDLNEEDED(JNUM,INOUT,AUTOMODE) --Ask user which records to get from server, then get them and update
|
|---|
| 28 | ;" pointer translation table.
|
|---|
| 29 |
|
|---|
| 30 | ;"=======================================================================
|
|---|
| 31 | ;"Dependancies
|
|---|
| 32 | ;"=======================================================================
|
|---|
| 33 | ;"TMGUSRIF, XLFSTR
|
|---|
| 34 | ;"=======================================================================
|
|---|
| 35 | ;
|
|---|
| 36 | ;
|
|---|
| 37 | TRANSFILE(JNUM)
|
|---|
| 38 | ;"Purpose: to move a remote file to local machine, overwriting local entries.
|
|---|
| 39 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 40 | ;"Results: none
|
|---|
| 41 | NEW X,Y,DIC,ARRAY,%
|
|---|
| 42 | SET DIC=1,DIC(0)="MAEQ"
|
|---|
| 43 | TF1 WRITE "Pick file to transfer COMPLETELY, or to resume transfer from",!
|
|---|
| 44 | DO ^DIC WRITE !
|
|---|
| 45 | IF +Y'>0 DO QUIT:(+Y'>0)!(%=-1)
|
|---|
| 46 | . SET %=1
|
|---|
| 47 | . WRITE "File not found on this client. Do you want to select a file",!
|
|---|
| 48 | . WRITE "to transfer from the server" DO YN^DICN WRITE !
|
|---|
| 49 | . QUIT:(%'=1)
|
|---|
| 50 | . WRITE "Pick file ON SERVER to transfer COMPLETELY: "
|
|---|
| 51 | . READ Y,!
|
|---|
| 52 | . IF Y["^" QUIT
|
|---|
| 53 | . NEW QUERY,REPLY,ERROR,RESULT
|
|---|
| 54 | . SET QUERY="DO DIC|1^"_Y
|
|---|
| 55 | . DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
|
|---|
| 56 | . IF $DATA(ERROR) WRITE ERROR,! SET Y=0 QUIT
|
|---|
| 57 | . SET Y=$GET(REPLY(1))
|
|---|
| 58 | . IF +Y>0 SET ^TMG("TMGSIPH","DD",+Y,"DIFF")=0
|
|---|
| 59 | FOR DO QUIT:(DDOK'=0)
|
|---|
| 60 | . SET DDOK=$$PREPDD^TMGSIPH1(JNUM,+Y)
|
|---|
| 61 | . QUIT:(DDOK=1)
|
|---|
| 62 | . WRITE "Before records can be transferred from the server, the local data",!
|
|---|
| 63 | . WRITE "dictionary must be made compatible. Must work on this now.",!
|
|---|
| 64 | . DO PressToCont^TMGUSRIF
|
|---|
| 65 | . SET DDOK=+$GET(^TMG("TMGSIPH","DD",+Y,"DIFF"))
|
|---|
| 66 | GOTO TF1:(DDOK'=1)
|
|---|
| 67 | DO TRANS1FIL(JNUM,+Y)
|
|---|
| 68 | GOTO TF1
|
|---|
| 69 | ;
|
|---|
| 70 | ;
|
|---|
| 71 | GET01FLD(JNUM,FILENUM,IEN) ;
|
|---|
| 72 | ;"Purpose: Get .01 field (internal format) from server, or return previously obtained value.
|
|---|
| 73 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 74 | ;" FILENUM -- The file number to compare.
|
|---|
| 75 | ;" IEN -- the record to query -- Server-side IEN, not client IEN
|
|---|
| 76 | ;"Result: returns the .01 value or "" if problem
|
|---|
| 77 | SET RESULT=$GET(^TMG("TMGSIPH",".01 VALUE",FILENUM,IEN))
|
|---|
| 78 | IF RESULT'="" GOTO G1DN
|
|---|
| 79 | NEW QUERY,REPLY,ERROR,RESULT
|
|---|
| 80 | SET QUERY="GET .01 FLD|"_FILENUM_"^"_IEN
|
|---|
| 81 | DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
|
|---|
| 82 | IF $DATA(ERROR) WRITE ERROR,!
|
|---|
| 83 | SET RESULT=$GET(REPLY(1))
|
|---|
| 84 | SET ^TMG("TMGSIPH",".01 VALUE",FILENUM,IEN)=RESULT
|
|---|
| 85 | G1DN QUIT RESULT
|
|---|
| 86 | ;
|
|---|
| 87 | ;
|
|---|
| 88 | TRANS1FIL(JNUM,FILENUM) ;
|
|---|
| 89 | ;"Purpose: to move a remote file to local machine, overwriting local entries.
|
|---|
| 90 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 91 | ;" FILENUM -- The file number to transfer. (Not a subfile)
|
|---|
| 92 | ;"Output: Will set output globals:
|
|---|
| 93 | ;" ^TMG("TMGSIPH","PT XLAT",FILENUM,RemoteIEN)=LocalIEN
|
|---|
| 94 | ;" ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,ReferToNodeToBeCorrected,Piece#OfNode)=""
|
|---|
| 95 | ;"Results: none
|
|---|
| 96 | ;
|
|---|
| 97 | NEW MAXNUM
|
|---|
| 98 | NEW QUERY,ERROR,RESULT,REPLY
|
|---|
| 99 | SET QUERY="NUMRECS|"_FILENUM
|
|---|
| 100 | DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,15)
|
|---|
| 101 | IF $DATA(ERROR) WRITE ERROR,! GOTO T1FD
|
|---|
| 102 | SET MAXNUM=+$GET(REPLY(1))
|
|---|
| 103 | IF MAXNUM'>0 DO GOTO T1FD
|
|---|
| 104 | . WRITE "Error: number of records=",MAXNUM,!
|
|---|
| 105 | NEW STARTTIME SET STARTTIME=$H
|
|---|
| 106 | NEW GLREF SET GLREF=$GET(^DIC(FILENUM,0,"GL"))
|
|---|
| 107 | NEW REF SET REF=$GET(^TMG("TMGSIPH","DOWNLOADED",FILENUM,"#PRIOR RUN#"))
|
|---|
| 108 | NEW % SET %=1 ;"Default=Y
|
|---|
| 109 | IF REF'="" DO
|
|---|
| 110 | . WRITE "Continue transfer of records from point of last run"
|
|---|
| 111 | . DO YN^DICN WRITE !
|
|---|
| 112 | . IF %=2 SET REF=""
|
|---|
| 113 | IF %=-1 GOTO T1FD
|
|---|
| 114 | IF REF="" SET REF=$$CREF^DILF(GLREF_""""",")
|
|---|
| 115 | SET GLREF=$$CREF^DILF(GLREF)
|
|---|
| 116 | NEW QL SET QL=$QLENGTH(REF)
|
|---|
| 117 | WRITE "Press ESC to abort...",!
|
|---|
| 118 | NEW REC SET REC=""
|
|---|
| 119 | NEW TMGABORT
|
|---|
| 120 | FOR DO QUIT:(REF="")!(TMGABORT=1)
|
|---|
| 121 | . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
|
|---|
| 122 | . SET QUERY="ORDREF|"_REF
|
|---|
| 123 | . DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
|
|---|
| 124 | . IF $DATA(ERROR) DO QUIT
|
|---|
| 125 | . . WRITE ERROR,!
|
|---|
| 126 | . . SET REF=""
|
|---|
| 127 | . IF $DATA(REPLY)=0 SET REF="" QUIT
|
|---|
| 128 | . DO STOREDATA^TMGSIPHU(.REPLY)
|
|---|
| 129 | . SET ^TMG("TMGSIPH","DOWNLOADED",FILENUM,"#PRIOR RUN#")=REF
|
|---|
| 130 | . SET REF=$GET(REPLY(1)) QUIT:(REF="")
|
|---|
| 131 | . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)
|
|---|
| 132 | . SET REF=$$QSUBS^TMGSIPHU(REF,QL)
|
|---|
| 133 | . IF $QSUBSCRIPT(REF,QL)=REC do
|
|---|
| 134 | . . write "ERROR: Record number didn't increase!",!
|
|---|
| 135 | . SET REC=$QSUBSCRIPT(REF,QL)
|
|---|
| 136 | . IF (+REC=REC) DO
|
|---|
| 137 | . . IF $$REAL1PTOUT^TMGSIPH1(FILENUM,REC) ;"Ignore function result
|
|---|
| 138 | . . SET ^TMG("TMGSIPH","PT XLAT",FILENUM,REC)=REC ;"remote and local IEN's are same
|
|---|
| 139 | . . SET ^TMG("TMGSIPH","DOWNLOADED",FILENUM,REC)=REC
|
|---|
| 140 | . IF (REC#10)=0 DO
|
|---|
| 141 | . . DO ProgressBar^TMGUSRIF(REC,"Progress: "_REC,0,MAXNUM,70,STARTTIME)
|
|---|
| 142 | T1FD QUIT
|
|---|
| 143 | ;
|
|---|
| 144 | ;
|
|---|
| 145 | QRYSERVER(JNUM) ;
|
|---|
| 146 | ;"Purpose: To display a given reference from the server
|
|---|
| 147 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 148 | SET JNUM=+$GET(JNUM)
|
|---|
| 149 | QUIT:(+JNUM'>0)
|
|---|
| 150 | NEW QUERY,ERROR,RESULT,REPLY
|
|---|
| 151 | FOR DO quit:(QUERY="^")
|
|---|
| 152 | . READ "Enter reference> ",QUERY,!
|
|---|
| 153 | . IF (QUERY="")!(QUERY="^") SET QUERY="^" QUIT
|
|---|
| 154 | . ELSE SET QUERY="GET|"_QUERY
|
|---|
| 155 | . DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,5)
|
|---|
| 156 | . IF $DATA(ERROR) WRITE ERROR,!
|
|---|
| 157 | . IF $DATA(REPLY) do
|
|---|
| 158 | . . WRITE "reply:",!
|
|---|
| 159 | . . ZWR REPLY
|
|---|
| 160 | quit
|
|---|
| 161 | ;
|
|---|
| 162 | ;
|
|---|
| 163 | TRANSREF(JNUM) ;
|
|---|
| 164 | ;"Purpose: To move an absolute reference from server to local
|
|---|
| 165 | SET JNUM=+$GET(JNUM)
|
|---|
| 166 | QUIT:(+JNUM'>0)
|
|---|
| 167 | WRITE "This will allow an arbitrary global to be transferred",!
|
|---|
| 168 | write "from the server.",!
|
|---|
| 169 | NEW REF,QUERY,ERROR,RESULT,REPLY,%
|
|---|
| 170 | FOR DO QUIT:(REF="^")
|
|---|
| 171 | . READ "Enter reference (e.g. ""^ABC(123,"" or ^ to quit)> ",REF,!
|
|---|
| 172 | . IF (REF="")!(REF="^") SET REF="^" QUIT
|
|---|
| 173 | . SET REF=$$CREF^DILF(REF)
|
|---|
| 174 | . SET QUERY="GET|"_REF
|
|---|
| 175 | . DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,5)
|
|---|
| 176 | . IF $DATA(ERROR) WRITE ERROR,! QUIT
|
|---|
| 177 | . IF $DATA(REPLY) ZWR REPLY WRITE !
|
|---|
| 178 | . SET %=1
|
|---|
| 179 | . IF $DATA(@REF) DO QUIT:(%'=1)
|
|---|
| 180 | . . WRITE "WARNING: There is already data locally at ",REF,!
|
|---|
| 181 | . . WRITE "Do you want to OVERWRITE this local data"
|
|---|
| 182 | . . SET %=2
|
|---|
| 183 | . . DO YN^DICN WRITE !
|
|---|
| 184 | . DO STOREDATA^TMGSIPHU(.REPLY)
|
|---|
| 185 | . WRITE "Data stored locally.",!,!
|
|---|
| 186 | . KILL REPLY
|
|---|
| 187 | quit
|
|---|
| 188 |
|
|---|
| 189 |
|
|---|
| 190 |
|
|---|
| 191 |
|
|---|
| 192 | ASKNEEDED(JNUM,OUTARRAY,INOUT,OPTIONS) ;
|
|---|
| 193 | ;"Purpose: To review records of needed records, and ask user which file, or
|
|---|
| 194 | ;" which records to get, and return results of selected in array.
|
|---|
| 195 | ;" This can handle either the list of needed pointers IN or OUT.
|
|---|
| 196 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 197 | ;" OUTARRAY -- PASS BY REFERNCE, an OUT PARAMETER. Filled as follows
|
|---|
| 198 | ;" OUTARRAY(FileNum,RecordNum)=""
|
|---|
| 199 | ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
|
|---|
| 200 | ;" OPTIONS -- OPTIONAL default is 0. See SELNEEDED for details.
|
|---|
| 201 | ;"Results: None.
|
|---|
| 202 | ;"NOTE: uses ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,RefToNodeToBeCorrected,Piece#OfNode)=""
|
|---|
| 203 | ;" ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,IEN)=""
|
|---|
| 204 | ;
|
|---|
| 205 | NEW REF SET REF=$NAME(^TMG("TMGSIPH","NEEDED RECORDS",INOUT))
|
|---|
| 206 | DO SELNEEDED(JNUM,.OUTARRAY,REF,.OPTIONS)
|
|---|
| 207 | QUIT
|
|---|
| 208 | ;
|
|---|
| 209 | ;
|
|---|
| 210 | SELNEEDED(JNUM,OUTARRAY,REF,OPTIONS) ;
|
|---|
| 211 | ;"Purpose: To review an array of needed records, and ask user which file, or
|
|---|
| 212 | ;" which records to get, and return results of selected in array.
|
|---|
| 213 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 214 | ;" OUTARRAY -- PASS BY REFERNCE, an OUT PARAMETER. Filled as follows
|
|---|
| 215 | ;" OUTARRAY(FileNum,RecordNum)=""
|
|---|
| 216 | ;" REF -- PASS BY NAME -- The name of the variable holding the records to ask from. Variable
|
|---|
| 217 | ;" array should have this format:
|
|---|
| 218 | ;" @REF@(FILENUM,RPTR)=""
|
|---|
| 219 | ;" @REF@(FILENUM,RPTR)=""
|
|---|
| 220 | ;" OPTIONS -- OPTIONAL default is 0. If 1, then all records are processed without asking.
|
|---|
| 221 | ;" OPTIONS("MAP MODE")=1 OPTIONAL, if exists, then different header is displayed
|
|---|
| 222 | ;" OPTIONS("NUMNEEDED")=1 OPTIONAL, if exists, will only get up to 200 records
|
|---|
| 223 | ;" OPTIONS("HEADER")=<header text> OPTIONAL. If present, will be used for header display
|
|---|
| 224 | ;"Results: None.
|
|---|
| 225 | NEW TMGARRAY,TMGSEL,TMGSEL2
|
|---|
| 226 | KILL OUTARRAY
|
|---|
| 227 | SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
|
|---|
| 228 | NEW FILENUM SET FILENUM=""
|
|---|
| 229 | NEW AUTOMODE SET AUTOMODE=(+$GET(OPTIONS)=1)
|
|---|
| 230 | FOR SET FILENUM=$ORDER(@REF@(FILENUM)) QUIT:(+FILENUM'>0) DO
|
|---|
| 231 | . NEW DISPSTR SET DISPSTR="Get records from REMOTE file #"_FILENUM_" ("
|
|---|
| 232 | . SET DISPSTR=DISPSTR_$$FILENAME^TMGFMUT2(FILENUM)_")"
|
|---|
| 233 | . SET TMGARRAY(DISPSTR)=FILENUM
|
|---|
| 234 | NEW STIME SET STIME=$H
|
|---|
| 235 | NEW SHOWPROG SET SHOWPROG=0
|
|---|
| 236 | NEW TMGCT SET TMGCT=0
|
|---|
| 237 | NEW TMGDONE SET TMGDONE=0
|
|---|
| 238 | NEW SHORTLST SET SHORTLST=+$GET(OPTIONS("NUMNEEDED"))
|
|---|
| 239 | NEW HEADER
|
|---|
| 240 | IF $DATA(OPTIONS("HEADER")) DO
|
|---|
| 241 | . SET HEADER=$GET(OPTIONS("HEADER"))
|
|---|
| 242 | ELSE DO
|
|---|
| 243 | . IF $GET(OPTIONS("MAP MODE"))=1 DO
|
|---|
| 244 | . . SET HEADER="Select File(s) to MAP to local records in. Press <ESC><ESC> when Done."
|
|---|
| 245 | . ELSE SET HEADER="Select File(s) to get REMOTE records from. Press <ESC><ESC> when Done."
|
|---|
| 246 | IF AUTOMODE MERGE TMGSEL=TMGARRAY
|
|---|
| 247 | ELSE DO Selector^TMGUSRIF("TMGARRAY","TMGSEL",HEADER)
|
|---|
| 248 | NEW TMGABORT SET TMGABORT=0
|
|---|
| 249 | NEW IDX SET IDX=""
|
|---|
| 250 | FOR SET IDX=$ORDER(TMGSEL(IDX)) QUIT:(IDX="")!TMGABORT!TMGDONE DO
|
|---|
| 251 | . SET FILENUM=$GET(TMGSEL(IDX)) QUIT:FILENUM=""
|
|---|
| 252 | . NEW FNAME SET FNAME=$$FILENAME^TMGFMUT2(FILENUM)
|
|---|
| 253 | . NEW RPTR SET RPTR=""
|
|---|
| 254 | . KILL TMGARRAY,TMGSEL2
|
|---|
| 255 | . NEW RECCT SET RECCT=0
|
|---|
| 256 | . NEW SELALL SET SELALL=0
|
|---|
| 257 | . NEW ASKED SET ASKED=0
|
|---|
| 258 | . IF AUTOMODE=0 WRITE "GETTING NAMES OF RECORDS...",!
|
|---|
| 259 | . FOR SET RPTR=$ORDER(@REF@(FILENUM,RPTR)) QUIT:(RPTR="")!SELALL!TMGABORT!TMGDONE DO
|
|---|
| 260 | . . NEW DISPSTR SET DISPSTR="File: "_FNAME_", record #"_$$RJ^XLFSTR(RPTR,6)
|
|---|
| 261 | . . IF AUTOMODE=0 SET DISPSTR=DISPSTR_" -- "_$$GET01FLD(JNUM,FILENUM,RPTR)
|
|---|
| 262 | . . SET TMGARRAY(DISPSTR)=RPTR
|
|---|
| 263 | . . SET RECCT=RECCT+1
|
|---|
| 264 | . . SET TMGCT=TMGCT+1
|
|---|
| 265 | . . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>10) DO ;"Turn on progress bar after 10 seconds.
|
|---|
| 266 | . . . SET SHOWPROG=1
|
|---|
| 267 | . . IF (SHOWPROG=1),(TMGCT>500) DO
|
|---|
| 268 | . . . DO ProgressBar^TMGUSRIF(100,"Gathering list of needed records "_RECCT,-1,-1,70,STIME)
|
|---|
| 269 | . . . SET TMGCT=0
|
|---|
| 270 | . . IF (RECCT>200),(ASKED=0) DO
|
|---|
| 271 | . . . IF SHORTLST SET TMGDONE=1,RECCT=0 QUIT
|
|---|
| 272 | . . . SET ASKED=1
|
|---|
| 273 | . . . IF AUTOMODE=1 QUIT
|
|---|
| 274 | . . . NEW MENU,USRSLCT
|
|---|
| 275 | . . . SET MENU(0)="File "_FNAME_" has > 200 records."
|
|---|
| 276 | . . . SET MENU(1)="Automatically Select ALL records"_$char(9)_"AutoSelALL"
|
|---|
| 277 | . . . SET MENU(2)="Show LONG list to allow picking individual records"_$char(9)_"SelectList"
|
|---|
| 278 | . . . NEW DONE SET DONE=0
|
|---|
| 279 | . . . FOR DO QUIT:(DONE=1)!(TMGABORT)
|
|---|
| 280 | . . . . WRITE #
|
|---|
| 281 | . . . . SET USRSLCT=$$MENU^TMGUSRIF(.MENU,"^")
|
|---|
| 282 | . . . . SET DONE=1
|
|---|
| 283 | . . . . IF USRSLCT="^" SET TMGABORT=1 QUIT
|
|---|
| 284 | . . . . IF USRSLCT="AutoSelALL" SET SELALL=1 QUIT
|
|---|
| 285 | . . . . IF USRSLCT="SelectList" QUIT
|
|---|
| 286 | . . . . ELSE SET DONE=0
|
|---|
| 287 | . IF TMGABORT QUIT
|
|---|
| 288 | . IF (RECCT=1)!AUTOMODE!SELALL DO
|
|---|
| 289 | . . NEW TMGSKIP SET TMGSKIP=0
|
|---|
| 290 | . . SET TMGCT=0
|
|---|
| 291 | . . NEW ONEREC SET ONEREC=""
|
|---|
| 292 | . . FOR SET ONEREC=$ORDER(@REF@(FILENUM,ONEREC)) QUIT:(ONEREC="")!TMGSKIP DO
|
|---|
| 293 | . . . SET TMGSEL2(ONEREC)=ONEREC
|
|---|
| 294 | . . . IF SHORTLST,(TMGCT>200) SET TMGSKIP=1,TMGDONE=1 QUIT
|
|---|
| 295 | . . . SET TMGCT=TMGCT+1
|
|---|
| 296 | . . . SET RECCT=RECCT+1
|
|---|
| 297 | . . . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>10) DO ;"Turn on progress bar after 10 seconds.
|
|---|
| 298 | . . . . SET SHOWPROG=1
|
|---|
| 299 | . . . IF (SHOWPROG=1),(TMGCT>500) DO
|
|---|
| 300 | . . . . DO ProgressBar^TMGUSRIF(100,"Gathering list of needed records "_RECCT,0,100,70,STIME)
|
|---|
| 301 | . . . . SET TMGCT=0
|
|---|
| 302 | . . SET SELALL=1
|
|---|
| 303 | . IF SELALL=0 DO
|
|---|
| 304 | . . IF $GET(OPTIONS("MAP MODE"))=1 DO
|
|---|
| 305 | . . . SET HEADER="Select records to MAP to local records. Press <ESC><ESC> when Done."
|
|---|
| 306 | . . ELSE SET HEADER="Select records to get from Server. Press <ESC><ESC> when Done."
|
|---|
| 307 | . . DO Selector^TMGUSRIF("TMGARRAY","TMGSEL2",HEADER)
|
|---|
| 308 | . NEW I2 SET I2=""
|
|---|
| 309 | . FOR SET I2=$ORDER(TMGSEL2(I2)) QUIT:(I2="") DO
|
|---|
| 310 | . . SET RPTR=$GET(TMGSEL2(I2))
|
|---|
| 311 | . . SET OUTARRAY(FILENUM,RPTR)=""
|
|---|
| 312 | ;
|
|---|
| 313 | QUIT
|
|---|
| 314 | ;
|
|---|
| 315 | ;
|
|---|
| 316 | NUMNEEDED(JNUM,INOUT)
|
|---|
| 317 | ;"Purpose: To count number of records needed from server.
|
|---|
| 318 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 319 | ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
|
|---|
| 320 | ;"Output: Returns the number of records needed.
|
|---|
| 321 | ;"
|
|---|
| 322 | NEW GETARRAY,FILENUM,RESULT
|
|---|
| 323 | SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
|
|---|
| 324 | NEW MODE SET MODE=1,MODE("NUMNEEDED")=1 ;"Will limit number counting to 200 mg
|
|---|
| 325 | DO ASKNEEDED(JNUM,.GETARRAY,INOUT,.MODE)
|
|---|
| 326 | SET FILENUM=0
|
|---|
| 327 | SET RESULT=0
|
|---|
| 328 | NEW TMGCT SET TMGCT=0
|
|---|
| 329 | NEW STIME SET STIME=$H
|
|---|
| 330 | NEW SHOWPROG SET SHOWPROG=0
|
|---|
| 331 | FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="") DO
|
|---|
| 332 | . NEW IEN SET IEN=""
|
|---|
| 333 | . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="") DO
|
|---|
| 334 | . . SET RESULT=RESULT+1
|
|---|
| 335 | . . SET TMGCT=TMGCT+1
|
|---|
| 336 | . . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>5) DO ;"Turn on progress bar after 5 seconds.
|
|---|
| 337 | . . . SET SHOWPROG=1
|
|---|
| 338 | . . IF (SHOWPROG=1),(TMGCT>1000) DO
|
|---|
| 339 | . . . DO ProgressBar^TMGUSRIF(100,"Counting records: "_TMGCT,0,100,70)
|
|---|
| 340 | . . . SET TMGCT=0
|
|---|
| 341 | IF TMGCT>200 SET TMGCT=TMGCT_"+"
|
|---|
| 342 | QUIT TMGCT
|
|---|
| 343 | ;
|
|---|
| 344 | ;
|
|---|
| 345 | CHCK4SIM(FILENUM,ARRAY,ANIEN,VALUE01,IENS)
|
|---|
| 346 | ;"Purpose: To look at an array, as returned from server, and see if there is
|
|---|
| 347 | ;" a similar record already on the client.
|
|---|
| 348 | ;"Input: FILENUM -- the fileman filenumber of file to get from remote server
|
|---|
| 349 | ;" ARRAY -- The global record array, as returned from server.
|
|---|
| 350 | ;" ANIEN -- PASS BY REFERENCE. Will be filled with IEN match
|
|---|
| 351 | ;" If IENS is passed (i.e. if dealing with a subfile), then ANIEN is passed
|
|---|
| 352 | ;" back in standard IENS format (e.g. '7,1234,')
|
|---|
| 353 | ;" VALUE01 -- OPTIONAL. This allows a .01 value to be passed. If provided, then
|
|---|
| 354 | ;" the ARRAY won't be searched for a .01 value.
|
|---|
| 355 | ;" IENS -- OPTIONAL. If FILENUM is a subfile, then IENS is needed for lookup.
|
|---|
| 356 | ;" IENS is modified, so **DON'T** PASS BY REFERENCE
|
|---|
| 357 | ;"Results: 0 if no similar record already on the local server (i.e. NO MATCH)
|
|---|
| 358 | ;" 1 if a match WAS found.
|
|---|
| 359 | ;"Output: ANIEN is modified.
|
|---|
| 360 | ;"NOTE: If .01 field of passed record array matches to 2 or more records, then NO MATCH resulted
|
|---|
| 361 | ;" Also, if file does not have a "B" cross reference, then NO MATCH resulted.
|
|---|
| 362 | ;" Also, the first 30 characters (only) are tested for match in "B" xref.
|
|---|
| 363 | ;
|
|---|
| 364 | NEW RESULT SET RESULT=0
|
|---|
| 365 | SET ANIEN=0
|
|---|
| 366 | SET FILENUM=+$GET(FILENUM) ;" If in format of 'SubFile{ParentFile', then strip off parent filenum.
|
|---|
| 367 | NEW GREF SET GREF=$$GETGREF^TMGFMUT2(FILENUM,.IENS) ;"IENS not used if not subfile.
|
|---|
| 368 | IF GREF="" GOTO C4SDN
|
|---|
| 369 | NEW BREF SET BREF=GREF_"""B"")"
|
|---|
| 370 | NEW SAVIENS SET SAVIENS=$GET(IENS)
|
|---|
| 371 | SET $PIECE(IENS,",",1)="" ;"e.g. '7,2345,' --> ',2345,' to specify parent, but no particular subfile entry
|
|---|
| 372 | IF $DATA(@BREF)=0 GOTO C4SDN
|
|---|
| 373 | NEW CGREF SET CGREF=$$CREF^DILF(GREF)
|
|---|
| 374 | NEW GREFLEN SET GREFLEN=$QLENGTH(CGREF)
|
|---|
| 375 | NEW VALUE SET VALUE=$GET(VALUE01)
|
|---|
| 376 | NEW TMGI SET TMGI=0
|
|---|
| 377 | FOR SET TMGI=$ORDER(ARRAY(TMGI)) QUIT:(TMGI="")!(VALUE'="") DO ;"Find .01 value
|
|---|
| 378 | . NEW REF SET REF=$GET(ARRAY(TMGI))
|
|---|
| 379 | . SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)
|
|---|
| 380 | . SET TMGI=TMGI+1
|
|---|
| 381 | . IF REF="" SET TMGI="" QUIT
|
|---|
| 382 | . IF $QSUBSCRIPT(REF,GREFLEN+2)'=0 QUIT ;"Only check 0 node.
|
|---|
| 383 | . IF $QLENGTH(REF)'=(GREFLEN+2) QUIT ;"Only allow ^GREF(xxx,xxx,IEN,0)
|
|---|
| 384 | . SET VALUE=$EXTRACT($GET(ARRAY(TMGI)),2,10000)
|
|---|
| 385 | . SET VALUE=$PIECE(VALUE,"^",1)
|
|---|
| 386 | IF VALUE="" GOTO C4SDN
|
|---|
| 387 | IF (FILENUM'=9999999.27),$GET(^TMG("TMGSIPH","SKIP CHCK4SIM",FILENUM,VALUE))=1 GOTO C4SDN
|
|---|
| 388 | NEW TMGOUT,TMGMSG
|
|---|
| 389 | DO FIND^DIC(FILENUM,IENS,"@;.01I","BOQUX",VALUE,"*","B","","","TMGOUT","TMGMSG")
|
|---|
| 390 | DO ShowIfDIERR^TMGDEBUG(.TMGOUT)
|
|---|
| 391 | NEW CT SET CT=+$GET(TMGOUT("DILIST",0))
|
|---|
| 392 | IF CT=1 DO
|
|---|
| 393 | . ;"Ensure matched local record didn't actually come from server
|
|---|
| 394 | . NEW LPTR SET LPTR=+$GET(TMGOUT("DILIST",2,1))
|
|---|
| 395 | . IF $DATA(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)) QUIT
|
|---|
| 396 | . IF SAVIENS'="" DO
|
|---|
| 397 | . . SET ANIEN=SAVIENS
|
|---|
| 398 | . . SET $PIECE(ANIEN,",",1)=LPTR
|
|---|
| 399 | . ELSE SET ANIEN=LPTR
|
|---|
| 400 | . SET RESULT=1
|
|---|
| 401 | ELSE IF CT>100 DO
|
|---|
| 402 | . SET ^TMG("TMGSIPH","SKIP CHCK4SIM",FILENUM,VALUE)=1
|
|---|
| 403 | ;
|
|---|
| 404 | C4SDN QUIT RESULT
|
|---|
| 405 | ;
|
|---|
| 406 | ;
|
|---|
| 407 | XTRACT01FLD(ARRAY) ;
|
|---|
| 408 | ;"Purpose: To remove pointed-to .01 Field values from array returned from GET RECORD & XREF,
|
|---|
| 409 | ;" and store these for future reference. Removes %PTRSOUT%
|
|---|
| 410 | ;"Input: ARRAY -- PASS BY REFERENCE. Results returned from GET RECORD & XREF. Format:
|
|---|
| 411 | ;" ARRAY(1)="<Ref>="
|
|---|
| 412 | ;" ARRAY(2)="=<Value>"
|
|---|
| 413 | ;" ARRAY(3)="<Ref>="
|
|---|
| 414 | ;" ARRAY(4)="=<Value>"
|
|---|
| 415 |
|
|---|
| 416 | ;" ...
|
|---|
| 417 | ;" ARRAY(20)="%PTRSOUT%^PointedToFile^IEN^FIELD_VALUE"
|
|---|
| 418 | ;" ARRAY(21)="%PTRSOUT%^PointedToFile^IEN^FIELD_VALUE"
|
|---|
| 419 | ;" ...
|
|---|
| 420 | ;"Results: none
|
|---|
| 421 | NEW RESULT SET RESULT=0 ;Default to error.
|
|---|
| 422 | NEW SHOWPG SET SHOWPG=0
|
|---|
| 423 | NEW TMGCT SET TMGCT=0
|
|---|
| 424 | NEW STIME SET STIME=$H
|
|---|
| 425 | NEW TMGI SET TMGI=""
|
|---|
| 426 | FOR SET TMGI=$ORDER(ARRAY(TMGI)) QUIT:(+TMGI'>0) DO
|
|---|
| 427 | . IF (SHOWPG=0),($$HDIFF^XLFDT($H,STIME,2)>15) DO ;"Turn on progress bar after 15 seconds.
|
|---|
| 428 | . . SET SHOWPG=1
|
|---|
| 429 | . . SET TMGMIN=$ORDER(ARRAY(0))
|
|---|
| 430 | . . SET TMGMAX=$ORDER(ARRAY(""),-1)
|
|---|
| 431 | . IF (SHOWPG=1),(TMGCT>2000) DO
|
|---|
| 432 | . . DO ProgressBar^TMGUSRIF(TMGI,"Extracting pointers from server data",TMGMIN,TMGMAX,70,STIME)
|
|---|
| 433 | . . SET TMGCT=0
|
|---|
| 434 | . SET TMGCT=TMGCT+1
|
|---|
| 435 | . IF $GET(ARRAY(TMGI))'["%PTRSOUT%" QUIT
|
|---|
| 436 | . NEW FILENUM SET FILENUM=$PIECE(ARRAY(TMGI),"^",2)
|
|---|
| 437 | . NEW IEN SET IEN=$PIECE(ARRAY(TMGI),"^",3)
|
|---|
| 438 | . NEW VALUE SET VALUE=$PIECE(ARRAY(TMGI),"^",4)
|
|---|
| 439 | . KILL ARRAY(TMGI)
|
|---|
| 440 | . SET ^TMG("TMGSIPH",".01 VALUE",FILENUM,IEN)=VALUE
|
|---|
| 441 | QUIT
|
|---|
| 442 | ;
|
|---|
| 443 | ;
|
|---|
| 444 | GETANDFIXREC(JNUM,FILENUM,RPTR,OVERWRITE,TALLY,INOUT) ;
|
|---|
| 445 | ;"Purpose: To request a record from server, and integrate into local vista,
|
|---|
| 446 | ;" resolving pointers locally to point to newly downloaded record.
|
|---|
| 447 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 448 | ;" FILENUM -- the fileman filenumber of file to get from remote server
|
|---|
| 449 | ;" Can be in format of SubFileNum{ParentFileNum{GrandParent....
|
|---|
| 450 | ;" RPTR -- The record number on the server to get.
|
|---|
| 451 | ;" Can be in IENS format, e.g. '7,34532,' if FILENUM is a subfile.
|
|---|
| 452 | ;" OVERWRITE -- OPTIONAL. If 1, then prior local records may be overwritten.
|
|---|
| 453 | ;" If '?' then figure out if should overwrite, asking user if needed.
|
|---|
| 454 | ;" TALLY -- OPTIONAL. PASS BY REFERENCE. An array to keep progress stats. Format:
|
|---|
| 455 | ;" TALLY("ALREADY LOCAL FOUND")=#
|
|---|
| 456 | ;" TALLY("DOWNLOADED")=#
|
|---|
| 457 | ;" TALLY(FILENUM,"NEW REC NEEDED")=#
|
|---|
| 458 | ;" TALLY("UNNEEDED RECORDS")=#
|
|---|
| 459 | ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
|
|---|
| 460 | ;"NOTE: Gobal ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT") used, with format as below:
|
|---|
| 461 | ;" ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM,RemotePointer,RefToNodeToBeCorrected,Piece#OfNode)=""
|
|---|
| 462 | ;" As pointers are resolved, the entries will be KILLED from the above global
|
|---|
| 463 | ;"Results: 1 if OK, -1 if error, -2 if abort
|
|---|
| 464 | ;
|
|---|
| 465 | NEW QUERY,REPLY,ERROR,NEWIEN
|
|---|
| 466 | NEW RESULT SET RESULT=-1 ;"Default to error
|
|---|
| 467 | NEW TMGABORT SET TMGABORT=0
|
|---|
| 468 | SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
|
|---|
| 469 | SET OVERWRITE=$GET(OVERWRITE)
|
|---|
| 470 | SET FILENUM=$GET(FILENUM)
|
|---|
| 471 | NEW ISSUBFIL SET ISSUBFIL=$$ISSUBFIL^TMGFMUT2(+FILENUM)
|
|---|
| 472 | IF +RPTR'>0 GOTO GAFRD
|
|---|
| 473 | SET NEWIEN=RPTR ;"Default of not changing IEN
|
|---|
| 474 | SET FILENUM=+FILENUM IF FILENUM'>0 GOTO GAFRD ;"If subfile, strip parent file number.
|
|---|
| 475 | NEW LPTR SET LPTR=$GET(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR))
|
|---|
| 476 | IF (+LPTR>0) DO GOTO GAFR1 ;"Remote records already downloaded, so just link to it.
|
|---|
| 477 | . SET NEWIEN=LPTR
|
|---|
| 478 | . SET TALLY("ALREADY LOCAL FOUND")=+$GET(TALLY("ALREADY LOCAL FOUND"))+1
|
|---|
| 479 | NEW CONHANDL SET CONHANDL=$GET(^TMG("TMGSIPH","CONFLICT HANDL",FILENUM))
|
|---|
| 480 | NEW USELOCAL SET USELOCAL=0
|
|---|
| 481 | IF CONHANDL="UseLocal" DO GOTO:(USELOCAL=1) GAF2
|
|---|
| 482 | . ;"If pointer is to a file specified as ALWAYS LOCAL, Handle here, if .01 value is known.
|
|---|
| 483 | . NEW VALUE SET VALUE=$GET(^TMG("TMGSIPH",".01 VALUE",FILENUM,RPTR))
|
|---|
| 484 | . QUIT:(VALUE="")
|
|---|
| 485 | . NEW ANIEN
|
|---|
| 486 | . IF $$CHCK4SIM(FILENUM,,.ANIEN,VALUE,RPTR)=0 QUIT ;"RPTR (as IENS) not used if not subfile.
|
|---|
| 487 | . IF +ANIEN'>0 QUIT
|
|---|
| 488 | . SET NEWIEN=ANIEN
|
|---|
| 489 | . SET USELOCAL=1
|
|---|
| 490 | NEW GREF SET GREF=$$GETGREF^TMGFMUT2(FILENUM,RPTR) ;"RPTR (as IENS) not used if not subfile.
|
|---|
| 491 | IF GREF="" GOTO GAFRD
|
|---|
| 492 | NEW ZREF SET ZREF=GREF_"0)"
|
|---|
| 493 | NEW CGREF SET CGREF=$$CREF^DILF(GREF)
|
|---|
| 494 | IF ISSUBFIL DO
|
|---|
| 495 | . NEW REF SET REF=GREF_+RPTR
|
|---|
| 496 | . SET QUERY="GET REF & FILE XREF|"_REF_"^"_FILENUM_"^"_RPTR
|
|---|
| 497 | ELSE DO
|
|---|
| 498 | . SET QUERY="GET RECORD & XREF|"_FILENUM_"^"_RPTR
|
|---|
| 499 | DO MSGCLIENT^TMGKERN2(JNUM,QUERY,.REPLY,.ERROR,30)
|
|---|
| 500 | IF $DATA(ERROR) DO GOTO GAFRD
|
|---|
| 501 | . WRITE ERROR,!
|
|---|
| 502 | IF $DATA(REPLY)=0 DO GOTO GAFR0 ;"No data on server for record, so zero pointers
|
|---|
| 503 | . SET NEWIEN=0
|
|---|
| 504 | DO XTRACT01FLD(.REPLY)
|
|---|
| 505 | NEW SIMIEN
|
|---|
| 506 | IF $$CHCK4SIM(FILENUM,.REPLY,.SIMIEN,,RPTR) DO ;"A prior similar record already is on client.
|
|---|
| 507 | . SET NEWIEN=SIMIEN ;"If dealing with subfiles, SIMIEN will be in IENS format.
|
|---|
| 508 | NEW REF SET REF=GREF_+NEWIEN_")"
|
|---|
| 509 | IF $DATA(@REF) DO
|
|---|
| 510 | . NEW TEMP SET TEMP=$$GETTARGETIEN^TMGSIPHU(FILENUM,.REPLY,.NEWIEN)
|
|---|
| 511 | . SET REF=GREF_+NEWIEN_")" ;"NEWIEN might have changed.
|
|---|
| 512 | . IF TEMP="ABORT" SET RESULT=-2,TMGABORT=1 QUIT
|
|---|
| 513 | . IF TEMP="USELOCAL" SET USELOCAL=1 QUIT
|
|---|
| 514 | . IF TEMP="OVERWRITE" DO QUIT ;"OVERWRITE LOCAL RECORD #LPTR (KILL, THEN STORE later)
|
|---|
| 515 | . . KILL @REF
|
|---|
| 516 | GAF2 IF ($GET(TMGABORT)=1)!(NEWIEN'>0) GOTO GAFRD
|
|---|
| 517 | IF USELOCAL=1 DO GOTO GAFR0
|
|---|
| 518 | . SET TALLY("ALREADY LOCAL FOUND")=$GET(TALLY("ALREADY LOCAL FOUND"))+1
|
|---|
| 519 | IF $$STOREDAS^TMGSIPHU(FILENUM,NEWIEN,.REPLY)=-1 GOTO GAFRD
|
|---|
| 520 | SET $PIECE(@ZREF,"^",4)=+$PIECE($GET(@ZREF),"^",4)+1 ;"Update File Header to reflect added records
|
|---|
| 521 | IF +NEWIEN>$PIECE(@ZREF,"^",3) SET $PIECE(@ZREF,"^",3)=NEWIEN
|
|---|
| 522 | IF $$REAL1PTOUT^TMGSIPH1(FILENUM,NEWIEN,.TALLY) ;"Scan for pointers out. Ignore function result
|
|---|
| 523 | SET ^TMG("TMGSIPH","DOWNLOADED",FILENUM,NEWIEN)=RPTR
|
|---|
| 524 | SET TALLY("DOWNLOADED")=+$GET(TALLY("DOWNLOADED"))+1
|
|---|
| 525 | GAFR0 SET ^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)=NEWIEN ;"Add entry to Pointer translation table.
|
|---|
| 526 | IF (RPTR'=NEWIEN) SET ^TMG("TMGSIPH","NEED RE-XREF",FILENUM)="" ;"Flag for re-cross referencing again later.
|
|---|
| 527 | IF USELOCAL=1 SET ^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR,"L")=1 ;"Signal that local record was used
|
|---|
| 528 | GAFR1 DO UNNEEDPTR^TMGSIPHU(FILENUM,RPTR,NEWIEN,INOUT,.TALLY)
|
|---|
| 529 | IF INOUT="PTIN" KILL ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,RPTR)
|
|---|
| 530 | IF $$NEEDPTIN(FILENUM)!(INOUT="PTIN") DO ;"See if pointers IN are needed
|
|---|
| 531 | . IF LPTR=RPTR QUIT ;"No need for relinking if this record was already local.
|
|---|
| 532 | . DO GETPTIN^TMGSIPH4(JNUM,FILENUM,RPTR)
|
|---|
| 533 | SET RESULT=1
|
|---|
| 534 | GAFRD IF (RESULT'=-1)&(TMGABORT=1) SET RESULT=-2
|
|---|
| 535 | QUIT RESULT
|
|---|
| 536 | ;
|
|---|
| 537 | ;
|
|---|
| 538 | NEEDPTIN(FILENUM) ;
|
|---|
| 539 | ;"Purpose: To have a centralized location for which files should automatically trigger a request
|
|---|
| 540 | ;" for pointers-IN
|
|---|
| 541 | ;"NOTE:
|
|---|
| 542 | NEW RESULT SET RESULT=0
|
|---|
| 543 | IF FILENUM=2 SET RESULT=1
|
|---|
| 544 | ELSE IF (FILENUM=9000001) SET RESULT=1
|
|---|
| 545 | ELSE IF (FILENUM=8925) SET RESULT=1
|
|---|
| 546 | ELSE IF (FILENUM["8925.") SET RESULT=1
|
|---|
| 547 | QUIT RESULT
|
|---|
| 548 | ;
|
|---|
| 549 | ;
|
|---|
| 550 | AUTONEEDED(JNUM) ;
|
|---|
| 551 | ;"Purpose: To automatically get all pointers IN records and also pointers OUT records
|
|---|
| 552 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 553 | ;"Results: None
|
|---|
| 554 | ;
|
|---|
| 555 | NEW NPTO,NPTI,TALLY
|
|---|
| 556 | AN1 SET NPTO=$$NUMNEEDED^TMGSIPH3(JNUM,"PTOUT")
|
|---|
| 557 | IF NPTO>0 IF $$HANDLNEEDED^TMGSIPH3(JNUM,"PTOUT",1,.TALLY)=-1 GOTO ANDN
|
|---|
| 558 | SET NPTI=$$NUMNEEDED^TMGSIPH3(JNUM,"PTIN")
|
|---|
| 559 | IF (NPTO=0)&(NPTI=0) GOTO ANDN
|
|---|
| 560 | IF NPTI>0 IF $$HANDLNEEDED^TMGSIPH3(JNUM,"PTIN",1,.TALLY)=-1 GOTO ANDN
|
|---|
| 561 | GOTO AN1
|
|---|
| 562 | ANDN IF $DATA(TALLY) WRITE ! ZWR TALLY
|
|---|
| 563 | ELSE WRITE "No records needed auto-downloading.",!
|
|---|
| 564 | DO PressToCont^TMGUSRIF
|
|---|
| 565 | QUIT
|
|---|
| 566 | ;
|
|---|
| 567 | ;
|
|---|
| 568 | HANDLNEEDED(JNUM,INOUT,AUTOMODE,TALLY) ;
|
|---|
| 569 | ;"Purpose: Ask user which records to get from server, then get them and update
|
|---|
| 570 | ;" pointer translation table.
|
|---|
| 571 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 572 | ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
|
|---|
| 573 | ;" AUTOMODE -- OPTIONAL default is 0. If 1, then all records are processed without asking.
|
|---|
| 574 | ;" TALLY -- OPTIONAL. PASS BY REFERENCE. An array to show downloads.
|
|---|
| 575 | ;"Results: 1 if OK, -1 if abort.
|
|---|
| 576 | ;
|
|---|
| 577 | NEW GETARRAY,FILENUM,IEN,STIME,TMGCT,SHOWPROG,QUERY,ERROR,TMGMAX
|
|---|
| 578 | SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
|
|---|
| 579 | NEW TMGABORT SET TMGABORT=0
|
|---|
| 580 | NEW RESULT SET RESULT=1 ;"Default to success
|
|---|
| 581 | HN1 DO ASKNEEDED(JNUM,.GETARRAY,INOUT,.AUTOMODE)
|
|---|
| 582 | IF $DATA(GETARRAY)=0 GOTO HNDN
|
|---|
| 583 | ;"Process JUST ONE record from each file to begin with, to try to minimize user interaction after that.
|
|---|
| 584 | SET FILENUM=0
|
|---|
| 585 | FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
|
|---|
| 586 | . QUIT:($$DDOK^TMGSIPH1(JNUM,FILENUM)'=1)
|
|---|
| 587 | . QUIT:($$PREPXREF^TMGSIPH1(JNUM,FILENUM)'=1)
|
|---|
| 588 | . SET IEN=$ORDER(GETARRAY(FILENUM,""),-1) QUIT:(IEN="")
|
|---|
| 589 | . NEW TMP SET TMP=$$GETANDFIXREC(JNUM,FILENUM,IEN,"?",.TALLY,INOUT)
|
|---|
| 590 | . IF TMP=-2 SET TMGABORT=1 QUIT
|
|---|
| 591 | . IF TMP=-1 DO HNDLGAFE(FILENUM,IEN,.TMGABORT) QUIT
|
|---|
| 592 | . KILL GETARRAY(FILENUM,IEN) ;"Prevent reprocessing below
|
|---|
| 593 | ;"Now loop through ALL the files and records
|
|---|
| 594 | SET FILENUM=0,SHOWPROG=0
|
|---|
| 595 | FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
|
|---|
| 596 | . QUIT:($$DDOK^TMGSIPH1(JNUM,FILENUM)'=1)
|
|---|
| 597 | . QUIT:($$PREPXREF^TMGSIPH1(JNUM,FILENUM)'=1)
|
|---|
| 598 | . SET TMGMAX=-1,STIME=$H,TMGCT=1,IEN=""
|
|---|
| 599 | . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="")!(TMGABORT=1) DO
|
|---|
| 600 | . . IF TMGMAX=-1 SET TMGMAX=IEN
|
|---|
| 601 | . . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
|
|---|
| 602 | . . SET TMGCT=TMGCT+1
|
|---|
| 603 | . . NEW TMP SET TMP=$$GETANDFIXREC(JNUM,FILENUM,IEN,"?",.TALLY,INOUT)
|
|---|
| 604 | . . IF TMP=-2 SET TMGABORT=1 QUIT
|
|---|
| 605 | . . IF TMP=-1 DO HNDLGAFE(FILENUM,IEN,.TMGABORT) QUIT
|
|---|
| 606 | . . IF (SHOWPROG=0),(($PIECE($H,",",2)-$PIECE(STIME,",",2))>10) SET SHOWPROG=1
|
|---|
| 607 | . . IF SHOWPROG,(TMGCT#10=0) DO
|
|---|
| 608 | . . . WRITE #
|
|---|
| 609 | . . . DO ProgressBar^TMGUSRIF(TMGCT,"Progress: "_TMGCT,0,TMGMAX,70,STIME)
|
|---|
| 610 | . . . IF $DATA(TALLY) WRITE ! ZWR TALLY
|
|---|
| 611 | IF (AUTOMODE=1)&(TMGABORT'=1) GOTO HN1 ;"Loop back and see if more records are now needed.
|
|---|
| 612 | ELSE DO
|
|---|
| 613 | . IF $DATA(TALLY) WRITE ! ZWR TALLY
|
|---|
| 614 | . DO PressToCont^TMGUSRIF
|
|---|
| 615 | HNDN IF TMGABORT SET RESULT=-1
|
|---|
| 616 | QUIT RESULT
|
|---|
| 617 | ;
|
|---|
| 618 | ;
|
|---|
| 619 | HNDLGAFE(FILENUM,RPTR,TMGABORT) ;" Handle GETANDFIXREC error.
|
|---|
| 620 | ;"Input: FILENUM -- The file containing the bad record
|
|---|
| 621 | ;" RPTR -- the IEN of the bad record, on the server
|
|---|
| 622 | ;" TMGABORT -- PASS BY REFERENCE. An OUT parameter to abort.
|
|---|
| 623 | WRITE !,"Error encountered processing FILE ",$$FILENAME^TMGFMUT2(FILENUM)," (#"_FILENUM_"), REC #"_IEN,!
|
|---|
| 624 | NEW % SET %=2
|
|---|
| 625 | WRITE "Mark REC #",IEN," in FILE #",FILENUM," as an invalid server record"
|
|---|
| 626 | DO YN^DICN WRITE !
|
|---|
| 627 | IF %=-1 SET TMGABORT=1
|
|---|
| 628 | IF %=1 DO BADPTR(FILENUM,IEN)
|
|---|
| 629 | HGAFEDN QUIT
|
|---|
| 630 | ;
|
|---|
| 631 | ;
|
|---|
| 632 | BADPTR(FILENUM,RPTR) ;
|
|---|
| 633 | ;"Purpose: To handle a pointer to a bad record on the server.
|
|---|
| 634 | ;"Input: FILENUM -- The file containing the bad record
|
|---|
| 635 | ;" RPTR -- the IEN of the bad record, on the server
|
|---|
| 636 | ;"NOTE: globally-scoped variable TMGABORT may be set.
|
|---|
| 637 | ;"Results: None
|
|---|
| 638 | NEW MENU,USRSLCT
|
|---|
| 639 | LC2 KILL MENU,USRSLCT
|
|---|
| 640 | SET MENU(0)="Pick Option for Handling INVALID server record"
|
|---|
| 641 | NEW IDX SET IDX=1
|
|---|
| 642 | SET MENU(IDX)="Examine who need this bad record"_$char(9)_"Examine",IDX=IDX+1
|
|---|
| 643 | SET MENU(IDX)="Redirect pointer to a different local record"_$char(9)_"RedirToLocal",IDX=IDX+1
|
|---|
| 644 | SET MENU(IDX)="Change pointer to a NULL pointer"_$char(9)_"MakeNull",IDX=IDX+1
|
|---|
| 645 | SET MENU(IDX)="Backup without making any changes"_$char(9)_"Quit",IDX=IDX+1
|
|---|
| 646 | SET MENU(IDX)="Abort"_$char(9)_"Abort",IDX=IDX+1
|
|---|
| 647 | ;
|
|---|
| 648 | WRITE #
|
|---|
| 649 | SET USRSLCT=$$MENU^TMGUSRIF(.MENU,"^")
|
|---|
| 650 | IF USRSLCT="^" GOTO LC3
|
|---|
| 651 | IF USRSLCT=0 SET USRSLCT=""
|
|---|
| 652 | IF USRSLCT="Examine" DO GOTO:(TMGABORT=1) LC3 GOTO LC2
|
|---|
| 653 | . NEW ARRAY SET ARRAY(FILENUM,RPTR)=""
|
|---|
| 654 | . IF $$SHOWNEED^TMGSIPH5(JNUM,.ARRAY)=-1 SET TMGABORT=1 QUIT
|
|---|
| 655 | IF USRSLCT="RedirToLocal" DO GOTO LC3
|
|---|
| 656 | . NEW DIC,X,Y
|
|---|
| 657 | . SET DIC=FILENUM,DIC(0)="MAEQ"
|
|---|
| 658 | . DO ^DIC WRITE !
|
|---|
| 659 | . IF +Y'>0 QUIT
|
|---|
| 660 | . SET ^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)=+Y
|
|---|
| 661 | IF USRSLCT="MakeNull" DO GOTO LC3
|
|---|
| 662 | . SET ^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)=0
|
|---|
| 663 | IF USRSLCT="Quit" GOTO LC3
|
|---|
| 664 | IF USRSLCT="Abort" SET TMGABORT=1 GOTO LC3
|
|---|
| 665 | GOTO LC2
|
|---|
| 666 | LC3 QUIT
|
|---|
| 667 | ;
|
|---|
| 668 | ;
|
|---|
| 669 | MAP2LOCAL(JNUM,INOUT) ;
|
|---|
| 670 | ;"Purpose: Ask user which records to map to local records
|
|---|
| 671 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 672 | ;" INOUT -- OPTIONAL -- Default is "PTOUT". Should be "PTIN" or "PTOUT"
|
|---|
| 673 | ;"Results: None
|
|---|
| 674 | ;
|
|---|
| 675 | NEW GETARRAY,FILENUM,IEN,STIME,TMGCT,SHOWPROG,TALLY,QUERY,ERROR,REPLY
|
|---|
| 676 | SET INOUT=$GET(INOUT) IF INOUT'="PTIN" SET INOUT="PTOUT"
|
|---|
| 677 | NEW AUTOMODE SET AUTOMODE=0
|
|---|
| 678 | SET AUTOMODE("MAP MODE")=1
|
|---|
| 679 | DO ASKNEEDED(JNUM,.GETARRAY,INOUT,.AUTOMODE)
|
|---|
| 680 | SET FILENUM=0
|
|---|
| 681 | SET STIME=$H
|
|---|
| 682 | SET TMGCT=1,SHOWPROG=0
|
|---|
| 683 | NEW TMGABORT SET TMGABORT=0
|
|---|
| 684 | FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="")!(TMGABORT=1) DO
|
|---|
| 685 | . QUIT:($$DDOK^TMGSIPH1(JNUM,FILENUM)'=1)
|
|---|
| 686 | . QUIT:($$PREPXREF^TMGSIPH1(JNUM,FILENUM)'=1)
|
|---|
| 687 | . NEW TMGMAX SET TMGMAX=-1,TMGCT=1,STIME=$H
|
|---|
| 688 | . NEW IEN SET IEN=""
|
|---|
| 689 | . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="")!(TMGABORT=1) DO
|
|---|
| 690 | . . IF TMGMAX=-1 SET TMGMAX=IEN
|
|---|
| 691 | . . SET TMGABORT=$$UserAborted^TMGUSRIF() QUIT:(TMGABORT=1)
|
|---|
| 692 | . . SET TMGCT=TMGCT+1
|
|---|
| 693 | . . IF (SHOWPROG=0),(($PIECE($H,",",2)-$PIECE(STIME,",",2))>15) SET SHOWPROG=1
|
|---|
| 694 | . . IF SHOWPROG,(TMGCT#2=0) DO
|
|---|
| 695 | . . . WRITE #
|
|---|
| 696 | . . . DO ProgressBar^TMGUSRIF(TMGCT,"Progress in "_FILENUM_": "_TMGCT,0,TMGMAX,70,STIME)
|
|---|
| 697 | . . . IF $DATA(TALLY) WRITE ! ZWR TALLY
|
|---|
| 698 | . . NEW NEWIEN SET NEWIEN=0
|
|---|
| 699 | . . IF $$CHCK4SIM(FILENUM,,.NEWIEN,$$GET01FLD(JNUM,FILENUM,IEN))=0 QUIT ;"Is a prior similar record already is on client?
|
|---|
| 700 | . . SET ^TMG("TMGSIPH","PT XLAT",FILENUM,IEN)=NEWIEN ;"Add entry to Pointer translation table.
|
|---|
| 701 | . . DO UNNEEDPTR^TMGSIPHU(FILENUM,IEN,NEWIEN,INOUT,.TALLY)
|
|---|
| 702 | . . IF INOUT="PTIN" KILL ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,IEN)
|
|---|
| 703 | . . KILL GETARRAY(FILENUM,IEN)
|
|---|
| 704 | SET RESULT=1
|
|---|
| 705 | IF $DATA(GETARRAY) DO
|
|---|
| 706 | . NEW TMGARRAY,TMGSEL,IEN
|
|---|
| 707 | . WRITE #
|
|---|
| 708 | . WRITE "One or more records could not be automatically matched to a local record.",!
|
|---|
| 709 | . WRITE "Select records to manually looked up.",!
|
|---|
| 710 | . DO PRESSTOCONT^TMGUSRIF QUIT:$GET(TMGPTCABORT)=1
|
|---|
| 711 | . FOR SET FILENUM=$ORDER(GETARRAY(FILENUM)) QUIT:(FILENUM="") DO
|
|---|
| 712 | . . NEW FNAME SET FNAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
|
|---|
| 713 | . . SET IEN=""
|
|---|
| 714 | . . FOR SET IEN=$ORDER(GETARRAY(FILENUM,IEN),-1) QUIT:(IEN="") DO
|
|---|
| 715 | . . . NEW DISPSTR SET DISPSTR="Get records from REMOTE file #"_FILENUM_" ("
|
|---|
| 716 | . . . SET DISPSTR="File: "_FNAME_"; Record: "_$$GET01FLD(JNUM,FILENUM,IEN)
|
|---|
| 717 | . . . SET TMGARRAY(DISPSTR)=FILENUM_"^"_IEN
|
|---|
| 718 | . NEW HEADER
|
|---|
| 719 | . SET HEADER="Select Record(s) in file "_FILENUM_" to MAP to local records. Press <ESC><ESC> when Done."
|
|---|
| 720 | . DO Selector^TMGUSRIF("TMGARRAY","TMGSEL",HEADER)
|
|---|
| 721 | . IF $DATA(TMGSEL)=0 QUIT
|
|---|
| 722 | . NEW TMGI SET TMGI=""
|
|---|
| 723 | . FOR SET TMGI=$ORDER(TMGSEL(TMGI)) QUIT:(TMGI="")!TMGABORT DO
|
|---|
| 724 | . . NEW ENTRY SET ENTRY=$GET(TMGSEL(TMGI))
|
|---|
| 725 | . . SET FILENUM=+ENTRY QUIT:FILENUM'>0
|
|---|
| 726 | . . SET IEN=$PIECE(ENTRY,"^",2)
|
|---|
| 727 | . . NEW X,Y,DIC
|
|---|
| 728 | . . SET DIC=FILENUM,DIC(0)="MAEQ"
|
|---|
| 729 | . . SET DIC("A")="Lookup a match for ["_$$GET01FLD(JNUM,FILENUM,IEN)_"]: "
|
|---|
| 730 | . . NEW DONE SET DONE=0
|
|---|
| 731 | . . FOR DO QUIT:(+Y>0)!(DONE)!TMGABORT
|
|---|
| 732 | . . . NEW %
|
|---|
| 733 | . . . DO ^DIC WRITE !
|
|---|
| 734 | . . . IF +Y>0 DO QUIT:TMGABORT
|
|---|
| 735 | . . . . SET %=1
|
|---|
| 736 | . . . . WRITE "Use [",$PIECE(Y,"^",2),"]" DO YN^DICN WRITE !
|
|---|
| 737 | . . . . IF %=-1 SET TMGABORT=1 QUIT
|
|---|
| 738 | . . . . IF %=2 SET Y=0 QUIT
|
|---|
| 739 | . . . IF +Y>0 QUIT
|
|---|
| 740 | . . . SET %=1
|
|---|
| 741 | . . . WRITE "Try another lookup" DO YN^DICN WRITE !
|
|---|
| 742 | . . . IF %=-1 SET TMGABORT=1 QUIT
|
|---|
| 743 | . . . IF %=2 SET DONE=1 QUIT
|
|---|
| 744 | . . IF +Y>0 DO
|
|---|
| 745 | . . . SET ^TMG("TMGSIPH","PT XLAT",FILENUM,IEN)=+Y ;"Add entry to Pointer translation table.
|
|---|
| 746 | . . . DO UNNEEDPTR^TMGSIPHU(FILENUM,IEN,+Y,INOUT,.TALLY)
|
|---|
| 747 | . . . IF INOUT="PTIN" KILL ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,IEN)
|
|---|
| 748 | . . . KILL GETARRAY(FILENUM,IEN)
|
|---|
| 749 | . . . SET TALLY("MANUALLY MATCHED TO LOCAL")=+$GET(TALLY("MANUALLY MATCHED TO LOCAL"))+1
|
|---|
| 750 | IF $DATA(TALLY) WRITE ! ZWR TALLY
|
|---|
| 751 | DO PRESSTOCONT^TMGUSRIF
|
|---|
| 752 | QUIT
|
|---|
| 753 | ;
|
|---|
| 754 | ;
|
|---|
| 755 | GETFILE |
|---|
