A Matter of Time - Part 2 - COBOL

A Matter of Time - Part 1 - Introduction

Back again to build a version of the TDF_LAP() Timing function in COBOL. This is a set of 21 timing entries used to easily monitor timings for embedded or stand-alone routines or SQL statements.

Above: LEGO Guy inspecting the World Time Zones before warming up with some COBOL.

Flashback: LEGO Guy Loves Assembler

Of course the LEGO Guy loves Assembler - virtually building programs brick by brick - but he also likes to warm up with other languages - this time COBOL. After building the lapse routine - TDF-LAP - he'll give it a quick test run. Just a main process that calls another one - with the nested timings produced for each.

Sample Log Output:

This version displays the level along with BEG/END times, lapsed time and the message.

TDF-LAP Function (Procedure) - TDFPROC.CPY

The input parameters consist of an operation code - BEG or END, a timing level - zero thru 20, and a message to print on the END operation. The routine will also populate output fields for the difference in seconds and the difference in the format HHHH:MI:SS.SSSSS - these can be used as needed (or ignored).

*The function is part of the TDFPROC.CPY Copybook (uses TDFWORK.CPY for working storage)

      *****************************************************************
      *    TDF LAP - LAPSE BETWEEN BEGIN/END TIMES (SQL TIMINGS)      *
      *****************************************************************
      *                                                               *
      *    FIELD              I/O  DESCRIPTION                        *
      *    -----------------  ---  ---------------------------------- *
      *    TDX-LAP-OPER        I   OPERATION TYPE (BEG/END)           *
      *    TDX-LAP-LEV         I   LAPSE INDEX SET (0 THRU 20)        *
      *    TDX-LAP-MSG         I   DISPLAY MESSAGE TEXT               *
      *    TDX-LAP-DIFF        O   BEG/END LAPSE IN SECONDS           *
      *    TDX-LAP-TXT-HMS     O   BEG/END LAPSE IN HHHH:MM:SS.SSSSS  *
      *                                                               *
      *****************************************************************
      *                                                               *
      *    EXAMPLE:                                                   *
      *    ---------------------------------------------------------- *
      *    MOVE 0              TO TDX-LAP-LEV                         *
      *    MOVE 'BEG'          TO TDX-LAP-OPER                        *
      *    PERFORM TDF-LAP                                            *
      *    <snip>                                                     *
      *    MOVE 0              TO TDX-LAP-LEV                         *
      *    MOVE 'END'          TO TDX-LAP-OPER                        *
      *    MOVE 'PROCESS-MAIN' TO TDX-LAP-MSG                         *
      *    PERFORM TDF-LAP                                            *
      *    ---------------------------------------------------------- *
      *    RESULTS:                                                   *
      *    L(00) BEG(2024:12:17_16:41:42) END(2024:12:17_16:41:43) -  *
      *          HMS(0000:00:01.35000) MSG: PROCESS-MAIN              *
      *    ---------------------------------------------------------- *
      *         *SINGLE LINE DISPLAYED FOR EACH NESTED LEVEL*         *
      *****************************************************************

       TDF-LAP.
           
           IF TDX-LAP-LEV-OK
               
              COMPUTE TDX-LAP-IDX         = TDX-LAP-LEV + 1
              
              MOVE FUNCTION CURRENT-DATE TO TDX-LAP-END(TDX-LAP-IDX)
              
              IF TDX-LAP-OPER-END
                 
                 MOVE TDX-LAP-BEG(TDX-LAP-IDX) TO TDX-SEC-IN
                 PERFORM TDF-SECONDS
                 MOVE TDX-SEC-OUT TO TDX-LAP-BEG-SEC
                 
                 MOVE TDX-SEC-IN( 1:4) TO TDX-LAP-TXT-BEG-Y
                 MOVE TDX-SEC-IN( 5:2) TO TDX-LAP-TXT-BEG-M
                 MOVE TDX-SEC-IN( 7:2) TO TDX-LAP-TXT-BEG-D
                 MOVE TDX-SEC-IN( 9:2) TO TDX-LAP-TXT-BEG-H
                 MOVE TDX-SEC-IN(11:2) TO TDX-LAP-TXT-BEG-I
                 MOVE TDX-SEC-IN(13:2) TO TDX-LAP-TXT-BEG-S

                 
                 MOVE TDX-LAP-END(TDX-LAP-IDX) TO TDX-SEC-IN
                 PERFORM TDF-SECONDS
                 MOVE TDX-SEC-OUT TO TDX-LAP-END-SEC
                 
                 MOVE TDX-SEC-IN( 1:4) TO TDX-LAP-TXT-END-Y
                 MOVE TDX-SEC-IN( 5:2) TO TDX-LAP-TXT-END-M
                 MOVE TDX-SEC-IN( 7:2) TO TDX-LAP-TXT-END-D
                 MOVE TDX-SEC-IN( 9:2) TO TDX-LAP-TXT-END-H
                 MOVE TDX-SEC-IN(11:2) TO TDX-LAP-TXT-END-I
                 MOVE TDX-SEC-IN(13:2) TO TDX-LAP-TXT-END-S
                 
                 COMPUTE TDX-LAP-DIFF = TDX-LAP-END-SEC
                                      - TDX-LAP-BEG-SEC
                 
                 MOVE TDX-LAP-DIFF TO TDX-HMS-SEC
                 PERFORM TDF-HMS

                 MOVE TDX-LAP-LEV TO TDX-LAP-TXT-LEV
                 MOVE TDX-HMS-TXT TO TDX-LAP-TXT-HMS
                 MOVE TDX-LAP-MSG TO TDX-LAP-TXT-MSG

                 DISPLAY TDX-LAP-TXT
                 
              END-IF
              
              MOVE FUNCTION CURRENT-DATE TO TDX-LAP-BEG(TDX-LAP-IDX)              
              
           ELSE
              DISPLAY '***ERROR - LEVELS 0 THRU 20 ONLY***'  
           END-IF
           .
       TDF-LAP-EXIT.
           EXIT.

      *****************************************************************

