create XML from RPG read as EXCEL

This program produces the below spreadsheet.
It writes XML to IFS which is then read automagically
by excel as a spreadsheet. This example can be used to
produce multi tabbed spreadsheets. These spreadsheets can
contain any/all of the features in excel.

[cc lang=”php”]
H dftactgrp( *no ) bnddir( ‘QC2LE’) OPTION(*NODEBUGIO)
* ————————————————–
* Program – EXCEL
* Purpose –
* Written –
* Author –
*
* PROGRAM DESCRIPTION
* create example XML to view as excel
*
* INPUT PARAMETERS
* Description Type Size How Used
* ———– —- —- ——–
*
*
* INDICATOR USAGE
* xx – xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
*—————————————————
*
*
d Buf s 65000A
d BufP s * INZ(%ADDR(Buf))
d BufLen s 10U 0
d CmdString s 10000
d CmdLength s 15 5
d company s 2s 0
d Complete s 1
d count s 5 0
d count2 s 5 0
d cp s 10U 0 INZ(819)
d CR c CONST(X’0d’)
d CRLF c CONST(X’0d25′)
d Current s 1
d cymd s 7 0
d Data s 65000
d dbxfil s 10
d dbxlib s 10
d dbxown s 10
d dbxtxt s 50
d dbxatr s 2
d deleted s n
d DQ c CONST(‘”‘)
d FileNam s 15A inz(‘/xml/jamie2.xml’)
d FileName1 s 21
d FileName2 s 21
d FileNamP s * inz(%ADDR(FileNam))
d FileDescr s 10I 0
d FirstNew s 1
d formated s 7
d formatBack s 65535A varying
d From c CONST(‘,””’)
d header s 65000
d ISODate s D
d LC# s 3 0
d LaborCodes s 3 dim(100)
d LaborCodeCu s 1 dim(100)
d LaborCodeCo s 1 dim(100)
d LaborCodePd s 7 0 dim(100)
d Len s 3 0
d Length s 9
d Lilian s 10i 0
d NewDate s 52a
d NLZero s 2A INZ(X’1500′)
d O_CREAT s 10I 0 INZ(8)
d O_RDWR s 10I 0 INZ(4)
d O_TEXTDATA s 10I 0 INZ(16777216)
d O_CODEPAGE s 10I 0 INZ(8388608)
d Oflag s 10I 0 INZ(0)
d Omode s 10U 0 INZ(511)
d Pos s 4 0
d Produced s 7 0
d Q c CONST(””)
d ReadOneRecord s 1
d reporttype s 20
d RC s 10I 0
d savecustomer s 5 0
d savelib s 10
d SI_Fmt s 50A INZ(‘\n’)
d SI_FmtP s * INZ(%ADDR(SI_Fmt))
d SI_Msg s 50A
d SI_MsgP s * INZ(%ADDR(SI_Msg))
d sqlrecords s 9 0
d sqlstmt s 23000 varying
d Str s 3 0
d style s 65000
d To c CONST(‘ ‘)
d useweight s 7 0
d Width s 7
d WKSDES s 30
d Workread s 3 0
d x s 2 0
d ZeroBin s 1A INZ(*ALLX’00’)
*
* Program Info
*
d SDS
d @PGM 001 010
d @PARMS 037 039 0
d @JOB 244 253
d @USER 254 263
d @JOB# 264 269 0
*
d openList pr
d FetchNext pr n
d closeList pr
*
d Num_DS DS
d Num_Hex 4A INZ(X’00000000′)
d Num 10I 0 OVERLAY(Num_Hex)

dperror PR 10I 0 EXTPROC(‘perror’)
dconst * VALUE

dsprintf PR 10I 0 EXTPROC(‘sprintf’)
d * VALUE
d * VALUE
d 10I 0 VALUE OPTIONS(*NOPASS)
d * VALUE OPTIONS(*NOPASS)
* Open Operations
* value returned = file descriptor 0 (OK), -1 (Error)

dopen PR 10I 0 EXTPROC(‘open’)
d * VALUE
d 10I 0 VALUE
d 10U 0 VALUE OPTIONS(*NOPASS)
d 10U 0 VALUE OPTIONS(*NOPASS)

