ecki/IBM-i-RPG-Free-CLP-Code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

PRTLN Initial Commit

Browse Source
This commit is contained in:
SJLennon 2022-07-20 20:08:12 -04:00
parent ac6d360199
commit 454036cc98
19 changed files with 1406 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Copy_Mbrs/PRT_P.RPGLE Normal file
View File

@ -0,0 +1,6 @@
**FREE
// Prototype for PRT program
dcl-pr PRT extpgm('PRT');
line char(132) const;
ctl char(10) const options(*nopass);
end-pr;

27
PRT_CL/DEMO_CL1.CLLE Normal file
View File

@ -0,0 +1,27 @@
/*=== Demo a simple report =================================*/
PGM
DCL (&LC) (*DEC) LEN(5 0) VALUE(1)
DCL (&UNDER) (*CHAR) LEN(20) VALUE('____________________')
/* Define print line and columns */
DCL (&LINE) (*CHAR) LEN(132)
DCL (&COUNT) (*CHAR) STG(*DEFINED) LEN(5) DEFVAR(&LINE 5)
DCL (&STAMP) (*CHAR) STG(*DEFINED) LEN(20) DEFVAR(&LINE 20)
/* Define heading 1 */
PRTLN LINE('Really Simple Report') HEADING(Y) HEAD(1 Y)
/* Define heading 2 */
CHGVAR &COUNT 'COUNT'
CHGVAR &STAMP 'TIMESTAMP'
PRTLN LINE(&LINE) HEADING(Y) HEAD(2)
/* Define hading 3 Underscoring heading 2 */
CHGVAR &COUNT &UNDER
CHGVAR &STAMP &UNDER
PRTLN LINE(&LINE) SPACE(S0) HEADING(Y) HEAD(3)
/* Print a report showing count and timestamp */
DOWHILE COND(&LC *LT 70)
CHGVAR &COUNT %CHAR(&LC)
RTVSYSVAL SYSVAL(QDATETIME) RTNVAR(&STAMP)
PRTLN LINE(&LINE)
CHGVAR VAR(&LC) VALUE(&LC + 1)
ENDDO
PRTLN CONTROL(*CLOSE)
ENDPGM

50
PRT_CL/DEMO_CL2.CLP Normal file
View File

@ -0,0 +1,50 @@
/*=== Demo a complex report ================================*/
/* List files & members with record count and description. */
/* Has heading lines, an underscored heading & page number. */
PGM
DCL (&LINE) (*CHAR) LEN(132)
/* Define data columns in &LINE */
DCL (&LIB) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE)
DCL (&FILE) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE 12)
DCL (&MBR) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE 33)
DCL (&RCDS) (*CHAR) STG(*DEFINED) LEN(8) DEFVAR(&LINE 44)
DCL (&TEXT) (*CHAR) STG(*DEFINED) LEN(50) DEFVAR(&LINE 53)
DCL (&UNDER) (*CHAR) LEN(60) +
VALUe('____________________________________________________________')
/* Create some data */
DCLF FILE(QAFDMBRL)
DSPFD FILE(*CURLIB/Q*) TYPE(*MBRLIST) +
OUTPUT(*OUTFILE) FILEATR(*PF) +
OUTFILE(QTEMP/MBRLIST)
OVRDBF FILE(QAFDMBRL) TOFILE(QTEMP/MBRLIST)
/* Define heading lines. Second heading is underscored */
PRTLN LINE('Member List') HEADING(Y) HEAD(1 Y)
CHGVAR (&LIB) ('Library')
CHGVAR (&FILE) ('File')
CHGVAR (&MBR) ('Member')
CHGVAR (&RCDS) ('#Records')
CHGVAR (&TEXT) ('Description')
PRTLN LINE(&LINE) HEADING(Y) HEAD(2)
CHGVAR (&LIB) (&UNDER)
CHGVAR (&FILE) (&UNDER)
CHGVAR (&MBR) (&UNDER)
CHGVAR (&RCDS) (&UNDER)
CHGVAR (&TEXT) (&UNDER)
PRTLN LINE(&LINE) SPACE(S0) HEADING(Y) HEAD(3)
/* Loop thru the data and print */
LOOP:
RCVF RCDFMT(QWHFDML)
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EOF))
CHGVAR (&LIB) (&MLLIB)
CHGVAR (&FILE) (&MLFILE)
CHGVAR (&MBR) (&MLNAME)
CHGVAR (&RCDS) (%CHAR(&MLNRCD))
CHGVAR (&TEXT) (&MLMTXT)
PRTLN LINE(&LINE)
GOTO CMDLBL(LOOP)
EOF: PRTLN CONTROL(*CLOSE)
ENDPGM

58
PRT_CL/DEMO_CL3.CLLE Normal file
View File

@ -0,0 +1,58 @@
/*=== Demo a complex report with breaks ============================*/
/* Contains heading lines and underscored headings & page number */
/* - Library is in the heading line */
/* - File prints only when it changes */
PGM
DCL (&LINE) (*CHAR) LEN(132)
/* Define data columns in &LINE */
DCL (&FILE) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE)
DCL (&MBR) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE 13)
DCL (&RCDS) (*CHAR) STG(*DEFINED) LEN(8) DEFVAR(&LINE 24)
DCL (&TEXT) (*CHAR) STG(*DEFINED) LEN(50) DEFVAR(&LINE 33)
DCL (&UNDER) (*CHAR) LEN(60) +
VALUe('____________________________________________________________')
DCL (&THELIB) (*CHAR) LEN(10) VALUE('LENNONS1')
DCL (&LAST_FILE) (*CHAR) LEN(10) VALUE(' ')
DCL (&LINE_SPACE) (*CHAR) LEN(2)
/* Create some data */
DCLF FILE(QAFDMBRL)
DSPFD FILE(&THELIB/*ALL) TYPE(*MBRLIST) +
OUTPUT(*OUTFILE) FILEATR(*PF) +
OUTFILE(QTEMP/MBRLIST)
OVRDBF FILE(QAFDMBRL) TOFILE(QTEMP/MBRLIST)
/* Define heading lines. Second is underscored */
PRTLN LINE('File Member List - Library:' *BCAT &THELIB) HEADING(Y) HEAD(1 Y)
CHGVAR (&FILE) ('File')
CHGVAR (&MBR) ('Member')
CHGVAR (&RCDS) ('#Records')
CHGVAR (&TEXT) ('Description')
PRTLN LINE(&LINE) SPACE(S2) HEADING(Y) HEAD(2)
CHGVAR (&FILE) (&UNDER)
CHGVAR (&MBR) (&UNDER)
CHGVAR (&RCDS) (&UNDER)
CHGVAR (&TEXT) (&UNDER)
PRTLN LINE(&LINE) SPACE(S0) HEADING(Y) HEAD(3)
/* Loop thru the data and print */
LOOP:
RCVF RCDFMT(QWHFDML)
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EOF))
/* Print file just once */
IF (&MLFILE *NE &LAST_FILE) DO
CHGVAR (&LAST_FILE) &MLFILE
CHGVAR (&FILE) (&LAST_FILE)
CHGVAR (&LINE_SPACE) 'S2'
ENDDO
ELSE DO
CHGVAR (&FILE) ' '
ENDDO
CHGVAR (&MBR) (&MLNAME)
CHGVAR (&RCDS) (%CHAR(&MLNRCD))
CHGVAR (&TEXT) (&MLMTXT)
PRTLN LINE(&LINE) SPACE(&LINE_SPACE)
CHGVAR (&LINE_SPACE) 'S1'
GOTO CMDLBL(LOOP)
EOF: PRTLN CONTROL(*CLOSE)
ENDPGM