TDF-SECONDS Function - Convert Full Date/Time to Seconds

An additional function - TDF-SECONDS - is used to convert the dates to seconds. The intrinsic function INTEGER-OF-DATE returns the number of days since January 1, 1601 for both BEG/END values. The days are converted to seconds with a full day being removed. The time (Hours, minutes, seconds) are then converted and added to the total seconds. This allows an accurate lapsed time to be calculated by the TDF-LAP primary function.Yet one more function is utilized to convert the lapsed seconds into HHHH:MI.SS.SSSSS format - TDF-HMS.

      *****************************************************************
      *    TDF SECONDS - CONVERT FULL DATE FIELD TO SECONDS           *
      *****************************************************************
      *                                                               *
      *    FIELD              I/O  DESCRIPTION                        *
      *    -----------------  ---  ---------------------------------- *
      *    TDX-SEC-IN          I   FULL 20 CHARACTER DATE/TIME FIELD  *
      *    TDX-SEC-OUT         O   CONVERSION TO SECONDS              *
      *                                                               *
      *****************************************************************
      *                                                               *
      *    EXAMPLE:                                                   *
      *    ---------------------------------------------------------- *
      *    MOVE FUNCTION CURRENT-DATE TO TDX-SEC-IN                   *
      *    PERFORM TDF-SECONDS                                        *
      *    DISPLAY 'SECONDS: ' TDX-SEC-OUT                            *
      *    ---------------------------------------------------------- *
      *    RESULTS: 2024121715132474+050 => 013379008404.74000        *
      *                                                               *
      *****************************************************************
               
       TDF-SECONDS.
           
           COMPUTE TDX-SEC-INT
                 = FUNCTION INTEGER-OF-DATE(TDX-SEC-DATE)

           COMPUTE TDX-SEC-OUT
                 = (TDX-SEC-INT * (24*60*60))
                 - (24*60*60)
                 + (TDX-SEC-HH * 3600)
                 + (TDX-SEC-MI * 60)
                 + (TDX-SEC-SS)
                 + (TDX-SEC-MS / 100)
           .
       TDF-SECONDS-EXIT.
           EXIT.

      *****************************************************************

 

TDF-HMS Function - Format Lapsed Seconds (HMS)

This stand-alone function simply converts seconds into a more readable format - Hours, Minutes and Seconds. This will appear on the TDF-LAP Timing Log Output.

      *****************************************************************
      *    TDF HMS - CONVERT SECONDS TO HHHH:MM:SS.SSSSS FORMAT       *
      *****************************************************************
      *                                                               *
      *    FIELD              I/O  DESCRIPTION                        *
      *    -----------------  ---  ---------------------------------- *
      *    TDX-HMS-SEC         I   NUMBER OF SECONDS                  *
      *    TDX-HMS-TXT         O   OUTPUT STRING: HHHH:MM:SS.SSSSS    *
      *                                                               *
      *****************************************************************
      *                                                               *
      *    EXAMPLE:                                                   *
      *    ---------------------------------------------------------- *
      *    MOVE 22506.256          TO TDX-HMS-SEC                     *
      *    PERFORM TDF-HMS                                            *
      *    DISPLAY " OUT: " TDX-HMS-TXT                               *
      *    ---------------------------------------------------------- *
      *    RESULTS:  0006:15:06.25600 (22506.256 SECONDS)             *
      *                                                               *
      *****************************************************************

        TDF-HMS.

           COMPUTE TDX-HMS-HH  = TDX-HMS-SEC / 3600
           
           COMPUTE TDX-HMS-SEC = TDX-HMS-SEC
                               - (TDX-HMS-HH * 3600)
                               
           COMPUTE TDX-HMS-MM  = TDX-HMS-SEC / 60
           
           COMPUTE TDX-HMS-SEC = TDX-HMS-SEC
                               - (TDX-HMS-MM * 60)
           
           COMPUTE TDX-HMS-SS  = TDX-HMS-SEC

           MOVE TDX-HMS-HH    TO TDX-HMS-TXT-HH
           MOVE TDX-HMS-MM    TO TDX-HMS-TXT-MM
           MOVE TDX-HMS-SS    TO TDX-HMS-TXT-SS
                      
           .
       TDF-HMS-EXIT.
           EXIT.

      *****************************************************************

 

TDFWORK.CPY - Supporting Fields for TDFPROC.CPY Routines.