* Read Operations
* value returned = number of bytes read or , -1 (Error)

Dread PR 10I 0 EXTPROC(‘read’)
d 10I 0 VALUE
d * Value
d 10U 0 VALUE

* Write Operations
* value returned = number of bytes Written or , -1 (Error)

dwrite PR 10I 0 EXTPROC(‘write’)
d 10I 0 VALUE
d * VALUE
d 10U 0 VALUE

* Close Operations
* value returned = 0 (OK) or , -1 (Error)

dclose PR 10I 0 EXTPROC(‘close’)
d 10I 0 VALUE

* Open Directory Operation
* value returned = file descriptor 0 (OK), -1 (Error)

dopendir PR * EXTPROC(‘opendir’)
d * VALUE

* Read Directory Operation
*

dreaddir PR * EXTPROC(‘readdir’)
d * VALUE

* Open Directory Operation
* value returned = 0 (OK) or , -1 (Error)

dclosedir PR 10I 0 EXTPROC(‘closedir’)
d * VALUE

* Unlink a File from system… Delete File
* value returned = 0 (OK) or , -1 (Error)

dunlink PR 10I 0 EXTPROC(‘unlink’)
d path * Value options(*string)

d CEEDAYS pr opdesc
d InputDate 65535A const options(*varsize)
d picture 65535A const options(*varsize)
d Lilian 10i 0
d Feedback 12a options(*omit)

d CEEDATE pr opdesc
d Lilian 10i 0
d picture 65535A const options(*varsize)
d OutputDate 65535A const options(*varsize)
d Feedback 12a options(*omit)

/Free

exsr $buildifs;
exsr $readfile;

clear data;
data = ‘‘ + CRLF;
Buf = %trim(Data);
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);

RC = close(FileDescr);
if FileDescr = -1;
RC = perror(FileNamP);
Return;
endif;

*inlr = *on;

//——————————————————–
// $buildIFS – build the temp table in IFS
//——————————————————–
begsr $buildIFS;

Filenam = %trim(‘/xml/jamie.xml’);
Filenamp = %ADDR(FileNam);

Oflag = O_CREAT + O_RDWR + O_CODEPAGE;
FileDescr=open(FileNamP:Oflag:Omode:cp);
if FileDescr = -1;
RC = perror(FileNamP);
return;
endif;

RC = close(FileDescr);
if RC = -1;
RC = perror(FileNamP);
return;
endif;

Oflag = O_RDWR + O_TEXTDATA;
FileDescr=open(FileNamP:Oflag);
if FileDescr = -1;
RC = perror(FileNamP);
Return;
endif;

// Write the header
Buf = %trim(Data) + CRLF;
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
clear DATA;

endsr;

//——————————————————–
// $readfile – pretend to read file of libs
//——————————————————–
begsr $readfile;

for count2 = 1 to 5; // replace with your libraries
select;
when count2 = 1;
saveLib = ‘JAMIELIB’;
when count2 = 2;
saveLib = ‘QGPL’;
when count2 = 3;
saveLib = ‘QSYS’;
when count2 = 4;
saveLib = ‘QRPG’;
when count2 = 5;
saveLib = ‘QUSRSYS’;
endsl;
exsr $header;
exsr $detail;
exsr $footer;
endfor;

endsr;

//——————————————————–
// $header – write the header for the excel sheet.
//——————————————————–
begsr $header;

data =
‘‘ + cr +
‘

‘ + cr +
‘‘ +cr +
‘‘ +cr +
‘‘+crlf;

Buf = %trim(Data);
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
clear data;

// add new heading
data =
‘ ‘ +cr +
‘ ‘+cr +
‘ ‘ +cr +
‘ Files Listed from QADBXFIL’ +
cr + ‘ ‘+cr +
‘‘ + cr ;

// write the five column headings
data = %trim(data) + cr +
‘ ‘ +
‘ ‘ +
‘File’ +
‘ ‘ +
cr +
‘ ‘ +
‘Library’ +
‘ ‘ +
cr +
‘ ‘ +
‘Owner’ +
‘ ‘ +
cr +
‘ ‘ +
‘Description’ +
‘ ‘ +
cr +
‘ ‘ +
‘Attribute’ +
‘ ‘ +
cr +
‘ ‘ + crlf ;

