Go to:  Davar site entry | Site contents | Site index | Mainframe | COBOL | Text bottom

DATEOUT  COBOL II  Procedure

         

DATEOUT procedure is called from JCL to form DB2 current TimeStamp as YYYY-MM-DD-HH.MM.SS.000000 string and to write it as a single record to SYSDATE file (LRECL=26).  Date is Year 2000 compliant.

This program illustrates usage of IGZEDT4 system subroutine in COBOL II.  With COBOL/MVS all dates are Year 2000 compliant and the task of writing a date record is trivial.




      * Output Current System Date and Time as DB2 TimeStamp to a File.
      * ----------------------------------------------------------------
      * Copyright (C) 1996–1998 by Vladimir Veytsel        www.davar.net

      * Action ---------------------------------------------------------

      *    Forms DB2 current TimeStamp as YYYY-MM-DD-HH.MM.SS.000000
      *    string and writes it as a single record to SYSDATE file.

      * Note -----------------------------------------------------------

      *    Program is Year 2000 compliant.

      *-----------------------------------------------------------------
       IDENTIFICATION DIVISION.
      *-----------------------------------------------------------------

       PROGRAM-ID.     DATEOUT.
       AUTHOR.         Vladimir Veytsel.
       DATE-WRITTEN.   05/20/1996.
       DATE-COMPILED.  07/28/1998.

      *-----------------------------------------------------------------
       ENVIRONMENT DIVISION.
      *-----------------------------------------------------------------

       INPUT-OUTPUT SECTION.

       FILE-CONTROL.

           SELECT Date-File ASSIGN TO SYSDATE.

      *-----------------------------------------------------------------
       DATA DIVISION.
      *-----------------------------------------------------------------

       FILE SECTION.

       FD  Date-File
           RECORDING MODE IS  F
           RECORD CONTAINS    26 CHARACTERS.
       01  Date-Record  PIC X(26).

      *-----------------------------------------------------------------

       WORKING-STORAGE SECTION.

       77  Current-Date    PIC X(08).
       77  Current-Time    PIC X(06).

       77  DB2-Time-Stamp  PIC X(26).

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

      * Get Current System Date as YYYYMMDD (Year 2000 Compliant) ------

           CALL 'IGZEDT4' USING Current-Date.

      * Get Current System Time as HHMMSS ------------------------------

           ACCEPT Current-Time FROM TIME.

      * Form DB2 TimeStamp as YYYY-MM-DD-HH.MM.SS.000000 ---------------

           STRING Current-Date(1:4) '-'
                  Current-Date(5:2) '-'
                  Current-Date(7:2) '-'
                  Current-Time(1:2) '.'
                  Current-Time(3:2) '.'
                  Current-Time(5:2) '.000000'
                  DELIMITED BY SIZE INTO DB2-Time-Stamp.

      * Output DB2 TimeStamp to Date File ------------------------------

           OPEN OUTPUT Date-File.
           WRITE Date-Record FROM DB2-Time-Stamp.

      * Finish Program -------------------------------------------------

           STOP RUN.
  
         

View [and save] DATEOUT.COB text
(Use [Back] button or [Alt]+[CL] to return here from the viewed text)
Copyright © 1996–1998 by
Go to:  Davar site entry | Site contents | Site index | Mainframe | COBOL | Text top