Note: See the AS/400 Web Pages Index at WebPages.htm.
Sample COBOL ILE source program - CBL003 (97 statements)
Columns . . . : 1 71 Browse AS580/QCBLSRC
SEU==> CBL003
FMT CB ......-A+++B+++++++++++++++++++++++++++++++++++++++++++++++++++
*. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ..
*************** Beginning of data *****************************
0001.00 IDENTIFICATION DIVISION.
0002.00 PROGRAM-ID. CBL003.
0003.00 AUTHOR. C O BOLLE.
0004.00 *REV 05 JANUARY 29, 2003.
0005.00 ENVIRONMENT DIVISION.
0006.00 CONFIGURATION SECTION.
0007.00 SOURCE-COMPUTER. IBM-AS400.
0008.00 OBJECT-COMPUTER. IBM-AS400.
0009.00 INPUT-OUTPUT SECTION.
0010.00 FILE-CONTROL.
0011.00 SELECT EMPPF1
0012.00 ASSIGN TO DISK-EMPPF
0013.00 ORGANIZATION IS SEQUENTIAL
0014.00 ACCESS IS SEQUENTIAL.
0015.00 SELECT PRTFILE
0016.00 ASSIGN TO PRINTER-QPRINT
0017.00 ORGANIZATION IS SEQUENTIAL.
0018.00 DATA DIVISION.
0019.00 FILE SECTION.
0020.00 FD EMPPF1
0021.00 RECORD CONTAINS 8 CHARACTERS.
0022.00 01 EMPREC1 PIC X(8).
0023.00 FD PRTFILE
0024.00 RECORD CONTAINS 40 CHARACTERS.
0025.00 01 PRTREC1 PIC X(40).
0026.00 WORKING-STORAGE SECTION.
0027.00 77 WSDATE PIC 9(6) VALUE ZEROES.
0028.00 77 WSTIME PIC 9(8) VALUE ZEROES.
0029.00 77 COUNT1 PIC 9999 VALUE ZEROES.
0030.00 01 WSEOF PIC X(1) VALUE "0".
0031.00 88 EMP-MORE-RECS VALUE "0".
0032.00 88 EMP-EOF VALUE "1".
0033.00 01 EMPRECA PIC X(8) VALUE "000XXX00".
0034.00 01 EMPRECB REDEFINES EMPRECA.
0035.00 05 INPNUM1 PIC 9(3).
0036.00 05 INPCHR1 PIC X(3).
0037.00 05 INPNUM2 PIC 9(2).
0038.00 01 PRTHDRA.
0039.00 05 FILLER PIC X(6) VALUE "DATE ".
0040.00 05 PRTDATE1 PIC 99/99/99 VALUE ZEROES.
0041.00 05 FILLER PIC X(2) VALUE SPACES.
0042.00 05 PRTTIME1 PIC 99B99B99B99 VALUE ZEROES.
0043.00 01 PRTDETA.
0044.00 05 FILLER PIC X(14) VALUE "NUM/CHR/NUM ".
0045.00 05 PRTNUM1 PIC 9(3) VALUE ZEROES.
0046.00 05 FILLER PIC X(1) VALUE SPACES.
0047.00 05 PRTCHR1 PIC X(3) VALUE SPACES.
0048.00 05 FILLER PIC X(1) VALUE SPACES.
0049.00 05 PRTNUM2 PIC 9(2) VALUE ZEROES.
0050.00 01 PRTTOTALA.
0051.00 05 FILLER PIC X(8) VALUE "TOTALS ".
0052.00 05 PRTCOUNT1 PIC ZZZZ VALUE ZEROES.
0053.00 PROCEDURE DIVISION.
0054.00 PROC001.
0055.00 DISPLAY "Begin CBL003".
0056.00 ACCEPT WSDATE FROM DATE.
0057.00 ACCEPT WSTIME FROM TIME.
0058.00 MOVE WSDATE TO PRTDATE1.
0059.00 MOVE WSTIME TO PRTTIME1.
0060.00 INSPECT PRTTIME1
0061.00 REPLACING ALL " " BY ":".
0062.00 MOVE "." TO PRTTIME1 (9:1).
0063.00 OPEN INPUT EMPPF1.
0064.00 OPEN OUTPUT PRTFILE.
0065.00 MOVE PRTHDRA TO PRTREC1.
0066.00 WRITE PRTREC1
0067.00 BEFORE ADVANCING 1 LINES
0068.00 END-WRITE.
0069.00 READ EMPPF1
0070.00 AT END MOVE "1" TO WSEOF
0071.00 END-READ.
0072.00 PERFORM UNTIL EMP-EOF
0073.00 ADD 1 TO COUNT1
0074.00 MOVE EMPREC1 TO EMPRECA
0075.00 MOVE INPNUM1 TO PRTNUM1
0076.00 MOVE INPCHR1 TO PRTCHR1
0077.00 MOVE INPNUM2 TO PRTNUM2
0078.00 MOVE PRTDETA TO PRTREC1
0079.00 WRITE PRTREC1
0080.00 BEFORE ADVANCING 1 LINES
0081.00 END-WRITE
0082.00 READ EMPPF1
0083.00 AT END MOVE "1" TO WSEOF
0084.00 END-READ
0085.00 IF COUNT1 GREATER THAN 8
0086.00 MOVE "1" TO WSEOF
0087.00 END-IF
0088.00 END-PERFORM.
0089.00 MOVE COUNT1 TO PRTCOUNT1.
0090.00 MOVE PRTTOTALA TO PRTREC1.
0091.00 WRITE PRTREC1
0092.00 BEFORE ADVANCING 1 LINES
0093.00 END-WRITE
0094.00 CLOSE EMPPF1 PRTFILE.
0095.00 DISPLAY "Count: " COUNT1.
0096.00 DISPLAY "End CBL003".
0097.00 STOP RUN.
*************** Ending of data ********************************
F3=Exit F5=Refresh F9=Retrieve F10=Cursor F11=Toggle F12=Cancel
F16=Repeat find F24=More keys
Note: Will you please send corrections, and suggestions for the
improvement of this initial AS/400 Cobol ILE documentation,
to me at patmoss@patmoss.com. Thank You!