Sunday, February 2, 2025
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.
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 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.
*****************************************************************
* 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).
*****************************************************************
* 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
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.
Tuesday, January 28, 2025
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.
Sunday, December 15, 2024
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.
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 *
*****************************************************************
* *
* 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.
*****************************************************************
* 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.
*****************************************************************
* 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.
Subscribe to:
Comments (Atom)