208
PRT_CL/DEMO_RPG1.SQLRPGLE Normal file
View File

@ -0,0 +1,208 @@
**free
// ==============================================================
// RPG demo of the PRT program: Printing a file format listing.
// ==============================================================
// - Uses SQL input from QSYS2.SYSCOLUMNS2 and QSYS.TABLES.
// - Specify a single file or generic. Source files are omitted.
// - Each file starts on a new page.
// - Report is sorted by file and either field name or sequence.
// Parms
// 1 Library: Char 10.
// 2 File name: Char 10.
// For generic, append *, e.g., LINE* will print all
// all files that start with LINE.
// 3 Order Char(1)
// N: sort by field name (default)
// S: sort by ordinal sequence of fields
// Sample call:
// CALL PGM(DEMO_RPG1) PARM((LENNONS1) (BOMMASPF) (S))
// If you plan to use this, creating a command is recommended.
ctl-opt option(*srcstmt: *nodebugio)
bnddir('SQL_BND')
actgrp(*new) main(Main);
/COPY copy_mbrs,prt_p
/COPY copy_mbrs,srv_sql_p
dcl-proc Main;
dcl-pi Main;
pi_library char(10);
pi_filelike char(10);
pi_order char(1);
end-pi;
dcl-c SQLSUCCESS '00000';
dcl-c SQLNODATA '02000';
dcl-c SQLNOMOREDATA '02000';
dcl-s theLibrary varchar(10) ;
dcl-s theFile varchar(10);
dcl-s theSeq char(1) inz('N');
dcl-s lastFile char(10) inz(' ');
dcl-s eofSW ind inz(*off);
dcl-ds inSQL qualified ; // SQL data returned here
library char(10);
file char(10);
file_desc char(50);
field_name char(10);
type char(8);
length int(10);
decimals int(10);
field_desc char(50);
col_head char(60);
seq int(10);
end-ds;
dcl-ds line len(132) qualified; // Line layout
seq char(4);
*n char(2);
field_name char(10);
*n char(2);
type char(8);
*n char(2);
length char(10);
*n char(2);
decimal char(3);
*n char(2);
text char(50);
end-ds;
dcl-ds h1 qualified; // Header 1
*n char(15) inz('Field Listing: ');
lib_file char(21);
file_desc char(50);
end-ds;
dcl-ds h2 likeds(line); // Header 2 layout.
exsr init;
// Set up second heading line
h2.seq = ' Seq';
h2.field_name = 'Field Name';
h2.type = 'Type';
h2.length = 'Length';
h2.decimal = 'Dec';
h2.text = 'Description';
PRT(h2 : '*H2: S2');
// Underline second heading line
h2.seq = *all'_';
h2.field_name = *all'_';
h2.type = *all'_';
h2.length = *all'_';
h2.decimal = *ALL'_';
h2.text = *all'_';
PRT(h2 : '*H3: S0');
// === Loop through the data and print lines
// === Skip to new page if library changes
exsr fetch;
dow (eofSW = *off);
if (inSQL.file <> lastFile);
PRT(' ' : '*NEWPAGE');
h1.lib_file = %trim(inSQL.library) + '/' + inSQL.file;
h1.file_desc = inSQL.file_desc;
PRT(h1 : '*H1: *P');
lastFile = inSQL.file;
endif;
// Fill line with the rest of the data
evalr line.seq = %trim(%char(inSQL.seq));
line.field_name = inSQL.field_name;
line.type = inSQL.type;
evalr line.length = %trim(%char(inSQL.length));
if (inSQL.decimals >=0);
evalr line.decimal = %trim(%char(inSQL.decimals));
else;
line.decimal = ' ';
endif;
line.text = inSQL.field_desc;
PRT(line);
exsr fetch;
enddo;
PRT(' ' : '*NEWPAGE');
PRT('SQL parms: Library-' + theLibrary +
' File-' + theFile + ' Order-' + theSeq: 'S2');
PRT('** End of Report **' : 'S2');
PRT(' ' : '*CLOSE');
return;
// ==============================================================
// === Initial Paramets and SQL setup ===========================
begsr init;
// === Process paramters
if (%parms = 0); //no parms, set defaults for testing
theLibrary = 'LENNONS1';
theFile = 'ECL*';
theSeq = 'S';
endif;
if (%parms = 1 ) ;
theLibrary = %upper(%trim(pi_library));
theFile = 'ECL*';
theSeq = 'S';
endif;
if (%parms = 2);
theLibrary = %upper(%trim(pi_library));
theFile = %upper(%trim(pi_filelike));
theSeq = 'S';
endif;
if (%parms = 3);
theLibrary = %upper(%trim(pi_library));
theFile = %upper(%trim(pi_filelike));
theSeq = %upper(pi_order);
endif;
// === Handle generic file
theFile = %xlate('*' : '%' : theFile);
exec sql set option datfmt=*iso,
closqlcsr=*endmod,
commit=*none;
// === Cursor to get the data
exec sql declare data_cursor cursor for
SELECT TABLE_SCHEMA as library
,cols.SYSTEM_TABLE_NAME AS file_name
,char(tbls.TABLE_TEXT, 50) as file_desc
,cols.SYSTEM_COLUMN_NAME AS field_name
,char(cols.DATA_TYPE, 8) AS type
,cols.LENGTH
,cOALESCE(cols.NUMERIC_SCALE, -1) AS decimals
,char(coalesce(cols.COLUMN_TEXT, ' '), 50) as field_desc
,cHAR(COALESCE(cols.COLUMN_HEADING, ' '), 60) AS col_head
,cols.ORDINAL_POSITION AS seq
FROM QSYS2.SYSTABLES tbls
JOIN QSYS2.SYSCOLUMNS2 cols
using (TABLE_SCHEMA, TABLE_NAME)
WHERE TABLE_SCHEMA = :theLibrary
AND tbls.FILE_TYPE <> 'S' // omit source files
AND trim(cols.SYSTEM_TABLE_NAME) like :theFile
ORDER BY cols.SYSTEM_TABLE_NAME,
case :theSeq
when 'N' then cols.SYSTEM_COLUMN_NAME
else digits(cols.ORDINAL_POSITION)
end
;
//== Open cursor
exec sql open data_cursor;
if (sqlstate <> SQLSUCCESS);
SQLProblem('Open failed');
endif;
endsr;
// === Fetch next row from cursor ===============================
begsr fetch;
exec sql fetch data_cursor into :inSQL;
if (sqlstate = SQLNOMOREDATA);
eofSW = *on;
leavesr;
endif;
if (sqlstate = SQLSUCCESS);
eofSW = *off;
leavesr;
else;
SQLProblem('Fetch failed');
endif;
endsr;
end-proc main;

