AS/400 – iSeries Sample COBOL program.

CT wanted COBOL program written for IBM iSeries. The following is simple sample interactive program (online program) adding Customers Information. This program will add customer records and update existing Customers Information.

QB Software Inc.

*USER                                                                         *SYSNAME

*DATE                                                                         *TIME

Customer Number : 1234567890

Enter Customer Number and Press <Enter>

F3= End

When press enter second screen format will be displayed which will allow user to input or update the information.

Company heading constant.
Customer number will be output field on this format.

*USER                                                                         *SYSNAME

*DATE                                                                         *TIMEName : (25) Characters
Address : (25) Characters
City : (20) Characters
State : (2) Characters

Enter Customer Information and Press

F3=End F12=Previous Screen

The formats will be designed using SDA which will generate your DSPF DDS. Condition indicator 30 is used to check the input field. The error message will be displayed “Customer Number be blank.” on line number 24, if user press enter leaving this field blank. The condition indicator 30 will also have the reverse image associated with this field attributes.

Condition indicators with reverse image and position cursor will be associated with all the input fields.

Indicator 33 Customer Name when “ON” will display message “Customer Name cannot be blanks.”

Indicator 34 Customber Address.

Fields User System Name Date and Time will be retrieved from system date and time. User name will be retrieved from Job Attributes.

Indicator 35 Customer City

Indicator 36 Customer State

The messages usually are defined in user message file but it will be easy for beginers to include the error messages on SDA formats.

IDENTIFICATION DIVISION.
       PROGRAM-ID.                     CUSTMAST.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
            SELECT Customer-FILE ASSIGN TO DISK-Customer
                   ORGANIZATION IS Indexed
                   Access Mode Is Dynamic
                   Record Key Is Cust-No.

              SELECT Screen-File Assign TO WORKSTATION-CUSTFMTS
                   ORGANIZATION IS Transaction.                  

       DATA DIVISION.
       FILE SECTION.
       FD   Cust-FILE
            LABEL RECORDS ARE STANDARD.
       01   Custs-REC.
            Copy DDS-ALL-FORMATS of CUSTOMER.

       FD   SCREEN-FILE
            LABEL RECORDS ARE STANDARD.
       01   SCREEN-REC.
            COPY DDS-ALL-FORMATS OF CUSTFMTS.

       WORKING-STORAGE SECTION.

       77   IND-OFF                       PIC 1  VALUE B"0".
       77   IND-ON                        PIC 1  VALUE B"0".

       01   SCREEN-INDICATORS.
            05 F03-EXIT                   PIC 1.
            05 F12-PRV-SCRN               PIC 1.
            05 CUST-SPACES                PIC 1.
            05 CUST-NAME-SPACES           PIC 1.
            05 CUST-ADDRESS-SPACES        PIC 1.
            05 CUST-CITY-SPACES           PIC 1.
            05 CUST-STATE-SPACES          PIC 1.
            05 CUST-NOT-FOUND             PIC 1.

       PROCEDURE DIVISION.
       MAIN-RTN.
            OPEN I-O    CUSTOMER-FILE
                        SCREEN-FILE.

            PERFORM CUSTOMER-INUT-RTN UNTIL F03-EXIT.     

            CLOSE CUSTOMER-FILE
                  SCREEN-FILE.
            STOP RUN.

       CUSTOMER-INPUT-RTN. 

            WRITE SCREEN-REC  FORMAT IS "CUSTFMT1"
                  INDICATORS ARE SCREEN-INDICATORS.
            READ SCREEN-REC INDICATORS ARE SCREEN-INDICATORS.

            IF CUST-NO   = SPACES
               MOVE  IND-ON     TO CUST-SPACES
               GO TO CUSTOMER-INPUT-RTN.

            PERFORM CHECK-CUSTOMER.
            MOVE ZEROS          TO SCREEN-INDICATORS.
            PERFORM CUSTOMER-DETILAS.
       CUSTOMER-DETAILS.
            WRITE SCREEN-REC  FORMAT IS "CUSTFMT2'
                  INDICATORS ARE SCREEN-INDICATORS.
            READ SCREEN-REC INDICATORS ARE SCREEN-INDICATORS.

            IF CUST-NAME = SPACES
               MOVE IND-ON     TO CUST-NAME-SPACES
               GO TO CUSTOMER-DETAILS.

            IF ADDRESS = SPACES
               MOVE IND-ON TO CUST-ADDRESS-SPACES
               GO TO CUSTOMER-DETAILS.

            IF CITY = SPCACES
               MOVE IND-ON TO CUST-CITY-SPACES
               GO TO CUSTOMER-DETAILS.

            IF STATE = SPACES
               MOVE IND-ON TO CUST-STATE-SPACES
               GO TO CUSTOMER-DETAILS.

            MOVE ZEROS TO SCREEN-INDICATORS.
            IF RECORD-NOT-FOUND
               MOVE CORR CUSTFMT2 TO CUST-REC
               WRITE CUST-REC
            ELSE
               MOVE CORR CUSTFMT2 TO CUST-REC
               REWRITE CUST-REC.

       CHECK-CUSTOMER.
            MOVE IND-OFF      TO CUST-NOT-FOUND.
            READ CUST-FILE INVALID KEY
                MOVE SPACES TO CUST-NAME
                MOVE SPACES TO ADDRESS
                MOVE SPACES TO CITY
                MOVE SPACES TO STATE
                MOVE IND-ON TO CUST-NOT-FOUND
                NOT INVALID KEY
                MOVE IND-OFF TO CUST-NOT-FOUND
                MOVE CORR CUST-REC TO CUSTFMT1.

This is very simple iSeries COBOL program. You have to debug it for errors because
I did not compile and run the program. 

STRDBG CUSTMAST updprod(*yes) will let you debug the source. Compile it with *Source
debug view. Also have not worked on COBOL for many many years and its kind of rusty.
This program written in RPG/ILE will be much simple.