|
EDITINT COBOL Subroutine |
|
EDITINT subroutine determines validity of input unsigned integer number and edits it in its place (right-justifies by adding leading zeros), if the number is valid. If number is invalid, no editing is performed. Validity flag (Y/N) is passed back to the calling program. EDITINT Source Program Debugging program Debugging logout |
* Edit Input Unsigned Integer Number Subroutine (up to 16 Pos)
* ----------------------------------------------------------------
* Copyright (C) 1990–1997 by Vladimir Veytsel www.davar.net
* Call -----------------------------------------------------------
* CALL 'EDITINT' USING Number-Field
* Number-Length
* Validity-Flag.
* Parameters -----------------------------------------------------
* Number-Field - Input & output (edited) number (max 16 pos)
* If input number is invalid,
* then Number-Field is left unchanged.
* Number-Length - Length of input number (starts from 1-st pos
* of Number-Field; 16 - maximum).
* Output number has the same length.
* Validity-Flag - Number validity output indicator:
* 'Y' if input number is valid (and edited)
* 'N' if input number is invalid (unchanged)
* Action ---------------------------------------------------------
* If leftmost Number-Length positions of Number-Field contain
* a numeric value,
* then this value is right-justified in its place
* by adding the appropriate number of leading zeros and
* Validity-Flag is set to 'Y',
* else Validity-Flag is set to 'N'.
* Examples -------------------------------------------------------
* Number before: '12___'
* Number after : '00012' Validity flag: Y - Number edited
* Number before: '12345'
* Number after : '12345' Validity flag: Y - Number edited
* Number before: ' 45'
* Number after : '00045' Validity flag: Y - Number edited
* Number before: '__3__'
* Number after : '00003' Validity flag: Y - Number edited
* Number before: ' 2 4 '
* Number after : ' 2 4 ' Validity flag: N
* Number before: '+2345'
* Number after : '+2345' Validity flag: N
* Number before: '_2.4_'
* Number after : '_2.4_' Validity flag: N
* Number before: ' '
* Number after : '00000' Validity flag: Y - Number edited
* Number before: '00___'
* Number after : '00000' Validity flag: Y - Number edited
* Number before: ' 00'
* Number after : '00000' Validity flag: Y - Number edited
* Number before: '__0__'
* Number after : '00000' Validity flag: Y - Number edited
* Number before: ' 0 0 '
* Number after : ' 0 0 ' Validity flag: N
* Number before: '+0000'
* Number after : '+0000' Validity flag: N
* Number before: '_0.0_'
* Number after : '_0.0_' Validity flag: N
* Notes ----------------------------------------------------------
* - Examples show number values before and after calling EDITINT
* - Underscore '_' in examples stands for LOW-VALUE
*-----------------------------------------------------------------
IDENTIFICATION DIVISION.
*-----------------------------------------------------------------
PROGRAM-ID. EDITINT IS INITIAL PROGRAM.
AUTHOR. Vladimir Veytsel.
DATE-WRITTEN. 08/21/1990.
DATE-COMPILED. 10/15/1997.
*-----------------------------------------------------------------
DATA DIVISION.
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
77 Zero-Fill PIC X(16) VALUE ZEROS.
01 Work-Number PIC X(16).
01 FILLER REDEFINES Work-Number.
02 Number-Symbol PIC X OCCURS 16 TIMES.
77 Work-Number-Temp PIC X(16).
77 Work-Length PIC 9(02) COMP.
*-----------------------------------------------------------------
LINKAGE SECTION.
77 Number-Field PIC X(16).
77 Number-Length PIC 9(02) COMP.
01 Validity-Flag PIC X.
88 Valid-Number VALUE 'Y'.
88 InValid-Number VALUE 'N'.
*-----------------------------------------------------------------
PROCEDURE DIVISION USING Number-Field
Number-Length
Validity-Flag.
*-----------------------------------------------------------------
* Adjust Specified Length of Input Number ------------------------
IF (Number-Length > 16)
MOVE 16 TO Number-Length.
* Get Source Number String and Replace Low Values by Spaces ------
MOVE Number-Field(1:Number-Length) TO Work-Number.
INSPECT Work-Number REPLACING ALL LOW-VALUES BY SPACES.
* Replace Leading Spaces in Source Number Field by Zeros ---------
INSPECT Work-Number
REPLACING LEADING SPACES BY ZEROS.
* Determine Actual Length of Source Number Field -----------------
PERFORM WITH TEST AFTER
VARYING Work-Length FROM Number-Length BY -1
UNTIL ((Number-Symbol(Work-Length) NOT = SPACE) OR
(Work-Length < 2))
END-PERFORM.
* Adjust Number to Specified Length by Adding Leading Zeros ------
IF (Work-Length < Number-Length)
MOVE Work-Number TO Work-Number-Temp
STRING Zero-Fill(1 : Number-Length - Work-Length)
Work-Number-Temp DELIMITED BY SIZE
INTO Work-Number.
* Check Number Validity and Form Target Number if Valid ----------
IF (Work-Number(1:Number-Length) IS NUMERIC)
MOVE Work-Number (1:Number-Length)
TO Number-Field(1:Number-Length)
MOVE 'Y' TO Validity-Flag
ELSE
MOVE 'N' TO Validity-Flag.
|
EDITINT Debugging Program Source program Debugging logout |
* Debug Program for Edit Input Unsigned Integer Number Subroutine
* ----------------------------------------------------------------
*-----------------------------------------------------------------
IDENTIFICATION DIVISION.
*-----------------------------------------------------------------
PROGRAM-ID. ZEDITINT.
AUTHOR. Vladimir Veytsel.
DATE-WRITTEN. 09/23/1990.
DATE-COMPILED. 10/15/1997.
*-----------------------------------------------------------------
DATA DIVISION.
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
01 Test-Field.
02 FILLER PIC X(1) VALUE QUOTE.
02 Test-Number PIC X(5).
02 FILLER PIC X(1) VALUE QUOTE.
77 Test-Number-Length PIC 99 COMP.
01 Validity-Flag PIC X.
88 Valid-Number VALUE 'Y'.
88 InValid-Number VALUE 'N'.
01 Test-Table.
02 FILLER PIC X(5) VALUE '1 '.
02 FILLER PIC X(5) VALUE '12 '.
02 FILLER PIC X(5) VALUE '123 '.
02 FILLER PIC X(5) VALUE '1234 '.
02 FILLER PIC X(5) VALUE '12345'.
02 FILLER PIC X(5) VALUE ' 2345'.
02 FILLER PIC X(5) VALUE ' 345'.
02 FILLER PIC X(5) VALUE ' 45'.
02 FILLER PIC X(5) VALUE ' 5'.
02 FILLER PIC X(5) VALUE ' 3 '.
02 FILLER PIC X(5) VALUE ' 2 4 '.
02 FILLER PIC X(5) VALUE '1 3 5'.
02 FILLER PIC X(5) VALUE ' 234 '.
02 FILLER PIC X(5) VALUE '+2345'.
02 FILLER PIC X(5) VALUE '-2345'.
02 FILLER PIC X(5) VALUE '*2345'.
02 FILLER PIC X(5) VALUE '/2345'.
02 FILLER PIC X(5) VALUE ' 2 4 '.
02 FILLER PIC X(5) VALUE ' 2,4 '.
02 FILLER PIC X(5) VALUE ' 2.4 '.
02 FILLER PIC X(5) VALUE ' '.
02 FILLER PIC X(5) VALUE ' '.
02 FILLER PIC X(5) VALUE '0 '.
02 FILLER PIC X(5) VALUE '00 '.
02 FILLER PIC X(5) VALUE '000 '.
02 FILLER PIC X(5) VALUE '0000 '.
02 FILLER PIC X(5) VALUE '00000'.
02 FILLER PIC X(5) VALUE ' 0000'.
02 FILLER PIC X(5) VALUE ' 000'.
02 FILLER PIC X(5) VALUE ' 00'.
02 FILLER PIC X(5) VALUE ' 0'.
02 FILLER PIC X(5) VALUE ' 0 '.
02 FILLER PIC X(5) VALUE ' 0 0 '.
02 FILLER PIC X(5) VALUE '0 0 0'.
02 FILLER PIC X(5) VALUE ' 000 '.
02 FILLER PIC X(5) VALUE '+0000'.
02 FILLER PIC X(5) VALUE '-0000'.
02 FILLER PIC X(5) VALUE '*0000'.
02 FILLER PIC X(5) VALUE '/0000'.
02 FILLER PIC X(5) VALUE ' 0 0 '.
02 FILLER PIC X(5) VALUE ' 0,0 '.
02 FILLER PIC X(5) VALUE ' 0.0 '.
01 FILLER REDEFINES Test-Table.
02 Test-Value PIC X(5) OCCURS 42 TIMES.
77 Counter PIC 99 COMP.
77 Counter-Out PIC Z9.
77 Div-Count PIC 99 COMP.
77 Rem-Count PIC 9 COMP.
77 Comment PIC X(15).
01 Compile-Date-Time.
02 Compile-Date PIC X(8).
02 Compile-Time PIC X(5).
*-----------------------------------------------------------------
PROCEDURE DIVISION.
*-----------------------------------------------------------------
MOVE WHEN-COMPILED TO Compile-Date-Time.
MOVE ':' TO Compile-Time(3:1).
DISPLAY 'EDITINT Edit Input Unsigned Integer Number '
Compile-Date ' ' Compile-Time.
DISPLAY '------------------------------------------------'
'--------------'.
MOVE LENGTH OF Test-Number TO Test-Number-Length.
PERFORM Test-Next-Number
VARYING Counter FROM 1 BY 1
UNTIL Counter > 42.
STOP RUN.
* Test Next Number from the Test Table ---------------------------
Test-Next-Number.
MOVE Test-Value(Counter) TO Test-Number.
DIVIDE Counter BY 2 GIVING Div-Count
REMAINDER Rem-Count.
IF (Rem-Count = 0)
INSPECT Test-Number
REPLACING ALL SPACES BY '_'.
MOVE Counter TO Counter-Out.
DISPLAY ' '.
DISPLAY Counter-Out '. Number before: ' Test-Field.
INSPECT Test-Number
REPLACING ALL '_' BY LOW-VALUES.
CALL 'EDITINT' USING Test-Number
Test-Number-Length
Validity-Flag.
INSPECT Test-Number
REPLACING ALL LOW-VALUES BY '_'.
IF (Valid-Number)
MOVE '- Number edited' TO Comment
ELSE
MOVE SPACES TO Comment.
DISPLAY ' Number after : ' Test-Field
' Validity flag: ' Validity-Flag
' ' Comment.
|
EDITINT Debugging Logout Source program Debugging program |
EDITINT Edit Input Unsigned Integer Number 01/06/98 14:37
--------------------------------------------------------------
1. Number before: '1 '
Number after : '00001' Validity flag: Y - Number edited
2. Number before: '12___'
Number after : '00012' Validity flag: Y - Number edited
3. Number before: '123 '
Number after : '00123' Validity flag: Y - Number edited
4. Number before: '1234_'
Number after : '01234' Validity flag: Y - Number edited
5. Number before: '12345'
Number after : '12345' Validity flag: Y - Number edited
6. Number before: '_2345'
Number after : '02345' Validity flag: Y - Number edited
7. Number before: ' 345'
Number after : '00345' Validity flag: Y - Number edited
8. Number before: '___45'
Number after : '00045' Validity flag: Y - Number edited
9. Number before: ' 5'
Number after : '00005' Validity flag: Y - Number edited
10. Number before: '__3__'
Number after : '00003' Validity flag: Y - Number edited
11. Number before: ' 2 4 '
Number after : ' 2 4 ' Validity flag: N
12. Number before: '1_3_5'
Number after : '1_3_5' Validity flag: N
13. Number before: ' 234 '
Number after : '00234' Validity flag: Y - Number edited
14. Number before: '+2345'
Number after : '+2345' Validity flag: N
15. Number before: '-2345'
Number after : '-2345' Validity flag: N
16. Number before: '*2345'
Number after : '*2345' Validity flag: N
17. Number before: '/2345'
Number after : '/2345' Validity flag: N
18. Number before: '_2_4_'
Number after : '_2_4_' Validity flag: N
19. Number before: ' 2,4 '
Number after : ' 2,4 ' Validity flag: N
20. Number before: '_2.4_'
Number after : '_2.4_' Validity flag: N
21. Number before: ' '
Number after : '00000' Validity flag: Y - Number edited
22. Number before: '_____'
Number after : '00000' Validity flag: Y - Number edited
23. Number before: '0 '
Number after : '00000' Validity flag: Y - Number edited
24. Number before: '00___'
Number after : '00000' Validity flag: Y - Number edited
25. Number before: '000 '
Number after : '00000' Validity flag: Y - Number edited
26. Number before: '0000_'
Number after : '00000' Validity flag: Y - Number edited
27. Number before: '00000'
Number after : '00000' Validity flag: Y - Number edited
28. Number before: '_0000'
Number after : '00000' Validity flag: Y - Number edited
29. Number before: ' 000'
Number after : '00000' Validity flag: Y - Number edited
30. Number before: '___00'
Number after : '00000' Validity flag: Y - Number edited
31. Number before: ' 0'
Number after : '00000' Validity flag: Y - Number edited
32. Number before: '__0__'
Number after : '00000' Validity flag: Y - Number edited
33. Number before: ' 0 0 '
Number after : ' 0 0 ' Validity flag: N
34. Number before: '0_0_0'
Number after : '0_0_0' Validity flag: N
35. Number before: ' 000 '
Number after : '00000' Validity flag: Y - Number edited
36. Number before: '+0000'
Number after : '+0000' Validity flag: N
37. Number before: '-0000'
Number after : '-0000' Validity flag: N
38. Number before: '*0000'
Number after : '*0000' Validity flag: N
39. Number before: '/0000'
Number after : '/0000' Validity flag: N
40. Number before: '_0_0_'
Number after : '_0_0_' Validity flag: N
41. Number before: ' 0,0 '
Number after : ' 0,0 ' Validity flag: N
42. Number before: '_0.0_'
Number after : '_0.0_' Validity flag: N
|
View [and save] EDITINT.COB text View [and save] ZEDITINT.COB text (Use [Back] button or [Alt]+[CL] to return here from the viewed text) Copyright © 1990–1997 by Go to: Davar site entry | Site contents | Site index | Mainframe | COBOL | Text top |