7
PRT_CL/MYPRT.CLLE Normal file
View File

@ -0,0 +1,7 @@
/* Create program described printer file used by PRT RPG program */
PGM
CRTPRTF FILE(LENNONS1/MYPRT) DEVTYPE(*SCS) +
PAGESIZE(66 133) LPI(6) CPI(10) +
OVRFLW(60) CTLCHAR(*FCFC) CHLVAL((1 (6))) +
FONT(*CPI)
ENDPGM

292
PRT_CL/PRT.RPGLE Normal file
View File

@ -0,0 +1,292 @@
**free
// ==================================================================
// PRT: A program that prints a report by printing a line at a time.
// A convenience routine for simple reports, since O-SPECs are not
// supported in **FREE RPG programs. It avoids having to create an
// externally defined printer file.
// ==================================================================
// Parms:
//
// 1) Char(132) Line text. (Or blank for certain control cases.)
//
// 2) Char(10) Control field. Optional.
// blank Parm 1 contains the line to be printed with
// single spacing.
// Line control: How to print Parm 1:
// S1 Space one line and print.
// Omitted or blank is the same as S1.
// S2 Space two lines and print.
// S3 Space three lines and print.
// S0 Overprint current line.
//
// Definitions - no line are printed with this call.
// *Hn Define heading line "n", where n is 1 to 9
// Parm 1 can be all blanks to print a blank line
// heading line.
// *Hn:Sx Define heading line "n", where n is 1 to 9 and
// "x" is the number of lines to space, where
// x is 0 to 3. S0 will overprint prior line.
// *Hn:*P:Sx Page number will be printed at the end of this
// header line.
//
// Special control funtions - no line is printed.
// *NEWPAGE Next line will print on a new page.
// Parm 1 is ignored.
// *CLOSE Close the print file.
// Parm 1 is ignored.
// ==================================================================
ctl-opt option(*srcstmt: *nodebugio)
actgrp(*caller)
main(Prt);
// ==================================================================
// === Program defined print file. ==================================
dcl-f MYPRT printer(133) usropn oflind(*in99) extfile('MYPRT');
// Change extfile above to use another *FCFC print file.
// === Global Constants =============================================
dcl-c SP0 'S0'; // Overprint
dcl-c SP1 'S1'; // Space 1 & print
dcl-c SP2 'S2'; // Space &2 print
dcl-c SP3 'S3'; // Space 3 and print
dcl-c TOP 'SK1'; // Skip to top and print
dcl-c PAGELINE '*P'; // Header line has page #
// ==================================================================
// ===Prt procedure =================================================
dcl-proc Prt;
dcl-pi Prt;
pi_line char(132); // Line text
pi_ctl char(10); // Control
end-pi;
// Data structure template for write to printer file
dcl-ds lines qualified template;
line char(132) inz;
isHdr ind inz;
isPage ind inz;
Ctl char(2) inz(SP1);
end-ds;
dcl-s j int(10);
dcl-s pageNumC char(8);
dcl-s wk_Ctl like(pi_ctl);
dcl-ds wkLn likeds(lines); // header line with page num
dcl-s headerSkip ind;
dcl-s gotHeaders ind;
dcl-s ctlValues varchar(4) dim(*auto : 3); // Values split from Ctl
// Array of Valid Spacing control chars.
dcl-ds vs qualified;
s1 char(3) inz(' ');
*n char(3) inz(SP0);
*n char(3) inZ(SP1);
*n char(3) inZ(SP2);
*n char(3) inZ(SP3);
validSpaces char(3) dim(5) samepos(s1);
end-ds;
// Static fields: These need to be retained across calls
dcl-ds hdrs likeds(lines) dim(9) static; // Up to 9 header lines
dcl-s newPage ind inz(*on) static; // First page is a new page
dcl-s pageNum packed(5) static inz(1);
// === Open printer file ===
if (not %open(MYPRT));
open MYPRT;
endif;
// ================================================================
// === Main processing logic ======================================
select;
// A non-printing control function
when (%parms = 2 and %subst(pi_ctl :1 :1) = '*');
exsr doControl;
// Print with a control
when (%parms = 2);
wk_Ctl = pi_ctl;
exsr doPrint;
// Print without a control - default space 1
when (%parms = 1);
wk_Ctl = SP1;
exsr doPrint;
other;
PrtLn('>>1>>>>>> Error: Called with missing/incorrect parmaters':SP1);
endsl;
return;
// ================================================================
// === Non-printing control functions =============================
begsr doControl;
wk_Ctl = %upper(pi_ctl);
select;
// Force a new page if next line won't be a new page
when (pi_ctl = '*NEWPAGE');
newPage = *on;
// Handle closing the report
when (pi_ctl = '*CLOSE');
if (%open(MYPRT));
close MYPRT;
endif;
// Reset static in case called again from same activation group
reset newPage;
reset pageNum;
reset hdrs;
*inlr =*on;
// Save head line definitions
when (%subst(wk_Ctl :1 :2) = '*H');
// Split up the control function par,
%elem(ctlValues) = 0;
ctlValues = %split(wk_Ctl :':');
// first one is *Hn, where n is 1=9
if (%len(%trim(ctlValues(1))) > 3);
PrtLn('>>2>>>>>> *Hn value too long: ' + %trim(pi_ctl)
+ '. Missing ":" maybe?' : SP1);
endif;
j = %int(%subst(ctlValues(1) : 3 :1));
hdrs(j).isHdr = *on;
hdrs(j).line = pi_line;
// Process 2nd and/or 3rd parms
select;
// If it is page control
when (%elem(ctlValues) = 2);
if (%trim(ctlValues(2)) = PAGELINE);
hdrs(j).isPage = *on;
else;
// If no, should be spacing
if (%trim(ctlValues(2)) in vs.validSpaces);
hdrs(j).Ctl = %trim(ctlValues(2));
else;
PrtLn('>>3>>>>>> Space or page value is not valid: ' + %trim(pi_ctl) : SP1);
endif;
endif;
// Process 2nd and 3rd parms
when (%elem(ctlValues) = 3);
// second must be paging
if (%trim(ctlValues(2)) = PAGELINE);
hdrs(j).isPage = *on;
else;
PrtLn('>>4>>>>>> Paging value is not valid: ' + %trim(pi_ctl) : SP1);
endif;
// 3rd is spacing
if (%trim(ctlValues(3)) in vs.validSpaces);
hdrs(j).Ctl = %trim(ctlValues(3));
else;
PrtLn('>5>>>>>>> Space value is not valid: ' + %trim(pi_ctl) : SP1);
endif;
endsl;
other;
PrtLn('>>7>>>>> Calling error. Control value not supported: ' + pi_ctl :SP1);
endsl;
endsr;
// ================================================================
// === Print the line =============================================
begsr doPrint;
select;
// Need new page
when (newPage);
exsr doHeaders;
// If heading lines were printed, then print the line with
// the specified spacing, else skip to a new page and print.
If (gotHeaders);
PrtLn(pi_Line : wk_Ctl);
else;
PrtLn(pi_line : TOP);
newPage = *off;
endif;
// Just print the line
other;
PrtLn(pi_Line : wk_Ctl);
endsl;
// === If overflow, remember for next line ===
if (*in99 = *on);
newPage = *on;
*in99 = *off;
endif;
endsr ;
// ================================================================
// === Print Headers ==============================================
begsr doHeaders;
if (newPage);
// Print the Heading lines and page number.
// No defined headers is possible.
gotHeaders = *off;
// Set up character page number
pageNumC = 'Page +++';
if (pageNum <= 999);
pageNumC = 'Page ' + %char(pageNum);
endif;
// Loop through header definitions, printing those defined
for j = 1 to 9;
if (hdrs(j).isHdr);
gotHeaders = *on;
wkLn.line = hdrs(j).line;
if (hdrs(j).isPage);
%subst(wkLn.line :%len(wkLn.line) - %len(pageNumC) ) = pageNumC;
endif;
// First header line, and only the first, has to be a skip to top
if (headerSkip = *off);
PrtLn(wkLn.line : TOP);
headerSkip = *on;
else;
PrtLn(wkLn.line : hdrs(j).Ctl);
endif;
endif;
endfor;
headerSkip = *off;
newPage = *off;
pageNum += 1;
endif;
endsr ;
end-proc Prt;
// ==================================================================
// === Procedure to print a line ====================================
dcl-proc PrtLn;
dcl-pi PrtLn;
pi_Line char(132) const;
pi_Ctl char(10) const;
end-pi;
dcl-ds line len(133) qualified;
end-ds;
// FCFC Definitions for printer file
dcl-s SK1 char(1) inz('1'); // skip to channel 1
dcl-s S1 char(1) inz(' '); // space 1 and print
dcl-s S2 char(1) inz('0'); // spacw 2 and print
dcl-s S3 char(1) inz('-'); // Space 3 and print
dcl-s S0 char(1) inz('+'); // Overprint (space 0)
dcl-s fcFC char(1);
select;
when (pi_Ctl = SP1 or pi_Ctl = ' ');
fcFC = S1;
when (pi_Ctl = SP2);
fcFC = S2;
when (pi_Ctl = SP3);
fcFC = S3;
when (pi_Ctl = SP0);
fcFC = S0;
when (pi_Ctl = TOP);
fcFC = SK1;
other;
PrtLn('>>>>>>>> Invalid spacing control: ' + pi_Ctl :SP1);
endsl;
// Write must be from a data structure
line = fcFC + pi_Line;
write MYPRT line;
end-proc PrtLn;

