| [796] | 1 | TMGXMLEX ;TMG/kst/XML Exporter ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;07/12/05
|
|---|
| 3 |
|
|---|
| 4 | ;"TMG XML EXPORT FUNCTION
|
|---|
| 5 | ;"Kevin Toppenberg MD
|
|---|
| 6 | ;"GNU General Public License (GPL) applies
|
|---|
| 7 | ;"7-12-2005
|
|---|
| 8 |
|
|---|
| 9 | ;"=======================================================================
|
|---|
| 10 | ;" API -- Public Functions.
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 |
|
|---|
| 13 | ;"=======================================================================
|
|---|
| 14 | ;"PRIVATE API FUNCTIONS
|
|---|
| 15 | ;"=======================================================================
|
|---|
| 16 |
|
|---|
| 17 | ;"=======================================================================
|
|---|
| 18 | ;"Dependencies (duplicates shown in parenthesies)
|
|---|
| 19 | ;"TMGXMLUI
|
|---|
| 20 | ;"--XLFSTR
|
|---|
| 21 | ;"--TMGDBAPI
|
|---|
| 22 | ;"----TMGDEBUG
|
|---|
| 23 | ;"------TMGUSRIF
|
|---|
| 24 | ;"--------(TMGDEBUG)
|
|---|
| 25 | ;"--------TMGSTUTL
|
|---|
| 26 | ;"----------(TMGDEBUG)
|
|---|
| 27 | ;"--------TMGXDLG
|
|---|
| 28 | ;"----(TMGUSRIF)
|
|---|
| 29 | ;"----(TMGSTUTL)
|
|---|
| 30 | ;"--(TMGDEBUG)
|
|---|
| 31 | ;"-- TMGMISC
|
|---|
| 32 | ;"----(TMGDBAPI)
|
|---|
| 33 | ;"----TMGIOUTL
|
|---|
| 34 | ;"----(TMGDEBUG)
|
|---|
| 35 | ;"----(TMGSTUTL)
|
|---|
| 36 | ;"TMGXMLE2
|
|---|
| 37 | ;"--(TMGDBAPI)
|
|---|
| 38 | ;"--(TMGDEBUG)
|
|---|
| 39 | ;"--(TMGMISC)
|
|---|
| 40 | ;"--(TMGUSRIF)
|
|---|
| 41 | ;"TMGIOUTL
|
|---|
| 42 | ;"--(TMGUSRIF)
|
|---|
| 43 | ;"--(TMGDEBUG)
|
|---|
| 44 | ;"--(TMGSTUTL)
|
|---|
| 45 | ;"--(TMGMISC)
|
|---|
| 46 |
|
|---|
| 47 |
|
|---|
| 48 | ;"TMGDEBUG
|
|---|
| 49 | ;"=======================================================================
|
|---|
| 50 | ;"=======================================================================
|
|---|
| 51 |
|
|---|
| 52 |
|
|---|
| 53 | EXPORT
|
|---|
| 54 | ;"Purpose: To ask for parameters, select output, and do actual export
|
|---|
| 55 |
|
|---|
| 56 | new XMLarray
|
|---|
| 57 | new pArray set pArray=$name(XMLarray)
|
|---|
| 58 | new fileName,PriorErrorFound
|
|---|
| 59 |
|
|---|
| 60 | if $$UI^TMGXMLUI(pArray)=0 goto ExDone
|
|---|
| 61 |
|
|---|
| 62 | if (1=0) do if fileName="" do goto ExDone
|
|---|
| 63 | . write "Please select an output file for the XML export",!
|
|---|
| 64 | . set fileName=$$GetFName^TMGIOUTL()
|
|---|
| 65 | . ;"Here I need to select IO channel
|
|---|
| 66 | . if fileName="" quit
|
|---|
| 67 | . . do ShowError^TMGDEBUG(.PriorErrorFound,"No file selected, so aborting.")
|
|---|
| 68 | . set %ZIS("HFSNAME")=fileName
|
|---|
| 69 | . set %ZIS="Q" ;"queing allowed
|
|---|
| 70 | . set %ZIS("HFSMODE")="W" ;"write mode
|
|---|
| 71 | . set IOP="HFS"
|
|---|
| 72 | else do
|
|---|
| 73 | . write "Select device to output XML data to.",!
|
|---|
| 74 | . write "HFS (i.e. Host File System) will allow output to a file.",!
|
|---|
| 75 | . write "(A file name will be asked after HFS is chosen)."
|
|---|
| 76 | . set %ZIS("A")="Enter Output Device: "
|
|---|
| 77 | . set %ZIS("B")="HFS"
|
|---|
| 78 |
|
|---|
| 79 | do ^%ZIS ;"standard device call
|
|---|
| 80 | if POP do goto ExDone
|
|---|
| 81 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening output file. Aborting.")
|
|---|
| 82 | use IO
|
|---|
| 83 |
|
|---|
| 84 | do WriteXMLData^TMGXMLE2(pArray,,,1)
|
|---|
| 85 | do ^%ZISC ;" Close the output device
|
|---|
| 86 |
|
|---|
| 87 | write !,"(Data written to ouput file)",!
|
|---|
| 88 |
|
|---|
| 89 | ExDone
|
|---|
| 90 | kill TMGXDEBUG
|
|---|
| 91 | write !,"Leaving XML Exporter. Goodbye.",!
|
|---|
| 92 | quit
|
|---|
