Customer Database, Update a Row
 COBOL, Embedded SQL
http://www.simotime.com
When technology complements business    Copyright © 1987-2010  SimoTime Enterprises  All Rights Reserved
  Table of Contents Version 10.03.20 
  Introduction
 
  Programming Requirements
  Programming Overview
  CMD Member for Execution with Net Express
  JCL Member for OS/390 or Mainframe Express
  The COBOL Demonstration Program
  Summary
 
  Software Agreement and Disclaimer
  Downloads and Links to Similar Pages
  Comments or Suggestions
  About SimoTime

Introduction
(Next) (Previous) (Table-of-Contents)

This example uses embedded SQL in a COBOL program to update a row within a table. This example sequentially reads the records in a VSAM, Keyed-Sequential-Data-Set (KSDS) and uses the information to update the relational data base. If an existing row with a matching primary key cannot be selected then a new row will be inserted. In the world of programming there are many ways to solve a problem. This suite of programs is provided as a COBOL programming example of one of the possible solutions.

Programming Requirements
(Next) (Previous) (Table-of-Contents)

This suite of samples programs will run on the following platforms.

1. Executes on Windows/XP using Micro Focus Net Express and the CMD file provided.
2. Executes on Windows/XP using Micro Focus Mainframe Express and the JCL member provided.
3. May be ported to run on the UNIX platforms supported by Micro Focus COBOL.

Programming Overview
(Next) (Previous) (Table-of-Contents)

The following diagram is an overview of how the demonstration program fits into the example. The BLUE boxes are unique to the mainframe and Micro Focus Mainframe Express. The RED boxes are unique to the PC with Windows and Micro Focus Net Express. The GREEN boxes are platform independent and will execute on the mainframe or a PC with Windows. Also, the GREEN boxes may be ported to a UNIX platform that is supported by Micro Focus COBOL.

             
Entry Point
z/OS or MFE
     
Entry Point
Net Express
   
 
   
 
  Start the Job
CUQUP1J1
jcl
     
CUQUPDE1
cmd
   
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
   
CUSTMAST
Indexed
     
     
     
CUQUP1C1
cobol
     
     
     
CUSTRDB1
relational
  Read an Indexed file and update or insert a row into a relational data base table
   
 
       
   
EOJ
      End-of-Job
             

The main program (CUQUP1C1) will read an Indexed file (CUSTMAST) and use this information to update an existing row in a relational data base table (CUSTRDB1). If a row with a matching key does not exist then a new row will be inserted.

CMD Member for Execution with Net Express
(Next) (Previous) (Table-of-Contents)

The following is the Windows Command file (CUQUP1E1.CMD) that is required to run as a job on a PC using Micro Focus Net Express.

@echo OFF
rem  * *******************************************************************
rem  *                   This program is provided by:                    *
rem  *                    SimoTime Enterprises, LLC                      *
rem  *           (C) Copyright 1987-2010 All Rights Reserved             *
rem  *             Web Site URL:   http://www.simotime.com               *
rem  *                   e-mail:   helpdesk@simotime.com                 *
rem  * *******************************************************************
rem  *
rem  * Text    - COBOL with embedded SQL to Update rows in a table
rem  * Author  - SimoTime Enterprises
rem  * Date    - November 11, 2003
rem  * Version - 08.07.12
rem  *
rem  * This set of programs illustrate the use of embedded SQL in a COBOL
rem  * program that Update rows in a Table.
rem  *
rem  * This technique provides for the use of a single COBOL source
rem  * program that will run on ZOS, Windows or Unix.
rem  *
rem  * This set of programs will run on a Personal Computer with Windows
rem  * and Micro Focus Net Express or Mainframe Express.
rem  *
rem  *
rem  *                    ************
rem  *                    * CUQUP1E1 *
rem  *                    ********cmd*
rem  *                         *
rem  *                         *
rem  *   ************     ************     ************
rem  *   * CUSTMAST *-----* CUQUP1C1 *-----* CUSTMRDB1 *
rem  *   *******ksds*     ********cbl*     ********rdb*
rem  *                         *
rem  *                         *
rem  *                    ************
rem  *                    *   EOJ    *
rem  *                    ************
echo *
echo * The SQL Server must be started prior to executing this command.
echo *
     set CmdName=CUQUP1E1
     call ezPROD01
     call SimoNOTE "*******************************************************%CmdName%"
     call SimoNOTE "Starting JobName %CmdName%"
     set CUSTMAST=%DataLib1%\Dyn1\SIMOTIME.DATA.CUSTMAST.DAT
     run CUQUP1C1
     if errorlevel = 1 set JobStatus=0001
     if not "%JobStatus%" == "0000" goto :EojNOK
