Inside COBOL #63 (String Manipulation)
by
Shawn Gordon
President
The Kompany

This month I’m going to share with you several macros that we developed over time as some standard aids in COBOL reporting. In figure 1 we have the variable declarations we are using, you are free to change these assumptions, but they work for me. These macros are also designed to take the source information as either a literal value or in a variable, this allows for maximum flexibility.

In figure 2 we start with JustifyRightLeadZero. How many times have you ACCEPTed a numeric value into a string and needed to get it into a numeric correctly justified with leading zeroes? There are a number of ways to do it, but this macro does the trick nicely and was written a while back.

First we figure out the length of the return variable, then find the first space in the sending variable and take out the portion that has the value, and stick it into the end of the other variable and put zeroes in the front of it.

Centering text in a title is often important. Many reports will have a customers name at the top, and making sure the data is properly centered is just a professional way to do business. The JustifyCenter does just that for you.

Finally we store each portion of a persons name in different fields, but when it’s reported we want it to come out as “last, first m.”, while none of these are huge tricks they do give you an encapsulated, easily reusable way of getting data in the format you need. I wish COBOL had some more robust string handling (and have suggested it to the ANSI committee), but the simple macro extension by HP makes almost anything possible.

Figure 3 shows some examples of calling the various macros. I hope you enjoyed this months tips, and remember to send your ideas in, nothing get’s rejected (it may not get used, but it won’t be rejected).

Figure 1.

01 JUSTMACS-VARIABLES.
    03 WS-ZEROS                  PIC X(30)  VALUE ALL '0'.
    03 WS-SPACES                 PIC X(100) VALUE SPACES.
    03 WS-BUFFER                 PIC X(100) VALUE SPACES.
    03 WS-OUT-STRING             PIC X(100) VALUE SPACES.
    03 WS-COUNTERS-SUBS.
       05 WS-SPACE-CTR           PIC S9(04) COMP VALUE 0.
       05 WS-CHAR-CTR            PIC S9(04) COMP VALUE 0.
       05 WS-CHAR-CTR2           PIC S9(04) COMP VALUE 0.
       05 WS-SUB1                PIC S9(04) COMP VALUE 0.
       05 WS-SUB2                PIC S9(04) COMP VALUE 0.
       05 WS-LEFT-SPACE          PIC S9(04) COMP VALUE 0.
       05 WS-RIGHT-SPACE         PIC S9(04) COMP VALUE 0.
    03 WS-FIELD-LEN              PIC S9(04) COMP VALUE 0.
    03 WS-FIELD-LEN2             PIC S9(04) COMP VALUE 0.

Figure 2.

* This macro receives a left-justified numeric string and returns
* a right-justified with leading zeroes numeric string.
* The receiving-field length is determined by the COBOL function
* LENGTH.
*
* !1 = Receiving left-justified string
* !2 = Returning right-justified string

$DEFINE %JustifyRightLeadZero =
        COMPUTE WS-FIELD-LEN = FUNCTION LENGTH (!2)
        MOVE 0                      TO WS-CHAR-CTR
        INSPECT !1 TALLYING WS-CHAR-CTR
                FOR CHARACTERS BEFORE INITIAL ' '
        IF WS-CHAR-CTR = 0
           MOVE WS-ZEROS (1:WS-FIELD-LEN) TO !2
        ELSE
           COMPUTE WS-SUB1 = WS-FIELD-LEN - WS-CHAR-CTR
           IF WS-SUB1 = 0
              MOVE !1      TO !2
           ELSE
           STRING WS-ZEROS (1:WS-SUB1) DELIMITED BY SIZE
                  !1 (1:WS-CHAR-CTR)   DELIMITED BY SIZE
             INTO !2
           END-IF
        END-IF#

* This one receives a left-justified alphanumeric string and
* centers it into another alphanumeric string. Both strings
* can be of any.
*
* !1 = Receiving left-justified string
* !2 = Returning centered-justified string

$DEFINE %JustifyCenter =
        MOVE 0                  TO WS-FIELD-LEN
                                   WS-FIELD-LEN2
                                   WS-CHAR-CTR
        MOVE !1                 TO WS-BUFFER
        COMPUTE WS-FIELD-LEN    =  FUNCTION LENGTH (WS-BUFFER)
        PERFORM VARYING WS-CHAR-CTR FROM WS-FIELD-LEN BY -1
                UNTIL WS-BUFFER (WS-CHAR-CTR:1) <> SPACES OR
                      WS-CHAR-CTR = 1
           CONTINUE
        END-PERFORM
        IF WS-CHAR-CTR > 1
           MOVE 0                  TO WS-FIELD-LEN2
           COMPUTE WS-FIELD-LEN2   =  FUNCTION LENGTH (!2)
           COMPUTE WS-LEFT-SPACE ROUNDED  =
                   ((WS-FIELD-LEN2 - WS-CHAR-CTR) / 2)
           COMPUTE WS-RIGHT-SPACE  =
                   WS-FIELD-LEN2 - (WS-LEFT-SPACE + WS-CHAR-CTR)
           STRING WS-SPACES (1:WS-LEFT-SPACE)  DELIMITED BY SIZE
                  WS-BUFFER (1:WS-CHAR-CTR)    DELIMITED BY SIZE
                  WS-SPACES (1:WS-RIGHT-SPACE) DELIMITED BY SIZE
                  INTO !2
           END-STRING
        ELSE
           MOVE SPACES               TO !2
        END-IF#
*
***JUSTIFY A PERSON'S NAME
***
*** !1 = Last Name
*** !2 = First Name
*** !3 = Middle Initial
*** !4 = Sending field
*
$DEFINE %JustifyName =
        COMPUTE WS-FIELD-LEN   = FUNCTION LENGTH(!1)
        PERFORM VARYING WS-CHAR-CTR FROM WS-FIELD-LEN BY -1
                UNTIL !1 (WS-CHAR-CTR:1) <> SPACES
           CONTINUE
        END-PERFORM
        COMPUTE WS-FIELD-LEN2  = FUNCTION LENGTH(!2)
        PERFORM VARYING WS-CHAR-CTR2 FROM WS-FIELD-LEN2 BY -1
                UNTIL !2 (WS-CHAR-CTR2:1) <> SPACES
           CONTINUE
        END-PERFORM
        STRING !1
               (1:WS-CHAR-CTR)     DELIMITED BY SIZE
               ', '                DELIMITED BY SIZE
               !2 
               (1:WS-CHAR-CTR2)    DELIMITED BY SIZE
          ' '                      DELIMITED BY SIZE
          !3                       DELIMITED BY SIZE
                              INTO !4#

Figure 3.

    %JustifyCenter('Accounting Summary'#,T2-TITLE#).
    %JustifyCenter(CUSTOMER-NAME#,T4-TITLE#).
    %JustifyName(CUST-LAST#,CUST-FIRST#,CUST-MI#,CUST-NAME#)
    %JustifyRightLeadZero(WS-CLIENT-IN#,WS-CLIENT-OUT#)