33
PRT_CL/PRTLN.CMD Normal file
View File

@ -0,0 +1,33 @@
PRTLN: CMD PROMPT('Print a line ')
/* ================================================================*/
/* PRTLNC is the command processing program */
/* CRTCMD CMD(PRTLN) PGM(*LIBL/PRTLNC) SRCFILE(PRT_CL) */
/* VLDCKR(*LIBL/PRTLNCV) */
/* ALLOW(*IPGM *BPGM *IMOD *IPGM *INTERACT) */
/* HLPPNLGRP(PRTLNP) HLPID(*CMD) */
/* ================================================================*/
PARM KWD(LINE) TYPE(*CHAR) LEN(132) MIN(0) +
EXPR(*YES) PROMPT('Line text')
PARM KWD(SPACE) TYPE(*CHAR) LEN(2) RSTD(*YES) +
DFT(S1) VALUES('S1' 'S2' 'S3' 'S0') +
MIN(0) PROMPT('Line spacing')
PARM KWD(HEADING) TYPE(*CHAR) LEN(1) RSTD(*YES) +
DFT(N) VALUES(Y N) PROMPT('Defining +
heading line?')
PARM KWD(HEAD) TYPE(HDEF) PMTCTL(HEAD) +
PROMPT('Heading definitions')
PARM KWD(CONTROL) TYPE(*CHAR) LEN(10) RSTD(*YES) +
VALUES(*NEWPAGE *CLOSE) PMTCTL(CTRL) +
PROMPT('Non-printing control functions')
HDEF: ELEM TYPE(*CHAR) LEN(1) DFT(1) RANGE(1 9) MIN(0) +
PROMPT('Header line number')
ELEM TYPE(*CHAR) LEN(1) RSTD(*YES) DFT(N) +
VALUES(N Y) PROMPT('Include page number')
HEAD: PMTCTL CTL(HEADING) COND((*EQ 'Y'))
CTRL: PMTCTL CTL(LINE) COND((*EQ ' '))

47
PRT_CL/PRTLNC.CLLE Normal file
View File

@ -0,0 +1,47 @@
PRTLNC: PGM PARM(&P_LINE &P_SPACE &P_DEFHEAD &P_HEAD +
&P_CONTROL)
/* ================================================================*/
/* CPP for the PRTLN command. */
/* Maps the command parameters to what the PRT program expects */
/* then calls PRT to print or process the line. */
/* ================================================================*/
/* For RPG convenient usage, PRT has only two parms. PRTLN cmd */
/* has more parms for more meaningful usage. */
/* ================================================================*/
DCL (&P_LINE) TYPE(*CHAR) LEN(132) /* Line text */
DCL (&P_SPACE) TYPE(*CHAR) LEN(2) /* Spacing */
DCL (&P_DEFHEAD) TYPE(*CHAR) LEN(1) /* Defining Heading? */
DCL (&P_HEAD) TYPE(*CHAR) LEN(4) /* Heading definition */
DCL (&P_CONTROL) TYPE(*CHAR) LEN(10) /* Control field */
DCL (&PRT_PARM2) TYPE(*CHAR) LEN(10) /* Parm 2 for PRT pgm */
DCL (&HLINE_NUM) TYPE(*CHAR) LEN(1)
DCL (&HEADPAGE) TYPE(*CHAR) LEN(1)
/* PHEAD is a list of 2 elements. Just ignore the 2 byte length. */
CHGVAR (&HLINE_NUM) VALUE(%SST(&P_HEAD 3 1))
CHGVAR (&HEADPAGE) VALUE(%SST(&P_HEAD 4 1))
/* If defining headings */
IF (&P_DEFHEAD = 'Y') DO
/* Building either "*Hn:*P:Sn" or "*Hn:Sn" */
CHGVAR VAR(&PRT_PARM2) VALUE('*H' *TCAT &HLINE_NUM)
IF (&HEADPAGE = 'Y') DO
CHGVAR VAR(&PRT_PARM2) VALUE(&PRT_PARM2 *TCAT ':*P')
ENDDO
CHGVAR VAR(&PRT_PARM2) VALUE(&PRT_PARM2 *TCAT ':' *TCAT &P_SPACE)
/* Define the header and return */
CALL PGM(PRT) PARM(&P_LINE &PRT_PARM2)
RETURN
ENDDO
/* Handle other special control fields & return: *CLOSE & *NEWPAGE */
IF (&P_CONTROL *NE ' ') DO
CALL PGM(PRT) PARM(&P_LINE &P_CONTROL)
RETURN
ENDDO
/* Else print the line and return */
CHGVAR (&P_CONTROL) (&P_SPACE)
CALL PGM(PRT) PARM(&P_LINE &P_CONTROL)
RETURN
ENDPGM

41
PRT_CL/PRTLNCV.CLLE Normal file
View File

@ -0,0 +1,41 @@
PRTLNC: PGM PARM(&P_LINE &P_SPACE &P_DEFHEAD &P_HEAD +
&P_CONTROL)
/* ================================================================*/
/* VCP for the PRTLN command. */
/* Checks consistency of paremeters: */
/* If doing a CONTROL function, LINE must be blank. */
/* If doing a CONTROL function, you can't be defining headings. */
/* ================================================================*/
DCL (&P_LINE) TYPE(*CHAR) LEN(132) /* Line text */
DCL (&P_SPACE) TYPE(*CHAR) LEN(2) /* Spacing */
DCL (&P_DEFHEAD) TYPE(*CHAR) LEN(1) /* Defining Heading? */
DCL (&P_HEAD) TYPE(*CHAR) LEN(4) /* Heading definition */
DCL (&P_CONTROL) TYPE(*CHAR) LEN(10) /* Control field */
DCL (&ERR_MSG) TYPE(*CHAR) LEN(200)
IF (&P_CONTROL *NE ' ') DO
SELECT
WHEN (&P_LINE *NE ' ') DO
CHGVAR &ERR_MSG +
('If "CONTROL" is specified "LINE" should be blank')
GOTO SEND_ERR
ENDDO
WHEN (&P_DEFHEAD = 'Y') DO
CHGVAR &ERR_MSG +
('If "CONTROL" is specified "HEADING" should be "N"')
GOTO SEND_ERR
ENDDO
ENDSELECT
ENDDO
RETURN /* All Consistent */
/* Send the error back to the command */
/* Note the definition of CPD0006 is a bit funky. 1234 below is */
/* needed but is ignored when the message is sent. */
SEND_ERR: SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) +
MSGDTA('1234' *CAT &ERR_MSG) MSGTYPE(*DIAG)
SNDPGMMSG MSGID(CPF0002) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
ENDPGM