Buf = %trim(Data);
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
clear data;

endsr;
//——————————————————–
// $detail – get detail for current salesperson for today
//——————————————————–
begsr $detail;

sqlstmt = ‘select ‘ +
‘dbxfil,dbxlib,dbxown,dbxtxt,dbxatr ‘ +
‘ from QADBXFIL ‘ +
‘ where DBXLIB = ‘ + Q+ %trim(saveLib) + Q ;
openList();
dow fetchNext();
exsr $writerow;
enddo;
closeList();

endsr;
//——————————————————–
// $writerow – write detail row of spread sheet
//——————————————————–
begsr $writerow;

dbxtxt = %xlate(‘/’:’ ‘: dbxtxt);
dbxtxt = %xlate(‘*’:’ ‘: dbxtxt);

for count = 1 to 05;
select;
when count = 1;
data = cr + ‘‘ + CR +
‘‘ +
%trim(dbxfil) + ‘‘ + cr ;
when count = 2;
data = %trim(data) + CR +
‘‘ +
%trim(dbxlib) +
‘‘ + cr;
when count = 3;
data = %trim(data) + CR +
‘‘ +
%trim(dbxown) +
‘‘ + cr;
when count = 4;
data = %trim(data) + CR +
‘‘ +
%trim(dbxtxt) +
‘‘ + cr;
when count = 5;
data = %trim(data) + CR +
‘‘ +
%trim(dbxatr) +
‘‘ + cr;

endsl;

endfor;

data = %trim(data) + cr + ‘‘ + CRLF;
Buf = %trim(Data);
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
clear DATA;

endsr;
//——————————————————–
// $footer – close all the tags
//——————————————————–
begsr $footer;

// write footer
data =
‘

‘ + cr +
‘ ‘ + cr +
‘ 47‘ + cr +
‘ False‘ +cr +
‘ False‘ + cr +
‘ ‘ + cr +
‘ ‘ + crlf ;
Buf = %trim(Data);
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
clear DATA;

endsr;

//——————————————————–
// *inzsr – initial one time run subroutine
//——————————————————–
begsr *inzsr;

// get todays date in cymd format

isodate = %date();

// build the headers for the xml

header =
‘‘ + CR +
‘‘ + CR +
‘‘ +
CR +
‘‘ + CR +
‘Author‘ + CR +
‘flanary‘ + CR +
‘2008-05-10T01:38:01Z‘ + CR +
‘11.9999‘ + CR +
‘‘ + CR +
‘‘ +CR +
‘7755‘ + CR +
‘15225‘ + CR +
‘0‘ + CR +
‘255‘ + CR +
‘1‘ + CR +
‘False‘ +CR +
‘False‘ +CR +
‘ ‘ + CR ;

style =
‘‘ + CR +
‘‘ + CR +
‘‘ + CR +
‘‘ + CR +
‘‘ + CR +
‘‘ + CR +
‘‘ + CR +
‘‘ + CR +
‘‘ + CR;

data = %trim(header) + CR + %trim(style) ;
CEEDAYS(%char(isodate): ‘YYYY-MM-DD’: lilian: *omit);
formatBack = ‘Wwwwwwwwwz, DD Mmmmmmmmmz YYYY’;
CEEDATE(Lilian: Formatback : NewDate: *omit);
// this ===> Wednesday, 27 June 2007

endsr;

/End-Free
*——————————————————–
* openList – Open a cursor to read file
*——————————————————–
p openList b

d openList pi

/Free

exec sql
declare MyCursor cursor for statement;

exec sql
prepare statement from :sqlstmt;

exec sql
open mycursor;

/End-Free

p openList e
*——————————————————–
* fetchNext – read one record at a time
*——————————————————–
p fetchNext b

d fetchNext pi n

/free

exec sql
fetch next from mycursor into : dbxfil ,
: dbxlib ,
: dbxown ,
: dbxtxt ,
: dbxatr ;
if sqlstt < '02000'; return *on; else; return *off; endif; /end-free p fetchNext e *-------------------------------------------------------- * closeOrderList - Close the OrderHdr cursor *-------------------------------------------------------- p closeList b d closeList pi /free exec sql close MyCursor; /end-free p closeList e [/cc]