TMGXMLE2 ;TMG/kst/XML Exporter -- Core functionality ;03/25/06
         ;;1.0;TMG-LIB;**1**;07/12/05

 ;"TMG XML EXPORT FUNCTIONS (CORE FUNCTIONALITY)
 ;"Kevin Toppenberg MD
 ;"GNU General Public License (GPL) applies
 ;"7-12-2005
 ;"=======================================================================
 ;" API -- Public Functions.
 ;"=======================================================================
 ;"WriteXMLData(pArray,Flags,IndentS)
 ;"Write1File(File,Recs,Flags,IndentS,SavFieldInfo)
 ;"Write1Rec(File,IEN,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
 ;"Write1Fld(FileNum,IEN,Field,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)

 ;"=======================================================================
 ;"PRIVATE API FUNCTIONS
 ;"=======================================================================


 ;"=======================================================================
 ;"DEPENDENCIES
 ;" TMGDBAPI,TMGDEBUG,TMGMISC,TMGUSRIF
 ;"=======================================================================
 ;"=======================================================================

 ;"The basic format is to be as follows:

 ;"Array(File,Record,Field,subRec,SubField...)=""   <--- means export this entry to XML
 ;"Array(File,"TEMPLATE",Field)
 ;"Array(File,"TEMPLATE","ORDER",OrderNum)=Field
 ;"Array(File,"TEMPLATE","TAG NAME",FieldNumber)="Custom field name to put in XML file"
 ;"Array("FLAGS","b")=""  b -- show tags for ALL fields, even if field has no data
 ;"Array("FLAGS","i")=""  i -- indent tags for pretty, but technically useless, file formating.
 ;"Array("FLAGS","I")=""  I -- output INTERNAL values
 ;"Array("FLAGS","D")=""  D -- output the data dictionary
 ;"Array("!DOCTYPE")=MyLabel
 ;"Array("EXPORT_SYSTEM_NAME")=LabelForExportingSystem   -- OPTIONAL
 ;"
 ;"-----------------------------------------------------------------------------------------------
 ;"Note: File numbers can be replaces with full FILE NAMES, e.g.
 ;"   Array("NEW PERSON",1234,.01)=""
 ;"
 ;"Example:  For ALL records, output ALL fields, and ALL subfields
 ;"     Array(8925,"*")=""   <--- this is default if Recs is not specified/passed
 ;"
 ;"Example: to print from:
 ;"   file 8925, records 1234,1235,1236,1237
 ;"   file 200, ALL records
 ;"   file 22705, records 3,5
 ;"   file 2, ALL records
 ;"
 ;"   Array(8925,1234)=""
 ;"   Array(8925,1235)=""
 ;"   Array(8925,1236)=""
 ;"   Array(8925,1237)=""
 ;"   Array(200,"*")=""
 ;"   Array(22705,3)=""
 ;"   Array(22705,5)=""
 ;"   Array(2,"*")=""
 ;"
 ;"Example:  Output extra info in record node
 ;"   Array(8925,1232)="tag=value^tag2=value2" <-- optional extra info for record
 ;"     e.g. -->  <Record id=1232 tag="value" tag2="value2">
 ;"
 ;"Example:  For record 1231, output fields .01 and .02
 ;"              For record 1232, output field .01 only
 ;"              For record 1234, output field "NAME" only
 ;"              For record 1235, output ALL fields
 ;"     Array(8925,1231,.01)=""
 ;"     Array(8925,1231,.02)=""
 ;"     Array(8925,1232,.01)=""
 ;"     Array(8925,1234,"NAME")=""
 ;"     Array(8925,1235,"*")=""
 ;"
 ;"Example:
 ;"   Array(8925,"TEMPLATE",.01)=""   <-- define a template for file 8925, with fields .01,.02,.03
 ;"   Array(8925,"TEMPLATE",.02)=""
 ;"   Array(8925,"TEMPLATE",.03)=""
 ;"   Array(8925,1234)   <-- print record 1234  (will use the template)
 ;"   Array(8925,1235)   <-- print record 1235
 ;"
 ;"Example:
 ;"   Array(8925,"TEMPLATE","*"))=""  <-- include all fields in template
 ;"   Array(8925,"TEMPLATE","Field Exclude",.04)=""   <-- but exclude field .04
 ;"   Array(8925,1235)   <-- print record 1235, all fields but .04
 ;"
 ;"Example:  For all records, output fields .01 and .02 and "NAME"
 ;"    Array(8925,"*",.01)=""
 ;"    Array(8925,"*",.02)=""
 ;"    Array(8925,"*","NAME")=""
 ;"
 ;"Example:
 ;"    Array(8925,1231,"*")=""    <--- indicates that ALL fields, ALL subrecs,and ALL subfields are wanted
 ;"
 ;"Example:  For all records, output field "ENTRY", which is a multiple.  In
 ;"            subfile, output all records, fields  .01, and .02
 ;"    Array(8925,"*","ENTRY","*",.01)=""
 ;"    Array(8925,"*","ENTRY","*",.02)=""
 ;"
 ;"Example:  For ALL records, output ALL fields, and ALL subfields, with 2 exceptions
 ;"    Array(8925,"Rec Exclude",1234)=""  <-- All records except 1234 & 1235 will be output
 ;"    Array(8925,"Rec Exclude",1235)=""
 ;"    Array(8925,"*")=""
 ;"
 ;"Example:
 ;"    Array(8925,"TEMPLATE","Field Exclude",.04)=""  <-- don't show field .04
 ;"    Array(8925,"TEMPLATE","Field Exclude","STATE")=""  <-- don't show field "STATE"
 ;"    Array(8925,1231,"*")=""   <-- in record 1231, show all fields but .04 and "STATE"
 ;"
 ;"Example: Field .04 is multiple. ALL sub records and ALL subfields to be written
 ;"    Array(8925,1231,.04,"*","*")=""
 ;"    Array(8925,1231,.04,"*")=""  <--- "*" assumed for subfields
 ;"    Array(8925,1231,.04)=""   <-- "*" assumed for subrecords and subfields.
 ;"
 ;"Example: Field .03 is multiple. All sub records to be written (except for #5) , and .01 and .02 fields to be written
 ;"    Array(8925,1231,.03,"*",.01)=""  <-- In all sub recs, sub field .01 is to be written
 ;"    Array(8925,1231,.03,"*",.02)=""  <-- In all sub recs, sub field .02 is to be written
 ;"    Array(8925,1231,.03,"Rec Exclude",5)=""  <-- Exclude subrec 5
 ;"
 ;"Example: Field .03 is multiple. All sub records to be written, and .01 and .02 fields to be written
 ;"    Array(8925,1231,"TEMPLATE",.03,"*","TEMPLATE",.01)=""  <-- In all sub recs, sub field .01 is to be written
 ;"    Array(8925,1231,"TEMPLATE",.03,"*","TEMPLATE",.02)=""  <-- In all sub recs, sub field .02 is to be written

 ;"Example: Field .03 is multiple. Sub records 1,2,3 to be written, fields as below
 ;"    Array(8925,1231,.03,1,.01)=""   <-- In sub rec 1, sub field .01 is to be written
 ;"    Array(8925,1231,.03,1,.02)=""   <-- In sub rec 1, sub field .02 is to be written
 ;"    Array(8925,1231,.03,2,.01)=""   <-- In sub rec 2, sub field .01 is to be written
 ;"    Array(8925,1231,.03,3,"*")=""   <-- In sub rec 3, all sub fields are to be written
 ;"    Array(8925,1231,.03,4)=""        <-- In sub rec 4, all sub fields are to be written (defalt)
 ;"    Array(8925,1231,.03,5,"*")=""   <-- In sub rec 5, all sub fields are to be written, with one exception
 ;"    Array(8925,1231,.03,5,"Field Exclude",.01)="" <-- In sub rec 5, sub fields .01 is not to be written.
 ;"
 ;"Example:   Shows optional substitution of a new tag name for a given field
 ;"   Array(8925,"TEMPLATE","TAG NAME",.01)="Patent Name"  <-- use "Patient Name" instead of field name for .01 field
 ;"   Array(8925,"TEMPLATE","TAG NAME",.02)="City"  <-- use "City" instead of field name for .02 field
 ;"
 ;"Note: pattern continues for sub-sub-multiples etc.
 ;"
 ;"Example:
 ;"   Array(8925,1231,.01)=""
 ;"   Array(8925,1231,.02)=""
 ;"   Array(8925,1231,"NAME")=""  <--- note that field name is allowed in place of number
 ;"   Array(8925,1231,.03,1,.01)=""   <-- In sub rec 1, sub field .01 is to be written
 ;"   Array(8925,1231,.03,1,.02)=""   <-- In sub rec 1, sub field .02 is to be written
 ;"   Array(8925,1231,.03,2,.01)=""   <-- In sub rec 2, sub field .01 is to be written
 ;"   Array(8925,1231,.03,3,"*")=""   <-- In sub rec 3, all sub fields are to be written
 ;"   Array(8925,1231,.03,4)=""        <-- In sub rec 4, all sub fields are to be written (defalt)
 ;"
 ;"Example:  Field .03 is a multiple
 ;"   Array(8925,1231,.03,"TEMPLATE",.01)=""
 ;"   Array(8925,1231,.03,"TEMPLATE",.02)=""
 ;"   Array(8925,1231,.03,1)=""   <-- In sub rec 1, export fields .01,.02 from template
 ;"   Array(8925,1231,.03,2)=""   <-- In sub rec 2, export fields .01,.02 from template
 ;"   Array(8925,1231,.03,4)=""   <-- In sub rec 4, export fields .01,.02 from template
 ;"
 ;"Example:
 ;"  Array(8925,"TEMPLATE","ORDER",1)=.03            <-- 1st field to output
 ;"  Array(8925,"TEMPLATE","ORDER",2)=.02            <-- 2nd field to output
 ;"  Array(8925,"TEMPLATE","ORDER",3)="NAME"    <-- 3rd field to output
 ;"  Array(8925,"TEMPLATE","ORDER",4)=.01            <-- 4th field to output
 ;"  Note: Specifying an 'ORDER' is not compatible with specifying "*" fields
 ;"          If "ORDER" is specified, only fields with a given order will be output
 ;"          Both Field("ORDER",x)=FieldNum *AND* Field(FieldNum)="" should be defined
 ;"                  This will be primarily important for fields that are multiples, with sub recs.
 ;"
 ;"Example:
 ;"  Array(8925,"TEMPLATE","TRANSFORM",.01)="write ""Custom .01 output transform M code here..."""
 ;"  Array(8925,"TEMPLATE","TRANSFORM",.02)="write ""Custom .02 output transform M code here..."""



