Marty,
here is an example of writting a csv directly to ifs (attached) you can just modify to output
html instead.
jimmy
http://www.code400.com
itpweb1 <[EMAIL PROTECTED]> wrote:
here is an example of writting a csv directly to ifs (attached) you can just modify to output
html instead.
jimmy
http://www.code400.com
itpweb1 <[EMAIL PROTECTED]> wrote:
I have an existing application that extracts data, populates a PF in
QTEMP, creates CSV file in QTEMP with CPYTOIMPF, does a CPYTOPCD
to /QDLS then picks up and sends as mail attachment (MMAIL or
SNDEMAILSP) to user.
I want to improve the presentation using HTML instead of CSV/Excel.
What is the best way to do this? I use CGIDEV2 for generating
interactive pages but I have never wrote tried writing directly to IFS
file in RPG.
marty
Yahoo! Music Unlimited - Access over 1 million songs. Try it free.
SPONSORED LINKS
| How to format a computer hard drive | Cobol programmer | Iseries 400 |
| How to format a computer |
YAHOO! GROUPS LINKS
- Visit your group "Easy400Group" on the web.
- To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
- Your use of Yahoo! Groups is subject to the Yahoo! Terms of Service.
H dftactgrp( *no ) bnddir( 'QC2LE':'WRITEIFS' ) OPTION(*NODEBUGIO)
* --------------------------------------------------
* Program - WRITEIFS
* Purpose - write csv table to Server for Process Scheduling
* Written -
* Author -
*
* PROGRAM DESCRIPTION
* this program reads open orders and customized releases
* and writes them to the IFS. Then copies the file back to
* the server. (Network share)
*
*
* INPUT PARAMETERS
* Description Type Size How Used
* ----------- ---- ---- --------
*
*
* INDICATOR USAGE
* xx - xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
*---------------------------------------------------
foehdordg if e k disk
foeidordb if e k disk
foeiadlba if e k disk
faracustd if e k disk
findesca if e k disk
foeqopdsa if e k disk
fcsarlabg if e k disk
fcihreleasaif e k disk
fcibcustomcif e k disk
fcibcustomdif e k disk rename(CIBCUSTOMR:CIBCUSTOD)
f prefix(D_)
fcicadlbd if e k disk
*
* strpccmd 'net use Z: \\lbi-nt1\SharedDocs\Processes'
*
d AllComplete S 1
d CmdString S 512
d CmdLength S 15 5
d count S 5 0
d cp S 10U 0 INZ(819)
d CRLF C CONST(X'0d25')
d Complete S 1
d Current S 1
d Data S 500
d DQ C CONST('"')
d FileNam S 24A inz('/Processes/Processes.csv')
d FileNamP S * inz(%ADDR(FileNam))
d FileDescr S 10I 0
d FirstNew S 1
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 Produced S 7 0
d Buf S 500A
d BufP S * INZ(%ADDR(Buf))
d BufLen S 10U 0
d deleted S n
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 Q C CONST('''')
d Pos S 4 0
d ReadOneRecord S 1
d RC S 10I 0
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 Str S 3 0
d Width s 7
d WKSDES s 30
d WkLenInch s 9 0
d WkWidInch s 7 0
d WorkBracket s 5 0
d WorkUnique s 28
d WorkVersion s 3 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 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)
*
/copy qprcsrc,FMTITM2_CP
*
c exsr $BuildFile
*
* Shut down the IFS file and prepare to email.
*
c exsr $TheEnd
c exsr $copy2Z
*
* delete the IFS file we just created
*
c*******> if unlink('/Processes/Processes.csv') < 0
*
* send some error message !!!! Cannot delete file
*
c*******> endif
*
c eval *INLR = *On
*
*----------------------------------------------------------------
* $BuildFile
*----------------------------------------------------------------
CSR $BuildFile Begsr
*
c z-add O_CREAT Oflag
c add O_RDWR Oflag
c add O_CODEPAGE Oflag
c eval FileDescr=open(FileNamP:Oflag:Omode:cp)
c if FileDescr = -1
c eval RC = perror(FileNamP)
c return
c endif
c eval RC = close(FileDescr)
c if RC = -1
c eval RC = perror(FileNamP)
c return
c endif
c z-add O_RDWR Oflag
c add O_TEXTDATA Oflag
c eval FileDescr=open(FileNamP:Oflag)
c if FileDescr = -1
c eval RC = perror(FileNamP)
c Return
c endif
*
*----------------------------------------
* This is where the writting takes place
*----------------------------------------
*
* write the column names first
*
c clear Data
c clear Buf
*
c eval Data = 'ProNumber' + ',' +
c 'Counter' + ',' +
c 'Sold-To' + ',' +
c 'Sold-To Name' + ',' +
c 'Date Requested' + ',' +
c 'Start Date' + ',' +
c 'Description' + ',' +
c 'Size Desc' + ',' +
c 'Part' + ',' +
c 'Material' + ',' +
c 'Analysis' + ',' +
c 'Size' + ',' +
c 'Width' + ',' +
c 'Length' + ',' +
c 'Decimal' + ',' +
c 'Actual Weight' + ',' +
c 'Billed Weight' + ',' +
c 'labor Code' + ',' +
c 'labor Desc' + ',' +
c 'labor Loc' + ',' +
c 'Complete' + ',' +
c 'Current' + ',' +
c 'Process Time' + ',' +
c 'Qty Ordered' + ',' +
c 'Qty Produced' + ',' +
c 'Order Type' + ',' +
c 'Customer PO' +
c CRLF
c eval Buf = %trim(Data)
c eval BufLen = %scan(CRLF:Buf)
c eval RC = write(FileDescr: BufP: BufLen)
*
c read OEHDORDG
c dow not%eof(OEHDORDG)
*
c if OHPRO7 > *zeros
*
c OHPRO7 setll OEIDORDB
c OHPRO7 reade OEIDORDB
c dow not%eof(OEIDORDB)
*
c OHSL# chain ARACUSTD
c if %found(ARACUSTD)
*
* write the indi records
*
*
*
c INDKY1 chain indesca
c if %found(indesca)
*
c exsr $laborCodes
*
* read all additional labor codes
*
c OEIKY1 setll oeiadlba
c OEIKY1 reade oeiadlba
c dow not%eof(oeiadlba)
*
c OIALCO chain OEQOPDSA
c if %found(OEQOPDSA)
*
c clear Data
c clear Buf
*
c eval pos = %lookup(OIALCO : LaborCodes)
c if pos > *zeros
c eval Complete = LaborCodeCo(pos)
c eval Current = laborCodeCu(pos)
c eval Produced = laborCodePd(pos)
c endif
*
c eval Data = %trim(%char(OHPRO7)) + ',' +
c %trim(%char(Oicnt3)) + ',' +
c %trim(%char(OHSL#)) + ',' +
c %trim(%xlate(',':'-':AASLNM)) + ',' +
c %trim(%char(OHDTRQST)) + ',' +
c %trim(%char(0)) + ',' +
c %trim(%xlate(',':'-':IDMDES)) + ',' +
c %trim(%xlate(',':'-':OISDES)) + ',' +
c 'Part:' +
c %trim(%xlate(',':'-':OIPART)) + ',' +
c %trimr(Oimat) + ',' +
c 'Anal:' +
c %trimr(Oianal) + ',' +
c %trimr(Oisize) + ',' +
c %trim(%char(Oicwid)) + ',' +
c %trim(%char(Oiclgt)) + ',' +
c %trim(OIDEC) + ',' +
c %trim(%char(Oipewt)) + ',' +
c %trim(%char(OIWGT )) + ',' +
c %trim(OIALCO) + ',' +
c %trim(%xlate(',':'-':OQLDES))+ ',' +
c %trim(%xlate(',':'-':OIALLC))+ ',' +
c %trim(Complete) + ',' +
c %trim(Current) + ',' +
c '0' + ',' +
c %trim(%char(OIQT07)) + ',' +
c %trim(%char(Produced)) + ',' +
c %trim(OHORTP) + ',' +
c %trim(OHPONM) +
c CRLF
c eval Buf = %trim(Data)
c eval BufLen = %scan(CRLF:Buf)
c eval RC = write(FileDescr: BufP: BufLen)
*
c endif
*
c OEIKY1 reade oeiadlba
c enddo
*
c endif
c endif
*
c OHPRO7 reade OEIDORDB
c enddo
*
c endif
*
c read OEHDORDG
c enddo
*
* now read customized releases
*
c *start setll CIHRELEASA
c read CIHRELEASA
c dow not%eof(CIHRELEASA)
*
c clear Data
c clear Buf
*
c CHACCT chain ARACUSTD
c if %found(ARACUSTD)
*
c CHPART chain CIBCUSTOMC
c if %found(CIBCUSTOMC)
*
c eval WkWidInch =
c %dec(%editc(CBFWDIN:'X') +
c %editc(CBFWDFR:'X'):7:0)
c eval Width = %editc(WkWidInch:'X')
c eval WkLenInch =
c %dec(%editc(CBFLDFT:'X') +
c %editc(CBFLDIN:'X') +
c %editc(CBFLDFR:'X'):9:0)
c eval Length = %editc(WkLenInch:'X')
*
c eval WkSDES =
c FmtItm2(cbrMat:cbrAnal:cbrSize:Width:Length:
c CBRNUMFMT : CBRCIRC)
*
c INDKY2 chain indesca
c if %found(indesca)
*
* need to figure out which bracket we are in to know selling Price
*
c clear WorkUnique
c clear WorkVersion
*
c CHPART chain cibcustomc
c if %found(cibcustomc)
c eval WorkUnique = CBUNQKEY
c eval WorkVersion = CBVERSION
c endif
*
c clear WorkBracket
c CICKY1 setll CIBCUSTOMD
c read CIBCUSTOMD
c eval WorkBracket = D_CBBRCK#
c dow not%eof(CIBCUSTOMD)
*
c if CHRELPCS >= D_CBBRCK#
c eval WorkBracket = D_CBBRCK#
c leave
c endif
*
c read CIBCUSTOMD
c enddo
*
c CICKY2 setll cicadlbd
c CICKY2 reade cicadlbd
c dow not%eof(cicadlbd)
*
c CCLABCOD chain OEQOPDSA
c if %found(OEQOPDSA)
*
c clear Complete
c clear Current
*
c eval Data = %trim(%char(0)) + ',' +
c %trim(%char(0)) + ',' +
c %trim(%char(CHACCT)) + ',' +
c %trim(%xlate(',':'-':AASLNM)) + ',' +
c %trim(%editc(CHDUEDAT:'X')) + ',' +
c %trim(%editc(CHSTRDAT:'X')) + ',' +
c %trim(%xlate(',':'-':IDMDES)) + ',' +
c %trim(%xlate(',':'-':WkSDES)) + ',' +
c 'Part:' +
c %trim(%xlate(',':'-':CHPART)) + ',' +
c %trimr(cbrmat) + ',' +
c %trimr(cbranal) + ',' +
c %trimr(cbrsize) + ',' +
c %trim(Width) + ',' +
c %trim(Length) + ',' +
c %trim(CBRNUMFMT) + ',' +
c %char(cbaweight * CHRELPCS) + ',' +
c %char(cbbweight * CHRELPCS) + ',' +
c %trim(CCLABCOD) + ',' +
c %trim(%xlate(',':'-':OQLDES))+ ',' +
c %trim(%xlate(',':'-':OIALLC))+ ',' +
c %trim(Complete ) + ',' +
c %trim(Current) + ',' +
c %trim(%char(CCTOTLTM)) +
c %trim(%char(CHRELPCS)) + ',' +
c %trim('0') + ',' +
c %trim(' ') + ',' +
c %trim(' ') +
c CRLF
c eval Buf = %trim(Data)
c eval BufLen = %scan(CRLF:Buf)
c eval RC = write(FileDescr: BufP: BufLen)
*
c endif
*
c CICKY2 reade cicadlbd
c enddo
*
c endif
c endif
c endif
*
c read CIHRELEASA
c enddo
c endsr
*----------------------------------------------------------------
* $laborCodes - status and Active codes for each labor code
*----------------------------------------------------------------
CSR $LaborCodes begsr
*
c clear Complete
c clear Current
*
c clear LC#
c clear LaborCodes
c clear LaborCodeCu
c clear LaborCodeCo
c clear LaborCodePd
*
c clear FirstNew
c eval AllComplete = 'Y'
*
* read all additional labor codes
*
c OEIKY1 setll oeiadlba
c OEIKY1 reade oeiadlba
c dow not%eof(oeiadlba)
*
c eval LC# +=1
c eval LaborCodes(LC#) = OIALCO
*
c clear ReadOneRecord
*
c CSAKY1 setll CSARLABG
c CSAKY1 reade CSARLABG
*
c if %eof(CSARLABG)
c eval AllComplete = 'N'
c endif
*
c dow not%eof(CSARLABG)
*
c eval ReadOneRecord = 'Y'
c if CAESTAMP > *loval
c eval LaborCodeCo(LC#) = 'Y'
c else
c eval AllComplete = 'N'
c endif
*
c eval LaborCodePd(LC#) += CACPCS
*
c CSAKY1 reade CSARLABG
c enddo
c
*
c if FirstNew = *blanks
c if LaborCodeCo(LC#) <> 'Y' and
c ReadOneRecord = 'Y' or
c ReadOneRecord = *blanks
c clear LaborCodeCu
c eval LaborCodeCu(LC#) = 'Y'
c if ReadOneRecord = *blanks
c eval FirstNew = 'Y'
c endif
c endif
c endif
*
* If all complete then clear the current flag
*
c if AllComplete = 'Y'
c clear LaborCodeCu
c endif
*
c OEIKY1 reade oeiadlba
c enddo
*
c endsr
*----------------------------------------------------------------
* T H E E N D
*----------------------------------------------------------------
CSR $TheEnd Begsr
*
* Close the File
*
c EVAL RC = close(FileDescr)
c IF FileDescr = -1
c EVAL RC = perror(FileNamP)
c Return
c ENDIF
*
c Endsr
*----------------------------------------------------------------
* $Copy2Z - Copy from IFS to the Z: drive the new file
*----------------------------------------------------------------
CSR $Copy2Z begsr
*
c eval cmdstring = 'STRPCO'
c eval cmdlength = %len(%trim(cmdstring))
c call(e) 'QCMDEXC'
c parm cmdstring
c parm cmdlength
*
* strpccmd 'net use Z: \\lbi-nt1\SharedDocs\ProcessSchedule'
*
c eval cmdstring = 'strpccmd ' + Q +
c 'net use Z: \\lbi-nt1\SharedDocs\' +
c 'Processes' + Q
*
c eval cmdlength = %len(%trim(cmdstring))
c call(e) 'QCMDEXC'
c parm cmdstring
c parm cmdlength
*
* copy command X = IFS networkshare
* copy X:\tst.csv Z: STRPCCMD PCCMD('dir') PAUSE(*NO)
*
c eval cmdstring = 'strpccmd PCCMD(' + Q +
c 'copy X:\Processes.csv Z:' + Q +
c ') PAUSE(*NO)'
*
c eval cmdlength = %len(%trim(cmdstring))
c call(e) 'QCMDEXC'
c parm cmdstring
c parm cmdlength
c endsr
*----------------------------------------------------------------
* Hskpg - HouseKeeping one time run subroutine
*----------------------------------------------------------------
c Hskpg begsr
*
* klist
*
c CICKY1 klist
c kfld WorkUnique
c kfld WorkVersion
*
c CICKY2 klist
c kfld WorkUnique
c kfld WorkVersion
c kfld WorkBracket
*
c CSAKY1 klist
c kfld OIPRO7
c kfld OICNT3
c kfld OIALCO
*
c INDKY1 klist
c kfld OIMAT
c kfld OIANAL
*
c INDKY2 klist
c kfld CBRMAT
c kfld CBRANAL
*
c OEIKY1 klist
c kfld OIPRO7
c kfld OICNT3
*
c endsr
*----------------------------------------------------------------