221
PRT_CL/PRTLNP.PNLGRP Normal file
View File

@ -0,0 +1,221 @@
:pnlgrp.
.************************************************************************
.* Help for command PRTLN
.************************************************************************
:help name='PRTLN'.
Print a line - Help
:p.The Print a line (PRTLN) command provides report printing capabilities
in a CLP or CLLE program. Heading lines may be defined and print when
overflow occurs. A page number can also be printed in the headings.
:ehelp.
.*******************************************
.* Help for parameter LINE
.*******************************************
:help name='PRTLN/LINE'.
Line text (LINE) - Help
:xh3.Line text (LINE)
:p.Specifies the text to print on this line, or if defining a header line,
specifies the text of that header line.
.* Describe the function provided by the parameter.
:parml.
:pt.:pv.character-value:epv.
:pd.
May be blank.
.* Describe the function provided by the user-defined parameter value.
:eparml.
:ehelp.
.*******************************************
.* Help for parameter SPACE
.*******************************************
:help name='PRTLN/SPACE'.
Line spacing (SPACE) - Help
:xh3.Line spacing (SPACE)
:p.Specifies the spacing of the printed line or the header line.
:parml.
:pt.:pk def.S1:epk.
:pd.
Space 1 line and print.
:pt.:pk.S2:epk.
:pd.
Space 2 lines and print.
:pt.:pk.S3:epk.
:pd.
Space 3 lines and print.
:pt.:pk.S0:epk.
:pd.
Overprint previous line.
:eparml.
:ehelp.
.*******************************************
.* Help for parameter HEADING
.*******************************************
:help name='PRTLN/HEADING'.
Defining heading line? (HEADING) - Help
:xh3.Defining heading line? (HEADING)
:p.Specifies if this execution is defining a heading line. No
printing occurs.
:parml.
:pt.:pk.Y:epk.
:pd.
This is a header line definition. Additional fields open up
to speicify which header line and if it should include a page number.
:pt.:pk def.N:epk.
:pd.
This is not defining a heading.
:eparml.
:ehelp.
.*******************************************
.* Help for parameter HEAD
.*******************************************
:help name='PRTLN/HEAD'.
Heading definitions (HEAD) - Help
:xh3.Heading definitions (HEAD)
:p.:hp2.Element 1: Header line number:ehp2.
:parml.
:pt.:pv.1-9:epv.
:pd.
Which heading line is being defined.
:ul.
:li.
Heading lines can be defined in any sequence. For example, you can define
heading 9 then define heading 1, then define heading 3, etc.
:li.
Heading lines always print in ordinal order, not the order in which
they were defined.
:li.
A heading line that is not defined does not print.
:li.
A heading line may be defined with blank text and will print a blank
heading line.
:li.
Once defined, a heading line cannot be undefined.
:li.
A heading line may be redefined at any time and will take effect at the next
page break. Normally you would force a page break after redefining a heading line.
:eul.
:eparml.
:p.:hp2.Element 2: Include page number:ehp2.
:parml.
:pt.:pk def.N:epk.
:pd.
Do not print a page number on this header line.
:pt.:pk.Y:epk.
:pd.
Print a page number in the rightmost 8 positions of this header line.
:eparml.
:ehelp.
.*******************************************
.* Help for parameter CONTROL
.*******************************************
:help name='PRTLN/CONTROL'.
Non-printing control functions (CONTROL) - Help
:xh3.Non-printing control functions (CONTROL)
:p.Operations which are not related to printing a line or defining headings.
:parml.
:pt.:pk.*NEWPAGE:epk.
:pd.
Force a new page when the next line prints. (Page overflow and header printing is
handled automatically, so you need to use this only if you have
break handing logic in your program.)
:pt.:pk.*CLOSE:epk.
:pd.
Close the print file. Normally you do this at the end of the program.
:eparml.
:ehelp.
.**************************************************
.* Examples for PRTLN
.**************************************************
:help name='PRTLN/COMMAND/EXAMPLES'.
Examples for PRTLN - Help
:xh3.Examples for PRTLN
:p.:hp2.Example 1: Simple Command Example:ehp2.
:xmp.
/* Demo a mimimal report - no headings */
PGM
DCL (&LINE) (*CHAR) LEN(132)
DCL VAR(&LC) TYPE(*DEC) LEN(5 0) VALUE(1)
/* Loop thru the data and print */
DOWHILE COND(&LC *LT 70)
CHGVAR VAR(&LINE) +
VALUE('Loop control =' *BCAT %CHAR(&LC))
PRTLN LINE(&LINE)
CHGVAR VAR(&LC) VALUE(&LC + 1)
ENDDO
PRTLN CONTROL(*CLOSE)
ENDPGM
:exmp.
.*
:p.:hp2.Example 2: More Complex Command Example:ehp2.
:xmp.
/* List files & members with record count and description. */
/* Has heading lines, an underscored heading & page number. */
PGM
DCL (&LINE) (*CHAR) LEN(132)
/* Define data columns in &LINE */
DCL (&LIB) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE)
DCL (&FILE) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE 12)
DCL (&MBR) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE 33)
DCL (&RCDS) (*CHAR) STG(*DEFINED) LEN(8) DEFVAR(&LINE 44)
DCL (&TEXT) (*CHAR) STG(*DEFINED) LEN(50) DEFVAR(&LINE 53)
DCL (&UNDER) (*CHAR) LEN(60) +
VALUe('____________________________________________________________')
/* Create some data */
DCLF FILE(QAFDMBRL)
DSPFD FILE(*CURLIB/Q*) TYPE(*MBRLIST) +
OUTPUT(*OUTFILE) FILEATR(*PF) +
OUTFILE(QTEMP/MBRLIST)
OVRDBF FILE(QAFDMBRL) TOFILE(QTEMP/MBRLIST)
/* Define heading lines. Second heading is underscored */
PRTLN LINE('Member List') HEADING(Y) HEAD(1 Y)
CHGVAR (&LIB) ('Library')
CHGVAR (&FILE) ('File')
CHGVAR (&MBR) ('Member')
CHGVAR (&RCDS) ('#Records')
CHGVAR (&TEXT) ('Description')
PRTLN LINE(&LINE) HEADING(Y) HEAD(2)
CHGVAR (&LIB) (&UNDER)
CHGVAR (&FILE) (&UNDER)
CHGVAR (&MBR) (&UNDER)
CHGVAR (&RCDS) (&UNDER)
CHGVAR (&TEXT) (&UNDER)
PRTLN LINE(&LINE) SPACE(S0) HEADING(Y) HEAD(3)
/* Loop thru the data and print */
LOOP:
RCVF RCDFMT(QWHFDML)
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EOF))
CHGVAR (&LIB) (&MLLIB)
CHGVAR (&FILE) (&MLFILE)
CHGVAR (&MBR) (&MLNAME)
CHGVAR (&RCDS) (%CHAR(&MLNRCD))
CHGVAR (&TEXT) (&MLMTXT)
PRTLN LINE(&LINE)
GOTO CMDLBL(LOOP)
EOF: PRTLN CONTROL(*CLOSE)
ENDPGM
:exmp.
:ehelp.
.**************************************************
.*
.* Error messages for PRTLN
.*
.**************************************************
:help name='PRTLN/ERROR/MESSAGES'.
&msg(CPX0005,QCPFMSG). PRTLN - Help
:xh3.&msg(CPX0005,QCPFMSG). PRTLN
:p.:hp3.*ESCAPE &msg(CPX0006,QCPFMSG).:ehp3.
.************************************************************************
.* List the *ESCAPE, *STATUS, and *NOTIFY messages signalled from the command.
.* The following are generic messages defined in message file QCPFMSG.
.* Modify this list to match the list of error messages for the command.
.************************************************************************
:DL COMPACT.
.*:DT.CPF9801
.*:DD.&MSG(CPF9801,QCPFMSG,*LIBL,nosub).
:EDL.
:ehelp.
:epnlgrp.