WriteXMLData(pArray,Flags,IndentS,ShowProgress)
        ;"Scope: PUBLIC
        ;"Purpose: to dump out a specified set of files and records in XML Format
        ;"Input: pArray -- pointer to (i.e. name of) array containting formatting/output info.
        ;"              REQUIRED An array specifying which files and records to display
        ;"              Format as follows:
        ;"              ;"-----------------------------------------
        ;"              Array(File,IEN,FieldInfo)   ; For FieldInfo, see Write1File, and Write1Rec
        ;"              Array(File,["TEMPLATE"],...)   ;For Template info see function Write1File
        ;"              Array("FLAGS","b")=""  b -- show tags for ALL fields, even if field has no data
        ;"              Array("FLAGS","i")=""  i -- indent tags for pretty, but technically useless, file formating.
        ;"              Array("FLAGS","I")=""  I -- output INTERNAL values
        ;"              Array("FLAGS","D")=""  D -- output the data dictionary
        ;"              Array("FLAGS","S")=""  S -- output export settings.
        ;"              Array("!DOCTYPE")=MyLabel
        ;"              Array("EXPORT_SYSTEM_NAME")=LabelForExportingSystem   -- OPTIONAL
        ;"              ;"-----------------------------------------
        ;"
        ;"      e.g.    Array(8925,1234)=""
        ;"              Array(8925,1235)=""
        ;"              Array(8925,1236)=""
        ;"              Array(8925,1237)=""
        ;"              Array(8925,1232)="tag=value^tag2=value2" <-- optional extra info for record
        ;"                  e.g. -->  <Record id=1232 tag="value" tag2="value2">
        ;"              Array(200,"*")=""
        ;"              Array(22705,3)=""
        ;"              Array(22705,5)=""
        ;"              Array(2,"*")=""
        ;"
        ;"              This would print from:
        ;"                      file 8925, records 1234,1235,1236,1237
        ;"                      file 200, ALL records
        ;"                      file 22705, records 3,5
        ;"                      file 2, ALL records
        ;"
        ;"           Example:
        ;"              Array(8925,"TEMPLATE",.01)=""   <-- define a template for file 8925
        ;"              Array(8925,"TEMPLATE",.02)=""
        ;"              Array(8925,"TEMPLATE",.02)=""
        ;"              Array(8925,1234)   <-- print record 1234
        ;"              Array(8925,1235)   <-- print record 1235
        ;"
        ;"           Example:
        ;"              Array(8925,1234)   <-- print record 1234
        ;"              Array(8925,1235)   <-- print record 1235
        ;"
        ;"           Example:
        ;"              Array(8925,1234,.01)   <-- print record 1234, only field .01
        ;"              Array(8925,1235,.04)   <-- print record 1235, only field .04
        ;"
        ;"              Note: File numbers can be replaces with full FILE NAMES, e.g.
        ;"              Array("NEW PERSON","*")=""
        ;"
        ;"            Note: All File numbers and field numbers can be replaced with NAMES
        ;"
        ;"         Flags -- OPTIONAL  (Note Flags can also be specified with a "FLAGS" node)
        ;"                      b -- show tags for ALL fields, even if field has no data
        ;"                      i -- indent tags for pretty, but technically useless, file formating.
        ;"                      I -- output INTERNAL values
        ;"                      D -- output Data dictionary
        ;"                      e.g. Flags="b"  or "bi"  or "ib"  or "iI" etc.
        ;"         IndentS -- OPTIONAL -- current string to write to indent line.
        ;"                    IndentS("IncIndent")=IncIndent
        ;"        ShowProgress -- OPTIONAL -- if =1, then a progress bar will be shown.
        ;"Output: results are written to the current device.
        ;"result : none

        new File,tArray,SavFieldInfo
        merge tArray=@pArray
        set Flags=$get(Flags)
        new IncIndent set IncIndent=$get(IndentS("IncIndent")," ")

        if ($data(tArray("FLAGS","b"))>0)&(Flags'["b") set Flags=Flags_"b"
        if ($data(tArray("FLAGS","i"))>0)&(Flags'["i") set Flags=Flags_"i"
        if ($data(tArray("FLAGS","I"))>0)&(Flags'["I") set Flags=Flags_"I"
        if ($data(tArray("FLAGS","D"))>0)&(Flags'["D") set Flags=Flags_"D"
        if ($data(tArray("FLAGS","S"))>0)&(Flags'["S") set Flags=Flags_"S"

        do WriteHeader
        write "<!DOCTYPE "_$get(tArray("!DOCTYPE"),"UNDEFINED"),">",!
        new SrcName set SrcName=$get(tArray("EXPORT_SYSTEM_NAME"),"?Unnamed?")
        write "<EXPORT source=""",$$SYMENC^MXMLUTL(SrcName),""">",!
        set IndentS=$get(IndentS)_IncIndent
        if Flags["S" do WriteSettings(.Flags,.IndentS)  ;"output writing settings

        set File=""
        for  set File=$order(tArray(File)) quit:(+File'>0)  do
        . new IEN,Template,Recs
        . merge Template=tArray(File,"TEMPLATE")
        . kill tArray(File,"TEMPLATE")
        . merge Recs=tArray(File)
        . set IEN=$order(tArray(File,""))
        . if IEN'="" do
        . . if $data(TMGXDEBUG) do
        . . . use $P write "Writing file: ",File,! use IO
        . . if IEN="*" do
        . . . do Write1File(File,.Recs,.Flags,.IndentS,.Template,.ShowProgress,,,,,.SavFieldInfo)
        . . else  do
        . . . new Recs merge Recs=tArray(File)
        . . . do Write1File(File,.Recs,.Flags,.IndentS,,.ShowProgress,,,,,.SavFieldInfo)

        write "</EXPORT>",!

        quit


WriteHeader
        ;"Scope: PUBLIC
        ;"Purpose: A shell to write out a proper XML header.  This should be done prior
        ;"              to writing out XML formatted data to a device
        ;"Output: Header is output to current device
        ;"Results: none

        new s
        set s=$$XMLHDR^MXMLUTL
        write s,!
        quit


Write1File(File,Recs,Flags,IndentS,Template,ShowProgress,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
        ;"Scope: PUBLIC
        ;"Purpose: to dump out (in XML) one file, for specified records
        ;"Input: File -- name or number of file to dump
        ;"       Recs -- OPTIONAL. PASS BY REFERENCE (default is to write ALL records)
        ;"          To specify records to write out, use Recs array with following format:
        ;"          -------------------------------------------------------------------
        ;"          Recs(IEN,Field,FieldInfo);  (Default for all is "*")
        ;"                For format of FieldInfo, see function Write1Rec
        ;"          Recs("Rec Exclude",IEN) <-- exclude IEN from output
        ;"          -------------------------------------------------------------------
        ;"          Example:
        ;"                  Recs(1231)=""
        ;"                  Recs(1232)=""
        ;"                  Recs(1234)=""            this would be used to print records 1231,1232,1234
        ;"                  Recs(1232)="tag=value^tag2=value2" <-- optional extra info for record
        ;"                      e.g. <Record id=1232 tag="value" tag2="value2">
        ;"
        ;"           Example:  For ALL records, output ALL fields, and ALL subfields
        ;"                   Recs("*")=""   <--- this is default if Recs is not specified/passed
        ;"           Example:  For all records, output fields .01 and .02 and "NAME"
        ;"                   Recs("*",.01)=""
        ;"                   Recs("*",.02)=""
        ;"                   Recs("*","NAME")=""
        ;"           Example:  For record 1231, output fields .01 and .02
        ;"                          For record 1232, output field .01 only
        ;"                          For record 1234, output field "NAME" only
        ;"                          For record 1235, output ALL fields
        ;"                   Recs(1231,.01)=""
        ;"                   Recs(1231,.02)=""
        ;"                   Recs(1232,.01)=""
        ;"                   Recs(1234,"NAME")=""
        ;"                   Recs(1235,"*")=""
        ;"           Example:  For all records, output field "ENTRY", which is a multiple.  In
        ;"                           subfile, output records .01, and .02
        ;"                   Recs("*","ENTRY",.01)=""
        ;"                   Recs("*","ENTRY",.02)=""
        ;"           Example:  For ALL records, output ALL fields, and ALL subfields, with 2 exceptions
        ;"                   Recs("*")=""
        ;"                   Recs("Rec Exclude",1234)=""  <-- All records except 1234 & 1235 will be output
        ;"                   Recs("Rec Exclude",1235)=""
        ;"       Flags -- OPTIONAL
        ;"                    b -- show tags for ALL fields, even if field has no data
        ;"                    i -- indent tags for pretty, but technically useless, file formating.
        ;"                    I -- output INTERNAL values
        ;"                    D -- include data dictionary for file.
        ;"                    S -- output export settings
        ;"       IndentS -- OPTIONAL -- current string to write to indent line.
        ;"                    IndentS("IncIndent")=IncIndent
        ;"       Template -- OPTIONAL.  PASS BY REFERENCE
        ;"                    This can be used for instances where the same set of fields are desired for
        ;"                    multiple records.
        ;"                    Example:
        ;"                      Recs(1231)=""
        ;"                      Recs(1232)=""
        ;"                      Recs(1234)=""
        ;"                      with  Template(.01)=""
        ;"                              Template(.02)=""
        ;"                      Is the same as specifying:
        ;"                      Recs(1231,.01)=""
        ;"                      Recs(1231,.02)=""
        ;"                      Recs(1232,.01)=""
        ;"                      Recs(1232,.02)=""
        ;"                      Recs(1234,.01)=""
        ;"                      Recs(1234,.02)=""
        ;"       ShowProgress   -- OPTIONAL -- if >0, then a progress bar will be shown.
        ;"       RWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                actual starting and ending <record> </record>.  e.g.
        ;"                "MyCustomFn".  Note do NOT include parameters.  Function named
        ;"                as custom function must accept same parameters as WriteRLabel
        ;"       FWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                actual line of text out.  e.g. "WriteFLabel" or
        ;"                "MyCustomFn".  Note do NOT include parameters.  Function named
        ;"       LWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                actual line of text out for WP fields.  e.g. "WriteLine" or
        ;"                "MyCustomFn".  Note do NOT include parameters.  Function named
        ;"                as custom function must accept same parameters as WriteLine
        ;"                as custom function must accept same parameters as WriteFLabel
        ;"       WPLWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                actual line of text out for WP fields.  If not provided, then
        ;"                LWriter will be used instead.
        ;"                e.g. "WriteWPLine" or "MyWPCustomFn".  Note do NOT include parameters.
        ;"                Function named as custom function must accept same parameters as WriteLine
        ;"       SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE.  An array to hold lookup values about
        ;"                fields, so it doesn't have to be done each time (faster)
        ;"Output: results are written to the current device.
        ;"result : none

        new ORoot,GRef
        new FileNum,FName
        new prgsCt set prgsCt=0
        new prgsMax

        new IncIndent set IncIndent=$get(IndentS("IncIndent")," ")
        if $data(Template)=0 set Template("*")=""
        new RecsSpecified set RecsSpecified=(($data(Recs)>1)&($data(Recs("*"))=0))
        new keyin set keyin=32
        new startTime set startTime=$H
        set RWriter=$get(RWriter,"WriteRLabel")
        set IndentS=$get(IndentS)

        set FileNum=+$get(File)
        if FileNum=0 do
        . set FileNum=$$GetFileNum^TMGDBAPI(.File)
        . set FName=File
        else  do
        . set FName=$order(^DD(FileNum,0,"NM",""))
        if FileNum=0 do  goto WFDone
        . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.")

        set ORoot=$$GET1^DID(FileNum,"","","GLOBAL NAME") ;" Get global root   (Thanks, Don Donati...)
        set GRef=$$CREF^DILF(ORoot) ;" Convert open to closed root

        if $get(ShowProgress) do
        . if RecsSpecified do
        . . set prgsMax=$$ListCt^TMGMISC("Recs")
        . else  do
        . . set prgsMax=0
        . . set IEN=$order(@GRef@("")) ;"count ALL records in file.
        . . for  do  quit:(IEN'>0)
        . . . set IEN=$order(@GRef@(IEN))
        . . . if +IEN>0 set prgsMax=prgsMax+1

        set Flags=$get(Flags)
        if Flags["i" write IndentS
        write "<FILE id=""",FileNum,""" label=""",$$SYMENC^MXMLUTL(FName),""">",!

        if Flags["D" do WriteDD(FileNum,Flags,IndentS_IncIndent)  ;"write out data dictionary file

        new IndS2 set IndS2=IndentS_IncIndent
        new IEN set IEN=0
        for  do  quit:(IEN'>0)
        . if $data(Fields)'>1 set Fields("*")=""
        . if RecsSpecified do
        . . set IEN=$order(Recs(IEN))  ;"Cycle through specified records
        . . new Extra set Extra=$get(Recs(IEN))
        . . if Extra'="" do  ;"parse extra info into IEN array for output
        . . . new s,n,tag,value
        . . . for n=1:1:$length(Extra,"^") do
        . . . . set s=$piece(Extra,"^",n)
        . . . . if s'["=" quit
        . . . . set tag=$piece(s,"=",1)
        . . . . set value=$piece(s,"=",2)
        . . . . set IEN(tag)=value
        . else  do
        . . set IEN=$order(@GRef@(IEN)) ;"Cycle through ALL records in file.
        . if (IEN'>0) quit
        . if $data(Recs("Rec Exclude",IEN)) quit ;"skip excluded records
        . new Fields merge Fields=Recs(IEN)
        . if $data(Fields)'>1 merge Fields=Template
        . if $get(Flags)["i" write $get(IndS2)
        . new exFn set exFn="do "_RWriter_"(.IEN,0)"
        . xecute exFn
        . if $data(TMGXDEBUG) do
        . . use $P
        . . write "Writing record: ",IEN,"  prgsCt=",prgsCt," prgsMax=",prgsMax,!
        . . use IO
        . do Write1Rec(FileNum,IEN,.Fields,.Flags,"","",IndS2_IncIndent,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo)
        . if $get(Flags)["i" write $get(IndS2)
        . set exFn="do "_RWriter_"(.IEN,1)"
        . xecute exFn
        . set prgsCt=prgsCt+1
        . if $get(ShowProgress)&(prgsCt#2=1) do
        . . use $P
        . . do ProgressBar^TMGUSRIF(prgsCt,"Writing "_FName,1,prgsMax,,startTime)
        . . use IO
        . ;"use $P read *keyin use IO
        . if keyin=27 do
        . . new Abort
        . . use $P
        . . write prgsCt," records written so far...",!
        . . write !,"Do you want to abort XML export? NO// "
        . . read Abort:$get(DTIME,3600),!
        . . if Abort="" set Abort="NO"
        . . if "YESyesYes"[Abort set IEN=0  ;"abort signal
        . . write "OK.  Continuing...",!
        . . use IO

        if $get(Flags)["i" write IndentS
        write "</FILE>",!

        if $get(ShowProgress) do
        . use $P
        . do ProgressBar^TMGUSRIF(100,"Writing "_FName,1,100)
        . use IO

WFDone
        quit

WriteSettings(Flags,IndentS)
        ;"Scope: PRIVATE
        ;"Purpose: to output XML output settings.
        ;"Input: Flags -- flags as declared above.  Only "i" used here
        ;"       IndentS -- OPTIONAL -- current string to write to indent line.
        ;"          IndentS("IncIndent")=IncIndent

        ;"NOTE: Uses GLOBAL SCOPED IncIndent variable.  But setting this is OPTIONAL.
        ;"Results: none

        set IndentS=$get(IndentS)
        set Flags=$get(Flags)
        new IncIndent set IncIndent=$get(IndentS("IncIndent")," ")

        if Flags["i" write IndentS
        write "<ExportSettings>",!

        new fArray,fl
        set fArray("i")="Indent_Output"
        set fArray("b")="Output_Blanks"
        set fArray("I")="Output_Internal_Values"
        set fArray("D")="Output_Data_Dictionary"

        set fl=""
        for  set fl=$order(fArray(fl)) quit:(fl="")  do
        . if Flags["i" write IndentS_IncIndent
        . write "<Setting id=""",$$SYMENC^MXMLUTL($get(fArray(fl))),""">"
        . write $select((Flags[fl):"TRUE",1:"FALSE")
        . write "</Setting>",!

        if Flags["i" write IndentS
        write "</ExportSettings>",!

        quit

WriteDD(FileNum,Flags,IndentS)
        ;"Scope: PRIVATE
        ;"Purpose: to write out data dictionary file, ^DIC,and file Header in XML format
        ;"Input: FileNum -- the file number (not name) of the data dictionary to export
        ;"       Flags -- flags as declared above.  Only "i" used here
        ;"       IndentS -- OPTIONAL -- current string to write to indent line.
        ;"NOTE: Uses GLOBAL SCOPED IncIndent variable.  But setting this is OPTIONAL.
        ;"Results: none

        new ProgressFn
        use $P write ! use IO
        set IncIndent=$get(IncIndent,"  ")

        set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^DD("_FileNum_")"",0,100000,,"""_$H_""") use IO"
        do WriteArray^TMGXMLT($name(^DD(FileNum)),"DataDictionary",FileNum,.Flags,.IndentS,.IncIndent,.ProgressFn)

        set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^(DIC("_FileNum_")"",0,1000000,,"""_$H_""") use IO"
        new DIC ;"Pull just the fileman nodes.  ^DIC also contains some full files...
        merge DIC(FileNum,0)=^DIC(FileNum,0)
        merge DIC(FileNum,"%")=^DIC(FileNum,"%")
        merge DIC(FileNum,"%A")=^DIC(FileNum,"%A")
        merge DIC(FileNum,"%D")=^DIC(FileNum,"%D")
        do WriteArray^TMGXMLT("DIC("_FileNum_")","DIC_File",FileNum,.Flags,.IndentS,.IncIndent,.ProgressFn)

        do
        . new Ref set Ref=$get(^DIC(FileNum,0,"GL"))
        . set Ref=$$CREF^DILF(Ref) ;" Convert open to closed root
        . if $get(Flags)["i" write IndentS
        . write "<FILE_HEADER id=""",FileNum,""">",!
        . if $get(Flags)["i" write IndentS
        . write $get(@Ref@(0)),!
        . if $get(Flags)["i" write IndentS
        . write "</FILE_HEADER>",!

        ;"use $P write ! use IO
        quit


Write1Rec(File,IEN,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
        ;"Scope: PUBLIC
        ;"Purpose: To dump one record out in XML format
        ;"Input:      File -- name or number of file to dump
        ;"              IEN -- Record number (IEN) to dump (see also IENS below)
        ;"              Fields -- OPTIONAL.  PASS BY REFERENCE.  Array of fields to write, format at follows
        ;"                      Fields(Field,[SubRecNums,[SubFields,...]])=""
        ;"                      Fields(Field,["Rec Exclude",Excluded IEN])=""
        ;"                      Fields("Field Exclude",ExcludedField)=""                 <-- OPTIONAL
        ;"                      Fields("ORDER",OrderNum)=Field                          <-- OPTIONAL
        ;"                      Fields("TAG NAME",FieldNumber)="Custom field name to put in XML file"  <-- OPTIONAL
        ;"
        ;"                   Example:
        ;"                      Fields(.01)=""
        ;"                      Fields(.02)=""
        ;"                      Fields("NAME")=""  <--- note that field name is allowed in place of number
        ;"                      Fields(.03)=""
        ;"
        ;"                  Example:
        ;"                      Fields("*")=""    <--- indicates that ALL fields, ALL subrecs,and ALL subfields are wanted
        ;"
        ;"                  Example:
        ;"                      Fields("*")=""
        ;"                      Fields("Field Exclude",.04)=""  <-- don't show field .04
        ;"                      Fields("Field Exclude","STATE")=""  <-- don't show field "STATE"
        ;"
        ;"                  Example: Field .04 is multiple. ALL sub records and ALL subfields to be written
        ;"                      Fields(.04,"*","*")=""
        ;"                      Fields(.04,"*")=""  <--- "*" assumed for subfields
        ;"                      Fields(.04)=""   <-- "*" assumed for subrecords and subfields.
        ;"
        ;"                  Example: Field .03 is multiple. All sub records to be written, and .01 and .02 fields to be written
        ;"                      Fields(.03,"*",.01)=""  <-- In all sub recs, sub field .01 is to be written
        ;"                      Fields(.03,"*",.02)=""  <-- In all sub recs, sub field .02 is to be written
        ;"                      Fields(.03,"Rec Exclude",5)=""  <-- Exclude subrec 5
        ;"
        ;"                  Example: Field .03 is multiple. Sub records 1,2,3 to be written, fields as below
        ;"                      Fields(.03,1,.01)=""   <-- In sub rec 1, sub field .01 is to be written
        ;"                      Fields(.03,1,.02)=""   <-- In sub rec 1, sub field .02 is to be written
        ;"                      Fields(.03,2,.01)=""   <-- In sub rec 2, sub field .01 is to be written
        ;"                      Fields(.03,3,"*")=""   <-- In sub rec 3, all sub fields are to be written
        ;"                      Fields(.03,4)=""        <-- In sub rec 4, all sub fields are to be written (defalt)
        ;"                      Fields(.03,5,"*")=""   <-- In sub rec 5, all sub fields are to be written, with one exception
        ;"                      Fields(.03,5,"Field Exclude",.01)="" <-- In sub rec 5, sub fields .01 is not to be written.
        ;"
        ;"                   Example:   Shows optional substitution of a new tag name for a given field
        ;"                      Fields("TAG NAME",.01)="Patent Name"  <-- use "Patient Name" instead of field name for .01 field
        ;"                      Fields("TAG NAME",.02)="City"  <-- use "City" instead of field name for .02 field
        ;"
        ;"                   Example:
        ;"                      Array("TRANSFORM",.01)="write ""Custom .01 output transform M code here..."""
        ;"                      Array("TRANSFORM",.02)="write ""Custom .02 output transform M code here..."""
        ;"
        ;"                   Note: pattern continues for sub-sub-multiples etc.
        ;"
        ;"                   Example:
        ;"                      Fields(.01)=""
        ;"                      Fields(.02)=""
        ;"                      Fields("NAME")=""  <--- note that field name is allowed in place of number
        ;"                      Fields(.03,1,.01)=""   <-- In sub rec 1, sub field .01 is to be written
        ;"                      Fields(.03,1,.02)=""   <-- In sub rec 1, sub field .02 is to be written
        ;"                      Fields(.03,2,.01)=""   <-- In sub rec 2, sub field .01 is to be written
        ;"                      Fields(.03,3,"*")=""   <-- In sub rec 3, all sub fields are to be written
        ;"                      Fields(.03,4)=""        <-- In sub rec 4, all sub fields are to be written (defalt)
        ;"                      Fields("ORDER",1)=.03            <-- 1st field to output
        ;"                      Fields("ORDER",2)=.02            <-- 2nd field to output
        ;"                      Fields("ORDER",3)="NAME"    <-- 3rd field to output
        ;"                      Fields("ORDER",4)=.01            <-- 4th field to output
        ;"                      Note: Specifying an 'ORDER' is not compatible with specifying "*" fields
        ;"                              If "ORDER" is specified, only fields with a given order will be output
        ;"                              Both Field("ORDER",x)=FieldNum *AND* Field(FieldNum)="" should be defined
        ;"                                      This will be primarily important for fields that are multiples, with sub recs.
        ;"
        ;"              Flags -- OPTIONAL
        ;"                      b -- show tags for fields, even if field has no data
        ;"                      i -- indent tags for pretty, but technically useless, file formating.
        ;"                      I -- output INTERNAL values
        ;"              SRef -- OPTIONAL (Used only when calling self recursively)
        ;"              IENS -- OPTIONAL a standard IENS string
        ;"                              e.g. "IEN,parent-IEN,grandparent-IEN," etc.
        ;"                              This is used when calling self recursively, to handle subfiles
        ;"              IndentS -- OPTIONAL -- current string to write to indent line.
        ;"              RWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                               actual starting and ending <record> </record>.  e.g.
        ;"                              "MyCustomFn".  Note do NOT include parameters.  Function named
        ;"                              as custom function must accept same parameters as WriteRLabel
        ;"              FWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                              actual line of text out.  e.g. "WriteFLabel" or
        ;"                              "MyCustomFn".  Note do NOT include parameters.  Function named
        ;"                              as custom function must accept same parameters as WriteFLabel
        ;"              LWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                              actual line of text out for fields.  e.g. "WriteLine" or
        ;"                              "MyCustomFn".  Note do NOT include parameters.  Function named
        ;"                              as custom function must accept same parameters as WriteLine
        ;"            WPLWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                              actual line of text out for WP fields.  If not provided, then
        ;"                              LWriter will be used instead.
        ;"                              e.g. "WriteWPLine" or "MyWPCustomFn".  Note do NOT include parameters.
        ;"                              Function named as custom function must accept same parameters as WriteLine
        ;"            SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE.  An array to hold lookup values about
        ;"                              fields, so it doesn't have to be done each time (faster)

        ;"Output: Values are written to the current device
        ;"Results: None
        ;"Note: this code began its life as a function written by Greg Woodhouse (thanks Greg!)

        new Field,FldType,FieldInfo
        new StoreLoc,Node,Pos
        new IntValue,ORoot,GRef
        new Range,FIRST,LAST
        new SubFile,SRoot,CRoot
        new SubRec,VAL2,Label
        new FileNum
        new IncIndent set IncIndent="  "
        if $data(Fields)<10 set Fields("*")=""
        new AllFields set AllFields=($data(Fields("*"))>0)
        new OrdFields,OrdIndex set OrdFields=0,OrdIndex=0
        if $order(Fields("ORDER"))>1 set AllFields=0,OrdFields=1

        new LastFileName

        set FileNum=+$get(File)
        if FileNum=0 set FileNum=$$GetFileNum^TMGDBAPI(.File)
        if FileNum=0 do  goto WRDone
        . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.")

        if $get(IENS)="" set IENS=IEN_","

        set Field=0
        set LastFileName=Field

        ;"Ensure all text exclusion fields are converted to numeric ones.
        if $data(Fields("Field Exclude"))>0 do
        . new field
        . set field=$order(Fields("Field Exclude",""))
        . if field'="" for  do  quit:(field="")
        . . if +field'=field do
        . . . new tempField
        . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field)
        . . . set Fields("Field Exclude",tempField)=""
        . . set field=$order(Fields("Field Exclude",field))

        ;"Ensure all custom tag field names are converted to numeric ones.
        if $data(Fields("TAG NAME"))>0 do
        . new field
        . set field=$order(Fields("TAG NAME",""))
        . if field'="" for  do  quit:(field="")
        . . if +field'=field do
        . . . new tempField
        . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field)
        . . . set Fields("TAG NAME",tempField)=Fields("TAG NAME",field)
        . . set field=$order(Fields("TAG NAME",field))

        ;"Ensure all custom TRANSFORM field names are converted to numeric ones.
        if $data(Fields("TRANSFORM"))>0 do
        . new field
        . set field=$order(Fields("TRANSFORM",""))
        . if field'="" for  do  quit:(field="")
        . . if +field'=field do
        . . . new tempField
        . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field)
        . . . set Fields("TRANSFORM",tempField)=Fields("TRANSFORM",field)
        . . set field=$order(Fields("TRANSFORM",field))

        ;"NOTE: It is ineffecient to call a function for each field.  That requires
        ;"      the field function to call $$GET1^DIQ.  A more effecient way would
        ;"      be to call GETS^DIQ to get ALL the field's values at once, and then
        ;"      pass the value to the field function.  FIX LATER...

        for  do  quit:(+Field'>0)
        . if AllFields do
        . . set Field=$order(^DD(FileNum,Field))
        . else  if OrdFields do  quit:(Field="")
        . . set OrdIndex=$order(Fields("ORDER",OrdIndex))
        . . set Field=$get(Fields("ORDER",OrdIndex))
        . else  do  quit:(+Field'>0)
        . . set Field=$order(Fields(LastFileName))
        . set LastFileName=Field
        . if +Field=0 set Field=$$GetNumField^TMGDBAPI(FileNum,Field)
        . if $data(Fields("Field Exclude",Field))>0 quit
        . if +Field=0 quit
        . do Write1Fld(FileNum,IEN,Field,.Fields,.Flags,.SRef,.IENS,.IndentS,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo)

WRDone
        quit


Write1Fld(FileNum,IEN,Field,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo)
        ;"Scope: PUBLIC
        ;"Purpose: To dump one field out in XML format
        ;"Input: FileNum -- number of file containing field
        ;"       IEN -- Record number (IEN) to dump (see also IENS below).  Ignored if IENS supplied
        ;"       Field -- The field number to write from array below.
        ;"       Fields -- The field to write.
        ;"       Flags -- OPTIONAL
        ;"               b -- show tags for fields, even if field has no data
        ;"               i -- indent tags for pretty, but technically useless, file formating.
        ;"               I -- output INTERNAL values
        ;"       SRef -- OPTIONAL (Used only when calling self recursively)
        ;"       IENS -- OPTIONAL a standard IENS string
        ;"                       e.g. "IEN,parent-IEN,grandparent-IEN," etc.
        ;"                       This is used when calling self recursively, to handle subfiles
        ;"                       Late Note: if IENS is supplied, then IEN is ignored
        ;"       IndentS -- OPTIONAL -- current string to write to indent line.
        ;"       RWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                        actual starting and ending <record> </record>.  e.g.
        ;"                       "MyCustomFn".  Note do NOT include parameters.  Function named
        ;"                       as custom function must accept same parameters as WriteRLabel
        ;"       FWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                       actual line of text out.  e.g. "WriteFLabel" or
        ;"                       "MyCustomFn".  Note do NOT include parameters.  Function named
        ;"                       as custom function must accept same parameters as WriteFLabel
        ;"       LWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                       actual line of text out for WP fields.  e.g. "WriteLine" or
        ;"                       "MyCustomFn".  Note do NOT include parameters.  Function named
        ;"                       as custom function must accept same parameters as WriteLine
        ;"       WPLWriter -- OPTIONAL -- the name of a custom function to use for writing
        ;"                       actual line of text out for WP fields.  If not provided, then
        ;"                       LWriter will be used instead.
        ;"                       e.g. "WriteWPLine" or "MyWPCustomFn".  Note do NOT include parameters.
        ;"                       Function named as custom function must accept same parameters as WriteLine
        ;"       SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE.  An array to hold lookup values about
        ;"                        fields, so it doesn't have to be done each time (faster)
        ;"Output: Values are written to the current device
        ;"Results: None
        ;"Note: this code began its life as a function written by Greg Woodhouse (thanks Greg!)

        new FldType,Label
        new FieldInfo

        if $get(IENS)="" set IENS=IEN_","
        if +$get(Field)=0 goto W1FDone
        set FWriter=$get(FWriter,"WriteFLabel")
        set RWriter=$get(RWriter,"WriteRLabel")
        set LWriter=$get(LWriter,"WriteLine")
        set WPLWriter=$get(WPLWriter,LWriter)
        set Flags=$get(Flags)

        if 1=1 do
        . if $data(SavFieldInfo(FileNum,Field))>0 do
        . . merge FieldInfo=SavFieldInfo(FileNum,Field)
        . else  do
        . . do GetFieldInfo^TMGDBAPI(FileNum,Field,"FieldInfo","LABEL")
        . . merge SavFieldInfo(FileNum,Field)=FieldInfo
        else  if 1=0 do
        . ;"try to get info directly to speed things up.... FINISH LATER
        . new node set node=$get(^DD(FileNum,Field,0))
        . set FieldInfo("SPECIFIER")=$piece(node,"^",2)
        . set FieldInfo("LABEL")=$piece(node,"^",1)
        . set FieldInfo("MULTIPLE-VALUED")=(+FieldInfo("SPECIFIER")>0)
        . if FieldInfo("SPECIFIER")["W" set FieldInfo("TYPE")="WORD-PROCESSING"
        . else  if FieldInfo("SPECIFIER")["D" set FieldInfo("TYPE")="DATE"
        . else  if FieldInfo("SPECIFIER")["F" set FieldInfo("TYPE")="FREE TEXT"
        . else  if FieldInfo("SPECIFIER")["P" set FieldInfo("TYPE")="POINTER"
        . else  if FieldInfo("SPECIFIER")["N" set FieldInfo("TYPE")="NUMERIC"
        . else  if FieldInfo("SPECIFIER")["S" set FieldInfo("TYPE")="SET"
        . else  set FieldInfo("TYPE")=FieldInfo("SPECIFIER")

        set FldType=FieldInfo("SPECIFIER")
        if $data(Fields("TAG NAME",Field))#10>1 set Label=Fields("TAG NAME",Field)
        else  set Label=FieldInfo("LABEL")

        if $get(FieldInfo("MULTIPLE-VALUED"))=1 do
        . if $get(FieldInfo("TYPE"))="WORD-PROCESSING" do
        . . new TMGWP,TMGMsg,result
        . . set result=$$ReadWP^TMGDBAPI(FileNum,IENS,Field,.TMGWP)
        . . if result=1 do
        . . . new i set i=$order(TMGWP(""))
        . . . if i="" quit
        . . . if Flags["i" write $get(IndentS)
        . . . new exFn set exFn="do "_FWriter_"(Label,"""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)"
        . . . xecute exFn
        . . . write !  ;"so first <LINE> will be on a separate line
        . . . for  do  quit:(i="")
        . . . . new line set line=$get(TMGWP(i))
        . . . . set line=$$CmdChStrip^TMGSTUTL(line)  ;"shouldn't be needed!!! ??GT.M bug??
        . . . . if Flags["i" write $get(IndentS)_IncIndent
        . . . . set exFn="do "_WPLWriter_"("""_$$QtProtect^TMGSTUTL(line)_""")"
        . . . . ;"WRITE exFn,!
        . . . . xecute exFn
        . . . . set i=$order(TMGWP(i))
        . . . if Flags["i" write $get(IndentS)
        . . . set exFn="do "_FWriter_"(Label,"""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)"
        . . . xecute exFn
        . else  do   ;"Other multiple (subfile)
        . . set SubFile=+FldType
        . . new AllSubRecs,tempField
        . . new ORoot,Node
        . . if $get(SRef)'="" set ORoot=SRef
        . . else  set ORoot=$get(^DIC(FileNum,0,"GL"))
        . . if ORoot="" quit
        . . if AllFields set tempField="*"
        . . else  set tempField=LastFileName
        . . set AllSubRecs=($data(Fields(tempField,"*"))>0)!($order(Fields(tempField,""))="")
        . . set Node=$piece($get(FieldInfo("StoreLoc")),";",1)
        . . if Node="" quit   ;"skip computed fields
        . . if (+Node'=Node) set Node=""""_Node_""""  ;" enclose text indices with quotes
        . . set SRoot=ORoot_IEN_","_Node_","  ;"open root
        . . set CRoot=ORoot_IEN_","_Node_")" ;"closed root
        . . set SubRec=$order(@CRoot@(0))
        . . if (SubRec'="")!(Flags["b") do
        . . . if Flags["i" write $get(IndentS)
        . . . new exFn set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)"
        . . . xecute exFn
        . . . write !
        . . . new IndS2 set IndS2=$get(IndentS)_IncIndent
        . . . if +SubRec>0 for  do  quit:+SubRec'>0
        . . . . ;"descend into subfile (if allowed subrecord #)
        . . . . if (AllSubRecs)!($data(Fields(tempField,SubRec))>0) do
        . . . . . if $data(Fields(tempField,"Rec Exclude",SubRec))>0 quit
        . . . . . new SubIENS,SubFields,tempSR
        . . . . . if AllSubRecs set tempSR="*"
        . . . . . else  set tempSR=SubRec
        . . . . . set SubIENS=SubRec_","_IENS
        . . . . . merge SubFields=Fields(tempField,tempSR)
        . . . . . if (AllFields)!($data(SubFields)=0) set SubFields("*")=""
        . . . . . if Flags["i" write $get(IndS2)
        . . . . . new exFn set exFn="do "_RWriter_"("_$$QtProtect^TMGSTUTL(SubRec)_",0)"
        . . . . . xecute exFn
        . . . . . do Write1Rec(SubFile,SubRec,.SubFields,Flags,SRoot,SubIENS,IndS2_IncIndent,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo)
        . . . . . if Flags["i" write $get(IndS2)
        . . . . . new exFn set exFn="do "_RWriter_"("_$$QtProtect^TMGSTUTL(SubRec)_",1)"
        . . . . . xecute exFn
        . . . . set SubRec=$order(@CRoot@(SubRec))
        . . . if Flags["i" write $get(IndentS)
        . . . set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)"
        . . . xecute exFn
        else  do  ;"the usual case here...
        . new line set line=""
        . new CustXForm set CustXForm=$get(Fields("TRANSFORM",Field))
        . if CustXForm'="" do
        . . new Pos,GRef,Node
        . . new FILE,FIELD,X,Y
        . . new IntValue set IntValue=""
        . . if $get(SRef)'="" set ORoot=SRef
        . . else  set ORoot=$get(^DIC(FileNum,0,"GL"))
        . . if ORoot="" quit
        . . set Node=$piece($get(FieldInfo("StoreLoc")),";",1)
        . . if Node="" quit   ;"skip computed fields
        . . if (+Node'=Node) set Node=""""_Node_""""  ;" enclose text indices with quotes
        . . set Pos=$piece($get(FieldInfo("StoreLoc")),";",2)
        . . set GRef=ORoot_IEN_","_Node_")"
        . . if +Pos>0 set IntValue=$piece($get(@GRef),"^",Pos)
        . . ;"Set up variables for use by transform code
        . . set FILE=FileNum
        . . set FIELD=+Field
        . . set X=IntValue
        . . set Y=""
        . . new $etrap set $etrap="set Y=""(Invalid custom transform M code!.  Error Trapped.)"" set $etrap="""",$ecode="""""
        . . xecute CustXForm
        . . set line=Y
        . else  do
        . . new GetFlag set GetFlag=""
        . . if Flags["I" set GetFlag="I"
        . . set line=$$GET1^DIQ(FileNum,IENS,Field,GetFlag)
        . if (line="")&(Flags'["b") quit
        . if Flags["i" write $get(IndentS)
        . new exFn set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)"
        . xecute exFn
        . set exFn="do "_LWriter_"(.line)"
        . xecute exFn   ;"write line
        . if Flags["i" write $get(IndentS)
        . set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)"
        . xecute exFn

W1FDone
        quit



WriteRLabel(IEN,Ender)
        ;"Purpose: To actually write out labels for record starting and ending.
        ;"      IEN -- the IEN (record number) of the record
        ;"              Optional extra informat:
        ;"              IEN(tag)=value
        ;"              IEN(tag2)=value2
        ;"              If provided, will be added to output as follows:
        ;"              <Record id="IEN" tag="value" tag2="value2">
        ;"      Ender -- OPTIONAL if 1, then ends field.
        ;"Results: none.
        ;"Note: This is a separate function so that a different callback function can replace it

        if +$get(Ender)>0 write "</Record>",!
        else  do
        . write "<Record id=""",IEN,""" "
        . new tag set tag=""
        . for  set tag=$order(IEN(tag)) quit:(tag="")  do
        . . write tag,"=""",$get(IEN(tag)),""" "
        . write ">",!

        quit

WriteFLabel(Label,Field,Type,Ender)
        ;"Purpose: This is the code that actually does writing of labels etc for output
        ;"Input: Label -- OPTIONAL -- Name of label, to write after  'label='
        ;"       Field -- OPTIONAL -- Name of field, to write after  'id='
        ;"       Type -- OPTIONAL -- Typeof field, to write after  'type='
        ;"      Ender -- OPTIONAL if 1, then ends field.
        ;"Results: none.
        ;"Note: This is a separate function so that a different callback function can replace it

        ;"To write out <Field label="NAME" id=".01" type="FREE TEXT"> or </Field>

        if +$get(Ender)>0 do
        . write "</Field>",!
        else  do
         . write "<Field "
         . if $get(Field)'="" write "id=""",$$SYMENC^MXMLUTL(Field),""" "
         . if $get(Label)'="" write "label=""",$$SYMENC^MXMLUTL(Label),""" "
         . if $get(Type)'="" write "type=""",$$SYMENC^MXMLUTL(Type),""" "
         . write ">"

         quit

WriteLine(Line)
        ;"Purpose: This is the code that actually does writing of labels etc for output
        ;"Input: Line -- the line of text to write out.
        ;"Results: none
        ;"Note: This is a separate function so that a different callback function can replace it

        set Line=$$SYMENC^MXMLUTL(Line)
        write "<LINE>",Line,"</LINE>",!
        quit


ConvertLabel(Label)
        ;"Note: This function is no longer being used...

        ;"To convert the XML tag into an acceptible format for XML
        ;"
        new i
        new result set result=""

        for i=1:1:$length(Label) do
        . new ch set ch=$ascii($extract(Label,i))
        . if ((ch>64)&(ch<91))!((ch>96)&(ch<123)) do  quit
        . . set result=result_$char(ch)
        . if (ch=32) set result=result_"_"
        . else  do
        . . set result=result_"x"

        quit result