The working storage fields/arrays are contained in the TDFWORK.CPY copybook.

      *****************************************************************
      *    TDF FUNCTION PARAMETERS / WORKING STORAGE                  *
      *****************************************************************

       01  TDX-HMS-PARMS.
           05  TDX-HMS-SEC            PIC 9(12)V9(5) COMP-3.
           05  TDX-HMS-HH             PIC 9(6)       COMP-3.
           05  TDX-HMS-MM             PIC 9(3)       COMP-3.
           05  TDX-HMS-SS             PIC 9(3)V9(5)  COMP-3.
           05  TDX-HMS-TXT.
               10  TDX-HMS-TXT-HH     PIC 9(4).
               10  FILLER             PIC X          VALUE ':'.
               10  TDX-HMS-TXT-MM     PIC 9(2).
               10  FILLER             PIC X          VALUE ':'.
               10  TDX-HMS-TXT-SS     PIC 9(2).9(5).

       01  TDX-SECONDS-PARMS.
           05  TDX-SEC-INT            PIC  9(8).
           05  TDX-SEC-OUT            PIC  9(16)V9(5) COMP-3.
           05  TDX-SEC-IN.
               10  TDX-SEC-DATE       PIC  9(8).
               10  TDX-SEC-TIME.
                   15  TDX-SEC-HH     PIC  9(2).
                   15  TDX-SEC-MI     PIC  9(2).
                   15  TDX-SEC-SS     PIC  9(2).
                   15  TDX-SEC-MS     PIC  9(2).
               10  TDX-SEC-GMT        PIC S9(4).

       01  TDX-LAP-PARMS.
           05  TDX-LAP-OPER           PIC  X(3).
               88  TDX-LAP-OPER-BEG   VALUE 'BEG'.
               88  TDX-LAP-OPER-END   VALUE 'END'.
           05  TDX-LAP-LEV            PIC  99.
               88  TDX-LAP-LEV-OK     VALUES 0 THRU 20.
           05  TDX-LAP-MSG            PIC  X(50).
           05  TDX-LAP-BEG-SEC        PIC  9(12)V9(5) COMP-3.
           05  TDX-LAP-END-SEC        PIC  9(12)V9(5) COMP-3.
           05  TDX-LAP-DIFF           PIC  9(12)V9(5) COMP-3.
           05  TDX-LAP-IDX            PIC  99.
           05  TDX-LAP-MTX            OCCURS 21 TIMES.
               10  TDX-LAP-BEG        PIC  X(20).
               10  TDX-LAP-END        PIC  X(20).
           05  TDX-LAP-TXT.
               10  FILLER             PIC  X(2) VALUE 'L('.
               10  TDX-LAP-TXT-LEV    PIC  99.
               10  FILLER             PIC  X(6) VALUE ') BEG('.
               10  TDX-LAP-TXT-BEG-Y  PIC  9999.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-BEG-M  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-BEG-D  PIC  99.
               10  FILLER             PIC  X    VALUE '_'.
               10  TDX-LAP-TXT-BEG-H  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-BEG-I  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-BEG-S  PIC  99.
               10  FILLER             PIC  X(6) VALUE ') END('.
               10  TDX-LAP-TXT-END-Y  PIC  9999.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-END-M  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-END-D  PIC  99.
               10  FILLER             PIC  X    VALUE '_'.
               10  TDX-LAP-TXT-END-H  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-END-I  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-END-S  PIC  99.
               10  FILLER             PIC  X(6) VALUE ') HMS('.
               10  TDX-LAP-TXT-HMS    PIC  X(16).
               10  FILLER             PIC  X(7) VALUE ') MSG: '.
               10  TDX-LAP-TXT-MSG    PIC  X(50).

      *****************************************************************

Test all 21 nested timings:

Here's a simple COBOL procedure that loops 21 times to populate BEG times for nested levels 0 thru 20. Then it loops an additional 21 times to populate the END times for levels 20 down to 0. A log entry will be printed for each END operation. The LAPSE-LOOP just creates a delay - otherwise the timings will vary in microseconds only.

           MOVE 0               TO TDX-LAP-LEV
           PERFORM UNTIL TDX-LAP-LEV > 20
              MOVE 'BEG'        TO TDX-LAP-OPER
              PERFORM TDF-LAP
              ADD 1             TO TDX-LAP-LEV
              PERFORM LAPSE-LOOP
           END-PERFORM

           PERFORM LAPSE-LOOP

           MOVE 21              TO TDX-LAP-LEV
           PERFORM UNTIL TDX-LAP-LEV <= 0
              PERFORM LAPSE-LOOP
              SUBTRACT 1      FROM TDX-LAP-LEV
              MOVE 'END'        TO TDX-LAP-OPER
              MOVE 'LEVEL TEST' TO TDX-LAP-MSG
              PERFORM TDF-LAP
           END-PERFORM

Full Test Output:

Running the test program TDDATE through OpenCobolIDE - the results are printed to the log.

Success! BEG/END times are registered for each level along with lapsed time. The first test loop set the BEG times while the second test loop marked the END and produced the output. Each level listed is a subset of the next with 20 being the lowest nest and 0 the primary. The entry levels can be used in any fashion - nested or not.

That's the end of the COBOL Timing Demonstration - Up next PC/370 Assembler.

A Matter of Time - Part 1 - Intro

It was only a matter of time before I posted an article about my TDF_LAP() function - which is literally a "matter of time". I created this useful function to measure the timings of routines and SQL statements in SQR batch processes. It's actually a set of timing entries that can be nested - levels 0 thru 20. In general, a simple BEG and END call will calculate the elapsed time in between and print the results on a log.

Above: LEGO Guy returns - he's going to replicate the TDF_LAP function in Asssembler. Stay tuned...

Flashback: LEGO Guy loves Assembler

Sample Log Output - AP Vendor/Sourcing Extract

Process_Main uses timing set number 1 and contains all the other routines which use the stand-alone level of zero. The nested levels end and appear first followed by the high level Process_Main routine which displays the total BEG/END information.

 

 

 

TDF_LAP() Function