221
PRT_CL/PRT_T.RPGLE Normal file
View File

@ -0,0 +1,221 @@
**free
// === Test program to exercise the PRT program =====================
ctl-opt option(*srcstmt: *nodebugio) actgrp(*new) main(Main);
/COPY copy_mbrs,prt_p
dcl-proc Main;
dcl-pi Main;
// pi_head char(132);
end-pi;
dcl-s myLine char(132);
dcl-s j int(10);
// === Test without a heading
for j = 1 to 121;
myLine = %char(j);
%subst(myLine :20) = %char(%timestamp());
PRT(myLine);
endfor;
PRT(' ' : '*CLOSE');
// === Test with a 4 line heading
PRT('*** Test with 4 heading lines ***' : '*H1');
PRT(' Indented header line 2':'*H2');
PRT('Non-Indented header line 3 with page # & 2 spaces':'*H3:*P:S2');
for j = 1 to 120;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ';
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Test with two headings
PRT('<< Test with two header lines >>' : '*H1');
PRT('++ Here is a second header(As H9!) with page # ++' : '*H9:*P');
for j = 1 to 60;
myLine = '<<< ' + %char(j);
%subst(myLine :130 :3) = '>>>';
PRT(myLine);
endfor;
PRT(' ' : '*CLOSE');
// === Test with a single heading
PRT('One header line: This is quite a long single heading line w/ page #' : '*H1:*P');
for j = 1 to 190;
myLine = %char(j);
%subst(myLine :20) = %char(%timestamp());
PRT(myLine);
endfor;
PRT(' ' : '*CLOSE');
// === Test with a 4 line heading, 2nd blank; 3rd under scored, with page num
PRT('Test with 2nd blank, 3rd line underlined with page #, 4th blank' : '*H1');
PRT('ABCDEFGH ZXY ' : '*H2:s2');
PRT('________ ___ ' : '*H5:*p:s0');
PRT(' ':'*h8');
for j = 1 to 70;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%time());
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Test with a 3 line heading, line 3 blank
PRT('Test with line 3 blank' : '*H1');
PRT('Blank header line should follow. Page # on this line. ' : '*H2:*P');
PRT(' ' : '*H3');
for j = 1 to 70;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Test a *NEWPAGE
PRT('Testing a new page at line 80' : '*H1:*P');
PRT('Section starting at line 1' : '*H2');
for j = 1 to 150;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
if (j=80);
PRT(' ':'*NEWPAGE');
PRT('New Section - Line 80 is the start' :'*H2');
endif;
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Test a *NEWPAGE - Break at overflow - 2
PRT('Testing a new page at line 52 (overflow -2)' : '*H1:*P');
for j = 1 to 150;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
if (j=52);
PRT('*********** ':'*NEWPAGE');
endif;
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Test a *NEWPAGE - Break at overflow - 1
PRT('Testing a new page at line 53 (overflow -1)' : '*H1:*P');
for j = 1 to 150;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
if (j=53);
PRT(' ':'*NEWPAGE');
endif;
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Test a *NEWPAGE - Break at overflow
PRT('Testing a new page at line 54 (overflow)' : '*H1:*P');
for j = 1 to 150;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
if (j=54);
PRT(' ':'*NEWPAGE');
endif;
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Test a *NEWPAGE - Break at overflow + 1
PRT('Testing a new page at line 55 (overflow +1)' : '*H1:*P');
for j = 1 to 150;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
if (j=55);
PRT(' ':'*NEWPAGE');
endif;
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Test a *NEWPAGE - Break at overflow + 2
PRT('Testing a new page at line 56 (overflow +2)' : '*H1:*P');
for j = 1 to 150;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
if (j=56);
PRT(' ':'*NEWPAGE');
endif;
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Test without a heading, double spaced
for j = 1 to 121;
myLine = %char(j);
%subst(myLine :20) = %char(%timestamp());
PRT(myLine : 'S2');
endfor;
PRT(' ' : '*CLOSE');
// === Test with a heading, double spaced
PRT('Double spaced test with heading and page #':'*H1:*P');
for j = 1 to 121;
myLine = %char(j);
%subst(myLine :20) = %char(%timestamp());
PRT(myLine : 'S2');
endfor;
PRT(' ' : '*CLOSE');
// === Test with a heading, triple spaced
PRT('Triple spaced test with heading and page #':'*H1:*P');
PRT('Header line 2':'*H2');
for j = 1 to 121;
myLine = %char(j);
%subst(myLine :20) = %char(%timestamp());
if (j = 75);
PRT('>>>>>> *** New header line 2':'*H2');
PRT(' ':'*NEWPAGE');
endif;
PRT(myLine : 'S3');
endfor;
PRT(' ' : '*CLOSE');
// ==== Testing errors ============================================
// === Bad spacing contol value om H2, paging not specified
PRT('!-!-! Bad SP value specified in header 2, paging not specified !-!-!' : '*H1');
PRT('Bad SP value specified in header 2 ' : '*H2:s7');
for j = 1 to 70;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Bad spacing contol value om H2, paging specified
PRT('!-!-! Bad spacing contol value on H2, paging specified !-!-!' : '*H1');
PRT('Bad SP value specified in header 2 specified ' : '*H2:*P:s7');
for j = 1 to 70;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Bad paging control value on H2
PRT('!-!-! Bad paging control value on H2 !-!-!' : '*H1');
PRT('Bad paging value specified in header 2 ' : '*H2:*xX');
for j = 1 to 70;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
// === Missing : after *Hn
PRT('!-!-! Bad paging control value on H2 !-!-!' : '*H1');
PRT('*** Missing : in H2 *** ' : '*H2*P');
for j = 1 to 70;
myLine = %char(j) + ' ABCDEFGHIHJKLMNOPQRSTUVWXYZ ' + %char(%timestamp());
PRT(myLine);
endfor;
PRT(' ' :'*CLOSE');
PRT('++++ Testing Bad Contol values ++++' : '*H1');
PRT('Bad contol after line 30' : '*H2');
for j = 1 to 70;
myLine = %char(j) + '-ABCDEFGHIHJK- ' + %char(%timestamp());
PRT(myLine);
if (j=30);
PRT(' ':'*Bad');
endif;
endfor;
PRT(' ' :'*CLOSE');
*inlr = *on;
end-proc;