:EojAOK
     call SimoNOTE "Finished JobName %CmdName%"
     goto :End
:EojNOK
     call SimoNOTE "ABENDING JobName %CmdName%"
     call SimoNOTE "ABENDING Message JobStatus %JobStatus%"
     goto :End
:End
     if not "%1" == "nopause" pause

JCL Member for ZOS or Mainframe Express
(Next) (Previous) (Table-of-Contents)

The following is the mainframe JCL (CUQUP1J1.JCL) that is required to run as a job on the mainframe or as a Mainframe Express project on the PC.

//CUQUP1J1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
//* *******************************************************************
//*                   This program is provided by:                    *
//*                    SimoTime Enterprises, LLC                      *
//*           (C) Copyright 1987-2010 All Rights Reserved             *
//*             Web Site URL:   http://www.simotime.com               *
//*                   e-mail:   helpdesk@simotime.com                 *
//* *******************************************************************
//*
//* TEXT   - Execute a COBOL program to UPDATE data within a Table.
//* AUTHOR - SimoTime Enterprises
//* DATE   - January 01, 1989
//*
//* This set of programs illustrate the use of a COBOL program with
//* embedded SQL syntax. This program will UPDATE rows into a table.
//*
//* This set of programs will run on a mainframe under ZOS or on
//* a personal computer running Windows and Mainframe Express (MFE)
//* by Micro Focus.
//*
//*                    ************
//*                    * CUQUP1J1 *
//*                    ********jcl*
//*                         *
//*                         *
//*                    ************
//*                    * IKJEFT01 *
//*                    ********dbm*
//*                         *
//*                         *
//*   ************     ************     ************
//*   * CUSTMAST *-----* CUQUP1C1 *-----* CUSTRDB1 *
//*   *******ksds*     ********cbl*     ********rdb*
//*                         *
//*                         *
//*                    ************
//*                    *   EOJ    *
//*                    ************
//*
//* *******************************************************************
//* Step   1 of 1  this is a single step job.
//*
//STEP01   EXEC PGM=IKJEFT01
//CUSTMAST DD  DSN=SIMOTIME.DATA.CUSTMAST,DISP=SHR
//SYSPRINT DD  SYSOUT=*
//SYSTSPRT DD  SYSOUT=*
//SYSOUT   DD  SYSOUT=*
//SYSTSIN  DD  *
  DSN SYSTEM (DSN)
      RUN PROG (CUQUP1C1)
  END
//

The COBOL Demonstration Program
(Next) (Previous) (Table-of-Contents)