Below are the usage notes & parameter descriptions for the TDF_LAP() function. The LOG Y/N option is useful if a routine or SQL statement is executed multiple times - say 1000 or more. The calculated lapsed time (#O_sec) can then be aggregated & printed after all instances have executed instead of printing 1000+ log entries.

!**********************************************************************
!*       LAPSE Between Begin/End Times                                *
!**********************************************************************
!*                                                                    *
!*        INPUT: $I_oper    - Operation Type (BEG/END)                *
!*               #I_idx     - Lapse Index Set (0 thru 20)             *
!*               $I_log     - Display Log Output? (Y/N)               *
!*               $I_msg     - Message Text                            *
!*       OUTPUT: #O_sec     - Lapsed in seconds                       *
!*               $O_hms     - Lapsed in HH:MI:SS Format               *
!*                                                                    *
!**********************************************************************
!*                                                                    *
!*      EXAMPLE: do TDF_LAP('BEG', 0, 'N','', #O_sec, $O_hms)         *
!*               ...                                                  *
!*               do TDF_LAP('END', 0, 'Y', 'Lapsed', #O_sec, $O_hms)  *
!*                                                                    *
!*      RESULTS: Displays Duration between BEG/END times.             *
!*               Returns Duration in both seconds and HH:MI:SS.       *
!*               Resets BEG time to END time for next lapse message.  *
!*               Index Set 0 used for timings (0 thru 20 available) - *
!*               use different sets for nested timings (otherwise 0). *
!*                                                                    *
!**********************************************************************

Sample - Nested Timings

The routine below is part of a much larger process - a custom Voucher Edit/Build module. The routine NSS_Edit_AP_Invoice_Dup will use timing levels 7, 8 and 9 to track each nested component of the routine.

!**********************************************************************
!*       NSS Edit AP Invoice Duplicate                                *
!**********************************************************************

begin-procedure NSS_Edit_AP_Invoice_Dup

do TDF_LAP('BEG', 7, 'N', '', #O_sec, $O_hms)

let $DUP_VNDR               = ' and a.vendor_setid  = ~<SETID>~ '   ||
                              ' and a.vendor_id     = u.vendor_id '

let $DUP_VNDR               = replace($DUP_VNDR, '<SETID>', $NSS_setid_vendor)
let $DUP_VNDR               = replace($DUP_VNDR, '~', chr(39))

create-array name=DUPmtx size=5 field=DUPsql:char

let DUPmtx.DUPsql (0)       = ' and a.business_unit = u.business_unit '
let DUPmtx.DUPsql (1)       = $DUP_vndr
let DUPmtx.DUPsql (2)       = ' and a.invoice_id    = u.invoice_id '
let DUPmtx.DUPsql (3)       = ' and a.invoice_dt    = u.invoice_dt '
let DUPmtx.DUPsql (4)       = ' and a.gross_amt     = u.invoice_amount '

!   Initialize Defaults at Origin/BU Levels

let #DUPdef                 = #OPT_dup_inv_comb_code

!   Update Staging Detail with Specified/Default Combination Options

let $SQL_proc               = 'NSS_Edit_AP_Invoice_Dup (Options)'
let $SQL_action             = 'Update'
let $SQL_table              = 'XX_API_STG_DTL'

do TDF_LAP('BEG', 8, 'N', '', #O_sec, $O_hms)

begin-sql On-Error=Error-Routine

update ps_xx_api_stg_dtl      u
   set (u.dup_invoice_ind,
        u.dup_inv_comb_code) =
       (select a.dup_invoice_ind,
               decode(a.dup_invoice_ind,
               'D', #DUPdef,
                 decode(a.dup_invoice_action,
                   'K',a.dup_inv_comb_code,0))
          from ps_vendor_invoice   a
         where a.setid           = $NSS_setid_vendor
           and a.vendor_id       = u.vendor_id
           and a.effdt           =
               (select max(a2.effdt)
                  from ps_vendor_invoice   a2
                 where a2.setid          = a.setid
                   and a2.vendor_id      = a.vendor_id
                   and a2.effdt         <= sysdate))
 where u.business_unit      = $NSS_business_unit
   and u.xx_batch_type      = $NSS_xx_batch_type
   and u.xx_batch_id        = #NSS_xx_batch_id
   and u.xx_line_status     = 'P'
   and exists
       (select 'X'
          from ps_vendor_invoice   a
         where a.setid           = $NSS_setid_vendor
           and a.vendor_id       = u.vendor_id
           and a.effdt          <= sysdate)

end-sql

do TDF_LAP('END', 8, 'Y', $SQL_proc, #O_sec, $O_hms)

!    Cycle Thru Distinct Combinations (Dynamic SQL)

do TDF_LAP('BEG', 8, 'N', '', #O_sec, $O_hms)

begin-select

dup.dup_inv_comb_code

  let $DUPwhere             = ''
  let #DUPcode              = &dup.dup_inv_comb_code
  let #DUPmap               = &dup.dup_inv_comb_code
  while #DUPmap             > 0
     do TDF_ERRBIT(#DUPmap, #DUPidx, #DUPval)
     let $DUPsql            = DUPmtx.DUPsql (#DUPidx)
     let $DUPwhere          = $DUPwhere || $DUPsql
  end-while

  do NSS_Edit_AP_Invoice_Dup_SQL

 from ps_xx_api_stg_dtl       dup
where dup.business_unit     = $NSS_business_unit
  and dup.xx_batch_type     = $NSS_xx_batch_type
  and dup.xx_batch_id       = #NSS_xx_batch_id
  and dup.xx_line_status    = 'P'
  and dup.dup_inv_comb_code > 0
group by dup.dup_inv_comb_code

end-select

let $SQL_proc               = 'NSS_Edit_AP_Invoice_Dup [SQL Cycles]'

do TDF_LAP('END', 8, 'Y', $SQL_proc, #O_sec, $O_hms)

let $SQL_proc               = 'NSS_Edit_AP_Invoice_Dup (Total)'

do TDF_LAP('END', 7, 'Y', $SQL_proc, #O_sec, $O_hms)

end-procedure

!**********************************************************************
!*       NSS Edit AP Invoice Duplicates (per SQL Combination)         *
!**********************************************************************

begin-procedure NSS_Edit_AP_Invoice_Dup_SQL

let $SQL_proc              = 'NSS_Edit_AP_Invoice_Dup_SQL'
let $SQL_action            = 'Update'
let $SQL_table             = 'XX_API_STG_DTL'

do TDF_LAP('BEG', 9, 'N', '', #O_sec, $O_hms)

begin-sql On-Error=Error-Routine

update ps_xx_api_stg_dtl     u
   set u.xx_err_ap         = u.xx_err_ap + {ERR_AP_duplicate},
       u.xx_errors         = u.xx_errors + 1
 where u.business_unit     = $NSS_business_unit
   and u.xx_batch_type     = $NSS_xx_batch_type
   and u.xx_batch_id       = #NSS_xx_batch_id
   and u.xx_line_status    = 'P'
   and u.dup_inv_comb_code = #DUPcode
   and exists
      (select 'X'
         from ps_voucher        a
        where 1 = 1
         [$DUPwhere]
          and a.business_unit in
              (select z.setcntrlvalue
                 from ps_set_cntrl_rec   z
                where z.setid          = $NSS_setid_vendor
                  and z.recname        = 'VENDOR')
          and a.invoice_id    = u.invoice_id
          and a.entry_status <> 'X'
          and a.close_status <> 'C');

commit;

end-sql

let $SQL_proc              = $SQL_proc || ' [' || to_char(#DUPcode) || ']'

do TDF_LAP('END', 9, 'Y', $SQL_proc, #O_sec, $O_hms)

end-procedure

!**********************************************************************

Portion of LOG Output:

 

The TDF_LAP() calls are highlighted in the code above. The 'nested' timings use levels 7, 8 and 9 in this example. The entire routine took .49 micro-seconds as shown by the last line (level 7 timing). The two nested level 8 entries show .32 and .17 microseconds - level 9 is a subset of the second level 8 entry at .06 microseconds.

The TDF_LAP() function is a staple in all my SQR processes.

Coming up - COBOL and Assembler/370 versions.

 

COBOL - Hyper-Extreme Numeric to Literal Translation Overkill

Back in March 2019 I posted a WinBatch routine that translates extremely large numeric values into it's literal English form. WinBatch - Hyper-Extreme Numeric to Literal Translation Overkill

The extremely nonsensical routine produces literal translations into the VIGINTILLIONS (I also have a more practical SQR version that is limited to Billions). Since I recently downloaded & installed OpenCobolIDE I've been having fun writing code - so why not replicate this practically useless but interesting function. 

Above: The WinBatch GUI with ridiculous Numeric-To-Literal translation.

The COBOL version will be kept much simpler - no need for a repeat of a GUI Check Interface. Just the function and a test module to produce the results.

Components:

TDFNLW.CPY - Numeric-To-Literal Working Storage CopyBook.

TDFNLP.CPY - Numeric-To-Literal Procedure CopyBook.

TDTESTNL.CBL - Test Module (Calls Function - Display Results)

TDFNLP.CPY - TDF-NL Function (Procedure)

      *****************************************************************
      *                                                               *
      *   MODULE: TDFNLP.CPY                                          *
      *   AUTHOR: TONY DELIA.                                         *
      *     DATE: 11/23/2024.                                         *
      *   SYSTEM: WINDOWS 11/OpenCobolIDE 4.7.6                       *
      *     DESC: COBOL USER FUNCTION - NUMERIC TO LITERAL.           *
      *                                                               *
      *****************************************************************
      *     NOTE: REQUIRES TDFNLW.CPY COPYBOOK (W-S SECTION).         *
      *           ALSO TDPROC.CPY/TDWORK.CPY FOR ADDL FUNCTIONS.      *
      *****************************************************************
      *                                                               *
      *  ROUTINE         DESCRIPTION                                  *
      *  --------------  -------------------------------------------- *
      *  TDF-NL          CONVERT NUMERIC VALUE TO LITERAL TEXT        *
      *                                                               *
      *****************************************************************

      *****************************************************************
      *    REVISIONS:                                                 *
      *****************************************************************
      *                                                               *
      *   DATE     PROGRAMMER      DESCRIPTION                        *
      * ---------- --------------- ---------------------------------- *
      *                                                               *
      * 11/23/2024 DELIA,TONY      ORIGINAL CODING.                   *
      *                                                               *
      *****************************************************************

      *****************************************************************
      *    TDF NL - CONVERT NUMERIC VALUE TO LITERAL TEXT             *
      *****************************************************************
      *                                                               *
      *    FIELD              I/O  DESCRIPTION                        *
      *    -----------------  ---  ---------------------------------- *
      *    TDX-NL-AMT          I   INPUT NUMERIC STRING               *
      *    TDX-NL-TEXT         O   RETURNS LITERAL TEXT CONVERSION    *
      *                                                               *
      *****************************************************************
      *                                                               *
      *    EXAMPLE:                                                   *
      *    ---------------------------------------------------------- *
      *    MOVE 789000000000093    TO TDX-NL-AMT                      *
      *    PERFORM TDF-NL                                             *
      *    DISPLAY 'TEXT: ' TDX-NL-TEXT                               *
      *    ---------------------------------------------------------- *
      *    RESULTS:                                                   *
      *    ---------------------------------------------------------- *
      *     IN: 789000000000093                                       *
      *    OUT: Seven Hundred Eighty-Nine Trillion Ninety-Three       *
      *    ---------------------------------------------------------- *
      *     IN: 72000009004000000000000                               *
      *    OUT: Seventy-Two Sextillion Nine Quadrillion Four Trillion *
      *    ---------------------------------------------------------- *
      *     IN: 123056                                                *
      *    OUT: One Hundred Twenty-Three Thousand Fifty-Six           *
      *                                                               *
      *****************************************************************

       TDF-NL.

           MOVE ZEROES TO TDX-NL-WRK
           MOVE SPACES TO TDX-NL-TEXT

           MOVE TDX-NL-AMT           TO TDX-LEN-FLD
           MOVE LENGTH OF TDX-NL-AMT TO TDX-LEN-VAL
           PERFORM TDF-LENGTH
           MOVE TDX-LEN-VAL          TO TDX-NL-LEN

           IF TDX-NL-LEN > LENGTH OF TDX-NL-WRK
              MOVE '***MAXIMUM LENGTH EXCEEDED***' TO TDX-NL-TEXT
           ELSE

           COMPUTE TDX-NL-X = 67 - TDX-NL-LEN

           MOVE TDX-NL-AMT(1:TDX-NL-LEN)
                TO TDX-NL-WRK(TDX-NL-X:TDX-NL-LEN)

           IF TDX-NL-WRK IS NOT NUMERIC
              MOVE '***INPUT NOT NUMERIC VALUE***' TO TDX-NL-TEXT
           ELSE

           MOVE 1 TO TDX-NL-POS
           MOVE 1 TO TDX-NL-LEV
           MOVE 1 TO TDX-NL-PTR

           PERFORM UNTIL TDX-NL-LEV > TDX-NL-MAX-B

             MOVE TDX-NL-WRK(TDX-NL-POS:3) TO TDX-NL-SEG

             IF  TDX-NL-SEG      <> '000'

                 IF TDX-NL-SEG-HI > 0

                    MOVE TDX-NL-LIT-A(TDX-NL-SEG-HI) TO TDX-NL-TMP
                    MOVE TDX-NL-TMP                  TO TDX-LEN-FLD
                    MOVE LENGTH OF TDX-NL-LIT-A      TO TDX-LEN-VAL
                    PERFORM TDF-LENGTH

                    ADD 1 TO TDX-LEN-VAL
                    MOVE ' Hundred' TO TDX-NL-TMP(TDX-LEN-VAL:8)
                    ADD 8 TO TDX-LEN-VAL

                    MOVE TDX-NL-TMP(1:TDX-LEN-VAL)
                      TO TDX-NL-TEXT(TDX-NL-PTR:TDX-LEN-VAL)

                    ADD TDX-LEN-VAL TO TDX-NL-PTR

                    IF TDX-NL-SEG-LO > 0
                       MOVE SPACE TO TDX-NL-TEXT(TDX-NL-PTR:1)
                    END-IF

                 END-IF

                 IF TDX-NL-SEG-LO > 20

                    DIVIDE TDX-NL-SEG-LO BY 10
                           GIVING TDX-NL-X REMAINDER TDX-NL-MOD
                    ADD 18 TO TDX-NL-X

                    MOVE TDX-NL-MOD TO TDX-NL-SEG-LO

                    MOVE TDX-NL-LIT-A(TDX-NL-X)  TO TDX-NL-TMP
                    MOVE TDX-NL-TMP              TO TDX-LEN-FLD
                    MOVE LENGTH OF TDX-NL-LIT-A  TO TDX-LEN-VAL
                    PERFORM TDF-LENGTH

                    MOVE TDX-NL-TMP(1:TDX-LEN-VAL)
                      TO TDX-NL-TEXT(TDX-NL-PTR:TDX-LEN-VAL)

                    ADD TDX-LEN-VAL TO TDX-NL-PTR

                    IF TDX-NL-SEG-LO > 0
                       MOVE '-' TO TDX-NL-TEXT(TDX-NL-PTR:1)
                       ADD 1 TO TDX-NL-PTR
                    END-IF

                 END-IF

                 IF TDX-NL-SEG-LO > 0

                    MOVE TDX-NL-LIT-A(TDX-NL-SEG-LO) TO TDX-NL-TMP
                    MOVE TDX-NL-TMP                  TO TDX-LEN-FLD
                    MOVE LENGTH OF TDX-NL-LIT-A      TO TDX-LEN-VAL
                    PERFORM TDF-LENGTH

                    MOVE TDX-NL-TMP(1:TDX-LEN-VAL)
                      TO TDX-NL-TEXT(TDX-NL-PTR:TDX-LEN-VAL)

                    ADD TDX-LEN-VAL TO TDX-NL-PTR

                    MOVE SPACE TO TDX-NL-TEXT(TDX-NL-PTR:1)
 
                 END-IF

                 MOVE TDX-NL-LIT-B(TDX-NL-LEV) TO TDX-NL-TMP
                 MOVE TDX-NL-TMP               TO TDX-LEN-FLD
                 MOVE LENGTH OF TDX-NL-LIT-B   TO TDX-LEN-VAL
                 PERFORM TDF-LENGTH

                 IF TDX-LEN-VAL > 0

                    MOVE TDX-NL-TMP(1:TDX-LEN-VAL)
                      TO TDX-NL-TEXT(TDX-NL-PTR:TDX-LEN-VAL)

                    ADD TDX-LEN-VAL TO TDX-NL-PTR

                    MOVE SPACE TO TDX-NL-TEXT(TDX-NL-PTR:1)
                    ADD  1     TO TDX-NL-PTR

                 END-IF

             END-IF

             ADD 1 TO TDX-NL-LEV
             ADD 3 TO TDX-NL-POS

           END-PERFORM

           IF TDX-NL-TEXT EQUAL SPACES
              MOVE 'Zero' TO TDX-NL-TEXT
           END-IF

           END-IF
           END-IF
           .
       TDF-NL-EXIT.
           EXIT.

      *****************************************************************
      *    END OF COPYBOOK                                            *
      *****************************************************************

TDFNLW.CPY - TDF-NL Working Storage/Variables

      *****************************************************************
      *                                                               *
      *   MODULE: TDFNLW.CPY                                          *
      *   AUTHOR: TONY DELIA.                                         *
      *     DATE: 11/23/2024.                                         *
      *   SYSTEM: WINDOWS 11/OpenCobolIDE 4.7.6                       *
      *     DESC: COBOL USER FUNCTION - NUMERIC TO LITERAL.           *
      *                                                               *
      *****************************************************************
      *     NOTE: REQUIRES TDFNLP.CPY COPYBOOK (PROCEDURE SECTION).   *
      *           ALSO TDPROC.CPY/TDWORK.CPY FOR ADDL FUNCTIONS.      *
      *****************************************************************
      *                                                               *
      *  ROUTINE         DESCRIPTION                                  *
      *  --------------  -------------------------------------------- *
      *  TDF-NL          CONVERT NUMERIC VALUE TO LITERAL TEXT        *
      *                                                               *
      *****************************************************************

      *****************************************************************
      *    REVISIONS:                                                 *
      *****************************************************************
      *                                                               *
      *   DATE     PROGRAMMER      DESCRIPTION                        *
      * ---------- --------------- ---------------------------------- *
      *                                                               *
      * 11/23/2024 DELIA,TONY      ORIGINAL CODING.                   *
      *                                                               *
      *****************************************************************

       01  TDF-NL-PARMS.
           05  TDX-NL-AMT           PIC X(70).
           05  TDX-NL-WRK           PIC X(66) VALUE ZEROES.
           05  TDX-NL-LEN           PIC 99.
           05  TDX-NL-X             PIC 99.
           05  TDX-NL-IDX           PIC 999.
           05  TDX-NL-MAX-A         PIC 999 VALUE 27.
           05  TDX-NL-MAX-B         PIC 999 VALUE 22.
           05  TDX-NL-POS           PIC 9(4).
           05  TDX-NL-LEV           PIC 99.
           05  TDX-NL-PTR           PIC 9(4).
           05  TDX-NL-MOD           PIC 99.
           05  TDX-NL-SEG.
               10  TDX-NL-SEG-HI    PIC 9.
               10  TDX-NL-SEG-LO    PIC 99.
           05  TDX-NL-TMP           PIC X(20).

           05  TDX-NL-MTX-A.
      *        Direct Indexing Literals
               10  FILLER           PIC X(10) VALUE 'One'.
               10  FILLER           PIC X(10) VALUE 'Two'.
               10  FILLER           PIC X(10) VALUE 'Three'.
               10  FILLER           PIC X(10) VALUE 'Four'.
               10  FILLER           PIC X(10) VALUE 'Five'.
               10  FILLER           PIC X(10) VALUE 'Six'.
               10  FILLER           PIC X(10) VALUE 'Seven'.
               10  FILLER           PIC X(10) VALUE 'Eight'.
               10  FILLER           PIC X(10) VALUE 'Nine'.
               10  FILLER           PIC X(10) VALUE 'Ten'.
               10  FILLER           PIC X(10) VALUE 'Eleven'.
               10  FILLER           PIC X(10) VALUE 'Twelve'.
               10  FILLER           PIC X(10) VALUE 'Thirteen'.
               10  FILLER           PIC X(10) VALUE 'Fourteen'.
               10  FILLER           PIC X(10) VALUE 'Fifteen'.
               10  FILLER           PIC X(10) VALUE 'Sixteen'.
               10  FILLER           PIC X(10) VALUE 'Seventeen'.
               10  FILLER           PIC X(10) VALUE 'Eighteen'.
               10  FILLER           PIC X(10) VALUE 'Nineteen'.
               10  FILLER           PIC X(10) VALUE 'Twenty'.
      *        Combination Indexing Literals
               10  FILLER           PIC X(10) VALUE 'Thirty'.
               10  FILLER           PIC X(10) VALUE 'Forty'.
               10  FILLER           PIC X(10) VALUE 'Fifty'.
               10  FILLER           PIC X(10) VALUE 'Sixty'.
               10  FILLER           PIC X(10) VALUE 'Seventy'.
               10  FILLER           PIC X(10) VALUE 'Eighty'.
               10  FILLER           PIC X(10) VALUE 'Ninety'.
           05  TDX-NL-MTX-X REDEFINES TDX-NL-MTX-A.
               10  TDX-NL-LIT-A     PIC X(10) OCCURS 27 TIMES.
           05  TDX-NL-MTX-B.
               10  FILLER           PIC X(20) VALUE ' Vigintillion'.
               10  FILLER           PIC X(20) VALUE ' Novemdecillion'.
               10  FILLER           PIC X(20) VALUE ' Octodecillion'.
               10  FILLER           PIC X(20) VALUE ' Septendecillion'.
               10  FILLER           PIC X(20) VALUE ' Sexdecillion'.
               10  FILLER           PIC X(20) VALUE ' Quindecillion'.
               10  FILLER           PIC X(20) VALUE ' Quatuordecillion'.
               10  FILLER           PIC X(20) VALUE ' Tredecillion'.
               10  FILLER           PIC X(20) VALUE ' Duodecillion'.
               10  FILLER           PIC X(20) VALUE ' Undecillion'.
               10  FILLER           PIC X(20) VALUE ' Decillion'.
               10  FILLER           PIC X(20) VALUE ' Nonillion'.
               10  FILLER           PIC X(20) VALUE ' Octillion'.
               10  FILLER           PIC X(20) VALUE ' Septillion'.
               10  FILLER           PIC X(20) VALUE ' Sextillion'.
               10  FILLER           PIC X(20) VALUE ' Quintillion'.
               10  FILLER           PIC X(20) VALUE ' Quadrillion'.
               10  FILLER           PIC X(20) VALUE ' Trillion'.
               10  FILLER           PIC X(20) VALUE ' Billion'.
               10  FILLER           PIC X(20) VALUE ' Million'.
               10  FILLER           PIC X(20) VALUE ' Thousand'.
               10  FILLER           PIC X(20) VALUE ' '.
           05  TDX-NL-MTX-Y REDEFINES TDX-NL-MTX-B.
               10  TDX-NL-LIT-B     PIC X(20) OCCURS 22 TIMES.
           05  TDX-NL-TEXT          PIC X(1000).

      *****************************************************************
      *    END OF COPYBOOK                                            *
      *****************************************************************

TDTESTNL.CBL - Test Module

Snippet of Working Storage - WS-TEXT will hold the initial numeric value. WS-SCALE will be displayed to illustrate the length of the numeric field and WS-BIG-NUM is a big number - the maximum accepted by the TDF-NL function.

      *****************************************************************
      *    WORKING STORAGE                                            *
      *****************************************************************

       WORKING-STORAGE SECTION.

       01  WS-TEXT                  PIC X(66).

       01  WS-SCALE.
           05  FILLER               PIC X(10) VALUE '1...5...10'.
           05  FILLER               PIC X(10) VALUE '...15...20'.
           05  FILLER               PIC X(10) VALUE '...25...30'.
           05  FILLER               PIC X(10) VALUE '...35...40'.
           05  FILLER               PIC X(10) VALUE '...45...50'.
           05  FILLER               PIC X(10) VALUE '...55...60'.
           05  FILLER               PIC X(10) VALUE '...65...70'.

       01  WS-BIG-NUM.
           05  FILLER               PIC X(15) VALUE '999999999999999'.
           05  FILLER               PIC X(15) VALUE '999999999999999'.
           05  FILLER               PIC X(15) VALUE '999999999999999'.
           05  FILLER               PIC X(15) VALUE '999999999999999'.
           05  FILLER               PIC X(6)  VALUE '999999'.

       COPY TDFNLW.

       COPY TDFWORK.

      *****************************************************************

Testing logic - some static samples are built into the TEST-NL procedure followed by an optional user entered loop. Enter any number or <ENTER> to break out.

      *****************************************************************
      *    PROCEDURE DIVISION                                         *
      *****************************************************************

       PROCEDURE DIVISION.

       MAIN-PROCEDURE.

           DISPLAY '*** STATIC TEST CASES ***'

           PERFORM TEST-NL

           DISPLAY '*** ENTER NUMBER OR <ENTER> ***'
           ACCEPT WS-TEXT

           PERFORM UNTIL WS-TEXT EQUALS SPACES

              MOVE WS-TEXT TO TDX-NL-AMT
              PERFORM TDF-NL

              DISPLAY ' '
              DISPLAY '---: ' WS-SCALE
              DISPLAY ' IN: ' TDX-NL-AMT
              DISPLAY 'OUT: ' TDX-NL-TEXT

              DISPLAY '*** ENTER NUMBER OR <ENTER> ***'
              ACCEPT WS-TEXT

           END-PERFORM

           STOP RUN.

      *****************************************************************

OUTPUT:

 Maximum Output:

---: 1...5...10...15...20...25...30...35...40...45...50...55...60...65...70

 IN: 999999999999999999999999999999999999999999999999999999999999999999

OUT: Nine Hundred Ninety-Nine Vigintillion Nine Hundred Ninety-Nine Novemdecillion Nine Hundred Ninety-Nine Octodecillion Nine Hundred Ninety-Nine Septendecillion Nine Hundred Ninety-Nine Sexdecillion Nine Hundred Ninety-Nine Quindecillion Nine Hundred Ninety-Nine Quatuordecillion Nine Hundred Ninety-Nine Tredecillion Nine Hundred Ninety-Nine Duodecillion Nine Hundred Ninety-Nine Undecillion Nine Hundred Ninety-Nine Decillion Nine Hundred Ninety-Nine Nonillion Nine Hundred Ninety-Nine Octillion Nine Hundred Ninety-Nine Septillion Nine Hundred Ninety-Nine Sextillion Nine Hundred Ninety-Nine Quintillion Nine Hundred Ninety-Nine Quadrillion Nine Hundred Ninety-Nine Trillion Nine Hundred Ninety-Nine Billion Nine Hundred Ninety-Nine Million Nine Hundred Ninety-Nine Thousand Nine Hundred Ninety-Nine

There's not much else to say about this - except to repeat it's ridiculous but also interesting & fun.