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 |