The following (CUQUP1C1.CBL) is a sample of the COBOL demonstration program.

       IDENTIFICATION DIVISION.
       PROGRAM-ID.    CUQUP1C1.
       AUTHOR.        SIMOTIME ENTERPRISES.
      *****************************************************************
      * Copyright (C) 1987-2010 SimoTime Enterprises, LLC.            *
      *                                                               *
      * All rights reserved.  Unpublished, all rights reserved under  *
      * copyright law and international treaty.  Use of a copyright   *
      * notice is precautionary only and does not imply publication   *
      * or disclosure.                                                *
      *                                                               *
      * Permission to use, copy, modify and distribute this software  *
      * for any commercial purpose requires a fee to be paid to       *
      * SimoTime Enterprises. Once the fee is received by SimoTime    *
      * the latest version of the software will be delivered and a    *
      * license will be granted for use within an enterprise,         *
      * provided the SimoTime copyright notice appear on all copies   *
      * of the software. The SimoTime name or Logo may not be used    *
      * in any advertising or publicity pertaining to the use of the  *
      * software without the written permission of SimoTime           *
      * Enterprises.                                                  *
      *                                                               *
      * Permission to use, copy and modify this software for a        *
      * non-commercial purpose and without fee is hereby granted,     *
      * provided the SimoTime copyright notice appear on all copies   *
      * of the software. The SimoTime name or Logo may not be used    *
      * in any advertising or publicity pertaining to the use of the  *
      * software without the written permission of SimoTime           *
      * Enterprises.                                                  *
      *                                                               *
      * SimoTime Enterprises makes no warranty or representations     *
      * about the suitability of the software for any purpose. It is  *
      * provided "AS IS" without any express or implied warranty,     *
      * including the implied warranties of merchantability, fitness  *
      * for a particular purpose and non-infringement. SimoTime       *
      * Enterprises shall not be liable for any direct, indirect,     *
      * special or consequential damages resulting from the loss of   *
      * use, data or projects, whether in an action of contract or    *
      * tort, arising out of or in connection with the use or         *
      * performance of this software                                  *
      *                                                               *
      * SimoTime Enterprises                                          *
      * 15 Carnoustie Drive                                           *
      * Novato, CA 94949-5849                                         *
      * 415.883.6565                                                  *
      *                                                               *
      * RESTRICTED RIGHTS LEGEND                                      *
      * Use, duplication, or disclosure by the Government is subject  *
      * to restrictions as set forth in subparagraph (c)(1)(ii) of    *
      * the Rights in Technical Data and Computer Software clause at  *
      * DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of          *
      * Commercial  Computer Software - Restricted Rights  at 48      *
      * CFR 52.227-19, as applicable.  Contact SimoTime Enterprises,  *
      * 15 Carnoustie Drive, Novato, CA 94949-5849.                   *
      *****************************************************************
      * This program will read the Item File (originally a VSAM, KSDS
      * downloaded to be a Micro Focus Keyed-Indexed file) and insert
      * or update rows into a table.
      *
      *                    ************
      *                    * CUQUP1J1 *
      *                    ********jcl*
      *                         *
      *                         *
      *                    ************
      *                    * IKJEFT01 *
      *                    ********dbm*
      *                         *
      *                         *
      *   ************     ************     ************
      *   * CUSTMAST *-----* CUQUP1C1 *-----* CUSTRDB1 *
      *   ********ksd*     ********cbl*     ********rdb*
      *                         *
      *                         *
      *                    ************
      *                    *   EOJ    *
      *                    ************
      *
      *****************************************************************
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
      *    The LINE SEQUENTIAL file organization is Micro Fcus
      *    syntax for an ASCII/Text file.
           SELECT CUSTMAST-FILE ASSIGN to CUSTMAST
                  ORGANIZATION  is indexed
                  ACCESS MODE   is SEQUENTIAL
                  RECORD KEY    is CUST-NUMBER
                  FILE STATUS   is CUSTMAST-STATUS.

      *****************************************************************
       DATA DIVISION.
       FILE SECTION.

       FD  CUSTMAST-FILE.
       COPY CUSTCB01.

       WORKING-STORAGE SECTION.
      *****************************************************************
      *    Data-structure for Title and Copyright...
      *    ------------------------------------------------------------
       01  SIM-TITLE.
           05  T1 pic X(11) value '* CUQUP1C1 '.
           05  T2 pic X(34) value 'Read KSDS, Update or Insert SQL   '.
           05  T3 pic X(10) value ' v08.07.25'.
           05  T4 pic X(24) value ' http://www.simotime.com'.
       01  SIM-COPYRIGHT.
           05  C1 pic X(11) value '* CUQUP1C1 '.
           05  C2 pic X(20) value 'Copyright 1987-2010 '.
           05  C3 pic X(28) value '  SimoTime Enterprises, LLC '.
           05  C4 pic X(20) value ' All Rights Reserved'.

       01  SIM-THANKS-01.
           05  C1 pic X(11) value '* CUQUP1C1 '.
           05  C2 pic X(32) value 'Thank you for using this sample '.
           05  C3 pic X(32) value 'by SimoTime Enterprises, LLC    '.
           05  C4 pic X(04) value '    '.

       01  SIM-THANKS-02.
           05  C1 pic X(11) value '* CUQUP1C1 '.
           05  C2 pic X(32) value 'Please send comments or suggesti'.
           05  C3 pic X(32) value 'ons to helpdesk@simotime.com    '.
           05  C4 pic X(04) value '    '.

       01  CUSTMAST-STATUS.
           05  CUSTMAST-STATUS-L   pic X.
           05  CUSTMAST-STATUS-R   pic X.
       01  CUSTMAST-EOF            pic X       value 'N'.
       01  CUSTMAST-OPEN-FLAG      pic X       value 'C'.


       01  CSVPUTD1-STATUS.
           05  CSVPUTD1-STATUS-L   pic X.
           05  CSVPUTD1-STATUS-R   pic X.
       01  CSVPUTD1-OPEN-FLAG      pic X       value 'C'.

       01  IO-STATUS.
           05  IO-STAT1            pic X.
           05  IO-STAT2            pic X.
       01  TWO-BYTES.
           05  TWO-BYTES-LEFT      pic X.
           05  TWO-BYTES-RIGHT     pic X.
       01  TWO-BYTES-BINARY        redefines TWO-BYTES pic 9(4) comp.
       01  IO-STATUS-4             pic 9(4)  value 0.
       01  IO-STATUS-4A            redefines IO-STATUS-4 pic X(4).

      *****************************************************************
      * Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine.    *
      *****************************************************************
       01  MESSAGE-BUFFER.
           05  MESSAGE-HEADER      pic X(11)   value '* CUQUP1C1 '.
           05  MESSAGE-TEXT.
               10  MESSAGE-TEXT-1  pic X(68)   value SPACES.
               10  MESSAGE-TEXT-2  pic X(188)  value SPACES.
       01  MESSAGE-BUFFER-SIZE     pic 9(3)    value 267.
       01  MSG-PTR                 pic 9(3)    value 0.
       01  MSG-LEN                 pic 9(3)    value 0.

       01  WORK-DATE.
           05  WORK-DATE-08        pic X(8).
       01  WORK-TIME               pic X(8).

       01  EDIT-TIMESTAMP.
           05  EDIT-DATE           pic X(10)   value 'yyyy-nn-nn'.
           05  filler              pic X       value '-'.
           05  EDIT-TIME           pic X(11)   value 'nn:nn:nn:nn'.
           05  filler              pic X(4)    value SPACES.

       01  APPL-RESULT             pic S9(9)   comp.
           88  APPL-AOK            value 0.
           88  APPL-EOF            value 16.

      *    ------------------------------------------------------------
           EXEC SQL BEGIN DECLARE SECTION END-EXEC.

           EXEC SQL INCLUDE CUSTCQ01      END-EXEC.

           EXEC SQL end DECLARE SECTION   END-EXEC.

           EXEC SQL INCLUDE SQLCA         END-EXEC.

      *****************************************************************
       PROCEDURE DIVISION.

           perform Z-POST-COPYRIGHT

           perform CUSTMAST-OPEN

           perform until CUSTMAST-STATUS not = '00'
               perform CUSTMAST-READ
      *    *   If a successful read of the input file
      *    *   and the input item number is not equal to SPACES
      *    *   then create an output.
               if  CUSTMAST-STATUS = '00'
               and CUST-NUMBER not = SPACES
                   display CUST-NUMBER ' - ' CUST-LAST-NAME
                   move CUST-RECORD      to CUQ1-RECORD
                   perform Z-GET-DATE-AND-TIME
                   perform CUSTRDB1-SELECT
                   if  SQLCODE = ZERO
                       perform MOVE-DATA-FOR-UPDATE
                       perform CUSTRDB1-UPDATE
                   else
                       perform MOVE-DATA-FOR-UPDATE
                       perform CUSTRDB1-INSERT
                   end-if
               end-if
           end-perform

           perform CUSTMAST-CLOSE

           perform Z-THANK-YOU

           GOBACK.

      *****************************************************************
       MOVE-DATA-FOR-UPDATE.
           move CUST-NUMBER          to CUQ1-NUMBER
           move CUST-STATUS          to CUQ1-STATUS
           move CUST-LAST-NAME       to CUQ1-LAST-NAME
           move CUST-FIRST-NAME      to CUQ1-FIRST-NAME
           move CUST-MID-NAME        to CUQ1-MID-NAME
           move CUST-ADDRESS-1       to CUQ1-ADDRESS-1
           move CUST-ADDRESS-2       to CUQ1-ADDRESS-2
           move CUST-CITY            to CUQ1-CITY
           move CUST-STATE           to CUQ1-STATE
           move CUST-POSTAL-CODE     to CUQ1-POSTAL-CODE
           move CUST-PHONE-HOME      to CUQ1-PHONE-HOME
           move CUST-PHONE-WORK      to CUQ1-PHONE-WORK
           move CUST-PHONE-CELL      to CUQ1-PHONE-CELL

           move WORK-DATE            to CUQ1-LADATE
           move WORK-TIME            to CUQ1-LATIME
           move ZERO                 to CUQ1-TOKEN
           exit.

      *****************************************************************
       CUSTRDB1-SELECT.
           EXEC SQL
                SELECT CUQ1_NUMBER,
                       CUQ1_STATUS,
                       CUQ1_LAST_NAME,
                       CUQ1_FIRST_NAME,
                       CUQ1_MID_NAME,
                       CUQ1_ADDRESS_1,
                       CUQ1_ADDRESS_2,
                       CUQ1_CITY,
                       CUQ1_STATE,
                       CUQ1_POSTAL_CODE,
                       CUQ1_PHONE_HOME,
                       CUQ1_PHONE_WORK,
                       CUQ1_PHONE_CELL,
                       CUQ1_LADATE,
                       CUQ1_LATIME,
                       CUQ1_TOKEN
                INTO :CUQ1-NUMBER,
                     :CUQ1-STATUS,
                     :CUQ1-LAST-NAME,
                     :CUQ1-FIRST-NAME,
                     :CUQ1-MID-NAME,
                     :CUQ1-ADDRESS-1,
                     :CUQ1-ADDRESS-2,
                     :CUQ1-CITY,
                     :CUQ1-STATE,
                     :CUQ1-POSTAL-CODE,
                     :CUQ1-PHONE-HOME,
                     :CUQ1-PHONE-WORK,
                     :CUQ1-PHONE-CELL,
                     :CUQ1-LADATE,
                     :CUQ1-LATIME,
                     :CUQ1-TOKEN
                FROM CUSTRDB1
                WHERE CUQ1_NUMBER = :CUQ1-NUMBER
           END-EXEC

           if  SQLCODE NOT = ZERO
               initialize CUQ1-RECORD
           end-if
           exit.
      *---------------------------------------------------------------*
       CUSTRDB1-INSERT.
           EXEC SQL
                INSERT into CUSTRDB1
                 (
                  CUQ1_NUMBER,
                  CUQ1_STATUS,
                  CUQ1_LAST_NAME,
                  CUQ1_FIRST_NAME,
                  CUQ1_MID_NAME,
                  CUQ1_ADDRESS_1,
                  CUQ1_ADDRESS_2,
                  CUQ1_CITY,
                  CUQ1_STATE,
                  CUQ1_POSTAL_CODE,
                  CUQ1_PHONE_HOME,
                  CUQ1_PHONE_WORK,
                  CUQ1_PHONE_CELL,
                  CUQ1_LADATE,
                  CUQ1_LATIME,
                  CUQ1_TOKEN
                 )
                VALUES
                 (
                  :CUQ1-NUMBER,
                  :CUQ1-STATUS,
                  :CUQ1-LAST-NAME,
                  :CUQ1-FIRST-NAME,
                  :CUQ1-MID-NAME,
                  :CUQ1-ADDRESS-1,
                  :CUQ1-ADDRESS-2,
                  :CUQ1-CITY,
                  :CUQ1-STATE,
                  :CUQ1-POSTAL-CODE,
                  :CUQ1-PHONE-HOME,
                  :CUQ1-PHONE-WORK,
                  :CUQ1-PHONE-CELL,
                  :CUQ1-LADATE,
                  :CUQ1-LATIME,
                  :CUQ1-TOKEN
                 )
           END-EXEC

           if SQLCODE = 0
              display 'INSERTED ON INSERT FOR CUSTMAST '
                      'SQLCODE = ' SQLCODE
                      ' Customer = ' CUQ1-NUMBER
           else
              display 'ABENDING ON INSERT FOR CUSTMAST '
                      'SQLCODE = ' SQLCODE
                      ' ITEM = ' CUQ1-NUMBER
              add 16 to ZERO giving RETURN-CODE
           end-if
           exit.
      *---------------------------------------------------------------*
       CUSTRDB1-UPDATE.
           EXEC SQL
                UPDATE CUSTRDB1
                SET CUQ1_NUMBER = :CUQ1-NUMBER,
                    CUQ1_STATUS = :CUQ1-STATUS,
                    CUQ1_LAST_NAME = :CUQ1-LAST-NAME,
                    CUQ1_FIRST_NAME = :CUQ1-FIRST-NAME,
                    CUQ1_MID_NAME = :CUQ1-MID-NAME,
                    CUQ1_ADDRESS_1 = :CUQ1-ADDRESS-1,
                    CUQ1_ADDRESS_2 = :CUQ1-ADDRESS-2,
                    CUQ1_CITY = :CUQ1-CITY,
                    CUQ1_STATE = :CUQ1-STATE,
                    CUQ1_POSTAL_CODE = :CUQ1-POSTAL-CODE,
                    CUQ1_PHONE_HOME = :CUQ1-PHONE-HOME,
                    CUQ1_PHONE_WORK = :CUQ1-PHONE-WORK,
                    CUQ1_PHONE_CELL = :CUQ1-PHONE-CELL,
                    CUQ1_LADATE = :CUQ1-LADATE,
                    CUQ1_LATIME = :CUQ1-LATIME,
                    CUQ1_TOKEN = :CUQ1-TOKEN
                WHERE CUQ1_NUMBER = :CUQ1-NUMBER
           END-EXEC.

           if SQLCODE = 0
              display 'Finished UPDATING of CUSTRDB1 for item '
                      CUQ1-NUMBER
           else
              display 'ABENDING OF UPDATE FOR CUSTRDB1 '
                      'SQLCODE = ' SQLCODE
                      ' Customer = ' CUQ1-NUMBER
              add 16 to ZERO giving RETURN-CODE
           end-if
           exit.

      *****************************************************************
      * I/O ROUTINES FOR CUSTMAST...                                  *
      *****************************************************************
       CUSTMAST-CLOSE.
           add 8 to ZERO giving APPL-RESULT.
           close CUSTMAST-FILE
           if  CUSTMAST-STATUS = '00'
               subtract APPL-RESULT from APPL-RESULT
           else
               add 12 to ZERO giving APPL-RESULT
           end-if
           if  APPL-AOK
               CONTINUE
           else
               move 'CUSTMAST-Failure-CLOSE...' to MESSAGE-TEXT
               perform Z-DISPLAY-MESSAGE-TEXT
               move CUSTMAST-STATUS to IO-STATUS
               perform Z-DISPLAY-IO-STATUS
               perform Z-ABEND-PROGRAM
           end-if
           exit.
      *---------------------------------------------------------------*
       CUSTMAST-READ.
           read CUSTMAST-FILE
           if  CUSTMAST-STATUS = '00'
               subtract APPL-RESULT from APPL-RESULT
           else
               if  CUSTMAST-STATUS = '10'
                   add 16 to ZERO giving APPL-RESULT
               else
                   add 12 to ZERO giving APPL-RESULT
               end-if
           end-if
           if  APPL-AOK
               CONTINUE
           else
               if  APPL-EOF
                   move 'Y' to CUSTMAST-EOF
               else
                   move 'CUSTMAST-Failure-GET...' to MESSAGE-TEXT
                   perform Z-DISPLAY-MESSAGE-TEXT
                   move CUSTMAST-STATUS to IO-STATUS
                   perform Z-DISPLAY-IO-STATUS
                   perform Z-ABEND-PROGRAM
               end-if
           end-if
           exit.
      *---------------------------------------------------------------*
       CUSTMAST-OPEN.
           add 8 to ZERO giving APPL-RESULT.
           open input CUSTMAST-FILE
           if  CUSTMAST-STATUS = '00'
               subtract APPL-RESULT from APPL-RESULT
               move 'O' to CUSTMAST-OPEN-FLAG
           else
               add 12 to ZERO giving APPL-RESULT
           end-if
           if  APPL-AOK
               CONTINUE
           else
               move 'CUSTMAST-Failure-OPEN...' to MESSAGE-TEXT
               perform Z-DISPLAY-MESSAGE-TEXT
               move CUSTMAST-STATUS to IO-STATUS
               perform Z-DISPLAY-IO-STATUS
               perform Z-ABEND-PROGRAM
           end-if
           exit.


      *****************************************************************
      * The following Z-ROUTINES provide administrative functions     *
      * for this program.                                             *
      *****************************************************************
      *
      *****************************************************************
      * ABEND the program, post a message to the console and issue    *
      * a STOP RUN.                                                   *
      *****************************************************************
       Z-ABEND-PROGRAM.
           if  MESSAGE-TEXT not = SPACES
               perform Z-DISPLAY-MESSAGE-TEXT
           end-if
           move 'PROGRAM-IS-ABENDING...'  to MESSAGE-TEXT
           perform Z-DISPLAY-MESSAGE-TEXT
           add 12 to ZERO giving RETURN-CODE
           STOP RUN.
      *    exit.

      *****************************************************************
      * Display CONSOLE messages...                                   *
      *****************************************************************
       Z-DISPLAY-MESSAGE-TEXT.
           display MESSAGE-BUFFER upon console
           move all SPACES to MESSAGE-TEXT
           exit.

      *****************************************************************
      * Display the file status bytes. This routine will display as   *
      * four digits. If the full two byte file status is numeric it   *
      * will display as 00nn. If the 1st byte is a numeric nine (9)   *
      * the second byte will be treated as a binary number and will   *
      * display as 9nnn.                                              *
      *****************************************************************
       Z-DISPLAY-IO-STATUS.
           if  IO-STATUS not NUMERIC
           or  IO-STAT1 = '9'
               subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
               move IO-STAT2 to TWO-BYTES-RIGHT
               add TWO-BYTES-BINARY to ZERO giving IO-STATUS-4
               move IO-STAT1 to IO-STATUS-4A(1:1)
               move 'File Status is: nnnn' to MESSAGE-TEXT
               move IO-STATUS-4A to MESSAGE-TEXT(17:4)
               perform Z-DISPLAY-MESSAGE-TEXT
           else
               move '0000' to IO-STATUS-4A
               move IO-STATUS to IO-STATUS-4A(3:2)
               move 'File Status is: nnnn' to MESSAGE-TEXT
               move IO-STATUS-4A to MESSAGE-TEXT(17:4)
               perform Z-DISPLAY-MESSAGE-TEXT
           end-if
           exit.

      *****************************************************************
       Z-GET-DATE-AND-TIME.
           accept WORK-DATE from DATE YYYYMMDD
           accept WORK-TIME from TIME

           move WORK-DATE(1:4) to EDIT-DATE(1:4)
           move WORK-DATE(5:2) to EDIT-DATE(6:2)
           move WORK-DATE(7:2) to EDIT-DATE(9:2)

           move WORK-TIME(1:2) to EDIT-TIME(1:2)
           move WORK-TIME(3:2) to EDIT-TIME(4:2)
           move WORK-TIME(5:2) to EDIT-TIME(7:2)
           move WORK-TIME(7:2) to EDIT-TIME(10:2)

           exit.

      *****************************************************************
       Z-POST-COPYRIGHT.
           display SIM-TITLE     upon console
           display SIM-COPYRIGHT upon console
           exit.

      *****************************************************************
       Z-THANK-YOU.
           display SIM-THANKS-01 upon console
           display SIM-THANKS-02 upon console
           exit.

      *****************************************************************
      *                 This program is provided by:                  *
      *                  SimoTime Enterprises, LLC                    *
      *         (C) Copyright 1987-2010 All Rights Reserved           *
      *           Web Site URL:   http://www.simotime.com             *
      *                 e-mail:   helpdesk@simotime.com               *
      *****************************************************************

