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

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) 19901997 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 © 19901997 by
Go to:  Davar site entry | Site contents | Site index | Mainframe | COBOL | Text top