| 1 | TMGSIPH0 ;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 | ;"----===== SERVER-SIDE CODE ====------
|
|---|
| 6 | ;"Kevin Toppenberg MD
|
|---|
| 7 | ;"GNU General Public License (GPL) applies
|
|---|
| 8 | ;"11/27/09
|
|---|
| 9 | ;
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;" API -- Public Functions.
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 | ;"HANDLMSG(MESSAGE) -- A message handler for communication between VistA instances.
|
|---|
| 14 | ;
|
|---|
| 15 | ;"=======================================================================
|
|---|
| 16 | ;" API -- Private Functions.
|
|---|
| 17 | ;"=======================================================================
|
|---|
| 18 | ;"HANDLGET(REF) --A handler for GET command between VistA instances. Get a ^global node
|
|---|
| 19 | ;"HANDLGDD(FILENUM) -- Return Data Dictionary information about specified file.
|
|---|
| 20 | ;"GETSUBDD(SUBFILENUM) -- Return DD information about subfiles (and sub-subfiles)
|
|---|
| 21 | ;"HANDLORD(REF) --A handler for ORDREF command between VistA instances. Will get ^Global node that is $ORDER'd after REF
|
|---|
| 22 | ;"HANDLNRS(FILENUM) -- Return the highest record number in given file.
|
|---|
| 23 | ;"HANDGRXR(PARAMS) -- Return one record, and associated cross-reference entries
|
|---|
| 24 | ;"SENDFLDS(FILENUM,IEN) -- send any .01 fields VALUES of any pointers OUT
|
|---|
| 25 | ;"HANDLDIC(PARAMS) -- Do a ^DIC lookup in file for value.
|
|---|
| 26 | ;"
|
|---|
| 27 | ;"=======================================================================
|
|---|
| 28 | ;"Dependancies
|
|---|
| 29 | ;"=======================================================================
|
|---|
| 30 | ;"DILF, XLFSTR, TMGSIPHU, TMGKERN2, TMGFMUT2
|
|---|
| 31 | ;"=======================================================================
|
|---|
| 32 | ;
|
|---|
| 33 | ;"=============================================================
|
|---|
| 34 | ;" Below will be core of server-side request handler.
|
|---|
| 35 | ;"=============================================================
|
|---|
| 36 | HANDLMSG(MESSAGE) ;
|
|---|
| 37 | ;"Purpose: A message handler for communication between VistA instances.
|
|---|
| 38 | ;"Input MESSAGE -- This is the message send from the client, who will be asking for
|
|---|
| 39 | ;" information and records etc from this instance.
|
|---|
| 40 | ;" Format: 'Command|parameters'
|
|---|
| 41 | ;" -----------------------
|
|---|
| 42 | ;" GET|REF -- Get a ^global node
|
|---|
| 43 | ;" GET DD|FILENUM -- return Data Dictionary information about specified file.
|
|---|
| 44 | ;" ORDREF|REF -- Get ^Global node that is $ORDER'd after REF
|
|---|
| 45 | ;" NUMRECS|FILENUM -- Return the highest record number in given file
|
|---|
| 46 | ;" PT XREF|FILENUM -- Prepair PT XREF for all records pointing INTO specified file.
|
|---|
| 47 | ;" WIPE PT XREF| -- Delete the last run of PT XREF, so it can be refreshened.
|
|---|
| 48 | ;" PREP XREFS|FILENUM^[1] -- Make a xref of cross-references (a backward xref)
|
|---|
| 49 | ;" GET REF & FILE XREF|REF^FILENUM^IENS -- Return one reference, and associated FILENUM cross-reference entries
|
|---|
| 50 | ;" GET RECORD & XREF|FILENUM^IEN -- Return one record, and associated cross-reference entries
|
|---|
| 51 | ;" GET PTRS IN|FILENUM^IEN -- Get a listing of all pointers INTO requested record
|
|---|
| 52 | ;" DO DIC|FILENUM^VALUE -- Do a ^DIC lookup in file for value.
|
|---|
| 53 | ;" GET XREF AGE -- Get age of server-side PT xrefs etc, in HOURS
|
|---|
| 54 | ;" GET .01 FLD|FILENUM^IEN -- Return INTERNAL format of .01 field. Doesn't support subfiles.
|
|---|
| 55 | ;" DUMP REC|FILENUM^IENS^SHOWEMPTY -- Display dump of server record.
|
|---|
| 56 | ;" GET IEN LIST|FILENUM -- Get a listing of all records (IEN's) in specified file.
|
|---|
| 57 | ;" GET IEN HDR|FILENUM -- Get Last IEN,HighestIEN from file header.
|
|---|
| 58 | ;" -----------------------
|
|---|
| 59 | ;"Results: None
|
|---|
| 60 | ;
|
|---|
| 61 | NEW CMD SET CMD=$$UP^XLFSTR($PIECE(MESSAGE,"|",1))
|
|---|
| 62 | SET CMD=$$TRIM^XLFSTR(CMD)
|
|---|
| 63 | NEW PARAMS SET PARAMS=$$TRIM^XLFSTR($PIECE(MESSAGE,"|",2,99))
|
|---|
| 64 | DO DEBUGMSG^TMGKERN2("In HANDLMSG. CMD="_CMD_" & PARAMS="_PARAMS)
|
|---|
| 65 | DO
|
|---|
| 66 | . NEW $ETRAP SET $ETRAP="write ""#ERROR TRAPPED# "",$ZSTATUS,! set $etrap="""",$ecode="""""
|
|---|
| 67 | . IF CMD="GET" DO HANDLGET(PARAMS) QUIT
|
|---|
| 68 | . IF CMD="GET DD" DO HANDLGDD(PARAMS) QUIT
|
|---|
| 69 | . IF CMD="ORDREF" DO HANDLORD(PARAMS) QUIT
|
|---|
| 70 | . IF CMD="NUMRECS" DO HANDLNRS(PARAMS) QUIT
|
|---|
| 71 | . IF CMD="PT XREF" DO HNDLPTIX^TMGSIPH2(PARAMS) QUIT
|
|---|
| 72 | . IF CMD="WIPE PT XREF" DO KILLPTIX^TMGFMUT2 QUIT
|
|---|
| 73 | . IF CMD="GET PTRS IN" DO GETPTIN^TMGSIPH2(PARAMS) QUIT
|
|---|
| 74 | . IF CMD="PREP XREFS" DO BAKXREF^TMGSIPH2(PARAMS) QUIT
|
|---|
| 75 | . IF CMD="GET RECORD & XREF" DO HANDGRXR(PARAMS) QUIT
|
|---|
| 76 | . IF CMD="GET REF & FILE XREF" DO HANDGRFX(PARAMS) QUIT
|
|---|
| 77 | . IF CMD="DO DIC" DO HANDLDIC(PARAMS) QUIT
|
|---|
| 78 | . IF CMD="GET XREF AGE" DO GETXRAGE^TMGSIPH2 QUIT
|
|---|
| 79 | . IF CMD="GET .01 FLD" DO GET01FLD^TMGSIPH2(PARAMS) QUIT
|
|---|
| 80 | . IF CMD="DUMP REC" DO DUMPREC(PARAMS) QUIT
|
|---|
| 81 | . IF CMD="GET IEN LIST" DO HANDIENL^TMGSIPH2(PARAMS) QUIT
|
|---|
| 82 | . IF CMD="GET IEN HDR" DO HANDLIENHDR^TMGSIPH2(PARAMS) QUIT
|
|---|
| 83 | . ELSE DO
|
|---|
| 84 | . . DO SEND^TMGKERN2("Got: ["_MESSAGE_"]. Server is $JOB="_$JOB)
|
|---|
| 85 | QUIT
|
|---|
| 86 | ;"=============================================================
|
|---|
| 87 | ;"=============================================================
|
|---|
| 88 | ;
|
|---|
| 89 | HANDLGET(REF) ;
|
|---|
| 90 | ;"Purpose: A handler for GET command between VistA instances. Get a ^global node
|
|---|
| 91 | ;"Input --REF -- reference to a global. May be in Open or Closed format
|
|---|
| 92 | ;"Results: none
|
|---|
| 93 | ;"Output: Will write output to current device (should be socket to other instance)
|
|---|
| 94 | ;
|
|---|
| 95 | NEW OREF SET OREF=$$OREF^DILF(REF)
|
|---|
| 96 | NEW LEN SET LEN=$LENGTH(OREF)
|
|---|
| 97 | SET REF=$$CREF^DILF(REF)
|
|---|
| 98 | NEW DONE SET DONE=0
|
|---|
| 99 | FOR DO QUIT:(DONE>0)
|
|---|
| 100 | . IF $DATA(@REF)#10 DO
|
|---|
| 101 | . . DO SEND^TMGKERN2(REF_"=")
|
|---|
| 102 | . . DO SEND^TMGKERN2("="_$GET(@REF))
|
|---|
| 103 | . SET REF=$QUERY(@REF)
|
|---|
| 104 | . IF (REF="")!($QSUBSCRIPT(REF,1)="") SET DONE=1 QUIT
|
|---|
| 105 | . IF $EXTRACT(REF,1,LEN)'=OREF SET DONE=1 QUIT
|
|---|
| 106 | QUIT
|
|---|
| 107 | ;
|
|---|
| 108 | ;
|
|---|
| 109 | HANDLGDD(FILENUM) ; "Handle Get DD
|
|---|
| 110 | ;"Purpose: to return Data Dictionary information about specified file.
|
|---|
| 111 | SET FILENUM=+$GET(FILENUM)
|
|---|
| 112 | NEW REF SET REF=$NAME(^DD(FILENUM))
|
|---|
| 113 | DO HANDLGET(REF)
|
|---|
| 114 | SET REF=$NAME(^DIC(FILENUM))
|
|---|
| 115 | DO HANDLGET(REF)
|
|---|
| 116 | ;"Get nodes from INDEX file
|
|---|
| 117 | NEW IDX SET IDX=""
|
|---|
| 118 | FOR SET IDX=$ORDER(^DD("IX","B",FILENUM,IDX)) QUIT:(IDX="") DO
|
|---|
| 119 | . SET REF=$NAME(^DD("IX",IDX))
|
|---|
| 120 | . DO HANDLGET(REF)
|
|---|
| 121 | NEW FLD SET FLD=0
|
|---|
| 122 | FOR SET FLD=$ORDER(^DD(FILENUM,FLD)) QUIT:(+FLD'>0) DO
|
|---|
| 123 | . NEW PT SET PT=+$PIECE($GET(^DD(FILENUM,FLD,0)),"^",2)
|
|---|
| 124 | . QUIT:(PT'>0)
|
|---|
| 125 | . IF $DATA(^DD(PT,0,"UP")) DO GETSUBDD(PT)
|
|---|
| 126 | QUIT
|
|---|
| 127 | ;
|
|---|
| 128 | ;
|
|---|
| 129 | GETSUBDD(SUBFILENUM)
|
|---|
| 130 | ;"Purpose: Return DD information about subfiles (and sub-subfiles)
|
|---|
| 131 | NEW REF SET REF=$NAME(^DD(SUBFILENUM))
|
|---|
| 132 | DO HANDLGET(REF)
|
|---|
| 133 | NEW PT SET PT=+$PIECE($GET(^DD(SUBFILENUM,0)),"^",2)
|
|---|
| 134 | QUIT:(PT'>0)
|
|---|
| 135 | IF $DATA(^DD(PT,0,"UP")) DO GETSUBDD(PT)
|
|---|
| 136 | QUIT
|
|---|
| 137 | ;
|
|---|
| 138 | ;
|
|---|
| 139 | HANDLORD(REF) ;
|
|---|
| 140 | ;"Purpose: A handler for ORDREF command between VistA instances.
|
|---|
| 141 | ;" Will get ^Global node that is $ORDER'd after REF
|
|---|
| 142 | ;" e.g. ^TIU(8925,"") --> returns node ^TIU(8925,0,
|
|---|
| 143 | ;" ^TIU(8925, --> returns node ^TIU(8925.1,
|
|---|
| 144 | ;"Input --REF -- reference to a global. May be in Open or Closed format
|
|---|
| 145 | ;"Results: none
|
|---|
| 146 | ;"Output: Will write output to current device (should be socket to other VistA instance)
|
|---|
| 147 | ;"
|
|---|
| 148 | NEW CREF SET CREF=$$CREF^DILF(REF)
|
|---|
| 149 | SET REF=$$ORDREF^TMGSIPHU(CREF)
|
|---|
| 150 | IF REF'="" DO HANDLGET(REF)
|
|---|
| 151 | QUIT
|
|---|
| 152 | ;
|
|---|
| 153 | ;
|
|---|
| 154 | HANDLNRS(FILENUM) ;
|
|---|
| 155 | ;"Purpose: Return the highest record number in given file.
|
|---|
| 156 | ;"Input: FILENUM -- The fileman number of the file to return info for.
|
|---|
| 157 | ;"Results: None
|
|---|
| 158 | DO SEND^TMGKERN2($$GETNUMREC^TMGSIPHU(FILENUM))
|
|---|
| 159 | QUIT
|
|---|
| 160 | ;
|
|---|
| 161 | ;
|
|---|
| 162 | HANDGRFX(PARAMS) ;" Handler for GET REF & FILE XREF|REF^FILENUM^IENS
|
|---|
| 163 | ;"Purpose: Return one reference, and associated FILENUM cross-reference entries
|
|---|
| 164 | ;" Note: It is anticipated that this will be used to get subfile entries.
|
|---|
| 165 | ;"Input: PARAMS : REF^FILENUM^IENS
|
|---|
| 166 | ;" REF -- should be in OPEN format (ending in a ',')
|
|---|
| 167 | ;" FILENUM -- the subfile number.
|
|---|
| 168 | ;" IENS -- A standard IENS string
|
|---|
| 169 | ;"Output: Will write output to current device (should be socket). Format
|
|---|
| 170 | ;" <Ref>=
|
|---|
| 171 | ;" =<Value>
|
|---|
| 172 | ;" <Ref>=
|
|---|
| 173 | ;" =<Value>
|
|---|
| 174 | ;" ...
|
|---|
| 175 | ;" %PTRSOUT%^PointedToFile^IEN^FIELD_VALUE
|
|---|
| 176 | ;" %PTRSOUT%^PointedToFile^IEN^FIELD_VALUE
|
|---|
| 177 | ;" ...
|
|---|
| 178 | ;"Result: none
|
|---|
| 179 | ;"NOTE: This function will assume that an xref of all the cross-references has
|
|---|
| 180 | ;" already been set up by calling BAKXREF^TMGSIPH1(FILENUM). This can be
|
|---|
| 181 | ;" triggered on the client side by calling QUERY="PREP XREFS|<filenumber>"
|
|---|
| 182 | SET PARAMS=$GET(PARAMS)
|
|---|
| 183 | NEW GREF SET GREF="^"_$PIECE(PARAMS,"^",2) ;"Ref itself has a ^ in it.
|
|---|
| 184 | NEW FILENUM SET FILENUM=$PIECE(PARAMS,"^",3)
|
|---|
| 185 | NEW IENS SET IENS=$PIECE(PARAMS,"^",4)
|
|---|
| 186 | DO HANDLGET(GREF) ;
|
|---|
| 187 | ;"Now send XRef entries for IEN.
|
|---|
| 188 | DO BAKXREF^TMGSIPH2(FILENUM_"^1") ;"organize XRefs if needed, keeping current orangization array
|
|---|
| 189 | NEW REF SET REF=""
|
|---|
| 190 | FOR SET REF=$ORDER(^TMG("PTXREF","XREFS",FILENUM,IENS,REF)) QUIT:(REF="") DO
|
|---|
| 191 | . DO SEND^TMGKERN2(REF_"=")
|
|---|
| 192 | . DO SEND^TMGKERN2("="_$GET(^TMG("PTXREF","XREFS",FILENUM,IENS,REF)))
|
|---|
| 193 | DO SENDFLDS(FILENUM,IENS) ;"Send values of .01 fields for all pointers OUT from record
|
|---|
| 194 | QUIT
|
|---|
| 195 | ;
|
|---|
| 196 | ;
|
|---|
| 197 | HANDGRXR(PARAMS) ;
|
|---|
| 198 | ;"Purpose: Return one record, and associated cross-reference entries
|
|---|
| 199 | ;"Input: PARAMS : Filenumber^IEN
|
|---|
| 200 | ;"Output: Will write output to current device (should be socket). Format
|
|---|
| 201 | ;" <Ref>=
|
|---|
| 202 | ;" =<Value>
|
|---|
| 203 | ;" <Ref>=
|
|---|
| 204 | ;" =<Value>
|
|---|
| 205 | ;" ...
|
|---|
| 206 | ;" %PTRSOUT%^PointedToFile^IEN^FIELD_VALUE
|
|---|
| 207 | ;" %PTRSOUT%^PointedToFile^IEN^FIELD_VALUE
|
|---|
| 208 | ;" ...
|
|---|
| 209 | ;"Result: none
|
|---|
| 210 | ;"NOTE: This function will assume that an xref of all the cross-references has
|
|---|
| 211 | ;" already been set up by calling BAKXREF^TMGSIPH1(FILENUM). This can be
|
|---|
| 212 | ;" triggered on the client side by calling QUERY="PREP XREFS|<filenumber>"
|
|---|
| 213 | ;
|
|---|
| 214 | NEW FILENUM,IEN
|
|---|
| 215 | SET PARAMS=$GET(PARAMS)
|
|---|
| 216 | SET FILENUM=+PARAMS
|
|---|
| 217 | SET IEN=$PIECE(PARAMS,"^",2)
|
|---|
| 218 | IF (FILENUM'>0)!(IEN'>0) QUIT
|
|---|
| 219 | NEW GREF SET GREF=$GET(^DIC(FILENUM,0,"GL"))
|
|---|
| 220 | IF GREF="" QUIT
|
|---|
| 221 | DO HANDLGET(GREF_IEN_",") ;
|
|---|
| 222 | ;"Now send XRef entries for IEN.
|
|---|
| 223 | NEW REF SET REF=""
|
|---|
| 224 | DO BAKXREF^TMGSIPH2(FILENUM_"^1") ;"organize XRefs if needed, keeping current orangization array
|
|---|
| 225 | FOR SET REF=$ORDER(^TMG("PTXREF","XREFS",FILENUM,IEN,REF)) QUIT:(REF="") DO
|
|---|
| 226 | . DO SEND^TMGKERN2(REF_"=")
|
|---|
| 227 | . DO SEND^TMGKERN2("="_$GET(^TMG("PTXREF","XREFS",FILENUM,IEN,REF)))
|
|---|
| 228 | DO SENDFLDS(FILENUM,IEN) ;"Send values of .01 fields for all pointers OUT from record
|
|---|
| 229 | HGXDN QUIT
|
|---|
| 230 | ;
|
|---|
| 231 | ;
|
|---|
| 232 | SENDFLDS(FILENUM,IEN) ;
|
|---|
| 233 | ;"Purpose to send any .01 fields VALUES of any pointers OUT
|
|---|
| 234 | ;"Input: FILENUM -- the file containing the record to be scanned
|
|---|
| 235 | ;" IEN -- The record number being scanned.
|
|---|
| 236 | ;"Results: none
|
|---|
| 237 | ;"Output: Values will be sent to client via SEND^TMGKERN2. Format as follows:
|
|---|
| 238 | ;" %PTRSOUT%^PointedToFile^IEN^FIELD_VALUE
|
|---|
| 239 | ;" %PTRSOUT%^PointedToFile^IEN^FIELD_VALUE
|
|---|
| 240 | NEW TALLY
|
|---|
| 241 | KILL ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM)
|
|---|
| 242 | IF $$REAL1PTOUT^TMGSIPH1(FILENUM,IEN,.TALLY)=1 DO
|
|---|
| 243 | . NEW REF SET REF=""
|
|---|
| 244 | . FOR SET REF=$ORDER(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",REF)) QUIT:(REF="") DO
|
|---|
| 245 | . . NEW INFO SET INFO=""
|
|---|
| 246 | . . FOR SET INFO=$ORDER(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",REF,INFO)) QUIT:(INFO="") DO
|
|---|
| 247 | . . . NEW PCE SET PCE=+INFO
|
|---|
| 248 | . . . NEW P2FILE SET P2FILE=$PIECE(INFO,"^",2)
|
|---|
| 249 | . . . NEW P2REF SET P2REF=$PIECE(INFO,"^",3)
|
|---|
| 250 | . . . NEW IENDEPTH SET IENDEPTH=$PIECE(INFO,"^",4)
|
|---|
| 251 | . . . NEW ISVIRT SET ISVIRT=($PIECE(INFO,"^",5)="V")
|
|---|
| 252 | . . . NEW TEMP SET TEMP=IEN KILL IEN SET IEN=TEMP ;"kill subnodes
|
|---|
| 253 | . . . NEW OKCOMBO
|
|---|
| 254 | . . . FOR DO QUIT:(OKCOMBO=0)
|
|---|
| 255 | . . . . SET OKCOMBO=$$IENCOMBO^TMGFMUT2(REF,IENDEPTH,.IEN) ;"Sets up IEN(n).. needed for @REF
|
|---|
| 256 | . . . . QUIT:(OKCOMBO=0)
|
|---|
| 257 | . . . . NEW PT SET PT=$PIECE($GET(@REF),"^",PCE)
|
|---|
| 258 | . . . . IF ISVIRT,$PIECE(PT,";",2)'=P2REF QUIT ;"Loop to handle PTR with different INFO entry (V-Ptrs stored as IEN;OREF)
|
|---|
| 259 | . . . . SET PT=+PT QUIT:(PT'>0)
|
|---|
| 260 | . . . . NEW VALUE SET VALUE=$$FLD01^TMGSIPH2(P2FILE_"^"_PT) ;
|
|---|
| 261 | . . . . DO SEND^TMGKERN2("%PTRSOUT%^"_P2FILE_"^"_PT_"^"_VALUE)
|
|---|
| 262 | . . . KILL IEN("DONE"),IEN("INIT")
|
|---|
| 263 | ;"KILL ^TMG("TMGSIPH","UNRESOLVED",FILENUM)
|
|---|
| 264 | KILL ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",FILENUM)
|
|---|
| 265 | KILL ^TMG("TMGSIPH","DD",FILENUM)
|
|---|
| 266 | QUIT
|
|---|
| 267 | ;
|
|---|
| 268 | ;
|
|---|
| 269 | HANDLDIC(PARAMS) ;
|
|---|
| 270 | ;"Purpose: Do a ^DIC lookup in file for value.
|
|---|
| 271 | ;"Input: Params: this is FILENUM^LOOKUPVALUE
|
|---|
| 272 | ;"Result: Will send back value of Y to client
|
|---|
| 273 | SET PARAMS=$GET(PARAMS)
|
|---|
| 274 | NEW DIC SET DIC=+$PIECE(PARAMS,"^",1)
|
|---|
| 275 | NEW Y,X SET X=$PIECE(PARAMS,"^",2)
|
|---|
| 276 | SET DIC(0)="M"
|
|---|
| 277 | DO ^DIC
|
|---|
| 278 | DO SEND^TMGKERN2(Y)
|
|---|
| 279 | QUIT
|
|---|
| 280 | ;
|
|---|
| 281 | ;
|
|---|
| 282 | DUMPREC(PARAMS) ;
|
|---|
| 283 | ;"Purpose: To do a record dump of a server-side record, sending output back to client
|
|---|
| 284 | ;"Input: Params -- FILENUM^IENS^SHOWEMPTY
|
|---|
| 285 | NEW FILENUM,IENS,SHOWEMPTY
|
|---|
| 286 | SET PARAMS=$GET(PARAMS)
|
|---|
| 287 | SET FILENUM=+PARAMS
|
|---|
| 288 | SET IENS=$PIECE(PARAMS,"^",2)
|
|---|
| 289 | IF (FILENUM'>0)!(IENS'>0) QUIT
|
|---|
| 290 | SET SHOWEMPTY=+$PIECE(PARAMS,"^",3)
|
|---|
| 291 | NEW OPTION
|
|---|
| 292 | SET OPTION("WRITE REC FN")="WRLABEL^TMGSIPH0"
|
|---|
| 293 | SET OPTION("WRITE FLD FN")="WFLABEL^TMGSIPH0"
|
|---|
| 294 | SET OPTION("WRITE LINE FN")="WLINE^TMGSIPH0"
|
|---|
| 295 | SET OPTION("WRITE WP LINE")="WWPLINE^TMGSIPH0"
|
|---|
| 296 | NEW TMGDUMPS ;"Will be used with global scope
|
|---|
| 297 | DO DumpRec2^TMGDEBUG(FILENUM,IENS,SHOWEMPTY,,.OPTION)
|
|---|
| 298 | QUIT
|
|---|
| 299 | ;
|
|---|
| 300 | ;
|
|---|
| 301 | WRLABEL(IEN,ENDER)
|
|---|
| 302 | ;"Purpose: To actually write out labels for record starting and ending.
|
|---|
| 303 | ;"Input: IEN -- the IEN (record number) of the record
|
|---|
| 304 | ;" ENDER -- OPTIONAL if 1, then ends field.
|
|---|
| 305 | ;"Note: also uses globally scoped variable TMGDUMPS
|
|---|
| 306 | ;"Results: none.
|
|---|
| 307 | ;"Note: Used by DumpRec2 above, with callback from TMGXMLE2
|
|---|
| 308 | SET TMGDUMPS=$GET(TMGDUMPS)
|
|---|
| 309 | IF +$GET(ENDER)>0 DO
|
|---|
| 310 | . IF TMGDUMPS="" SET TMGDUMPS="."
|
|---|
| 311 | ELSE SET TMGDUMPS=TMGDUMPS_" Multiple Entry #"_IEN
|
|---|
| 312 | DO SEND^TMGKERN2(TMGDUMPS)
|
|---|
| 313 | SET TMGDUMPS=""
|
|---|
| 314 | QUIT
|
|---|
| 315 | ;
|
|---|
| 316 | WFLABEL(LABEL,FIELD,TYPE,ENDER)
|
|---|
| 317 | ;"Purpose: This is the code that actually does writing of labels etc for output
|
|---|
| 318 | ;" This is a CUSTOM CALL BACK function called by Write1Fld^TMGXMLE2
|
|---|
| 319 | ;"Input: LABEL -- OPTIONAL -- Name of label, to write after 'label='
|
|---|
| 320 | ;" FIELD -- OPTIONAL -- Name of field, to write after 'id='
|
|---|
| 321 | ;" TYPE -- OPTIONAL -- TYPEof field, to write after 'type='
|
|---|
| 322 | ;" ENDER -- OPTIONAL if 1, then ends field.
|
|---|
| 323 | ;"Note: also uses globally scoped variable TMGDUMPS
|
|---|
| 324 | ;"Note: Used by DumpRec2 above, with callback from TMGXMLE2
|
|---|
| 325 | ;"To write out <FIELD label="NAME" id=".01" type="FREE TEXT"> or </FIELD>
|
|---|
| 326 | SET TMGDUMPS=$GET(TMGDUMPS)
|
|---|
| 327 | IF +$GET(ENDER)>0 DO
|
|---|
| 328 | . IF TMGDUMPS="" SET TMGDUMPS="."
|
|---|
| 329 | . DO SEND^TMGKERN2(TMGDUMPS)
|
|---|
| 330 | . SET TMGDUMPS=""
|
|---|
| 331 | ELSE DO
|
|---|
| 332 | . IF $GET(FIELD)'="" SET TMGDUMPS=TMGDUMPS_$$RJ^XLFSTR(FIELD,6," ")_"-"
|
|---|
| 333 | . IF $GET(LABEL)'="" SET TMGDUMPS=TMGDUMPS_LABEL_" "
|
|---|
| 334 | . ;"IF $GET(TYPE)'="" SET TMGDUMPS=TMGDUMPS_"type="""_TYPE_""" "
|
|---|
| 335 | . SET TMGDUMPS=TMGDUMPS_": "
|
|---|
| 336 | QUIT
|
|---|
| 337 | ;
|
|---|
| 338 | WLINE(LINE)
|
|---|
| 339 | ;"Purpose: To actually write out labels for record starting and ending.
|
|---|
| 340 | ;"Input: Line -- The line of text to be written out.
|
|---|
| 341 | ;"Note: also uses globally scoped variable TMGDUMPS
|
|---|
| 342 | ;"Note: Used by DumpRec2 above, with callback from TMGXMLE2
|
|---|
| 343 | SET TMGDUMPS=$GET(TMGDUMPS)_$GET(LINE)
|
|---|
| 344 | QUIT
|
|---|
| 345 | ;
|
|---|
| 346 | WWPLINE(LINE)
|
|---|
| 347 | ;"Purpose: To actually write out line from WP field
|
|---|
| 348 | ;"Input: Line -- The line of text to be written out.
|
|---|
| 349 | ;"Note: also uses globally scoped variable TMGDUMPS
|
|---|
| 350 | ;"Note: Used by DumpRec2 above, with callback from TMGXMLE2
|
|---|
| 351 | SET TMGDUMPS=$GET(TMGDUMPS)_$GET(LINE)
|
|---|
| 352 | IF TMGDUMPS="" SET TMGDUMPS="."
|
|---|
| 353 | DO SEND^TMGKERN2(TMGDUMPS)
|
|---|
| 354 | SET TMGDUMPS=""
|
|---|
| 355 | QUIT
|
|---|