189
PRT_CL/README.MD Normal file
View File

@ -0,0 +1,189 @@
# Printing from a CL program (The PRTLN command)
# (Under Construction)
Generating a report from an IBM i CL program isn’t straight forward, because in CL there is no direct way to write to a spool file. Here I provide the CL PRTLN command, which allows simple, direct printing from a CL or CLLE program, including page control and headings.
(Note: I'm not suggesting you should do your payroll checks or month-end general ledger from CL--use RPG for that. But sometimes it is just convenient to print from CL without bothering with extra objects, like Query/400, or STRQMQRY or an RPG program.)
## The PRTLN Command
The PRTLN command allows you to:
- Print a line to a spool file with single, double, or triple spacing, or overprinting.
- Define zero to nine heading lines that print on overflow.
- Print a page number in a heading line.
- Force a new page if you want break handlling.
Fully prompted, the PRTLN command looks like this:
![PRTLN Command](images/PRTLN_command.png)
### Line text
Specifies the text to print on this line, or if defining a header line, specifies the text of that header line.
### Line spacing
Specifies the spacing of the printed line or the header line. (S1: Space 1 line and print; S2: Space 2 lines and print; S3: Space 3 lines and print; S0: Overprint previous line.)
### Defining heading line?
Y means this is a header line definition.
### Header line number
Specifies which heading line is being defined, 1 through 9.
- Heading lines can be defined in any order. For example, you can define heading 9, then define heading 1, then define heading 3, etc.
- Heading lines always print in ordinal order, not the order in which they were defined.
- A heading line that is not defined does not print.
- A heading line may be defined with blank text and will print a blank heading line.
- Once defined, a heading line cannot be undefined.
- A heading line may be redefined at any time and will take effect at the next page break. Normally you would force a page break after redefining a heading line.
### Include page number
Y to print a page number in the rightmost 8 positions of this header line.
### Non-printing control functions
These are operations which are not related to printing a line or defining headings.
- *NEWPAGE forces a new page when the next line prints. (Page overflow and header printing is handled automatically, so you need to use this only if you have break handing logic in your program.)
- *CLOSE closes the print file. Normally you do this at the end of the report, but you can use it to create a new spool file..
## Formatting the Print Line
In [Printing Techniques in RPG/**FREE](https://github.com/SJLennon/IBM-i-RPG-Free-CLP-Code/tree/master/Printing) I showed how easily RPG can format print line columns using a data structure. CL doesn't have data structures, but they can be simulated using the STG(*DEFINED) and DEFVAR parameters of the DCL command. This is much simpler than building the print line through concatenation.
As an example, you can define a print line with 3 columns like this:
```
DCL (&LINE) (*CHAR) LEN(132)
DCL (&LIB) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE)
DCL (&FILE) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE 12)
DCL (&MBR) (*CHAR) STG(*DEFINED) LEN(10) DEFVAR(&LINE 33)
```
Then you just need to populate the line using the column names.
## PRTLN Example
Here's a simple program to demonstrate the concepts.
```PGM
DCL (&LC) (*DEC) LEN(5 0) VALUE(1)
DCL (&UNDER) (*CHAR) LEN(20) VALUE('____________________')
/* Define print line and columns */
DCL (&LINE) (*CHAR) LEN(132)
DCL (&COUNT) (*CHAR) STG(*DEFINED) LEN(5) DEFVAR(&LINE 5)
DCL (&STAMP) (*CHAR) STG(*DEFINED) LEN(20) DEFVAR(&LINE 20)
/* Define heading 1 */
PRTLN LINE('Really Simple Report') HEADING(Y) HEAD(1 Y)
/* Define heading 2 */
CHGVAR &COUNT 'COUNT'
CHGVAR &STAMP 'TIMESTAMP'
PRTLN LINE(&LINE) HEADING(Y) HEAD(2)
/* Define hading 3 Underscoring heading 2 */
CHGVAR &COUNT &UNDER
CHGVAR &STAMP &UNDER
PRTLN LINE(&LINE) SPACE(S0) HEADING(Y) HEAD(3)
/* Print a report showing count and timestamp */
DOWHILE COND(&LC *LT 70)
CHGVAR &COUNT %CHAR(&LC)
RTVSYSVAL SYSVAL(QDATETIME) RTNVAR(&STAMP)
PRTLN LINE(&LINE)
CHGVAR VAR(&LC) VALUE(&LC + 1)
ENDDO
PRTLN CONTROL(*CLOSE)
ENDPGM
```
It produces a two page report like this:
![Demo Rept part 1](images/DemoRpt_1.png)
![Demo Rept part 2](images/DemoRpt_2.png)
## The Code
### PRTLN.CMD
This is the source for the PRTLN command.
### PRTLNCV.CLLE
This is the VCP (Validity Checking Program) for the PRTLN command. A VCP is optional and can be used to do parameter validity checking that is difficult or impossible in standard command definition source. When used, it receives the same parameters as the CCP and can pass back error messages to the command.
It is used here to ensure that non-printing CONTOL functions don't also try to print a line or define a heading.
### PRTLNC.CLLE
This is the CPP (Command Processing Program). A CPP is called when there are no errors in the command.
Here it reformats the parameter from the command to pass to the PRT program.
### PRTLNP.PNLGRP
This is the UIM help text for the PRTLN command. I created a skeleton using the IBM GENCMDDOC command, then edited it with the [Code for IBM i](https://github.com/halcyon-tech/vscode-ibmi) extension to VS Code.
### PRT.RPGLE
This is a RPG/FREE program that does the heavy lifting. It saves heading lines in an array, takes care of opening and closing the print file and prints headings on overflow.
It writes to the MYPRINT printer file which is defined like this:
```
CRTPRTF FILE(LENNONS1/MYPRT) DEVTYPE(*SCS)
PAGESIZE(66 133) LPI(6) CPI(10)
OVRFLW(60) CTLCHAR(*FCFC) CHLVAL((1 (6)))
FONT(*CPI)
```
Adjust the overflow or top of form line to suit your needs.
MYPRT.CLLE is a simple CL program to create MYPRT.
### DEMO_CL1.CLLE, DEMO2_CL2.CLP and DEMO_CL3.CLLE
Demonstartion programs of PRTLN in use.
### DEMO_RPG1.SQLRPGLE
A demonstration RPG/**FREE program calling the PRT program directly to print a a file layout. It produces a report like this:
![Prt Demo Rpt](images/PRT_Demo_Rept.png)
### More on PRT.RPGLE
I also wanted PRT to be easily called from RPG as well as from the PRTLN command. While RPG parameters can be omitted or optional, they are still positional and not quite a flexible as defining and defaulting parameters in a command. So I opted for just two parameters, the second being optional.
Parm 1 is the line text, either to print or to define a heading.
Parm 2 is a multipart control parameter that qualifies Parm 1.
- If blank or omitted. the line text in Parm 1 is printed with single spacing.
- Spacing Control when printing Parm 1
- __S1__ Space one line and print. (Omitted or blank is the same as S1.
- __S2__ Space two lines and print.
- __S3__ Space three lines and print.
- __S0__ Overprint current line.
- Defining - no lines are printed with this call.
- __*Hn__ Define heading line "n", where n is 1 to 9. Parm 1 can be all blanks to print a blank heading line.
- __*Hn:Sx__ Define heading line "n", where n is 1 to 9 and "x" is the number of lines to space, where
x is 0 to 3. S0 will overprint prior line.
- __*Hn:*P:Sx__ Page number will be printed at the end of this header line.
- Non Printing functions -
- __*CLOSE__ Close the print file. Must be done at the end of the report. Parm 1 is ignored.
- __*NEWPAGE__ Next line will print on a new page. Parm 1 is ignored.
Parm 2 values are separated by a "__:__" as in RPG. I used the new %SPLIT BIF to take apart Parm2 and put it into a variable length autosized array.
```
dcl-s ctlValues varchar(4) dim(*auto : 3);
%elem(ctlValues) = 0;
ctlValues = %split(wk_Ctl :':');
```
It is very easy to split up parms this way. You do need to be aware that and leading and trailing blanks are included in the array elements and you need to %TRIM them.

BIN
PRT_CL/images/DemoRpt_1.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 21 KiB

BIN
PRT_CL/images/DemoRpt_2.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 22 KiB

BIN
PRT_CL/images/PRTLN_command.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 9.0 KiB

BIN
PRT_CL/images/PRT_Demo_Rept.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 34 KiB

5
Printing/Readme.md
View File

@ -1,9 +1,8 @@
# Printing Techniques, from RPG and CL.
# (Under construction)
# Printing Techniques in RPG/**FREE
## Printing without O-Specs or Externally Defined Printer Files
IBM has made just about everything in free format RPG truly free format. Except O-specs. Instead of adding free format support for O-specs, IBM expects you to use a separately externally defined printer file. This can can do everything O-specs can, but is an extra object.
But you can print without needing an externally defined printer file.
But you can easily print without needing an externally defined printer file. Following is an explanation and two demonstration programs.
It turns out to be easy in free form RPG, writing from a data structure, with code like this:
```

4
README.md
View File

@ -46,6 +46,10 @@ Commands, with CLP and RPG programs, calling IBM i APis.
Commands, CLLE, SQLRPGLE using SQL access to APIs.
## Printing Techniques in RPG/**FREE
Printing without O-Specs or Externally Defined Printer Files
## GRP_JOB
Sets up group jobs suitable for an IBM i developer.