Did I write a good (efficient) program?

I haven't written COBOL in a number of years and am quite rusty.
Recently someone asked my help to write some code to display an IP V6
address in human-readable code. I wrote something, but am not sure if
I used the best available techniques. Please have a look at what I
wrote and feel free to comment.

Background. An IP V6 address is 4 words (128-bit) long. It is in
binary format. For human-readable purposes it is converted into 8
"octets" separated by colons. leading zeroes in each field are
suppressed. To compact the address, one or more adjacent octets
containing all zeroes can be compressed *once* per IP address by
simply producing a pair of colons.

thus:  76DF:54AE:A30:1:1:4321:EAD5:AA43
or       FD05::1:0:5 (in this instance 4 octets have been suppressed)
or even: ::1 (loopback address)

I was under a little time pressure (only had yesterday morning), so I
haven't figured out the compression part yet. However, that is
optional, so I'll do it when I have some spare time. In the meantime,
I'd like to hear from members of this group if I could have written
cleaner, leaner and more efficient COBOL.

Thanks.

-----------------------------------------------------------------------------------------------------------
000300 IDENTIFICATION
DIVISION.
000400 PROGRAM-ID.
IPDISP.
003200 ENVIRONMENT
DIVISION.
003300 DATA
DIVISION.
003400 WORKING-STORAGE
SECTION.
007212*
IPV6
007213 01 HEX-
VALUES.
007214  05  FILLER  PIC X(32) VALUE
"000102030405060708090A0B0C0D0E0F".
007215  05  FILLER  PIC X(32) VALUE
"101112131415161718191A1B1C1D1E1F".
007216  05  FILLER  PIC X(32) VALUE
"202122232425262728292A2B2C2D2E2F".
007217  05  FILLER  PIC X(32) VALUE
"303132333435363738393A3B3C3D3E3F".
007218  05  FILLER  PIC X(32) VALUE
"404142434445464748494A4B4C4D4E4F".
007219  05  FILLER  PIC X(32) VALUE
"505152535455565758595A5B5C5D5E5F".
007220  05  FILLER  PIC X(32) VALUE
"606162636465666768696A6B6C6D6E6F".
007221  05  FILLER  PIC X(32) VALUE
"707172737475767778797A7B7C7D7E7F".
007222  05  FILLER  PIC X(32) VALUE
"808182838485868788898A8B8C8D8E8F".
007223  05  FILLER  PIC X(32) VALUE
"909192939495969798999A9B9C9D9E9F".
007224  05  FILLER  PIC X(32) VALUE
"A0A1A2A3A4A5A6A7A8A9AAABACADAEAF".
007225  05  FILLER  PIC X(32) VALUE
"B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF".
007226  05  FILLER  PIC X(32) VALUE
"C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF".
007227  05  FILLER  PIC X(32) VALUE
"D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF".
007228  05  FILLER  PIC X(32) VALUE
"E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF".
007229  05  FILLER  PIC X(32) VALUE
"F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF".
007230 01 HEX-TABLE REDEFINES HEX-
VALUES.
007231     05  HEX-BYTE    PIC XX OCCURS 256
TIMES.
007232
007235 01 IP-
ADDRESS.
007236     05 IP-ONE      PIC
X(8).
007237     05 IP-TWO      PIC
X(8).
007238 01  IP-BYTES REDEFINES IP-
ADDRESS.
007239     05  IP-BYTE6   PIC X OCCURS 16
TIMES.
007240
007241 01 IP-
BINARY.
007242     05  IP-HEX OCCURS 16
TIMES.
007243         10  FILLER           PIC X VALUE LOW-
VALUES.
007244         10  IP-NUMBER-BINARY PIC
X.
007245 01  IP-INDEX REDEFINES IP-
BINARY.
007246      05  IP-NUMBER-INDEX     PIC 99 USAGE COMP-5 OCCURS 16
TIMES.
007247
007248 01  IP-
DISPLAY.
007249     05  IP-DISPLAY-BYTE      PIC XX OCCURS 16
TIMES.
007250 01  IP-OCTETS REDEFINES IP-
DISPLAY.
007251     05  IP-OCTET             PIC X(4) OCCURS 8
TIMES.
007252
007253 01  IP-PRINT-FIELD   PIC X(40) VALUE
SPACE.
007256
007257 01  IP-INDEX1                        PIC S9(4) COMP VALUE
ZERO.
007258 01  HEX-INDEX1                       PIC S9(4) COMP VALUE
ZERO.
007259 01  IP-PRINT-POSITION                PIC S9(4) COMP VALUE
ZERO.
007260 01  FLD-START                        PIC S9(4) COMP VALUE
ZERO.
007261 01  FLD-LENGTH                       PIC S9(4) COMP VALUE
ZERO.
030600
030700 PROCEDURE DIVISION.
      * for each of the 16 bytes in the IPV6
address:
046522         PERFORM  VARYING IP-INDEX1 FROM 1 BY
1
046523                  UNTIL IP-INDEX1 > 16
      * move a byte into a two-byte field that can be used as a number
046524            MOVE IP-BYTE6(IP-
INDEX1)
046525              TO IP-NUMBER-BINARY(IP-INDEX1)
      * bump the number up to be used as an index into the array
046532            ADD 1 TO IP-NUMBER-INDEX(IP-
INDEX1)
046533              GIVING HEX-INDEX1
      * move the indicated bytes in the array (translation table) to
the
      * display field
046540            MOVE HEX-BYTE(HEX-
INDEX1)
046541              TO IP-DISPLAY-BYTE(IP-
INDEX1)
046554            END-
PERFORM
046555
046556         MOVE 1 TO IP-PRINT-
POSITION
046557         MOVE SPACES TO IP-PRINT-
FIELD
046558
      * IP V6 addresses are formatted as half-word "octets" dearated
by
      * colons (":") and with leading zeroes suppressed.
      *
      * for each of the 8 octets:
046560         PERFORM VARYING IP-INDEX1 FROM 1 BY
1
046561                 UNTIL IP-INDEX1 > 8
      * set tally field to zero
046562            MOVE ZEROES TO FLD-START
      * count leading zeroes
046563            INSPECT IP-OCTET(IP-INDEX1) TALLYING FLD-
START
046564              FOR LEADING "0"
046576            IF FLD-START =
4
046577               THEN
      * if the entire field are zeroes, then simply display "0:"
      *at a later stage figure out the IP compaction convention
      * of allowing one or more zero address fields to be compacted
*once* per
      * address into a sequence of
"::"
046578                   MOVE "0:" TO IP-PRINT-FIELD(IP-PRINT-POSITION:
2)
046579                   ADD 2 TO IP-PRINT-
POSITION
046586               ELSE
      * only suppress leading zeroes
      * how many bytes to move?
046587                   COMPUTE FLD-LENGTH = (4 - FLD-START)
      * move them into the display field
046598                   MOVE IP-OCTET(IP-INDEX1)(FLD-START + 1:FLD-
LENGTH)
046599                      TO IP-PRINT-FIELD(IP-PRINT-POSITION:fld-
length)
      * calculate next position in display field
046600                   COMPUTE IP-PRINT-POSITION = (IP-PRINT-
POSITION + fld-length)
      * add a colon (":")
046601                   MOVE ":" TO IP-PRINT-FieLD(IP-PRINT-POSITION:
1)
      * bump position in display field
046602                   ADD 1 TO IP-PRINT-
POSITION
046613               END-
IF
046614            END-PERFORM