Creating a journaling program in COBOL
GNU COBOL Version
The first version we'll take a look at is done using GNU COBOL. The source computer and target computer are both IBM-PC, allowing you to compile and run the program on an amd64 computer.
Getting Started with GNU COBOL
One of the joys of working with an older programming language is that you get to approach problems differently than how you might approach a modern application. There are certain idiosyncrasies which each programming language has that makes it unique. COBOL is no different. The way you set up the application and design the screen section can create some really intriguing interfaces that might otherwise be difficult in other languages. When it comes to raw data entry, these interfaces are much easier to navigate and key data.
We're going to start by using GNU COBOL to flesh out a journaling program that you can run on your home PC.
Prerequisites
Install GNU COBOL by running the following commands depending on your operating system:
# Fedora
$ dnf install gnucobol
# Ubuntu
$ apt install gnucobol
Identification Division
The identification division of the program is where we name the program using the PROGRAM-ID clause. We tell the compiler the source computer and the object computer, where the application is built from and where the application is run from.
IDENTIFICATION DIVISION
PROGRAM-ID. JOURNAL.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-PC.
OBJECT-COMPUTER. IBM-PC.
Special Names
Here we outline two data elements, which will come later, whose purpose is to capture the cursor position and screen status.
SPECIAL-NAMES. CURSOR IS CRSPOS.
CRT STATUS IS CRTSTAT.
Input/Output Section
At this point in the program we define the files which will be accessed. For our purposes, we will need to create a file called JRN which will be used to store the journal data.
$ touch JRN
Once we have created the JRN file, we will select the file using the handle JRN-MASTER. The organization of the file is indexed, meaning that it is a keyed file. Access is dynamic, which allows us to do both random reads and sequential reads. We set the record key to a data element called JRNDK and assign the return status into a data element called RETJRN.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT JRN-MASTER ASSIGN "./JRN"
ORGANIZATION INDEXED
ACCESS DYNAMIC
RECORD KEY JRNDK
FILE STATUS RETJRN.
Data Division
We're not quite done with the file just yet. In our Data Division, we need to define the file descriptor. For JRN-MASTER we define a level one data element called JRND which will be used to hold data read from the file. JRNDK is the key we assigned above. JRNDD holds the data read from the file which is not part of the key.
DATA DIVISION.
FILE SECTION.
FD JRN-MASTER
RECORD CONTAINS 1284 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS JRND.
01 JRND.
05 JRNDK PIC X(10).
05 JRNDD PIC X(1274).
Working-Storage Section
In our working-storage section, we create a data element called JRN which will be used to hold the data once it is moved from JRND. Here we define our key, JRNKEY and our data, JRNDATA. We use two group elements to define the update date and update time. This will allow us to construct the data in different formats later.
WORKING-STORAGE SECTION.
01 JRN.
05 JRNKEY.
10 JRNKYEAR PIC X(04).
10 JRNKMONTH PIC X(02).
10 JRNKDAY PIC X(02).
10 JRNKPAGE PIC X(02).
05 JRNDATA.
10 JRNUDATE.
15 JRNUCC PIC X(02).
15 JRNUYY PIC X(02).
15 JRNUMM PIC X(02).
15 JRNUDD PIC X(02).
10 JRNUTIME.
15 JRNUHR PIC X(02).
15 JRNUMN PIC X(02).
15 JRNUSC PIC X(02).
10 JRNUUSR PIC X(10).
10 JRNLINE1 PIC X(78).
10 JRNLINE2 PIC X(78).
10 JRNLINE3 PIC X(78).
10 JRNLINE4 PIC X(78).
10 JRNLINE5 PIC X(78).
10 JRNLINE6 PIC X(78).
10 JRNLINE7 PIC X(78).
10 JRNLINE8 PIC X(78).
10 JRNLINE9 PIC X(78).
10 JRNLINE10 PIC X(78).
10 JRNLINE11 PIC X(78).
10 JRNLINE12 PIC X(78).
10 JRNLINE13 PIC X(78).
10 JRNLINE14 PIC X(78).
10 JRNLINE15 PIC X(78).
10 JRNLINE16 PIC X(78).
Here we define our previously stated RETJRN, which holds the return code for the file.
01 RET.
05 RETJRN PIC X(02).
What would life be without a little color? We add values to data elements corresponding to each GNU COBOL color codes.
01 COLORS.
05 BLACK PIC 9 VALUE 0.
05 BLUE PIC 9 VALUE 1.
05 GREEN PIC 9 VALUE 2.
05 CYAN PIC 9 VALUE 3.
05 RED PIC 9 VALUE 4.
05 MAGENTA PIC 9 VALUE 5.
05 BROWN PIC 9 VALUE 6.
05 WHITE PIC 9 VALUE 7.
05 GREY PIC 9 VALUE 8.
05 LIGHT-BLUE PIC 9 VALUE 9.
05 LIGHT-GREEN PIC 99 VALUE 10.
05 LIGHT-CYAN PIC 99 VALUE 11.
05 LIGHT-RED PIC 99 VALUE 12.
05 LIGHT-MAGENTA PIC 99 VALUE 13.
05 YELLOW PIC 99 VALUE 14.
05 HI-WHITE PIC 99 VALUE 15.
In order to read the keys which are sent to the program, we must define them first. Here we do something similar to what we did with the colors, assigning each data element to its GNU COBOL value.
01 CFKEYS.
05 SUBMIT PIC 9(4) VALUE 0000.
05 CF1 PIC 9(4) VALUE 1001.
05 CF2 PIC 9(4) VALUE 1002.
05 CF3 PIC 9(4) VALUE 1003.
05 CF4 PIC 9(4) VALUE 1004.
05 CF5 PIC 9(4) VALUE 1005.
05 CF6 PIC 9(4) VALUE 1006.
05 CF7 PIC 9(4) VALUE 1007.
05 CF8 PIC 9(4) VALUE 1008.
05 CF9 PIC 9(4) VALUE 1009.
05 CF10 PIC 9(4) VALUE 1010.
05 CF11 PIC 9(4) VALUE 1011.
05 CF12 PIC 9(4) VALUE 1012.
05 CF13 PIC 9(4) VALUE 1013.
05 CF14 PIC 9(4) VALUE 1014.
05 CF15 PIC 9(4) VALUE 1015.
05 CF16 PIC 9(4) VALUE 1016.
05 CF17 PIC 9(4) VALUE 1017.
05 CF18 PIC 9(4) VALUE 1018.
05 CF19 PIC 9(4) VALUE 1019.
05 CF20 PIC 9(4) VALUE 1020.
05 CF21 PIC 9(4) VALUE 1021.
05 CF22 PIC 9(4) VALUE 1022.
05 CF23 PIC 9(4) VALUE 1023.
05 CF24 PIC 9(4) VALUE 1024.
Here we define our cursor position which was listed in the special names clause. We do a little redefine to allow us to access the cursor Y and X positions independently. Redefining allows you to create additional data elements which "overlay" the existing data element.
01 CRSPOS PIC 9(6).
01 CRSXY REDEFINES CRSPOS.
05 CRSPOSY PIC 999.
05 CRSPOSX PIC 999.
Another data element referenced in the special names clause, which we use to hold the screen status.
01 CRTSTAT PIC 9(4).
At some point in the program, we are going to accept the current date and time. We will need a place to hold this information, so we define two new data groups NOWD and NOWT similar to JRNUDATE and JRNUTIME from before.
01 NOWD.
05 NOWDCC PIC X(02).
05 NOWDYY PIC X(02).
05 NOWDMM PIC X(02).
05 NOWDDD PIC X(02).
01 NOWT.
05 NOWTHR PIC X(02).
05 NOWTMN PIC X(02).
05 NOWTSC PIC X(02).
05 NOWTNS PIC X(02).
When working with the screen we want to be able to read data in and out of the screen. We define some passthrough data elements to read/write data from/to the screen along with some additional data points like a message.
01 PT.
05 PT-MSG PIC X(50).
05 PT-YEAR PIC X(04).
05 PT-MONTH PIC X(02).
05 PT-DAY PIC X(02).
05 PT-PAGE PIC X(02).
05 PT-LN1 PIC X(78).
05 PT-LN2 PIC X(78).
05 PT-LN3 PIC X(78).
05 PT-LN4 PIC X(78).
05 PT-LN5 PIC X(78).
05 PT-LN6 PIC X(78).
05 PT-LN7 PIC X(78).
05 PT-LN8 PIC X(78).
05 PT-LN9 PIC X(78).
05 PT-LN10 PIC X(78).
05 PT-LN11 PIC X(78).
05 PT-LN12 PIC X(78).
05 PT-LN13 PIC X(78).
05 PT-LN14 PIC X(78).
05 PT-LN15 PIC X(78).
05 PT-LN16 PIC X(78).
Here we define NEWKEY which contains the newly entered key.
01 NEWKEY.
05 NEWKYEAR PIC X(04).
05 NEWKMONTH PIC X(02).
05 NEWKDAY PIC X(02).
05 NEWKPAGE PIC X(02).
Here we define OLDKEY which contains the previously entered key.
01 OLDKEY.
05 OLDKYEAR PIC X(04).
05 OLDKMONTH PIC X(02).
05 OLDKDAY PIC X(02).
05 OLDKPAGE PIC X(02).
Screen Section
Arguably the most fun part of a GNU COBOL program is the screen section. Although the next section may seem a little daunting, it is based upon a few basic building blocks. We define a CLEAR-SCREEN data element which holds a blank screen. This is used to clear the screen. After that we define our panel, which contains quite a few fixed fields denoted by the VALUE clause with no data element name. Each 05 element can contain a data element name such as PANEL-YEAR. This allows us to reference the field later. The LINE clause sets which line the field appears. The COL clause sets which column the field appears. The FOREGROUND-COLOR and BACKGROUND-COLOR clauses use the previously defined colors to set the field colors. The picture (PIC) clause defines the length of the field. The TO and FROM clauses are used to pass data through our pass-through elements
SCREEN SECTION.
01 CLEAR-SCREEN.
05 BLANK SCREEN.
01 PANEL.
05 VALUE "Journal"
LINE 01 COL 38
FOREGROUND-COLOR IS HI-WHITE.
05 VALUE "Year:"
LINE 02 COL 02
FOREGROUND-COLOR IS BLUE.
05 PANEL-YEAR
LINE 02 COL 08
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(04) TO PT-YEAR
FROM PT-YEAR.
05 VALUE "Month:"
LINE 02 COL 13
FOREGROUND-COLOR IS BLUE.
05 PANEL-MONTH
LINE 02 COL 20
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(02) TO PT-MONTH
FROM PT-MONTH.
05 VALUE "Day:"
LINE 02 COL 23
FOREGROUND-COLOR IS BLUE.
05 PANEL-DAY
LINE 02 COL 28
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(02) TO PT-DAY
FROM PT-DAY.
05 VALUE "Page:"
LINE 02 COL 31
FOREGROUND-COLOR IS BLUE.
05 PANEL-PAGE
LINE 02 COL 37
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(02) TO PT-PAGE
FROM PT-PAGE.
05 VALUE "_______________________________"
LINE 03 COL 01
FOREGROUND-COLOR IS BLUE.
05 VALUE "_______________________________"
LINE 03 COL 31
FOREGROUND-COLOR IS BLUE.
05 VALUE "____________________"
LINE 03 COL 61
FOREGROUND-COLOR IS BLUE.
05 PANEL-LN1
LINE 05 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN1
FROM PT-LN1.
05 PANEL-LN2
LINE 06 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN2
FROM PT-LN2.
05 PANEL-LN3
LINE 07 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN3
FROM PT-LN3.
05 PANEL-LN4
LINE 08 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN4
FROM PT-LN4.
05 PANEL-LN5
LINE 09 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN5
FROM PT-LN5.
05 PANEL-LN6
LINE 10 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN6
FROM PT-LN6.
05 PANEL-LN7
LINE 11 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN7
FROM PT-LN7.
05 PANEL-LN8
LINE 12 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN7
FROM PT-LN7.
05 PANEL-LN9
LINE 13 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN8
FROM PT-LN8.
05 PANEL-LN10
LINE 14 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN10
FROM PT-LN10.
05 PANEL-LN11
LINE 15 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN11
FROM PT-LN11.
05 PANEL-LN12
LINE 16 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN12
FROM PT-LN12.
05 PANEL-LN13
LINE 17 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN13
FROM PT-LN13.
05 PANEL-LN14
LINE 18 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN14
FROM PT-LN14.
05 PANEL-LN15
LINE 19 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN15
FROM PT-LN15.
05 PANEL-LN16
LINE 20 COL 02
UNDERLINE
FOREGROUND-COLOR IS GREEN
PIC X(78) TO PT-LN16
FROM PT-LN16.
05 VALUE "F3=Exit"
FOREGROUND-COLOR IS BLACK
BACKGROUND-COLOR IS WHITE
LINE 23 COL 10.
05 VALUE "F12=Esc"
FOREGROUND-COLOR IS BLACK
BACKGROUND-COLOR IS WHITE
LINE 23 COL 74.
05 PANEL-DATE-MM
FROM NOWDMM
LINE 24 COL 01.
05 VALUE "/"
LINE 24 COL 03.
05 PANEL-DATE-DD
FROM NOWDDD
LINE 24 COL 04.
05 VALUE "/"
LINE 24 COL 06.
05 PANEL-DATE-CC
FROM NOWDCC
LINE 24 COL 07.
05 PANEL-DATE-YY
FROM NOWDYY
LINE 24 COL 09.
05 PANEL-TIME-HR
FROM NOWTHR
LINE 24 COL 13.
05 VALUE ":"
LINE 24 COL 15.
05 PANEL-TIME-MN
FROM NOWTMN
LINE 24 COL 16.
05 VALUE ":"
LINE 24 COL 18.
05 PANEL-TIME-SC
FROM NOWTSC
LINE 24 COL 19.
05 VALUE "."
LINE 24 COL 21.
05 PANEL-TIME-NS
FROM NOWTNS
LINE 24 COL 22.
05 PANEL-MSG
FOREGROUND-COLOR IS HI-WHITE
FROM PT-MSG
LINE 24 COL 26.
05 PANEL-POSX
FOREGROUND-COLOR IS HI-WHITE
FROM CRSPOSX
LINE 24 COL 74.
05 VALUE "/"
LINE 24 COL 77.
05 PANEL-POSY
FOREGROUND-COLOR IS HI-WHITE
FROM CRSPOSY
LINE 24 COL 78.
Procedure Division
Now to the meat and potatoes of the program. First we create a declaratives section which we use to catch and discard errors on the file.
PROCEDURE DIVISION.
DECLARATIVES.
000-ERROR SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON JRN-MASTER.
000-ERRORED.
CONTINUE.
END DECLARATIVES.
The main section performs several routines to initiate the program. Then displays the panel, accepts input from the panel, checks the screen status against several CF keys and moves the keyed data into the NEWKEY. If the new key does not equal the old key, we will display the new record, else we update the data.
000-MAIN.
PERFORM 999-OPEN THRU 999-OPEN-EXIT.
000-LOOP.
PERFORM 999-TIMESTAMP THRU 999-TIMESTAMP-EXIT.
PERFORM 000-INIT THRU 000-EXIT.
DISPLAY PANEL.
ACCEPT PANEL.
IF (CRTSTAT = CF3)
GO TO 000-EOJ.
IF (CRTSTAT = CF12)
GO TO 000-EOJ.
MOVE SPACES TO PT-MSG
MOVE PT-YEAR TO NEWKYEAR
MOVE PT-MONTH TO NEWKMONTH
MOVE PT-DAY TO NEWKDAY
MOVE PT-PAGE TO NEWKPAGE
IF NEWKEY NOT = OLDKEY
PERFORM 100-DISPLAY THRU 100-EXIT
ELSE
PERFORM 300-UPDATE THRU 300-EXIT.
GO TO 000-LOOP.
000-EOJ.
GO TO 999-CLOSE.
000-INIT.
IF (PT-YEAR = SPACES)
MOVE NOWDCC TO PT-YEAR (1:2)
MOVE NOWDYY TO PT-YEAR (3:2).
IF (PT-MONTH = SPACES)
MOVE NOWDMM TO PT-MONTH.
IF (PT-DAY = SPACES)
MOVE NOWDDD TO PT-DAY.
IF (PT-PAGE = SPACES)
MOVE '01' TO PT-PAGE.
000-EXIT.
EXIT.
In the display routine we load the new key into the file key, read the file accordingly, and move the data to the screen or display a message on error.
100-DISPLAY.
MOVE NEWKEY TO OLDKEY
MOVE NEWKYEAR TO JRNKEY
MOVE NEWKMONTH TO JRNKMONTH
MOVE NEWKDAY TO JRNKDAY
MOVE NEWKPAGE TO JRNKPAGE
MOVE JRNKEY TO JRNDK
READ JRN-MASTER
IF RETJRN NOT = '00'
INITIALIZE JRND
MOVE "Record Not Found. Type Data to Create." TO PT-MSG.
MOVE JRND TO JRN
MOVE JRNLINE1 TO PT-LN1
MOVE JRNLINE2 TO PT-LN2
MOVE JRNLINE3 TO PT-LN3
MOVE JRNLINE4 TO PT-LN4
MOVE JRNLINE5 TO PT-LN5
MOVE JRNLINE6 TO PT-LN6
MOVE JRNLINE7 TO PT-LN7
MOVE JRNLINE8 TO PT-LN8
MOVE JRNLINE9 TO PT-LN9
MOVE JRNLINE10 TO PT-LN10
MOVE JRNLINE11 TO PT-LN11
MOVE JRNLINE12 TO PT-LN12
MOVE JRNLINE13 TO PT-LN13
MOVE JRNLINE14 TO PT-LN14
MOVE JRNLINE15 TO PT-LN15
MOVE JRNLINE16 TO PT-LN16.
100-EXIT.
EXIT.
On the update procedure, we move the new key to the old key, read the record for existing data, move the data from the panel into the file data, timestamp the data, and write to the file displaying a message according to how the write proceeded.
300-UPDATE.
MOVE NEWKEY TO OLDKEY
MOVE NEWKYEAR TO JRNKEY
MOVE NEWKMONTH TO JRNKMONTH
MOVE NEWKDAY TO JRNKDAY
MOVE NEWKPAGE TO JRNKPAGE
MOVE JRNKEY TO JRNDK
READ JRN-MASTER
IF RETJRN = '00'
MOVE JRND TO JRN
ELSE
INITIALIZE JRND.
MOVE PT-YEAR TO JRNKYEAR
MOVE PT-MONTH TO JRNKMONTH
MOVE PT-DAY TO JRNKDAY
MOVE PT-PAGE TO JRNKPAGE
MOVE PT-LN1 TO JRNLINE1
MOVE PT-LN2 TO JRNLINE2
MOVE PT-LN3 TO JRNLINE3
MOVE PT-LN4 TO JRNLINE4
MOVE PT-LN5 TO JRNLINE5
MOVE PT-LN6 TO JRNLINE6
MOVE PT-LN7 TO JRNLINE7
MOVE PT-LN8 TO JRNLINE8
MOVE PT-LN9 TO JRNLINE9
MOVE PT-LN10 TO JRNLINE10
MOVE PT-LN11 TO JRNLINE11
MOVE PT-LN12 TO JRNLINE12
MOVE PT-LN13 TO JRNLINE13
MOVE PT-LN14 TO JRNLINE14
MOVE PT-LN15 TO JRNLINE15
MOVE PT-LN16 TO JRNLINE16
PERFORM 999-TIMESTAMP THRU 999-TIMESTAMP-EXIT
MOVE NOWDCC TO JRNUCC
MOVE NOWDYY TO JRNUYY
MOVE NOWDMM TO JRNUMM
MOVE NOWDDD TO JRNUDD
MOVE NOWTHR TO JRNUHR
MOVE NOWTMN TO JRNUMN
MOVE NOWTSC TO JRNUSC
MOVE JRN TO JRND
IF RETJRN NOT = '00'
MOVE 'Record Created' TO PT-MSG
WRITE JRND
ELSE
MOVE 'Record Updated' TO PT-MSG
READ JRN-MASTER
MOVE JRN TO JRND
REWRITE JRND.
300-EXIT.
EXIT.
Finally, in our last section we create the routines for accepting the data into the timestamp variables, opening and closing the file.
999-TIMESTAMP.
ACCEPT NOWD FROM DATE YYYYMMDD
ACCEPT NOWT FROM TIME.
999-TIMESTAMP-EXIT.
EXIT.
999-OPEN.
OPEN I-O SHARING WITH ALL OTHER JRN-MASTER.
999-OPEN-EXIT.
EXIT.
999-CLOSE.
CLOSE JRN-MASTER.
IF (RETJRN NOT = '00')
DISPLAY "ERROR: Could not close data file.".
STOP RUN.
Once you have entered the source, compile the program with the following command and run it:
$ cobc -x journal.cob -o journal
$ ./journal
You should see the following interface:
The final source code can be found here.
IBM iSeries Version
We will need to create a file to hold our source code. Run the following command to create a source physical file in your current library. If you want to use a different library than your current library, qualify the library when running the command.
CRTSRCPF FILE(JOURNAL) TEXT('Journal Program')
Start the programming development manager with the following command:
STRPDM
Take option 3 (Work with members). The FILE parameter will be JOURNAL and library will be *CURLIB or whichever library you specified previously. Press F6 to create a new member. This member will contain the source code for the physical file. The SRCMBR parameter will be JOURNALP. The TYPE parameter will be PF for Physical File. The TEXT parameter will be 'Journal Physical File'. Hit enter to confirm and the Source Entry Utility will start.
Physical File
We start off by defining our physical file. The UNIQUE keyword signifies that each key in the file will be unique. We define the record as JRN and define subsequent columns and data types. All data types are A which means character data. At the end of the physical file we define the key which consists of the year, month, day, and page. Enter the following source into the Source Entry Utility.
A UNIQUE
A R JRN
A JRNKYEAR 4A
A JRNKMONTH 2A
A JRNKDAY 2A
A JRNKPAGE 2A
A JRNUDATE 8A
A JRNUTIME 6A
A JRNUUSR 10A
A JRNLINE1 78A
A JRNLINE2 78A
A JRNLINE3 78A
A JRNLINE4 78A
A JRNLINE5 78A
A JRNLINE6 78A
A JRNLINE7 78A
A JRNLINE8 78A
A JRNLINE9 78A
A JRNLINE10 78A
A JRNLINE11 78A
A JRNLINE12 78A
A JRNLINE13 78A
A JRNLINE14 78A
A JRNLINE15 78A
A JRNLINE16 78A
A K JRNKYEAR
A K JRNKMONTH
A K JRNKDAY
A K JRNKPAGE
Press F3 to exit and hit enter to confirm you wish to save the member. Now we are going to create the physical file. Run the command below to create the physical file.
CRTPF FILE(JOURNALP) SRCFILE(JOURNAL) SRCMBR(JOURNALP)
Press F6 to create a new member. This member will contain the source code for the logical file. The SRCMBR parameter will be JOURNALO1. The TYPE parameter will be LF for Logical File. The TEXT parameter will be 'Journal Logical File'. Hit enter to confirm and the Source Entry Utility will start.
Logical File
Next we define our logical file. The UNIQUE keyword signifies that each key in the file will be unique. We define the record as JRN with the PFILE function pointing to our physical file and define subsequent columns. At the end of the logical file we define the key which consists of the year, month, day, and page. Enter the following source into the Source Entry Utility.
A UNIQUE
A R JRN PFILE(JOURNALP)
A JRNKYEAR
A JRNKMONTH
A JRNKDAY
A JRNKPAGE
A JRNUDATE
A JRNUTIME
A JRNUUSR
A JRNLINE1
A JRNLINE2
A JRNLINE3
A JRNLINE4
A JRNLINE5
A JRNLINE6
A JRNLINE7
A JRNLINE8
A JRNLINE9
A JRNLINE10
A JRNLINE11
A JRNLINE12
A JRNLINE13
A JRNLINE14
A JRNLINE15
A JRNLINE16
A K JRNKYEAR
A K JRNKMONTH
A K JRNKDAY
A K JRNKPAGE
Press F3 to exit and hit enter to confirm you wish to save the member. Now we are going to create the logical file. Run the command below to create the logical file.
CRTLF FILE(JOURNALO1) SRCFILE(JOURNAL) SRCMBR(JOURNALO1) SHARE(*YES)
Display Map
Next we define our display map. We first define the display size, the indicator area, and the keys which we will use to interact with the screen. Then we define the record JOURNAL, the fields on the display map and the indicators which map to which attributes on the display.
A DSPSIZ(24 80 *DS3)
A PRINT
A INDARA
A CF01(01)
A CF02(02)
A CF03(03)
A CF04(04)
A CF05(05)
A CF06(06)
A CF07(07)
A CF08(08)
A CF09(09)
A CF10(10)
A CF11(11)
A CF12(12)
A ROLLUP(08)
A ROLLDOWN(07)
A HELP(01)
A VLDCMDKEY(14)
A R JOURNAL
A KEEP
A CSRLOC(LINNBR POSNBR)
A OVERLAY
A PROTECT
A LINNBR 3S 0H
A POSNBR 3S 0H
A 3 2'Year:'
A COLOR(BLU)
A MYEAR 4A B 3 8
A 01 DSPATR(RI)
A 01 DSPATR(PC)
A 01 COLOR(RED)
A 3 14'Month:'
A COLOR(BLU)
A MMONTH 2A B 3 21
A 02 DSPATR(RI)
A 02 DSPATR(PC)
A 02 COLOR(RED)
A COLOR(BLU)
A MDAY 2A B 3 30
A 03 DSPATR(RI)
A 03 DSPATR(PC)
A 03 COLOR(RED)
A 1 37'Journal'
A COLOR(WHT)
A 4 1'__________________________________-
A ___________________________________-
A ___________'
A COLOR(BLU)
A 3 34'Page:'
A COLOR(BLU)
A MPAGE 2A B 3 40
A 04 DSPATR(RI)
A 04 DSPATR(PC)
A 04 COLOR(RED)
A MLN1 78 B 6 2CHECK(LC)
A MLN2 78A B 7 2CHECK(LC)
A MLN3 78A B 8 2CHECK(LC)
A MLN4 78A B 9 2CHECK(LC)
A MLN5 78A B 10 2CHECK(LC)
A MLN6 78A B 11 2CHECK(LC)
A MLN7 78A B 12 2CHECK(LC)
A MLN8 78A B 13 2CHECK(LC)
A MLN9 78A B 14 2CHECK(LC)
A MLN10 78A B 15 2CHECK(LC)
A MLN11 78A B 16 2CHECK(LC)
A MLN12 78A B 17 2CHECK(LC)
A MLN13 78A B 18 2CHECK(LC)
A MLN14 78A B 19 2CHECK(LC)
A MLN15 78A B 20 2CHECK(LC)
A MLN16 78A B 21 2CHECK(LC)
A 23 2' 2=Cur 3=Exit -
A 7=Bwd 8=Fwd 10=Del -
A 12=Esc'
A COLOR(BLU)
A MMSG 46A B 24 2CHGINPDFT
A DSPATR(HI)
A DSPATR(PR)
A 24 49'Upd'
A COLOR(BLU)
A MUDATE 10A B 24 53CHGINPDFT
A DSPATR(PR)
A COLOR(BLU)
A MUTIME 8A B 24 64CHGINPDFT
A DSPATR(PR)
A COLOR(BLU)
A MUSR 8A B 24 73CHGINPDFT
A DSPATR(PR)
A COLOR(BLU)
Press F3 to exit and hit enter to confirm you wish to save the member. Now we are going to create the display file. Run the command below to create the display file.
CRTDSPF FILE(MPJOURNAL) SRCFILE(*CURLIB/JOURNAL) SRCMBR(*FILE) SHARE(*YES)
COBOL Program
Next we define our COBOL program. In our file control section, we assign the display and the journal file. In the file section we write our file descriptors and their associated storage sections. In the working-storage section we define a number of data elements which we use throughout the program. These range from date/time to indicators to keys and storage for writing to the file. In the main section, we write the display and determine whether to update or display data. This will invoke either the 100-DISPLAY or 300-UPDATE sections. In the 100-DISPLAY procedure we write data from the file to the screen. In the 300-UPDATE procedure we write data from the screen to the file. The 990-EOJ procedure handles the input keys and runs the associated procedure based on which key was pressed.
IDENTIFICATION DIVISION.
PROGRAM-ID. JOURNAL.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. AS-400.
OBJECT-COMPUTER. AS-400.
SPECIAL-NAMES.
I-O-FEEDBACK IS PNL-FEEDBACK.
*****************************************************************
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*
SELECT PNL-PANEL ASSIGN WORKSTATION-MPJOURNAL
ORGANIZATION TRANSACTION
CONTROL-AREA PNLCTL
FILE STATUS RETPNL.
*
SELECT JRN-MASTER ASSIGN DATABASE-JOURNALO1
ORGANIZATION INDEXED
ACCESS DYNAMIC
RECORD KEY JRNDK
FILE STATUS RETJRN.
*****************************************************************
DATA DIVISION.
FILE SECTION.
*
FD PNL-PANEL.
01 PNL.
COPY DDS-JOURNAL-O OF MPJOURNAL.
*
FD JRN-MASTER
RECORD CONTAINS 1282 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS JRND.
01 JRND.
05 JRNDK PIC X(10).
05 JRNDD PIC X(1272).
*****************************************************************
WORKING-STORAGE SECTION.
*
01 RET.
05 RETPNL PIC X(02).
05 RETJRN PIC X(02).
*
01 WRKAREA.
05 WRKERR PIC X(01).
05 WRKDATE.
10 WRKYY PIC X(02).
10 WRKMM PIC X(02).
10 WRKDD PIC X(02).
05 WRKTIME.
10 WRKHR PIC X(02).
10 WRKMN PIC X(02).
10 WRKSC PIC X(02).
05 DSPDATE.
10 DSPMM PIC X(02).
10 FILLER PIC X(01) VALUE '/'.
10 DSPDD PIC X(02).
10 FILLER PIC X(01) VALUE '/'.
10 DSPCCYY.
15 DSPCC PIC X(02).
15 DSPYY PIC X(02).
05 DSPTIME.
10 DSPHR PIC X(02).
10 FILLER PIC X(01) VALUE ':'.
10 DSPMN PIC X(02).
10 FILLER PIC X(01) VALUE ':'.
10 DSPSC PIC X(02).
*
01 PNLCTL.
05 PNLFUNCKEY PIC X(02).
05 PNLTRMID PIC X(10).
05 PNLFORMAT PIC X(10).
*
01 IND.
05 INDAREA OCCURS 99 TIMES INDEXED BY IND1
PIC 1 INDICATOR 1.
88 INDOFF VALUE B'0'.
88 INDON VALUE B'1'.
*
01 INDUSED.
05 CF01 PIC 9(02) VALUE 01.
05 CF02 PIC 9(02) VALUE 02.
05 CF03 PIC 9(02) VALUE 03.
05 CF04 PIC 9(02) VALUE 04.
05 CF05 PIC 9(02) VALUE 05.
05 CF06 PIC 9(02) VALUE 06.
05 CF07 PIC 9(02) VALUE 07.
05 CF08 PIC 9(02) VALUE 08.
05 CF09 PIC 9(02) VALUE 09.
05 CF10 PIC 9(02) VALUE 10.
05 CF11 PIC 9(02) VALUE 11.
05 CF12 PIC 9(02) VALUE 12.
05 CLEAR PIC 9(02) VALUE 13.
05 ROLLUP PIC 9(02) VALUE 08.
05 ROLLDOWN PIC 9(02) VALUE 07.
05 HELP PIC 9(02) VALUE 01.
05 VLDCMDKEY PIC 9(02) VALUE 14.
*
01 NEWKEY.
05 NEWYEAR.
10 NEWYEARF PIC X(02).
10 NEWYEART PIC X(02).
05 NEWMONTH PIC X(02).
05 NEWDAY PIC X(02).
05 NEWPAGE PIC X(02).
*
01 OLDKEY.
05 OLDYEAR.
10 OLDYEARF PIC X(02).
10 OLDYEART PIC X(02).
05 OLDMONTH PIC X(02).
05 OLDDAY PIC X(02).
05 OLDPAGE PIC X(02).
*
01 JRN.
05 JRNKEY.
10 JRNKYEAR PIC X(04).
10 JRNKMONTH PIC X(02).
10 JRNKDAY PIC X(02).
10 JRNKPAGE PIC X(02).
05 JRNDATA.
10 JRNUDATE.
15 JRNUCC PIC X(02).
15 JRNUYY PIC X(02).
15 JRNUMM PIC X(02).
15 JRNUDD PIC X(02).
10 JRNUTIME.
15 JRNUHR PIC X(02).
15 JRNUMN PIC X(02).
15 JRNUSC PIC X(02).
10 JRNUUSR PIC X(10).
10 JRNLINE1 PIC X(78).
10 JRNLINE2 PIC X(78).
10 JRNLINE3 PIC X(78).
10 JRNLINE4 PIC X(78).
10 JRNLINE5 PIC X(78).
10 JRNLINE6 PIC X(78).
10 JRNLINE7 PIC X(78).
10 JRNLINE8 PIC X(78).
10 JRNLINE9 PIC X(78).
10 JRNLINE10 PIC X(78).
10 JRNLINE11 PIC X(78).
10 JRNLINE12 PIC X(78).
10 JRNLINE13 PIC X(78).
10 JRNLINE14 PIC X(78).
10 JRNLINE15 PIC X(78).
10 JRNLINE16 PIC X(78).
*****************************************************************
PROCEDURE DIVISION.
DECLARATIVES.
000-ERROR SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON
PNL-PANEL JRN-MASTER.
000-ENCOUNTERED.
CONTINUE.
END DECLARATIVES.
*****************************************************************
000-MAIN SECTION.
PERFORM 900-HOUSE THRU 900-EXIT.
000-LOOP.
PERFORM 095-INIT THRU 095-EXIT
WRITE PNL FORMAT IS 'JOURNAL'
INDICATORS ARE IND
READ PNL-PANEL RECORD
INDICATORS ARE IND
MOVE ZEROS TO LINNBR POSNBR
MOVE MYEAR TO NEWYEAR
MOVE MMONTH TO NEWMONTH
MOVE MDAY TO NEWDAY
MOVE MPAGE TO NEWPAGE
IF (INDON (VLDCMDKEY))
PERFORM 990-EOJ THRU 990-EXIT
ELSE
IF NEWKEY NOT = OLDKEY
PERFORM 100-DISPLAY THRU 100-EXIT
ELSE
PERFORM 300-UPDATE THRU 300-EXIT.
GO TO 000-LOOP.
*****************************************************************
095-INIT.
IF MYEAR <= SPACES
MOVE '20' TO MYEAR (1:2)
MOVE WRKYY TO MYEAR (3:2).
IF MMONTH <= SPACES
MOVE WRKMM TO MMONTH.
IF MDAY <= SPACES
MOVE WRKDD TO MDAY.
IF MPAGE <= SPACES
MOVE '01' TO MPAGE.
095-EXIT.
EXIT.
*****************************************************************
100-DISPLAY.
MOVE ZEROS TO IND
MOVE 'N' TO WRKERR
MOVE SPACES TO PNL
MOVE LOW-VALUES TO OLDKEY
MOVE NEWYEAR TO MYEAR
MOVE NEWMONTH TO MMONTH
MOVE NEWDAY TO MDAY
MOVE NEWPAGE TO MPAGE
MOVE NEWKEY TO OLDKEY
MOVE NEWYEAR TO JRNKYEAR
MOVE NEWMONTH TO JRNKMONTH
MOVE NEWDAY TO JRNKDAY
MOVE NEWPAGE TO JRNKPAGE
MOVE JRNKEY TO JRNDK
READ JRN-MASTER
IF RETJRN NOT = '00'
INITIALIZE JRNDATA
ELSE
MOVE JRND TO JRN.
MOVE JRNLINE1 TO MLN1
MOVE JRNLINE2 TO MLN2
MOVE JRNLINE3 TO MLN3
MOVE JRNLINE4 TO MLN4
MOVE JRNLINE5 TO MLN5
MOVE JRNLINE6 TO MLN6
MOVE JRNLINE7 TO MLN7
MOVE JRNLINE8 TO MLN8
MOVE JRNLINE9 TO MLN9
MOVE JRNLINE10 TO MLN10
MOVE JRNLINE11 TO MLN11
MOVE JRNLINE12 TO MLN12
MOVE JRNLINE13 TO MLN13
MOVE JRNLINE14 TO MLN14
MOVE JRNLINE15 TO MLN15
MOVE JRNLINE16 TO MLN16
MOVE JRNUMM TO DSPMM
MOVE JRNUDD TO DSPDD
MOVE JRNUCC TO DSPCC
MOVE JRNUYY TO DSPYY
MOVE JRNUHR TO DSPHR
MOVE JRNUMN TO DSPMN
MOVE JRNUSC TO DSPSC
MOVE DSPDATE TO MUDATE
MOVE DSPTIME TO MUTIME
MOVE JRNUUSR TO MUSR
MOVE 'Record Displayed. (Update)' TO MMSG.
100-EXIT.
EXIT.
*****************************************************************
300-UPDATE.
MOVE NEWKEY TO OLDKEY
MOVE ZEROS TO IND
MOVE 'N' TO WRKERR
MOVE NEWYEAR TO JRNKYEAR
MOVE NEWMONTH TO JRNKMONTH
MOVE NEWDAY TO JRNKDAY
MOVE NEWPAGE TO JRNKPAGE
MOVE JRNKEY TO JRNDK
READ JRN-MASTER
IF RETJRN = '00'
MOVE JRND TO JRN
ELSE
INITIALIZE JRNDATA
MOVE JRN TO JRND.
MOVE MLN1 TO JRNLINE1
MOVE MLN2 TO JRNLINE2
MOVE MLN3 TO JRNLINE3
MOVE MLN4 TO JRNLINE4
MOVE MLN5 TO JRNLINE5
MOVE MLN6 TO JRNLINE6
MOVE MLN7 TO JRNLINE7
MOVE MLN8 TO JRNLINE8
MOVE MLN9 TO JRNLINE9
MOVE MLN10 TO JRNLINE10
MOVE MLN11 TO JRNLINE11
MOVE MLN12 TO JRNLINE12
MOVE MLN13 TO JRNLINE13
MOVE MLN14 TO JRNLINE14
MOVE MLN15 TO JRNLINE15
MOVE MLN16 TO JRNLINE16
IF WRKERR NOT = 'N'
MOVE 'Error Updating Record.' TO MMSG
GO TO 300-EXIT.
IF JRND = JRN
MOVE 'No Change.' TO MMSG
ELSE
ACCEPT WRKTIME FROM TIME
MOVE WRKYY TO DSPYY JRNUYY
IF WRKYY > '50'
MOVE '19' TO DSPCC JRNUCC
ELSE
MOVE '20' TO DSPCC JRNUCC
END-IF
MOVE WRKMM TO DSPMM JRNUMM
MOVE WRKDD TO DSPDD JRNUDD
MOVE WRKHR TO DSPHR JRNUHR
MOVE WRKMN TO DSPMN JRNUMN
MOVE WRKSC TO DSPSC JRNUSC
MOVE DSPDATE TO MUDATE
MOVE DSPTIME TO MUTIME
MOVE 'ANON' TO MUSR JRNUUSR
MOVE JRN TO JRND
IF RETJRN NOT = '00'
MOVE 'Record Created.' TO MMSG
WRITE JRND
ELSE
MOVE 'Record Updated.' TO MMSG
READ JRN-MASTER
MOVE JRN TO JRND
REWRITE JRND.
300-EXIT.
EXIT.
*****************************************************************
900-HOUSE.
ACCEPT WRKDATE FROM DATE
OPEN I-O PNL-PANEL JRN-MASTER.
IF (RETPNL NOT = '00' AND '41') OR
(RETJRN NOT = '00' AND '41')
STOP RUN.
900-EXIT.
EXIT.
*****************************************************************
990-EOJ.
IF INDON (CF02)
MOVE '20' TO NEWYEAR (1:2)
MOVE WRKYY TO NEWYEAR (3:2)
MOVE WRKMM TO NEWMONTH
MOVE WRKDD TO NEWDAY
MOVE '01' TO NEWPAGE
PERFORM 100-DISPLAY THRU 100-EXIT
ELSE
IF INDON (CF03)
STOP RUN
ELSE
IF INDON (CF07)
PERFORM 993-BKWD THRU 993-EXIT
GO TO 990-EXIT
ELSE
IF INDON (CF08)
PERFORM 994-FWD THRU 994-EXIT
GO TO 990-EXIT
ELSE
IF INDON (CF10)
PERFORM 995-DEL THRU 995-EXIT
GO TO 990-EXIT
ELSE
IF INDON (CF12)
STOP RUN
ELSE
GO TO 990-EXIT.
990-EXIT.
EXIT.
*****************************************************************
993-BKWD.
MOVE NEWYEAR TO JRNKYEAR
MOVE NEWMONTH TO JRNKMONTH
MOVE NEWDAY TO JRNKDAY
MOVE NEWPAGE TO JRNKPAGE
MOVE JRNKEY TO JRNDK
READ JRN-MASTER
IF RETJRN NOT = '00'
START JRN-MASTER KEY > JRNDK.
READ JRN-MASTER PRIOR
IF RETJRN NOT = '00'
MOVE SPACES TO JRNKEY
MOVE JRNKEY TO JRND
START JRN-MASTER KEY > JRNDK
READ JRN-MASTER NEXT.
MOVE JRND TO JRN
IF RETJRN = '00'
MOVE JRNKYEAR TO NEWYEAR
MOVE JRNKMONTH TO NEWMONTH
MOVE JRNKDAY TO NEWDAY
MOVE JRNKPAGE TO NEWPAGE
PERFORM 100-DISPLAY THRU 100-EXIT
ELSE
MOVE 'No previous records.' TO MMSG.
993-EXIT.
EXIT.
*****************************************************************
994-FWD.
MOVE NEWYEAR TO JRNKYEAR
MOVE NEWMONTH TO JRNKMONTH
MOVE NEWDAY TO JRNKDAY
MOVE NEWPAGE TO JRNKPAGE
MOVE JRNKEY TO JRNDK
READ JRN-MASTER
IF RETJRN NOT = '00'
START JRN-MASTER KEY > JRNDK.
READ JRN-MASTER NEXT
MOVE JRND TO JRN
IF RETJRN = '00'
MOVE JRNKYEAR TO NEWYEAR
MOVE JRNKMONTH TO NEWMONTH
MOVE JRNKDAY TO NEWDAY
MOVE JRNKPAGE TO NEWPAGE
PERFORM 100-DISPLAY THRU 100-EXIT
ELSE
MOVE 'No Additional Records.' TO MMSG.
994-EXIT.
EXIT.
*****************************************************************
995-DEL.
MOVE NEWYEAR TO JRNKYEAR
MOVE NEWMONTH TO JRNKMONTH
MOVE NEWDAY TO JRNKDAY
MOVE NEWPAGE TO JRNKPAGE
MOVE JRNKEY TO JRNDK
READ JRN-MASTER
IF RETJRN = '00'
MOVE JRND TO JRN
DELETE JRN-MASTER
MOVE 'Record Deleted.' TO MMSG.
995-EXIT.
EXIT.
Press F3 to exit and hit enter to confirm you wish to save the member. Now we are going to create the COBOL program. Run the command below to create the COBOL program.
CRTCBLPGM PGM(*CURLIB/JOURNAL) SRCFILE(*CURLIB/JOURNAL) SRCMBR(JOURNAL) REPLACE(*NO)
Once all the components have been compiled, you can run the following command to execute the program:
CALL *CURLIB/JOURNAL
You should see the following interface:
