| [796] | 1 | TMGXMLE2 ;TMG/kst/XML Exporter -- Core functionality ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;07/12/05
|
|---|
| 3 |
|
|---|
| 4 | ;"TMG XML EXPORT FUNCTIONS (CORE FUNCTIONALITY)
|
|---|
| 5 | ;"Kevin Toppenberg MD
|
|---|
| 6 | ;"GNU General Public License (GPL) applies
|
|---|
| 7 | ;"7-12-2005
|
|---|
| 8 | ;"=======================================================================
|
|---|
| 9 | ;" API -- Public Functions.
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;"WriteXMLData(pArray,Flags,IndentS)
|
|---|
| 12 | ;"Write1File(File,Recs,Flags,IndentS,SavFieldInfo)
|
|---|
| 13 | ;"Write1Rec(File,IEN,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
|
|---|
| 14 | ;"Write1Fld(FileNum,IEN,Field,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
|
|---|
| 15 |
|
|---|
| 16 | ;"=======================================================================
|
|---|
| 17 | ;"PRIVATE API FUNCTIONS
|
|---|
| 18 | ;"=======================================================================
|
|---|
| 19 |
|
|---|
| 20 |
|
|---|
| 21 | ;"=======================================================================
|
|---|
| 22 | ;"DEPENDENCIES
|
|---|
| 23 | ;" TMGDBAPI,TMGDEBUG,TMGMISC,TMGUSRIF
|
|---|
| 24 | ;"=======================================================================
|
|---|
| 25 | ;"=======================================================================
|
|---|
| 26 |
|
|---|
| 27 | ;"The basic format is to be as follows:
|
|---|
| 28 |
|
|---|
| 29 | ;"Array(File,Record,Field,subRec,SubField...)="" <--- means export this entry to XML
|
|---|
| 30 | ;"Array(File,"TEMPLATE",Field)
|
|---|
| 31 | ;"Array(File,"TEMPLATE","ORDER",OrderNum)=Field
|
|---|
| 32 | ;"Array(File,"TEMPLATE","TAG NAME",FieldNumber)="Custom field name to put in XML file"
|
|---|
| 33 | ;"Array("FLAGS","b")="" b -- show tags for ALL fields, even if field has no data
|
|---|
| 34 | ;"Array("FLAGS","i")="" i -- indent tags for pretty, but technically useless, file formating.
|
|---|
| 35 | ;"Array("FLAGS","I")="" I -- output INTERNAL values
|
|---|
| 36 | ;"Array("FLAGS","D")="" D -- output the data dictionary
|
|---|
| 37 | ;"Array("!DOCTYPE")=MyLabel
|
|---|
| 38 | ;"Array("EXPORT_SYSTEM_NAME")=LabelForExportingSystem -- OPTIONAL
|
|---|
| 39 | ;"
|
|---|
| 40 | ;"-----------------------------------------------------------------------------------------------
|
|---|
| 41 | ;"Note: File numbers can be replaces with full FILE NAMES, e.g.
|
|---|
| 42 | ;" Array("NEW PERSON",1234,.01)=""
|
|---|
| 43 | ;"
|
|---|
| 44 | ;"Example: For ALL records, output ALL fields, and ALL subfields
|
|---|
| 45 | ;" Array(8925,"*")="" <--- this is default if Recs is not specified/passed
|
|---|
| 46 | ;"
|
|---|
| 47 | ;"Example: to print from:
|
|---|
| 48 | ;" file 8925, records 1234,1235,1236,1237
|
|---|
| 49 | ;" file 200, ALL records
|
|---|
| 50 | ;" file 22705, records 3,5
|
|---|
| 51 | ;" file 2, ALL records
|
|---|
| 52 | ;"
|
|---|
| 53 | ;" Array(8925,1234)=""
|
|---|
| 54 | ;" Array(8925,1235)=""
|
|---|
| 55 | ;" Array(8925,1236)=""
|
|---|
| 56 | ;" Array(8925,1237)=""
|
|---|
| 57 | ;" Array(200,"*")=""
|
|---|
| 58 | ;" Array(22705,3)=""
|
|---|
| 59 | ;" Array(22705,5)=""
|
|---|
| 60 | ;" Array(2,"*")=""
|
|---|
| 61 | ;"
|
|---|
| 62 | ;"Example: Output extra info in record node
|
|---|
| 63 | ;" Array(8925,1232)="tag=value^tag2=value2" <-- optional extra info for record
|
|---|
| 64 | ;" e.g. --> <Record id=1232 tag="value" tag2="value2">
|
|---|
| 65 | ;"
|
|---|
| 66 | ;"Example: For record 1231, output fields .01 and .02
|
|---|
| 67 | ;" For record 1232, output field .01 only
|
|---|
| 68 | ;" For record 1234, output field "NAME" only
|
|---|
| 69 | ;" For record 1235, output ALL fields
|
|---|
| 70 | ;" Array(8925,1231,.01)=""
|
|---|
| 71 | ;" Array(8925,1231,.02)=""
|
|---|
| 72 | ;" Array(8925,1232,.01)=""
|
|---|
| 73 | ;" Array(8925,1234,"NAME")=""
|
|---|
| 74 | ;" Array(8925,1235,"*")=""
|
|---|
| 75 | ;"
|
|---|
| 76 | ;"Example:
|
|---|
| 77 | ;" Array(8925,"TEMPLATE",.01)="" <-- define a template for file 8925, with fields .01,.02,.03
|
|---|
| 78 | ;" Array(8925,"TEMPLATE",.02)=""
|
|---|
| 79 | ;" Array(8925,"TEMPLATE",.03)=""
|
|---|
| 80 | ;" Array(8925,1234) <-- print record 1234 (will use the template)
|
|---|
| 81 | ;" Array(8925,1235) <-- print record 1235
|
|---|
| 82 | ;"
|
|---|
| 83 | ;"Example:
|
|---|
| 84 | ;" Array(8925,"TEMPLATE","*"))="" <-- include all fields in template
|
|---|
| 85 | ;" Array(8925,"TEMPLATE","Field Exclude",.04)="" <-- but exclude field .04
|
|---|
| 86 | ;" Array(8925,1235) <-- print record 1235, all fields but .04
|
|---|
| 87 | ;"
|
|---|
| 88 | ;"Example: For all records, output fields .01 and .02 and "NAME"
|
|---|
| 89 | ;" Array(8925,"*",.01)=""
|
|---|
| 90 | ;" Array(8925,"*",.02)=""
|
|---|
| 91 | ;" Array(8925,"*","NAME")=""
|
|---|
| 92 | ;"
|
|---|
| 93 | ;"Example:
|
|---|
| 94 | ;" Array(8925,1231,"*")="" <--- indicates that ALL fields, ALL subrecs,and ALL subfields are wanted
|
|---|
| 95 | ;"
|
|---|
| 96 | ;"Example: For all records, output field "ENTRY", which is a multiple. In
|
|---|
| 97 | ;" subfile, output all records, fields .01, and .02
|
|---|
| 98 | ;" Array(8925,"*","ENTRY","*",.01)=""
|
|---|
| 99 | ;" Array(8925,"*","ENTRY","*",.02)=""
|
|---|
| 100 | ;"
|
|---|
| 101 | ;"Example: For ALL records, output ALL fields, and ALL subfields, with 2 exceptions
|
|---|
| 102 | ;" Array(8925,"Rec Exclude",1234)="" <-- All records except 1234 & 1235 will be output
|
|---|
| 103 | ;" Array(8925,"Rec Exclude",1235)=""
|
|---|
| 104 | ;" Array(8925,"*")=""
|
|---|
| 105 | ;"
|
|---|
| 106 | ;"Example:
|
|---|
| 107 | ;" Array(8925,"TEMPLATE","Field Exclude",.04)="" <-- don't show field .04
|
|---|
| 108 | ;" Array(8925,"TEMPLATE","Field Exclude","STATE")="" <-- don't show field "STATE"
|
|---|
| 109 | ;" Array(8925,1231,"*")="" <-- in record 1231, show all fields but .04 and "STATE"
|
|---|
| 110 | ;"
|
|---|
| 111 | ;"Example: Field .04 is multiple. ALL sub records and ALL subfields to be written
|
|---|
| 112 | ;" Array(8925,1231,.04,"*","*")=""
|
|---|
| 113 | ;" Array(8925,1231,.04,"*")="" <--- "*" assumed for subfields
|
|---|
| 114 | ;" Array(8925,1231,.04)="" <-- "*" assumed for subrecords and subfields.
|
|---|
| 115 | ;"
|
|---|
| 116 | ;"Example: Field .03 is multiple. All sub records to be written (except for #5) , and .01 and .02 fields to be written
|
|---|
| 117 | ;" Array(8925,1231,.03,"*",.01)="" <-- In all sub recs, sub field .01 is to be written
|
|---|
| 118 | ;" Array(8925,1231,.03,"*",.02)="" <-- In all sub recs, sub field .02 is to be written
|
|---|
| 119 | ;" Array(8925,1231,.03,"Rec Exclude",5)="" <-- Exclude subrec 5
|
|---|
| 120 | ;"
|
|---|
| 121 | ;"Example: Field .03 is multiple. All sub records to be written, and .01 and .02 fields to be written
|
|---|
| 122 | ;" Array(8925,1231,"TEMPLATE",.03,"*","TEMPLATE",.01)="" <-- In all sub recs, sub field .01 is to be written
|
|---|
| 123 | ;" Array(8925,1231,"TEMPLATE",.03,"*","TEMPLATE",.02)="" <-- In all sub recs, sub field .02 is to be written
|
|---|
| 124 |
|
|---|
| 125 | ;"Example: Field .03 is multiple. Sub records 1,2,3 to be written, fields as below
|
|---|
| 126 | ;" Array(8925,1231,.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written
|
|---|
| 127 | ;" Array(8925,1231,.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written
|
|---|
| 128 | ;" Array(8925,1231,.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written
|
|---|
| 129 | ;" Array(8925,1231,.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written
|
|---|
| 130 | ;" Array(8925,1231,.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt)
|
|---|
| 131 | ;" Array(8925,1231,.03,5,"*")="" <-- In sub rec 5, all sub fields are to be written, with one exception
|
|---|
| 132 | ;" Array(8925,1231,.03,5,"Field Exclude",.01)="" <-- In sub rec 5, sub fields .01 is not to be written.
|
|---|
| 133 | ;"
|
|---|
| 134 | ;"Example: Shows optional substitution of a new tag name for a given field
|
|---|
| 135 | ;" Array(8925,"TEMPLATE","TAG NAME",.01)="Patent Name" <-- use "Patient Name" instead of field name for .01 field
|
|---|
| 136 | ;" Array(8925,"TEMPLATE","TAG NAME",.02)="City" <-- use "City" instead of field name for .02 field
|
|---|
| 137 | ;"
|
|---|
| 138 | ;"Note: pattern continues for sub-sub-multiples etc.
|
|---|
| 139 | ;"
|
|---|
| 140 | ;"Example:
|
|---|
| 141 | ;" Array(8925,1231,.01)=""
|
|---|
| 142 | ;" Array(8925,1231,.02)=""
|
|---|
| 143 | ;" Array(8925,1231,"NAME")="" <--- note that field name is allowed in place of number
|
|---|
| 144 | ;" Array(8925,1231,.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written
|
|---|
| 145 | ;" Array(8925,1231,.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written
|
|---|
| 146 | ;" Array(8925,1231,.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written
|
|---|
| 147 | ;" Array(8925,1231,.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written
|
|---|
| 148 | ;" Array(8925,1231,.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt)
|
|---|
| 149 | ;"
|
|---|
| 150 | ;"Example: Field .03 is a multiple
|
|---|
| 151 | ;" Array(8925,1231,.03,"TEMPLATE",.01)=""
|
|---|
| 152 | ;" Array(8925,1231,.03,"TEMPLATE",.02)=""
|
|---|
| 153 | ;" Array(8925,1231,.03,1)="" <-- In sub rec 1, export fields .01,.02 from template
|
|---|
| 154 | ;" Array(8925,1231,.03,2)="" <-- In sub rec 2, export fields .01,.02 from template
|
|---|
| 155 | ;" Array(8925,1231,.03,4)="" <-- In sub rec 4, export fields .01,.02 from template
|
|---|
| 156 | ;"
|
|---|
| 157 | ;"Example:
|
|---|
| 158 | ;" Array(8925,"TEMPLATE","ORDER",1)=.03 <-- 1st field to output
|
|---|
| 159 | ;" Array(8925,"TEMPLATE","ORDER",2)=.02 <-- 2nd field to output
|
|---|
| 160 | ;" Array(8925,"TEMPLATE","ORDER",3)="NAME" <-- 3rd field to output
|
|---|
| 161 | ;" Array(8925,"TEMPLATE","ORDER",4)=.01 <-- 4th field to output
|
|---|
| 162 | ;" Note: Specifying an 'ORDER' is not compatible with specifying "*" fields
|
|---|
| 163 | ;" If "ORDER" is specified, only fields with a given order will be output
|
|---|
| 164 | ;" Both Field("ORDER",x)=FieldNum *AND* Field(FieldNum)="" should be defined
|
|---|
| 165 | ;" This will be primarily important for fields that are multiples, with sub recs.
|
|---|
| 166 | ;"
|
|---|
| 167 | ;"Example:
|
|---|
| 168 | ;" Array(8925,"TEMPLATE","TRANSFORM",.01)="write ""Custom .01 output transform M code here..."""
|
|---|
| 169 | ;" Array(8925,"TEMPLATE","TRANSFORM",.02)="write ""Custom .02 output transform M code here..."""
|
|---|
| 170 |
|
|---|
| 171 |
|
|---|
| 172 |
|
|---|
| 173 | WriteXMLData(pArray,Flags,IndentS,ShowProgress)
|
|---|
| 174 | ;"Scope: PUBLIC
|
|---|
| 175 | ;"Purpose: to dump out a specified set of files and records in XML Format
|
|---|
| 176 | ;"Input: pArray -- pointer to (i.e. name of) array containting formatting/output info.
|
|---|
| 177 | ;" REQUIRED An array specifying which files and records to display
|
|---|
| 178 | ;" Format as follows:
|
|---|
| 179 | ;" ;"-----------------------------------------
|
|---|
| 180 | ;" Array(File,IEN,FieldInfo) ; For FieldInfo, see Write1File, and Write1Rec
|
|---|
| 181 | ;" Array(File,["TEMPLATE"],...) ;For Template info see function Write1File
|
|---|
| 182 | ;" Array("FLAGS","b")="" b -- show tags for ALL fields, even if field has no data
|
|---|
| 183 | ;" Array("FLAGS","i")="" i -- indent tags for pretty, but technically useless, file formating.
|
|---|
| 184 | ;" Array("FLAGS","I")="" I -- output INTERNAL values
|
|---|
| 185 | ;" Array("FLAGS","D")="" D -- output the data dictionary
|
|---|
| 186 | ;" Array("FLAGS","S")="" S -- output export settings.
|
|---|
| 187 | ;" Array("!DOCTYPE")=MyLabel
|
|---|
| 188 | ;" Array("EXPORT_SYSTEM_NAME")=LabelForExportingSystem -- OPTIONAL
|
|---|
| 189 | ;" ;"-----------------------------------------
|
|---|
| 190 | ;"
|
|---|
| 191 | ;" e.g. Array(8925,1234)=""
|
|---|
| 192 | ;" Array(8925,1235)=""
|
|---|
| 193 | ;" Array(8925,1236)=""
|
|---|
| 194 | ;" Array(8925,1237)=""
|
|---|
| 195 | ;" Array(8925,1232)="tag=value^tag2=value2" <-- optional extra info for record
|
|---|
| 196 | ;" e.g. --> <Record id=1232 tag="value" tag2="value2">
|
|---|
| 197 | ;" Array(200,"*")=""
|
|---|
| 198 | ;" Array(22705,3)=""
|
|---|
| 199 | ;" Array(22705,5)=""
|
|---|
| 200 | ;" Array(2,"*")=""
|
|---|
| 201 | ;"
|
|---|
| 202 | ;" This would print from:
|
|---|
| 203 | ;" file 8925, records 1234,1235,1236,1237
|
|---|
| 204 | ;" file 200, ALL records
|
|---|
| 205 | ;" file 22705, records 3,5
|
|---|
| 206 | ;" file 2, ALL records
|
|---|
| 207 | ;"
|
|---|
| 208 | ;" Example:
|
|---|
| 209 | ;" Array(8925,"TEMPLATE",.01)="" <-- define a template for file 8925
|
|---|
| 210 | ;" Array(8925,"TEMPLATE",.02)=""
|
|---|
| 211 | ;" Array(8925,"TEMPLATE",.02)=""
|
|---|
| 212 | ;" Array(8925,1234) <-- print record 1234
|
|---|
| 213 | ;" Array(8925,1235) <-- print record 1235
|
|---|
| 214 | ;"
|
|---|
| 215 | ;" Example:
|
|---|
| 216 | ;" Array(8925,1234) <-- print record 1234
|
|---|
| 217 | ;" Array(8925,1235) <-- print record 1235
|
|---|
| 218 | ;"
|
|---|
| 219 | ;" Example:
|
|---|
| 220 | ;" Array(8925,1234,.01) <-- print record 1234, only field .01
|
|---|
| 221 | ;" Array(8925,1235,.04) <-- print record 1235, only field .04
|
|---|
| 222 | ;"
|
|---|
| 223 | ;" Note: File numbers can be replaces with full FILE NAMES, e.g.
|
|---|
| 224 | ;" Array("NEW PERSON","*")=""
|
|---|
| 225 | ;"
|
|---|
| 226 | ;" Note: All File numbers and field numbers can be replaced with NAMES
|
|---|
| 227 | ;"
|
|---|
| 228 | ;" Flags -- OPTIONAL (Note Flags can also be specified with a "FLAGS" node)
|
|---|
| 229 | ;" b -- show tags for ALL fields, even if field has no data
|
|---|
| 230 | ;" i -- indent tags for pretty, but technically useless, file formating.
|
|---|
| 231 | ;" I -- output INTERNAL values
|
|---|
| 232 | ;" D -- output Data dictionary
|
|---|
| 233 | ;" e.g. Flags="b" or "bi" or "ib" or "iI" etc.
|
|---|
| 234 | ;" IndentS -- OPTIONAL -- current string to write to indent line.
|
|---|
| 235 | ;" IndentS("IncIndent")=IncIndent
|
|---|
| 236 | ;" ShowProgress -- OPTIONAL -- if =1, then a progress bar will be shown.
|
|---|
| 237 | ;"Output: results are written to the current device.
|
|---|
| 238 | ;"result : none
|
|---|
| 239 |
|
|---|
| 240 | new File,tArray,SavFieldInfo
|
|---|
| 241 | merge tArray=@pArray
|
|---|
| 242 | set Flags=$get(Flags)
|
|---|
| 243 | new IncIndent set IncIndent=$get(IndentS("IncIndent")," ")
|
|---|
| 244 |
|
|---|
| 245 | if ($data(tArray("FLAGS","b"))>0)&(Flags'["b") set Flags=Flags_"b"
|
|---|
| 246 | if ($data(tArray("FLAGS","i"))>0)&(Flags'["i") set Flags=Flags_"i"
|
|---|
| 247 | if ($data(tArray("FLAGS","I"))>0)&(Flags'["I") set Flags=Flags_"I"
|
|---|
| 248 | if ($data(tArray("FLAGS","D"))>0)&(Flags'["D") set Flags=Flags_"D"
|
|---|
| 249 | if ($data(tArray("FLAGS","S"))>0)&(Flags'["S") set Flags=Flags_"S"
|
|---|
| 250 |
|
|---|
| 251 | do WriteHeader
|
|---|
| 252 | write "<!DOCTYPE "_$get(tArray("!DOCTYPE"),"UNDEFINED"),">",!
|
|---|
| 253 | new SrcName set SrcName=$get(tArray("EXPORT_SYSTEM_NAME"),"?Unnamed?")
|
|---|
| 254 | write "<EXPORT source=""",$$SYMENC^MXMLUTL(SrcName),""">",!
|
|---|
| 255 | set IndentS=$get(IndentS)_IncIndent
|
|---|
| 256 | if Flags["S" do WriteSettings(.Flags,.IndentS) ;"output writing settings
|
|---|
| 257 |
|
|---|
| 258 | set File=""
|
|---|
| 259 | for set File=$order(tArray(File)) quit:(+File'>0) do
|
|---|
| 260 | . new IEN,Template,Recs
|
|---|
| 261 | . merge Template=tArray(File,"TEMPLATE")
|
|---|
| 262 | . kill tArray(File,"TEMPLATE")
|
|---|
| 263 | . merge Recs=tArray(File)
|
|---|
| 264 | . set IEN=$order(tArray(File,""))
|
|---|
| 265 | . if IEN'="" do
|
|---|
| 266 | . . if $data(TMGXDEBUG) do
|
|---|
| 267 | . . . use $P write "Writing file: ",File,! use IO
|
|---|
| 268 | . . if IEN="*" do
|
|---|
| 269 | . . . do Write1File(File,.Recs,.Flags,.IndentS,.Template,.ShowProgress,,,,,.SavFieldInfo)
|
|---|
| 270 | . . else do
|
|---|
| 271 | . . . new Recs merge Recs=tArray(File)
|
|---|
| 272 | . . . do Write1File(File,.Recs,.Flags,.IndentS,,.ShowProgress,,,,,.SavFieldInfo)
|
|---|
| 273 |
|
|---|
| 274 | write "</EXPORT>",!
|
|---|
| 275 |
|
|---|
| 276 | quit
|
|---|
| 277 |
|
|---|
| 278 |
|
|---|
| 279 | WriteHeader
|
|---|
| 280 | ;"Scope: PUBLIC
|
|---|
| 281 | ;"Purpose: A shell to write out a proper XML header. This should be done prior
|
|---|
| 282 | ;" to writing out XML formatted data to a device
|
|---|
| 283 | ;"Output: Header is output to current device
|
|---|
| 284 | ;"Results: none
|
|---|
| 285 |
|
|---|
| 286 | new s
|
|---|
| 287 | set s=$$XMLHDR^MXMLUTL
|
|---|
| 288 | write s,!
|
|---|
| 289 | quit
|
|---|
| 290 |
|
|---|
| 291 |
|
|---|
| 292 | Write1File(File,Recs,Flags,IndentS,Template,ShowProgress,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
|
|---|
| 293 | ;"Scope: PUBLIC
|
|---|
| 294 | ;"Purpose: to dump out (in XML) one file, for specified records
|
|---|
| 295 | ;"Input: File -- name or number of file to dump
|
|---|
| 296 | ;" Recs -- OPTIONAL. PASS BY REFERENCE (default is to write ALL records)
|
|---|
| 297 | ;" To specify records to write out, use Recs array with following format:
|
|---|
| 298 | ;" -------------------------------------------------------------------
|
|---|
| 299 | ;" Recs(IEN,Field,FieldInfo); (Default for all is "*")
|
|---|
| 300 | ;" For format of FieldInfo, see function Write1Rec
|
|---|
| 301 | ;" Recs("Rec Exclude",IEN) <-- exclude IEN from output
|
|---|
| 302 | ;" -------------------------------------------------------------------
|
|---|
| 303 | ;" Example:
|
|---|
| 304 | ;" Recs(1231)=""
|
|---|
| 305 | ;" Recs(1232)=""
|
|---|
| 306 | ;" Recs(1234)="" this would be used to print records 1231,1232,1234
|
|---|
| 307 | ;" Recs(1232)="tag=value^tag2=value2" <-- optional extra info for record
|
|---|
| 308 | ;" e.g. <Record id=1232 tag="value" tag2="value2">
|
|---|
| 309 | ;"
|
|---|
| 310 | ;" Example: For ALL records, output ALL fields, and ALL subfields
|
|---|
| 311 | ;" Recs("*")="" <--- this is default if Recs is not specified/passed
|
|---|
| 312 | ;" Example: For all records, output fields .01 and .02 and "NAME"
|
|---|
| 313 | ;" Recs("*",.01)=""
|
|---|
| 314 | ;" Recs("*",.02)=""
|
|---|
| 315 | ;" Recs("*","NAME")=""
|
|---|
| 316 | ;" Example: For record 1231, output fields .01 and .02
|
|---|
| 317 | ;" For record 1232, output field .01 only
|
|---|
| 318 | ;" For record 1234, output field "NAME" only
|
|---|
| 319 | ;" For record 1235, output ALL fields
|
|---|
| 320 | ;" Recs(1231,.01)=""
|
|---|
| 321 | ;" Recs(1231,.02)=""
|
|---|
| 322 | ;" Recs(1232,.01)=""
|
|---|
| 323 | ;" Recs(1234,"NAME")=""
|
|---|
| 324 | ;" Recs(1235,"*")=""
|
|---|
| 325 | ;" Example: For all records, output field "ENTRY", which is a multiple. In
|
|---|
| 326 | ;" subfile, output records .01, and .02
|
|---|
| 327 | ;" Recs("*","ENTRY",.01)=""
|
|---|
| 328 | ;" Recs("*","ENTRY",.02)=""
|
|---|
| 329 | ;" Example: For ALL records, output ALL fields, and ALL subfields, with 2 exceptions
|
|---|
| 330 | ;" Recs("*")=""
|
|---|
| 331 | ;" Recs("Rec Exclude",1234)="" <-- All records except 1234 & 1235 will be output
|
|---|
| 332 | ;" Recs("Rec Exclude",1235)=""
|
|---|
| 333 | ;" Flags -- OPTIONAL
|
|---|
| 334 | ;" b -- show tags for ALL fields, even if field has no data
|
|---|
| 335 | ;" i -- indent tags for pretty, but technically useless, file formating.
|
|---|
| 336 | ;" I -- output INTERNAL values
|
|---|
| 337 | ;" D -- include data dictionary for file.
|
|---|
| 338 | ;" S -- output export settings
|
|---|
| 339 | ;" IndentS -- OPTIONAL -- current string to write to indent line.
|
|---|
| 340 | ;" IndentS("IncIndent")=IncIndent
|
|---|
| 341 | ;" Template -- OPTIONAL. PASS BY REFERENCE
|
|---|
| 342 | ;" This can be used for instances where the same set of fields are desired for
|
|---|
| 343 | ;" multiple records.
|
|---|
| 344 | ;" Example:
|
|---|
| 345 | ;" Recs(1231)=""
|
|---|
| 346 | ;" Recs(1232)=""
|
|---|
| 347 | ;" Recs(1234)=""
|
|---|
| 348 | ;" with Template(.01)=""
|
|---|
| 349 | ;" Template(.02)=""
|
|---|
| 350 | ;" Is the same as specifying:
|
|---|
| 351 | ;" Recs(1231,.01)=""
|
|---|
| 352 | ;" Recs(1231,.02)=""
|
|---|
| 353 | ;" Recs(1232,.01)=""
|
|---|
| 354 | ;" Recs(1232,.02)=""
|
|---|
| 355 | ;" Recs(1234,.01)=""
|
|---|
| 356 | ;" Recs(1234,.02)=""
|
|---|
| 357 | ;" ShowProgress -- OPTIONAL -- if >0, then a progress bar will be shown.
|
|---|
| 358 | ;" RWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 359 | ;" actual starting and ending <record> </record>. e.g.
|
|---|
| 360 | ;" "MyCustomFn". Note do NOT include parameters. Function named
|
|---|
| 361 | ;" as custom function must accept same parameters as WriteRLabel
|
|---|
| 362 | ;" FWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 363 | ;" actual line of text out. e.g. "WriteFLabel" or
|
|---|
| 364 | ;" "MyCustomFn". Note do NOT include parameters. Function named
|
|---|
| 365 | ;" LWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 366 | ;" actual line of text out for WP fields. e.g. "WriteLine" or
|
|---|
| 367 | ;" "MyCustomFn". Note do NOT include parameters. Function named
|
|---|
| 368 | ;" as custom function must accept same parameters as WriteLine
|
|---|
| 369 | ;" as custom function must accept same parameters as WriteFLabel
|
|---|
| 370 | ;" WPLWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 371 | ;" actual line of text out for WP fields. If not provided, then
|
|---|
| 372 | ;" LWriter will be used instead.
|
|---|
| 373 | ;" e.g. "WriteWPLine" or "MyWPCustomFn". Note do NOT include parameters.
|
|---|
| 374 | ;" Function named as custom function must accept same parameters as WriteLine
|
|---|
| 375 | ;" SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE. An array to hold lookup values about
|
|---|
| 376 | ;" fields, so it doesn't have to be done each time (faster)
|
|---|
| 377 | ;"Output: results are written to the current device.
|
|---|
| 378 | ;"result : none
|
|---|
| 379 |
|
|---|
| 380 | new ORoot,GRef
|
|---|
| 381 | new FileNum,FName
|
|---|
| 382 | new prgsCt set prgsCt=0
|
|---|
| 383 | new prgsMax
|
|---|
| 384 |
|
|---|
| 385 | new IncIndent set IncIndent=$get(IndentS("IncIndent")," ")
|
|---|
| 386 | if $data(Template)=0 set Template("*")=""
|
|---|
| 387 | new RecsSpecified set RecsSpecified=(($data(Recs)>1)&($data(Recs("*"))=0))
|
|---|
| 388 | new keyin set keyin=32
|
|---|
| 389 | new startTime set startTime=$H
|
|---|
| 390 | set RWriter=$get(RWriter,"WriteRLabel")
|
|---|
| 391 | set IndentS=$get(IndentS)
|
|---|
| 392 |
|
|---|
| 393 | set FileNum=+$get(File)
|
|---|
| 394 | if FileNum=0 do
|
|---|
| 395 | . set FileNum=$$GetFileNum^TMGDBAPI(.File)
|
|---|
| 396 | . set FName=File
|
|---|
| 397 | else do
|
|---|
| 398 | . set FName=$order(^DD(FileNum,0,"NM",""))
|
|---|
| 399 | if FileNum=0 do goto WFDone
|
|---|
| 400 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.")
|
|---|
| 401 |
|
|---|
| 402 | set ORoot=$$GET1^DID(FileNum,"","","GLOBAL NAME") ;" Get global root (Thanks, Don Donati...)
|
|---|
| 403 | set GRef=$$CREF^DILF(ORoot) ;" Convert open to closed root
|
|---|
| 404 |
|
|---|
| 405 | if $get(ShowProgress) do
|
|---|
| 406 | . if RecsSpecified do
|
|---|
| 407 | . . set prgsMax=$$ListCt^TMGMISC("Recs")
|
|---|
| 408 | . else do
|
|---|
| 409 | . . set prgsMax=0
|
|---|
| 410 | . . set IEN=$order(@GRef@("")) ;"count ALL records in file.
|
|---|
| 411 | . . for do quit:(IEN'>0)
|
|---|
| 412 | . . . set IEN=$order(@GRef@(IEN))
|
|---|
| 413 | . . . if +IEN>0 set prgsMax=prgsMax+1
|
|---|
| 414 |
|
|---|
| 415 | set Flags=$get(Flags)
|
|---|
| 416 | if Flags["i" write IndentS
|
|---|
| 417 | write "<FILE id=""",FileNum,""" label=""",$$SYMENC^MXMLUTL(FName),""">",!
|
|---|
| 418 |
|
|---|
| 419 | if Flags["D" do WriteDD(FileNum,Flags,IndentS_IncIndent) ;"write out data dictionary file
|
|---|
| 420 |
|
|---|
| 421 | new IndS2 set IndS2=IndentS_IncIndent
|
|---|
| 422 | new IEN set IEN=0
|
|---|
| 423 | for do quit:(IEN'>0)
|
|---|
| 424 | . if $data(Fields)'>1 set Fields("*")=""
|
|---|
| 425 | . if RecsSpecified do
|
|---|
| 426 | . . set IEN=$order(Recs(IEN)) ;"Cycle through specified records
|
|---|
| 427 | . . new Extra set Extra=$get(Recs(IEN))
|
|---|
| 428 | . . if Extra'="" do ;"parse extra info into IEN array for output
|
|---|
| 429 | . . . new s,n,tag,value
|
|---|
| 430 | . . . for n=1:1:$length(Extra,"^") do
|
|---|
| 431 | . . . . set s=$piece(Extra,"^",n)
|
|---|
| 432 | . . . . if s'["=" quit
|
|---|
| 433 | . . . . set tag=$piece(s,"=",1)
|
|---|
| 434 | . . . . set value=$piece(s,"=",2)
|
|---|
| 435 | . . . . set IEN(tag)=value
|
|---|
| 436 | . else do
|
|---|
| 437 | . . set IEN=$order(@GRef@(IEN)) ;"Cycle through ALL records in file.
|
|---|
| 438 | . if (IEN'>0) quit
|
|---|
| 439 | . if $data(Recs("Rec Exclude",IEN)) quit ;"skip excluded records
|
|---|
| 440 | . new Fields merge Fields=Recs(IEN)
|
|---|
| 441 | . if $data(Fields)'>1 merge Fields=Template
|
|---|
| 442 | . if $get(Flags)["i" write $get(IndS2)
|
|---|
| 443 | . new exFn set exFn="do "_RWriter_"(.IEN,0)"
|
|---|
| 444 | . xecute exFn
|
|---|
| 445 | . if $data(TMGXDEBUG) do
|
|---|
| 446 | . . use $P
|
|---|
| 447 | . . write "Writing record: ",IEN," prgsCt=",prgsCt," prgsMax=",prgsMax,!
|
|---|
| 448 | . . use IO
|
|---|
| 449 | . do Write1Rec(FileNum,IEN,.Fields,.Flags,"","",IndS2_IncIndent,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo)
|
|---|
| 450 | . if $get(Flags)["i" write $get(IndS2)
|
|---|
| 451 | . set exFn="do "_RWriter_"(.IEN,1)"
|
|---|
| 452 | . xecute exFn
|
|---|
| 453 | . set prgsCt=prgsCt+1
|
|---|
| 454 | . if $get(ShowProgress)&(prgsCt#2=1) do
|
|---|
| 455 | . . use $P
|
|---|
| 456 | . . do ProgressBar^TMGUSRIF(prgsCt,"Writing "_FName,1,prgsMax,,startTime)
|
|---|
| 457 | . . use IO
|
|---|
| 458 | . ;"use $P read *keyin use IO
|
|---|
| 459 | . if keyin=27 do
|
|---|
| 460 | . . new Abort
|
|---|
| 461 | . . use $P
|
|---|
| 462 | . . write prgsCt," records written so far...",!
|
|---|
| 463 | . . write !,"Do you want to abort XML export? NO// "
|
|---|
| 464 | . . read Abort:$get(DTIME,3600),!
|
|---|
| 465 | . . if Abort="" set Abort="NO"
|
|---|
| 466 | . . if "YESyesYes"[Abort set IEN=0 ;"abort signal
|
|---|
| 467 | . . write "OK. Continuing...",!
|
|---|
| 468 | . . use IO
|
|---|
| 469 |
|
|---|
| 470 | if $get(Flags)["i" write IndentS
|
|---|
| 471 | write "</FILE>",!
|
|---|
| 472 |
|
|---|
| 473 | if $get(ShowProgress) do
|
|---|
| 474 | . use $P
|
|---|
| 475 | . do ProgressBar^TMGUSRIF(100,"Writing "_FName,1,100)
|
|---|
| 476 | . use IO
|
|---|
| 477 |
|
|---|
| 478 | WFDone
|
|---|
| 479 | quit
|
|---|
| 480 |
|
|---|
| 481 | WriteSettings(Flags,IndentS)
|
|---|
| 482 | ;"Scope: PRIVATE
|
|---|
| 483 | ;"Purpose: to output XML output settings.
|
|---|
| 484 | ;"Input: Flags -- flags as declared above. Only "i" used here
|
|---|
| 485 | ;" IndentS -- OPTIONAL -- current string to write to indent line.
|
|---|
| 486 | ;" IndentS("IncIndent")=IncIndent
|
|---|
| 487 |
|
|---|
| 488 | ;"NOTE: Uses GLOBAL SCOPED IncIndent variable. But setting this is OPTIONAL.
|
|---|
| 489 | ;"Results: none
|
|---|
| 490 |
|
|---|
| 491 | set IndentS=$get(IndentS)
|
|---|
| 492 | set Flags=$get(Flags)
|
|---|
| 493 | new IncIndent set IncIndent=$get(IndentS("IncIndent")," ")
|
|---|
| 494 |
|
|---|
| 495 | if Flags["i" write IndentS
|
|---|
| 496 | write "<ExportSettings>",!
|
|---|
| 497 |
|
|---|
| 498 | new fArray,fl
|
|---|
| 499 | set fArray("i")="Indent_Output"
|
|---|
| 500 | set fArray("b")="Output_Blanks"
|
|---|
| 501 | set fArray("I")="Output_Internal_Values"
|
|---|
| 502 | set fArray("D")="Output_Data_Dictionary"
|
|---|
| 503 |
|
|---|
| 504 | set fl=""
|
|---|
| 505 | for set fl=$order(fArray(fl)) quit:(fl="") do
|
|---|
| 506 | . if Flags["i" write IndentS_IncIndent
|
|---|
| 507 | . write "<Setting id=""",$$SYMENC^MXMLUTL($get(fArray(fl))),""">"
|
|---|
| 508 | . write $select((Flags[fl):"TRUE",1:"FALSE")
|
|---|
| 509 | . write "</Setting>",!
|
|---|
| 510 |
|
|---|
| 511 | if Flags["i" write IndentS
|
|---|
| 512 | write "</ExportSettings>",!
|
|---|
| 513 |
|
|---|
| 514 | quit
|
|---|
| 515 |
|
|---|
| 516 | WriteDD(FileNum,Flags,IndentS)
|
|---|
| 517 | ;"Scope: PRIVATE
|
|---|
| 518 | ;"Purpose: to write out data dictionary file, ^DIC,and file Header in XML format
|
|---|
| 519 | ;"Input: FileNum -- the file number (not name) of the data dictionary to export
|
|---|
| 520 | ;" Flags -- flags as declared above. Only "i" used here
|
|---|
| 521 | ;" IndentS -- OPTIONAL -- current string to write to indent line.
|
|---|
| 522 | ;"NOTE: Uses GLOBAL SCOPED IncIndent variable. But setting this is OPTIONAL.
|
|---|
| 523 | ;"Results: none
|
|---|
| 524 |
|
|---|
| 525 | new ProgressFn
|
|---|
| 526 | use $P write ! use IO
|
|---|
| 527 | set IncIndent=$get(IncIndent," ")
|
|---|
| 528 |
|
|---|
| 529 | set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^DD("_FileNum_")"",0,100000,,"""_$H_""") use IO"
|
|---|
| 530 | do WriteArray^TMGXMLT($name(^DD(FileNum)),"DataDictionary",FileNum,.Flags,.IndentS,.IncIndent,.ProgressFn)
|
|---|
| 531 |
|
|---|
| 532 | set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^(DIC("_FileNum_")"",0,1000000,,"""_$H_""") use IO"
|
|---|
| 533 | new DIC ;"Pull just the fileman nodes. ^DIC also contains some full files...
|
|---|
| 534 | merge DIC(FileNum,0)=^DIC(FileNum,0)
|
|---|
| 535 | merge DIC(FileNum,"%")=^DIC(FileNum,"%")
|
|---|
| 536 | merge DIC(FileNum,"%A")=^DIC(FileNum,"%A")
|
|---|
| 537 | merge DIC(FileNum,"%D")=^DIC(FileNum,"%D")
|
|---|
| 538 | do WriteArray^TMGXMLT("DIC("_FileNum_")","DIC_File",FileNum,.Flags,.IndentS,.IncIndent,.ProgressFn)
|
|---|
| 539 |
|
|---|
| 540 | do
|
|---|
| 541 | . new Ref set Ref=$get(^DIC(FileNum,0,"GL"))
|
|---|
| 542 | . set Ref=$$CREF^DILF(Ref) ;" Convert open to closed root
|
|---|
| 543 | . if $get(Flags)["i" write IndentS
|
|---|
| 544 | . write "<FILE_HEADER id=""",FileNum,""">",!
|
|---|
| 545 | . if $get(Flags)["i" write IndentS
|
|---|
| 546 | . write $get(@Ref@(0)),!
|
|---|
| 547 | . if $get(Flags)["i" write IndentS
|
|---|
| 548 | . write "</FILE_HEADER>",!
|
|---|
| 549 |
|
|---|
| 550 | ;"use $P write ! use IO
|
|---|
| 551 | quit
|
|---|
| 552 |
|
|---|
| 553 |
|
|---|
| 554 | Write1Rec(File,IEN,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
|
|---|
| 555 | ;"Scope: PUBLIC
|
|---|
| 556 | ;"Purpose: To dump one record out in XML format
|
|---|
| 557 | ;"Input: File -- name or number of file to dump
|
|---|
| 558 | ;" IEN -- Record number (IEN) to dump (see also IENS below)
|
|---|
| 559 | ;" Fields -- OPTIONAL. PASS BY REFERENCE. Array of fields to write, format at follows
|
|---|
| 560 | ;" Fields(Field,[SubRecNums,[SubFields,...]])=""
|
|---|
| 561 | ;" Fields(Field,["Rec Exclude",Excluded IEN])=""
|
|---|
| 562 | ;" Fields("Field Exclude",ExcludedField)="" <-- OPTIONAL
|
|---|
| 563 | ;" Fields("ORDER",OrderNum)=Field <-- OPTIONAL
|
|---|
| 564 | ;" Fields("TAG NAME",FieldNumber)="Custom field name to put in XML file" <-- OPTIONAL
|
|---|
| 565 | ;"
|
|---|
| 566 | ;" Example:
|
|---|
| 567 | ;" Fields(.01)=""
|
|---|
| 568 | ;" Fields(.02)=""
|
|---|
| 569 | ;" Fields("NAME")="" <--- note that field name is allowed in place of number
|
|---|
| 570 | ;" Fields(.03)=""
|
|---|
| 571 | ;"
|
|---|
| 572 | ;" Example:
|
|---|
| 573 | ;" Fields("*")="" <--- indicates that ALL fields, ALL subrecs,and ALL subfields are wanted
|
|---|
| 574 | ;"
|
|---|
| 575 | ;" Example:
|
|---|
| 576 | ;" Fields("*")=""
|
|---|
| 577 | ;" Fields("Field Exclude",.04)="" <-- don't show field .04
|
|---|
| 578 | ;" Fields("Field Exclude","STATE")="" <-- don't show field "STATE"
|
|---|
| 579 | ;"
|
|---|
| 580 | ;" Example: Field .04 is multiple. ALL sub records and ALL subfields to be written
|
|---|
| 581 | ;" Fields(.04,"*","*")=""
|
|---|
| 582 | ;" Fields(.04,"*")="" <--- "*" assumed for subfields
|
|---|
| 583 | ;" Fields(.04)="" <-- "*" assumed for subrecords and subfields.
|
|---|
| 584 | ;"
|
|---|
| 585 | ;" Example: Field .03 is multiple. All sub records to be written, and .01 and .02 fields to be written
|
|---|
| 586 | ;" Fields(.03,"*",.01)="" <-- In all sub recs, sub field .01 is to be written
|
|---|
| 587 | ;" Fields(.03,"*",.02)="" <-- In all sub recs, sub field .02 is to be written
|
|---|
| 588 | ;" Fields(.03,"Rec Exclude",5)="" <-- Exclude subrec 5
|
|---|
| 589 | ;"
|
|---|
| 590 | ;" Example: Field .03 is multiple. Sub records 1,2,3 to be written, fields as below
|
|---|
| 591 | ;" Fields(.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written
|
|---|
| 592 | ;" Fields(.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written
|
|---|
| 593 | ;" Fields(.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written
|
|---|
| 594 | ;" Fields(.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written
|
|---|
| 595 | ;" Fields(.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt)
|
|---|
| 596 | ;" Fields(.03,5,"*")="" <-- In sub rec 5, all sub fields are to be written, with one exception
|
|---|
| 597 | ;" Fields(.03,5,"Field Exclude",.01)="" <-- In sub rec 5, sub fields .01 is not to be written.
|
|---|
| 598 | ;"
|
|---|
| 599 | ;" Example: Shows optional substitution of a new tag name for a given field
|
|---|
| 600 | ;" Fields("TAG NAME",.01)="Patent Name" <-- use "Patient Name" instead of field name for .01 field
|
|---|
| 601 | ;" Fields("TAG NAME",.02)="City" <-- use "City" instead of field name for .02 field
|
|---|
| 602 | ;"
|
|---|
| 603 | ;" Example:
|
|---|
| 604 | ;" Array("TRANSFORM",.01)="write ""Custom .01 output transform M code here..."""
|
|---|
| 605 | ;" Array("TRANSFORM",.02)="write ""Custom .02 output transform M code here..."""
|
|---|
| 606 | ;"
|
|---|
| 607 | ;" Note: pattern continues for sub-sub-multiples etc.
|
|---|
| 608 | ;"
|
|---|
| 609 | ;" Example:
|
|---|
| 610 | ;" Fields(.01)=""
|
|---|
| 611 | ;" Fields(.02)=""
|
|---|
| 612 | ;" Fields("NAME")="" <--- note that field name is allowed in place of number
|
|---|
| 613 | ;" Fields(.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written
|
|---|
| 614 | ;" Fields(.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written
|
|---|
| 615 | ;" Fields(.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written
|
|---|
| 616 | ;" Fields(.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written
|
|---|
| 617 | ;" Fields(.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt)
|
|---|
| 618 | ;" Fields("ORDER",1)=.03 <-- 1st field to output
|
|---|
| 619 | ;" Fields("ORDER",2)=.02 <-- 2nd field to output
|
|---|
| 620 | ;" Fields("ORDER",3)="NAME" <-- 3rd field to output
|
|---|
| 621 | ;" Fields("ORDER",4)=.01 <-- 4th field to output
|
|---|
| 622 | ;" Note: Specifying an 'ORDER' is not compatible with specifying "*" fields
|
|---|
| 623 | ;" If "ORDER" is specified, only fields with a given order will be output
|
|---|
| 624 | ;" Both Field("ORDER",x)=FieldNum *AND* Field(FieldNum)="" should be defined
|
|---|
| 625 | ;" This will be primarily important for fields that are multiples, with sub recs.
|
|---|
| 626 | ;"
|
|---|
| 627 | ;" Flags -- OPTIONAL
|
|---|
| 628 | ;" b -- show tags for fields, even if field has no data
|
|---|
| 629 | ;" i -- indent tags for pretty, but technically useless, file formating.
|
|---|
| 630 | ;" I -- output INTERNAL values
|
|---|
| 631 | ;" SRef -- OPTIONAL (Used only when calling self recursively)
|
|---|
| 632 | ;" IENS -- OPTIONAL a standard IENS string
|
|---|
| 633 | ;" e.g. "IEN,parent-IEN,grandparent-IEN," etc.
|
|---|
| 634 | ;" This is used when calling self recursively, to handle subfiles
|
|---|
| 635 | ;" IndentS -- OPTIONAL -- current string to write to indent line.
|
|---|
| 636 | ;" RWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 637 | ;" actual starting and ending <record> </record>. e.g.
|
|---|
| 638 | ;" "MyCustomFn". Note do NOT include parameters. Function named
|
|---|
| 639 | ;" as custom function must accept same parameters as WriteRLabel
|
|---|
| 640 | ;" FWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 641 | ;" actual line of text out. e.g. "WriteFLabel" or
|
|---|
| 642 | ;" "MyCustomFn". Note do NOT include parameters. Function named
|
|---|
| 643 | ;" as custom function must accept same parameters as WriteFLabel
|
|---|
| 644 | ;" LWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 645 | ;" actual line of text out for fields. e.g. "WriteLine" or
|
|---|
| 646 | ;" "MyCustomFn". Note do NOT include parameters. Function named
|
|---|
| 647 | ;" as custom function must accept same parameters as WriteLine
|
|---|
| 648 | ;" WPLWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 649 | ;" actual line of text out for WP fields. If not provided, then
|
|---|
| 650 | ;" LWriter will be used instead.
|
|---|
| 651 | ;" e.g. "WriteWPLine" or "MyWPCustomFn". Note do NOT include parameters.
|
|---|
| 652 | ;" Function named as custom function must accept same parameters as WriteLine
|
|---|
| 653 | ;" SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE. An array to hold lookup values about
|
|---|
| 654 | ;" fields, so it doesn't have to be done each time (faster)
|
|---|
| 655 |
|
|---|
| 656 | ;"Output: Values are written to the current device
|
|---|
| 657 | ;"Results: None
|
|---|
| 658 | ;"Note: this code began its life as a function written by Greg Woodhouse (thanks Greg!)
|
|---|
| 659 |
|
|---|
| 660 | new Field,FldType,FieldInfo
|
|---|
| 661 | new StoreLoc,Node,Pos
|
|---|
| 662 | new IntValue,ORoot,GRef
|
|---|
| 663 | new Range,FIRST,LAST
|
|---|
| 664 | new SubFile,SRoot,CRoot
|
|---|
| 665 | new SubRec,VAL2,Label
|
|---|
| 666 | new FileNum
|
|---|
| 667 | new IncIndent set IncIndent=" "
|
|---|
| 668 | if $data(Fields)<10 set Fields("*")=""
|
|---|
| 669 | new AllFields set AllFields=($data(Fields("*"))>0)
|
|---|
| 670 | new OrdFields,OrdIndex set OrdFields=0,OrdIndex=0
|
|---|
| 671 | if $order(Fields("ORDER"))>1 set AllFields=0,OrdFields=1
|
|---|
| 672 |
|
|---|
| 673 | new LastFileName
|
|---|
| 674 |
|
|---|
| 675 | set FileNum=+$get(File)
|
|---|
| 676 | if FileNum=0 set FileNum=$$GetFileNum^TMGDBAPI(.File)
|
|---|
| 677 | if FileNum=0 do goto WRDone
|
|---|
| 678 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.")
|
|---|
| 679 |
|
|---|
| 680 | if $get(IENS)="" set IENS=IEN_","
|
|---|
| 681 |
|
|---|
| 682 | set Field=0
|
|---|
| 683 | set LastFileName=Field
|
|---|
| 684 |
|
|---|
| 685 | ;"Ensure all text exclusion fields are converted to numeric ones.
|
|---|
| 686 | if $data(Fields("Field Exclude"))>0 do
|
|---|
| 687 | . new field
|
|---|
| 688 | . set field=$order(Fields("Field Exclude",""))
|
|---|
| 689 | . if field'="" for do quit:(field="")
|
|---|
| 690 | . . if +field'=field do
|
|---|
| 691 | . . . new tempField
|
|---|
| 692 | . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field)
|
|---|
| 693 | . . . set Fields("Field Exclude",tempField)=""
|
|---|
| 694 | . . set field=$order(Fields("Field Exclude",field))
|
|---|
| 695 |
|
|---|
| 696 | ;"Ensure all custom tag field names are converted to numeric ones.
|
|---|
| 697 | if $data(Fields("TAG NAME"))>0 do
|
|---|
| 698 | . new field
|
|---|
| 699 | . set field=$order(Fields("TAG NAME",""))
|
|---|
| 700 | . if field'="" for do quit:(field="")
|
|---|
| 701 | . . if +field'=field do
|
|---|
| 702 | . . . new tempField
|
|---|
| 703 | . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field)
|
|---|
| 704 | . . . set Fields("TAG NAME",tempField)=Fields("TAG NAME",field)
|
|---|
| 705 | . . set field=$order(Fields("TAG NAME",field))
|
|---|
| 706 |
|
|---|
| 707 | ;"Ensure all custom TRANSFORM field names are converted to numeric ones.
|
|---|
| 708 | if $data(Fields("TRANSFORM"))>0 do
|
|---|
| 709 | . new field
|
|---|
| 710 | . set field=$order(Fields("TRANSFORM",""))
|
|---|
| 711 | . if field'="" for do quit:(field="")
|
|---|
| 712 | . . if +field'=field do
|
|---|
| 713 | . . . new tempField
|
|---|
| 714 | . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field)
|
|---|
| 715 | . . . set Fields("TRANSFORM",tempField)=Fields("TRANSFORM",field)
|
|---|
| 716 | . . set field=$order(Fields("TRANSFORM",field))
|
|---|
| 717 |
|
|---|
| 718 | ;"NOTE: It is ineffecient to call a function for each field. That requires
|
|---|
| 719 | ;" the field function to call $$GET1^DIQ. A more effecient way would
|
|---|
| 720 | ;" be to call GETS^DIQ to get ALL the field's values at once, and then
|
|---|
| 721 | ;" pass the value to the field function. FIX LATER...
|
|---|
| 722 |
|
|---|
| 723 | for do quit:(+Field'>0)
|
|---|
| 724 | . if AllFields do
|
|---|
| 725 | . . set Field=$order(^DD(FileNum,Field))
|
|---|
| 726 | . else if OrdFields do quit:(Field="")
|
|---|
| 727 | . . set OrdIndex=$order(Fields("ORDER",OrdIndex))
|
|---|
| 728 | . . set Field=$get(Fields("ORDER",OrdIndex))
|
|---|
| 729 | . else do quit:(+Field'>0)
|
|---|
| 730 | . . set Field=$order(Fields(LastFileName))
|
|---|
| 731 | . set LastFileName=Field
|
|---|
| 732 | . if +Field=0 set Field=$$GetNumField^TMGDBAPI(FileNum,Field)
|
|---|
| 733 | . if $data(Fields("Field Exclude",Field))>0 quit
|
|---|
| 734 | . if +Field=0 quit
|
|---|
| 735 | . do Write1Fld(FileNum,IEN,Field,.Fields,.Flags,.SRef,.IENS,.IndentS,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo)
|
|---|
| 736 |
|
|---|
| 737 | WRDone
|
|---|
| 738 | quit
|
|---|
| 739 |
|
|---|
| 740 |
|
|---|
| 741 | Write1Fld(FileNum,IEN,Field,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
|
|---|
| 742 | ;"Scope: PUBLIC
|
|---|
| 743 | ;"Purpose: To dump one field out in XML format
|
|---|
| 744 | ;"Input: FileNum -- number of file containing field
|
|---|
| 745 | ;" IEN -- Record number (IEN) to dump (see also IENS below). Ignored if IENS supplied
|
|---|
| 746 | ;" Field -- The field number to write from array below.
|
|---|
| 747 | ;" Fields -- The field to write.
|
|---|
| 748 | ;" Flags -- OPTIONAL
|
|---|
| 749 | ;" b -- show tags for fields, even if field has no data
|
|---|
| 750 | ;" i -- indent tags for pretty, but technically useless, file formating.
|
|---|
| 751 | ;" I -- output INTERNAL values
|
|---|
| 752 | ;" SRef -- OPTIONAL (Used only when calling self recursively)
|
|---|
| 753 | ;" IENS -- OPTIONAL a standard IENS string
|
|---|
| 754 | ;" e.g. "IEN,parent-IEN,grandparent-IEN," etc.
|
|---|
| 755 | ;" This is used when calling self recursively, to handle subfiles
|
|---|
| 756 | ;" Late Note: if IENS is supplied, then IEN is ignored
|
|---|
| 757 | ;" IndentS -- OPTIONAL -- current string to write to indent line.
|
|---|
| 758 | ;" RWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 759 | ;" actual starting and ending <record> </record>. e.g.
|
|---|
| 760 | ;" "MyCustomFn". Note do NOT include parameters. Function named
|
|---|
| 761 | ;" as custom function must accept same parameters as WriteRLabel
|
|---|
| 762 | ;" FWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 763 | ;" actual line of text out. e.g. "WriteFLabel" or
|
|---|
| 764 | ;" "MyCustomFn". Note do NOT include parameters. Function named
|
|---|
| 765 | ;" as custom function must accept same parameters as WriteFLabel
|
|---|
| 766 | ;" LWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 767 | ;" actual line of text out for WP fields. e.g. "WriteLine" or
|
|---|
| 768 | ;" "MyCustomFn". Note do NOT include parameters. Function named
|
|---|
| 769 | ;" as custom function must accept same parameters as WriteLine
|
|---|
| 770 | ;" WPLWriter -- OPTIONAL -- the name of a custom function to use for writing
|
|---|
| 771 | ;" actual line of text out for WP fields. If not provided, then
|
|---|
| 772 | ;" LWriter will be used instead.
|
|---|
| 773 | ;" e.g. "WriteWPLine" or "MyWPCustomFn". Note do NOT include parameters.
|
|---|
| 774 | ;" Function named as custom function must accept same parameters as WriteLine
|
|---|
| 775 | ;" SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE. An array to hold lookup values about
|
|---|
| 776 | ;" fields, so it doesn't have to be done each time (faster)
|
|---|
| 777 | ;"Output: Values are written to the current device
|
|---|
| 778 | ;"Results: None
|
|---|
| 779 | ;"Note: this code began its life as a function written by Greg Woodhouse (thanks Greg!)
|
|---|
| 780 |
|
|---|
| 781 | new FldType,Label
|
|---|
| 782 | new FieldInfo
|
|---|
| 783 |
|
|---|
| 784 | if $get(IENS)="" set IENS=IEN_","
|
|---|
| 785 | if +$get(Field)=0 goto W1FDone
|
|---|
| 786 | set FWriter=$get(FWriter,"WriteFLabel")
|
|---|
| 787 | set RWriter=$get(RWriter,"WriteRLabel")
|
|---|
| 788 | set LWriter=$get(LWriter,"WriteLine")
|
|---|
| 789 | set WPLWriter=$get(WPLWriter,LWriter)
|
|---|
| 790 | set Flags=$get(Flags)
|
|---|
| 791 |
|
|---|
| 792 | if 1=1 do
|
|---|
| 793 | . if $data(SavFieldInfo(FileNum,Field))>0 do
|
|---|
| 794 | . . merge FieldInfo=SavFieldInfo(FileNum,Field)
|
|---|
| 795 | . else do
|
|---|
| 796 | . . do GetFieldInfo^TMGDBAPI(FileNum,Field,"FieldInfo","LABEL")
|
|---|
| 797 | . . merge SavFieldInfo(FileNum,Field)=FieldInfo
|
|---|
| 798 | else if 1=0 do
|
|---|
| 799 | . ;"try to get info directly to speed things up.... FINISH LATER
|
|---|
| 800 | . new node set node=$get(^DD(FileNum,Field,0))
|
|---|
| 801 | . set FieldInfo("SPECIFIER")=$piece(node,"^",2)
|
|---|
| 802 | . set FieldInfo("LABEL")=$piece(node,"^",1)
|
|---|
| 803 | . set FieldInfo("MULTIPLE-VALUED")=(+FieldInfo("SPECIFIER")>0)
|
|---|
| 804 | . if FieldInfo("SPECIFIER")["W" set FieldInfo("TYPE")="WORD-PROCESSING"
|
|---|
| 805 | . else if FieldInfo("SPECIFIER")["D" set FieldInfo("TYPE")="DATE"
|
|---|
| 806 | . else if FieldInfo("SPECIFIER")["F" set FieldInfo("TYPE")="FREE TEXT"
|
|---|
| 807 | . else if FieldInfo("SPECIFIER")["P" set FieldInfo("TYPE")="POINTER"
|
|---|
| 808 | . else if FieldInfo("SPECIFIER")["N" set FieldInfo("TYPE")="NUMERIC"
|
|---|
| 809 | . else if FieldInfo("SPECIFIER")["S" set FieldInfo("TYPE")="SET"
|
|---|
| 810 | . else set FieldInfo("TYPE")=FieldInfo("SPECIFIER")
|
|---|
| 811 |
|
|---|
| 812 | set FldType=FieldInfo("SPECIFIER")
|
|---|
| 813 | if $data(Fields("TAG NAME",Field))#10>1 set Label=Fields("TAG NAME",Field)
|
|---|
| 814 | else set Label=FieldInfo("LABEL")
|
|---|
| 815 |
|
|---|
| 816 | if $get(FieldInfo("MULTIPLE-VALUED"))=1 do
|
|---|
| 817 | . if $get(FieldInfo("TYPE"))="WORD-PROCESSING" do
|
|---|
| 818 | . . new TMGWP,TMGMsg,result
|
|---|
| 819 | . . set result=$$ReadWP^TMGDBAPI(FileNum,IENS,Field,.TMGWP)
|
|---|
| 820 | . . if result=1 do
|
|---|
| 821 | . . . new i set i=$order(TMGWP(""))
|
|---|
| 822 | . . . if i="" quit
|
|---|
| 823 | . . . if Flags["i" write $get(IndentS)
|
|---|
| 824 | . . . new exFn set exFn="do "_FWriter_"(Label,"""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)"
|
|---|
| 825 | . . . xecute exFn
|
|---|
| 826 | . . . write ! ;"so first <LINE> will be on a separate line
|
|---|
| 827 | . . . for do quit:(i="")
|
|---|
| 828 | . . . . new line set line=$get(TMGWP(i))
|
|---|
| 829 | . . . . set line=$$CmdChStrip^TMGSTUTL(line) ;"shouldn't be needed!!! ??GT.M bug??
|
|---|
| 830 | . . . . if Flags["i" write $get(IndentS)_IncIndent
|
|---|
| 831 | . . . . set exFn="do "_WPLWriter_"("""_$$QtProtect^TMGSTUTL(line)_""")"
|
|---|
| 832 | . . . . ;"WRITE exFn,!
|
|---|
| 833 | . . . . xecute exFn
|
|---|
| 834 | . . . . set i=$order(TMGWP(i))
|
|---|
| 835 | . . . if Flags["i" write $get(IndentS)
|
|---|
| 836 | . . . set exFn="do "_FWriter_"(Label,"""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)"
|
|---|
| 837 | . . . xecute exFn
|
|---|
| 838 | . else do ;"Other multiple (subfile)
|
|---|
| 839 | . . set SubFile=+FldType
|
|---|
| 840 | . . new AllSubRecs,tempField
|
|---|
| 841 | . . new ORoot,Node
|
|---|
| 842 | . . if $get(SRef)'="" set ORoot=SRef
|
|---|
| 843 | . . else set ORoot=$get(^DIC(FileNum,0,"GL"))
|
|---|
| 844 | . . if ORoot="" quit
|
|---|
| 845 | . . if AllFields set tempField="*"
|
|---|
| 846 | . . else set tempField=LastFileName
|
|---|
| 847 | . . set AllSubRecs=($data(Fields(tempField,"*"))>0)!($order(Fields(tempField,""))="")
|
|---|
| 848 | . . set Node=$piece($get(FieldInfo("StoreLoc")),";",1)
|
|---|
| 849 | . . if Node="" quit ;"skip computed fields
|
|---|
| 850 | . . if (+Node'=Node) set Node=""""_Node_"""" ;" enclose text indices with quotes
|
|---|
| 851 | . . set SRoot=ORoot_IEN_","_Node_"," ;"open root
|
|---|
| 852 | . . set CRoot=ORoot_IEN_","_Node_")" ;"closed root
|
|---|
| 853 | . . set SubRec=$order(@CRoot@(0))
|
|---|
| 854 | . . if (SubRec'="")!(Flags["b") do
|
|---|
| 855 | . . . if Flags["i" write $get(IndentS)
|
|---|
| 856 | . . . new exFn set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)"
|
|---|
| 857 | . . . xecute exFn
|
|---|
| 858 | . . . write !
|
|---|
| 859 | . . . new IndS2 set IndS2=$get(IndentS)_IncIndent
|
|---|
| 860 | . . . if +SubRec>0 for do quit:+SubRec'>0
|
|---|
| 861 | . . . . ;"descend into subfile (if allowed subrecord #)
|
|---|
| 862 | . . . . if (AllSubRecs)!($data(Fields(tempField,SubRec))>0) do
|
|---|
| 863 | . . . . . if $data(Fields(tempField,"Rec Exclude",SubRec))>0 quit
|
|---|
| 864 | . . . . . new SubIENS,SubFields,tempSR
|
|---|
| 865 | . . . . . if AllSubRecs set tempSR="*"
|
|---|
| 866 | . . . . . else set tempSR=SubRec
|
|---|
| 867 | . . . . . set SubIENS=SubRec_","_IENS
|
|---|
| 868 | . . . . . merge SubFields=Fields(tempField,tempSR)
|
|---|
| 869 | . . . . . if (AllFields)!($data(SubFields)=0) set SubFields("*")=""
|
|---|
| 870 | . . . . . if Flags["i" write $get(IndS2)
|
|---|
| 871 | . . . . . new exFn set exFn="do "_RWriter_"("_$$QtProtect^TMGSTUTL(SubRec)_",0)"
|
|---|
| 872 | . . . . . xecute exFn
|
|---|
| 873 | . . . . . do Write1Rec(SubFile,SubRec,.SubFields,Flags,SRoot,SubIENS,IndS2_IncIndent,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo)
|
|---|
| 874 | . . . . . if Flags["i" write $get(IndS2)
|
|---|
| 875 | . . . . . new exFn set exFn="do "_RWriter_"("_$$QtProtect^TMGSTUTL(SubRec)_",1)"
|
|---|
| 876 | . . . . . xecute exFn
|
|---|
| 877 | . . . . set SubRec=$order(@CRoot@(SubRec))
|
|---|
| 878 | . . . if Flags["i" write $get(IndentS)
|
|---|
| 879 | . . . set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)"
|
|---|
| 880 | . . . xecute exFn
|
|---|
| 881 | else do ;"the usual case here...
|
|---|
| 882 | . new line set line=""
|
|---|
| 883 | . new CustXForm set CustXForm=$get(Fields("TRANSFORM",Field))
|
|---|
| 884 | . if CustXForm'="" do
|
|---|
| 885 | . . new Pos,GRef,Node
|
|---|
| 886 | . . new FILE,FIELD,X,Y
|
|---|
| 887 | . . new IntValue set IntValue=""
|
|---|
| 888 | . . if $get(SRef)'="" set ORoot=SRef
|
|---|
| 889 | . . else set ORoot=$get(^DIC(FileNum,0,"GL"))
|
|---|
| 890 | . . if ORoot="" quit
|
|---|
| 891 | . . set Node=$piece($get(FieldInfo("StoreLoc")),";",1)
|
|---|
| 892 | . . if Node="" quit ;"skip computed fields
|
|---|
| 893 | . . if (+Node'=Node) set Node=""""_Node_"""" ;" enclose text indices with quotes
|
|---|
| 894 | . . set Pos=$piece($get(FieldInfo("StoreLoc")),";",2)
|
|---|
| 895 | . . set GRef=ORoot_IEN_","_Node_")"
|
|---|
| 896 | . . if +Pos>0 set IntValue=$piece($get(@GRef),"^",Pos)
|
|---|
| 897 | . . ;"Set up variables for use by transform code
|
|---|
| 898 | . . set FILE=FileNum
|
|---|
| 899 | . . set FIELD=+Field
|
|---|
| 900 | . . set X=IntValue
|
|---|
| 901 | . . set Y=""
|
|---|
| 902 | . . new $etrap set $etrap="set Y=""(Invalid custom transform M code!. Error Trapped.)"" set $etrap="""",$ecode="""""
|
|---|
| 903 | . . xecute CustXForm
|
|---|
| 904 | . . set line=Y
|
|---|
| 905 | . else do
|
|---|
| 906 | . . new GetFlag set GetFlag=""
|
|---|
| 907 | . . if Flags["I" set GetFlag="I"
|
|---|
| 908 | . . set line=$$GET1^DIQ(FileNum,IENS,Field,GetFlag)
|
|---|
| 909 | . if (line="")&(Flags'["b") quit
|
|---|
| 910 | . if Flags["i" write $get(IndentS)
|
|---|
| 911 | . new exFn set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)"
|
|---|
| 912 | . xecute exFn
|
|---|
| 913 | . set exFn="do "_LWriter_"(.line)"
|
|---|
| 914 | . xecute exFn ;"write line
|
|---|
| 915 | . if Flags["i" write $get(IndentS)
|
|---|
| 916 | . set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)"
|
|---|
| 917 | . xecute exFn
|
|---|
| 918 |
|
|---|
| 919 | W1FDone
|
|---|
| 920 | quit
|
|---|
| 921 |
|
|---|
| 922 |
|
|---|
| 923 |
|
|---|
| 924 | WriteRLabel(IEN,Ender)
|
|---|
| 925 | ;"Purpose: To actually write out labels for record starting and ending.
|
|---|
| 926 | ;" IEN -- the IEN (record number) of the record
|
|---|
| 927 | ;" Optional extra informat:
|
|---|
| 928 | ;" IEN(tag)=value
|
|---|
| 929 | ;" IEN(tag2)=value2
|
|---|
| 930 | ;" If provided, will be added to output as follows:
|
|---|
| 931 | ;" <Record id="IEN" tag="value" tag2="value2">
|
|---|
| 932 | ;" Ender -- OPTIONAL if 1, then ends field.
|
|---|
| 933 | ;"Results: none.
|
|---|
| 934 | ;"Note: This is a separate function so that a different callback function can replace it
|
|---|
| 935 |
|
|---|
| 936 | if +$get(Ender)>0 write "</Record>",!
|
|---|
| 937 | else do
|
|---|
| 938 | . write "<Record id=""",IEN,""" "
|
|---|
| 939 | . new tag set tag=""
|
|---|
| 940 | . for set tag=$order(IEN(tag)) quit:(tag="") do
|
|---|
| 941 | . . write tag,"=""",$get(IEN(tag)),""" "
|
|---|
| 942 | . write ">",!
|
|---|
| 943 |
|
|---|
| 944 | quit
|
|---|
| 945 |
|
|---|
| 946 | WriteFLabel(Label,Field,Type,Ender)
|
|---|
| 947 | ;"Purpose: This is the code that actually does writing of labels etc for output
|
|---|
| 948 | ;"Input: Label -- OPTIONAL -- Name of label, to write after 'label='
|
|---|
| 949 | ;" Field -- OPTIONAL -- Name of field, to write after 'id='
|
|---|
| 950 | ;" Type -- OPTIONAL -- Typeof field, to write after 'type='
|
|---|
| 951 | ;" Ender -- OPTIONAL if 1, then ends field.
|
|---|
| 952 | ;"Results: none.
|
|---|
| 953 | ;"Note: This is a separate function so that a different callback function can replace it
|
|---|
| 954 |
|
|---|
| 955 | ;"To write out <Field label="NAME" id=".01" type="FREE TEXT"> or </Field>
|
|---|
| 956 |
|
|---|
| 957 | if +$get(Ender)>0 do
|
|---|
| 958 | . write "</Field>",!
|
|---|
| 959 | else do
|
|---|
| 960 | . write "<Field "
|
|---|
| 961 | . if $get(Field)'="" write "id=""",$$SYMENC^MXMLUTL(Field),""" "
|
|---|
| 962 | . if $get(Label)'="" write "label=""",$$SYMENC^MXMLUTL(Label),""" "
|
|---|
| 963 | . if $get(Type)'="" write "type=""",$$SYMENC^MXMLUTL(Type),""" "
|
|---|
| 964 | . write ">"
|
|---|
| 965 |
|
|---|
| 966 | quit
|
|---|
| 967 |
|
|---|
| 968 | WriteLine(Line)
|
|---|
| 969 | ;"Purpose: This is the code that actually does writing of labels etc for output
|
|---|
| 970 | ;"Input: Line -- the line of text to write out.
|
|---|
| 971 | ;"Results: none
|
|---|
| 972 | ;"Note: This is a separate function so that a different callback function can replace it
|
|---|
| 973 |
|
|---|
| 974 | set Line=$$SYMENC^MXMLUTL(Line)
|
|---|
| 975 | write "<LINE>",Line,"</LINE>",!
|
|---|
| 976 | quit
|
|---|
| 977 |
|
|---|
| 978 |
|
|---|
| 979 | ConvertLabel(Label)
|
|---|
| 980 | ;"Note: This function is no longer being used...
|
|---|
| 981 |
|
|---|
| 982 | ;"To convert the XML tag into an acceptible format for XML
|
|---|
| 983 | ;"
|
|---|
| 984 | new i
|
|---|
| 985 | new result set result=""
|
|---|
| 986 |
|
|---|
| 987 | for i=1:1:$length(Label) do
|
|---|
| 988 | . new ch set ch=$ascii($extract(Label,i))
|
|---|
| 989 | . if ((ch>64)&(ch<91))!((ch>96)&(ch<123)) do quit
|
|---|
| 990 | . . set result=result_$char(ch)
|
|---|
| 991 | . if (ch=32) set result=result_"_"
|
|---|
| 992 | . else do
|
|---|
| 993 | . . set result=result_"x"
|
|---|
| 994 |
|
|---|
| 995 | quit result
|
|---|
| 996 |
|
|---|