Summary
(Next) (Previous) (Table-of-Contents)

The purpose of this program is to provide examples using embedded SQL in a COBOL program to create, manipulate and delete relational data bases.

Software Agreement and Disclaimer
(Next) (Previous) (Table-of-Contents)

Permission to use, copy, modify and distribute this software for any commercial purpose requires a fee to be paid to SimoTime Enterprises. Once the fee is received by SimoTime the latest version of the software will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Enterprises.

Permission to use, copy, modify and distribute this software for a non-commercial purpose and without fee is hereby granted, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Enterprises.

SimoTime Enterprises makes no warranty or representations about the suitability of the software for any purpose. It is provided "AS IS" without any express or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Enterprises shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software.

Downloads and Links to Similar Pages
(Next) (Previous) (Table-of-Contents)

You may download this example at http://www.simotime.com/sim4dzip.htm#ZipsforSQL or view the complete list of SimoTime Examples at http://www.simotime.com/sim4dzip.htm.

Note: You must be attached to the Internet to download a Z-Pack or view the list.

Check out  The VSAM - QSAM Connection  for more examples of mainframe VSAM and QSAM accessing techniques with sample code.

This document provides a quick summary of the  File Status Key  for VSAM data sets and QSAM files.

Check out  The SQL Connection  for more examples of mainframe Relational Data Base management and accessing techniques with sample code.

The example for Create a Table uses embedded SQL in a COBOL program to create a data base for the item information.

The example for Insert a Row uses embedded SQL in a COBOL program to insert data into a table of an existing data base.

The example for Sequential Processing uses embedded SQL in a COBOL program to insert data into a table of an existing data base.

The example for Delete a Table uses embedded SQL in a COBOL program to delete a data base for the item information.

Check out  The SimoTime Library  for a wide range of topics for Programmers, Project Managers and Software Developers.

To review all the information available on this site start at  The SimoTime Home Page .

Comments or Suggestions
(Next) (Previous) (Table-of-Contents)

If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com

We appreciate your comments and feedback.

About SimoTime Enterprises
(Next) (Previous) (Table-of-Contents)

Founded in 1987, SimoTime Enterprises is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. This includes the smallest thin client using the Internet and the very large mainframe systems. There is more to making the Internet work for your company's business than just having a nice looking WEB site. It is about combining the latest technologies and existing technologies with practical business experience. It's about the business of doing business and looking good in the process. Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com


Return-to-Top
Copyright © 1987-2010  SimoTime Enterprises  All Rights Reserved
When technology complements business