Writing ASCII Data
RPG can manage EBCIDIC or ASCII data.
This is an example of a program that writes stream file information to a network folder. The program creates the file, specifying a code page. Reading from a database table, the information from the row and columns is written to the stream file.
ctl-Opt DEBUG(*YES) OPTION(*SRCSTMT : *NODEBUGIO)
DFTACTGRP(*NO) ACTGRP('HSFTRN') Main(CSG080RP ) EXTBININT(*YES)
BNDDIR('QC2LE') ;
//***************************************************************
//* PROGRAM NAME - CSG080RP
//* FUNCTION - Copy HSF output to Export directory.
//* PROGRAMMER - Steve Croy 07/20/17
//* ***************************************************************
Dcl-F csglogpf disk(*ext) usage (*output) usropn ;
Dcl-F prttrans disk(*ext) usage (*input:*delete)
usropn INFDS(DBFeedBk);
*---------------------------------------------------------------
* Procedure prototypes
*---------------------------------------------------------------
Dcl-PR access int(10) extproc('access') ;
pathptr1 pointer value ;
mode1 int(10) value ;
End-Pr ;
Dcl-PR open int(10) EXTPROC('open') ;
filename pointer VALUE ;
openflags int(10) VALUE ;
mode int(10) Value OPTIONS(*NOPASS);
codepage uns(10) VALUE OPTIONS(*NOPASS);
End-Pr ;
Dcl-PR write int(10) EXTPROC('write') ;
filehandle int(10) VALUE ;
datatowrite pointer VALUE ;
nbytes uns(10) VALUE ;
End-Pr ;
Dcl-PR close int(10) EXTPROC('close');
filehandle int(10) VALUE ;
End-Pr ;
Dcl-Pr exit extProc('exit') ;
*n uns(3) value ;
END-PR;
Dcl-Pr syscmd int(10) extproc('system') ;
cmd pointer value options(*string) ;
End-Pr ;
Dcl-Pr getCSGdestination extpgm('CSG005RP') ;
area char(15) const ;
element char(25) const ;
rtnvalue char(200) ;
End-Pr ;
*---------------------------------------------------------------
* Data Structures
*---------------------------------------------------------------
Dcl-DS *N PSDS ;
thisPgm char(10) pos(1);
thisUser char(10) pos(254);
End-DS;
Dcl-DS DBFeedBk ;
nbrRecords binDec(9:0) pos(156) ;
End-DS ;
dcl-ds inRecord likerec(PTRANR:*input);
dcl-ds logRecord likerec(RCSGLOG : *output);
*---------------------------------------------------------------
* Global constants
*---------------------------------------------------------------
Dcl-C SQLsttOK Const( '00000' ) ;
Dcl-C SQLsttEOF Const( '02000' ) ;
Dcl-C lf const(x'0d25') ;
*---------------------------------------------------------------
* Global variables
*---------------------------------------------------------------
*** File Access Modes for open()
Dcl-S O_RDONLY int(10) INZ(1) ;
Dcl-S O_WRONLY int(10) INZ(2) ;
Dcl-S O_RDWR int(10) INZ(4) ;
Dcl-S O_CREAT int(10) INZ(8) ;
Dcl-S O_EXCL int(10) INZ(16) ;
Dcl-S O_TRUNC int(10) INZ(64) ;
*** File Status Flags for open()
Dcl-S O_NONBLOCK int(10) INZ(128) ;
Dcl-S O_APPEND int(10) INZ(256) ;
*** file permissions
Dcl-S S_IRUSR int(10) INZ(256) ;
Dcl-S S_IWUSR int(10) INZ(128) ;
Dcl-S S_IXUSR int(10) INZ(64) ;
Dcl-S S_IRWXU int(10) INZ(448) ;
Dcl-S S_IRGRP int(10) INZ(32) ;
Dcl-S S_IWGRP int(10) INZ(16) ;
Dcl-S S_IXGRP int(10) INZ(8) ;
Dcl-S S_IRWXG int(10) INZ(56) ;
Dcl-s S_IROTH int(10) INZ(4) ;
Dcl-s S_IWOTH int(10) INZ(2) ;
Dcl-s S_IXOTH int(10) INZ(1) ;
Dcl-S S_IRWXO int(10) INZ(7) ;
Dcl-S O_TEXTDATA int(10) INZ(16777216) ;
Dcl-S O_CODEPAGE int(10) INZ(8388608) ;
Dcl-s DateISO char(8) ;
Dcl-s ptrToPolDS pointer ;
Dcl-s ptrToUntDs pointer ;
Dcl-s ptrToDrvDs pointer ;
Dcl-s ptfToMsgAry pointer ;
Dcl-S stateCode char(2) ;
Dcl-s pEffDate zoned(8:0) ;
Dcl-s result ind inz ;
Dcl-s cutOff zoned(8:0) ;
Dcl-s expiredDate zoned(8:0) ;
Dcl-s today date inz ;
Dcl-s x int(10) ;
Dcl-s count int(10) ;
Dcl-s naic char(5) inz('37648') ;
Dcl-s envir char(1) inz('P') ;
Dcl-s extn char(4) inz('.txt') ;
Dcl-s AsciiCodePage uns(10) INZ(819) ;
Dcl-s fileCreated ind ;
Dcl-s FileDesc int(10) ;
Dcl-s bytesRead int(10) ;
Dcl-s bytesWrt int(10) ;
Dcl-s returnInd ind ;
Dcl-s returnInt int(10) ;
Dcl-s fileName char(255);
Dcl-s msgData char(9999) ;
Dcl-s testMsg char(32767);
Dcl-s dataRead char(9899) ;
Dcl-s comMsg char(132) ;
Dcl-s EOR char(2) inz(X'0D25') ;
Dcl-s null char(1) inz(X'00') ;
Dcl-s OprReply char(1) ;
Dcl-s fmDir char(128) ;
Dcl-s toDir char(30) ;
Dcl-S cmdString char(256) ;
Dcl-S failed int(10) ;
Dcl-S filePath char(200) ;
Dcl-S fullName char(200) ;
Dcl-S fullPath char(200) ;
Dcl-S i int(5) ;
Dcl-S j int(5) ;
dcl-S LastSlash zoned(3:0) ;
Dcl-S Length packed(5:0) ;
Dcl-S spoolNbr char(6) ;
Dcl-S toName char(200) ;
Dcl-S toPath char(200) ;
Dcl-S workField char(26) ;
dcl-S pos int(5) ;
dcl-S pos2 int(5) ;
//*-----------------------------------------------------------
//* Start program procedures
//*-----------------------------------------------------------
Dcl-Proc CSG080RP ;
Dcl-PI CSG080RP extPgm('CSG080RP ') ;
End-PI ;
If not %open(PRTTRANS);
Open PRTTRANS ;
EndIf;
IF nbrRecords < 1 ;
quit();
ENDIF;
If not %open(CSGLOGPF);
Open CSGLOGPF ;
EndIf;
Read(N) prttrans;
workfield = prpdffil ;
pos = %scan( '.' : workfield) ;
pos2= %scan( '.' : workfield:pos + 1) ;
toName = %subst(workfield:1:pos2) + 'TXT' ;
pos = %scan( 'B' : toname) ;
%subst(toname:pos:1) = 'P' ;
toPath = getFolderName() ;
fullPath = %trim(toPath) + %trim(toName) ;
WriteIFSfile();
Quit() ;
RETURN;
END-PROC CSG080RP ;
//*-----------------------------------------------------------
//* Close file and exit
//*-----------------------------------------------------------
Dcl-Proc Quit ;
Dcl-PI Quit End-PI ;
Monitor ;
Close PRTTRANS ;
Close CSGLOGPF ;
ReturnInt = close(FileDesc) ;
ON-ERROR ;
ENDMON;
exit(0) ;
END-PROC Quit ;
//*-----------------------------------------------------------
//* Retrieve the destination folder name
//*-----------------------------------------------------------
Dcl-Proc getFolderName ;
Dcl-PI getFolderName char(200) ;
END-PI ;
Dcl-S thisFolder char(200) ;
Dcl-S area char(15) inz('HSSYSTEM') ;
Dcl-S element char(25) inz('DOC-') ;
Dcl-S x int(5) inz ;
x = %scan( 'P' : toName) ;
element = %trim(element) + %subst(toName : x + 1 : 1) ;
Monitor ;
getCSGdestination ( area
: element
: thisFolder
) ;
On-Error ;
thisFolder = *blanks;
EndMon ;
Return thisFolder ;
End-Proc getFolderName ;
*---------------------------------------------------------------
Dcl-Proc writeIFSfile ;
DCL-pi WriteIFSfile ;
End-pi ;
*---------------------------------------------------------------
Dcl-s noMoreRecords ind ;
createIFSfile() ;
SetLL 1 PRTTRANS ;
noMoreRecords = *off;
DoU noMoreRecords;
READ PRTTRANS inRecord ;
If %eof(PRTTRANS) ;
noMoreRecords = *on ;
Else ;
writeDetailRecord() ;
eval-corr logRecord = inRecord ;
logRecord.prtdate = %dec(%date():*ISO) ;
logRecord.prttime = %dec(%time():*HMS) ;
write Rcsglog logRecord ;
delete PTRANR ;
ENDIF ;
Enddo ;
fileCreated = *On ;
return ;
End-Proc writeIFSfile ;
//*---------------------------------------------------------------
Dcl-Proc writeDetailRecord ;
Dcl-PI writeDetailRecord end-PI ;
//*---------------------------------------------------------------
dcl-ds outRecord len(200) End-DS;
clear msgData ;
clear outRecord ;
outRecord = %trim(PRRECTP) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRGUID) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRPOLNUM) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRCLAIM) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRDOCTYP) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRFLD6) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRBRECRE) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRFLD8) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRPDATE) + '|' ;
outRecord = %trimR(outrecord) + %char(inRecord.PRPHYPAG) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRCDATE) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRFLD12) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRFLD13) + '|' ;
outRecord = %trimR(outrecord) + %trim(inRecord.PRPDFFIL) ;
msgData = %trimR(outRecord) + EOR ;
BytesWrt = write(FileDesc : %addr(msgData) :
%len(%trimR(msgData))) ;
Return ;
End-Proc writeDetailRecord ;
//*---------------------------------------------------------------
Dcl-Proc createIFSfile ;
Dcl-PI createIFSfile end-PI ;
//*---------------------------------------------------------------
FullName = %trim(FullPath) + null ;
//*---------------------------------------------
//* If file exists, quit the program
//*---------------------------------------------
Dou FileDesc <> 0 ;
FileDesc = access(%addr(fullName): fileDesc) ;
IF fileDesc = 0 ;
QUIT() ;
ENDIF ;
EndDo ;
//*---------------------------------------------
//* Create the file and set the code page
//*---------------------------------------------
FileDesc = open(%addr(FullName)
: O_CREAT + O_WRONLY + O_TRUNC + O_CodePage
: S_IRWXU + S_IROTH
: AsciiCodePage) ;
ReturnInt = close(FileDesc) ;
//*---------------------------------------------
//* Open the file as text for Read-Write
//*---------------------------------------------
FileDesc = open(%addR(FullName) : O_TEXTDATA + O_RDWR) ;
Return ;
end-Proc createIFSfile ;