COBOL is rather selective as to when it enforces the restriction
on what the J1 type integer can contain.  As mentioned IMAGE does not
enforce it, so a retrieved value can contain -32768 thru 32767.  COBOL
will happily use values outside the "permitted range" as long as it's not
storing them into the variable of restricted size, which point it will
truncate or generate a size error if specified.  A display of the variable
will get truncated but it still contains more than it should.  Similar
situations would occur when restricting S9(9) to less than 9 digits.

QUERY (Not Image) will enforce the range on Jn values during update
transactions IIRC.

The following program generates some interesting results when you give it
numbers a PIC S9(4) isn't supposed to accept.


BTEST3
--- Respond with a zero to quit ---

Enter test value:     1234
PIC-S99: +000001234
PIC-S94: +1234
PIC-94: 1234
Logical retrieved value: +000001234
Integer retrieved value: +000001234
PIC-S94 x 2 : +000002468

Enter test value:     12345
PIC-S99: +000012345
PIC-S94: +2345
PIC-94: 2345
Logical retrieved value: +000012345
Integer retrieved value: +000012345
PIC-S94 x 2 : +000024690

Enter test value:     -1
PIC-S99: -000000001
PIC-S94: -0001
PIC-94: 0001
Logical retrieved value: +000065535
Integer retrieved value: -000000001
PIC-S94 x 2 : -000000002

Enter test value:     -1234
PIC-S99: -000001234
PIC-S94: -1234
PIC-94: 1234
Logical retrieved value: +000064302
Integer retrieved value: -000001234
PIC-S94 x 2 : -000002468

Enter test value:     -12345
PIC-S99: -000012345
PIC-S94: -2345
PIC-94: 2345
Logical retrieved value: +000053191
Integer retrieved value: -000012345
PIC-S94 x 2 : -000024690

Enter test value:

:
:PRINT ZTEST3
001000$CONTROL LIST
001100 IDENTIFICATION DIVISION.
001200 PROGRAM-ID. SIZE-TEST.
001300 DATA DIVISION.
001400 WORKING-STORAGE SECTION.
001500 01 TEST-VALUE          PIC S9(9) COMP VALUE ZERO.
001600 01 PIC-XX.
001700    05 PIC-S94          PIC S9(4) COMP VALUE ZERO.
001800 01 PIC-XX-2 REDEFINES PIC-XX.
001900    05 PIC-94           PIC 9(4) COMP.
002000 01 PIC-S99             PIC S9(9) COMP VALUE ZERO.
002100 01 PIC-X4 REDEFINES PIC-S99.
002200    05 HIGH-WORD       PIC XX.
002300    05 LOW-WORD        PIC XX.
002400 PROCEDURE DIVISION.
002500 MAIN-LINE.
002510     DISPLAY "--- Respond with a zero to quit ---"
002600     PERFORM WITH TEST AFTER UNTIL TEST-VALUE = ZERO
002700       DISPLAY SPACE
002800       DISPLAY "Enter test value:     " with no advancing
002900       ACCEPT TEST-VALUE FREE
003000       IF TEST-VALUE <> ZERO
003100         PERFORM CHOP-TEST
003200       END-IF
003300     END-PERFORM.
003400     STOP RUN.
003500
003600 CHOP-TEST.
003700     MOVE TEST-VALUE TO PIC-S99
003800     MOVE LOW-WORD TO PIC-XX
003900     DISPLAY "PIC-S99: " PIC-S99
004000     DISPLAY "PIC-S94: " PIC-S94
004100     DISPLAY "PIC-94: " PIC-94
004200     MOVE ZERO TO PIC-S99
004300     MOVE PIC-XX TO LOW-WORD
004400     DISPLAY "Logical retrieved value: " PIC-S99.
004500     IF PIC-S94 < 0
004600       MOVE HIGH-VALUES TO HIGH-WORD
004700     END-IF
004800     DISPLAY "Integer retrieved value: " PIC-S99.
004900     MULTIPLY 2 BY PIC-S94 GIVING PIC-S99
005000     DISPLAY "PIC-S94 x 2 : " PIC-S99.
:BTEST3
--- Respond with a zero to quit ---

Enter test value:     1234
PIC-S99: +000001234
PIC-S94: +1234
PIC-94: 1234
Logical retrieved value: +000001234
Integer retrieved value: +000001234
PIC-S94 x 2 : +000002468

Enter test value:     12345
PIC-S99: +000012345
PIC-S94: +2345
PIC-94: 2345
Logical retrieved value: +000012345
Integer retrieved value: +000012345
PIC-S94 x 2 : +000024690

Enter test value:     -1
PIC-S99: -000000001
PIC-S94: -0001
PIC-94: 0001
Logical retrieved value: +000065535
Integer retrieved value: -000000001
PIC-S94 x 2 : -000000002

Enter test value:     -1234
PIC-S99: -000001234
PIC-S94: -1234
PIC-94: 1234
Logical retrieved value: +000064302
Integer retrieved value: -000001234
PIC-S94 x 2 : -000002468

Enter test value:     -12345
PIC-S99: -000012345
PIC-S94: -2345
PIC-94: 2345
Logical retrieved value: +000053191
Integer retrieved value: -000012345
PIC-S94 x 2 : -000024690

Enter test value:

:
:PRINT ZTEST3
001000$CONTROL LIST
001100 IDENTIFICATION DIVISION.
001200 PROGRAM-ID. SIZE-TEST.
001300 DATA DIVISION.
001400 WORKING-STORAGE SECTION.
001500 01 TEST-VALUE          PIC S9(9) COMP VALUE ZERO.
001600 01 PIC-XX.
001700    05 PIC-S94          PIC S9(4) COMP VALUE ZERO.
001800 01 PIC-XX-2 REDEFINES PIC-XX.
001900    05 PIC-94           PIC 9(4) COMP.
002000 01 PIC-S99             PIC S9(9) COMP VALUE ZERO.
002100 01 PIC-X4 REDEFINES PIC-S99.
002200    05 HIGH-WORD       PIC XX.
002300    05 LOW-WORD        PIC XX.
002400 PROCEDURE DIVISION.
002500 MAIN-LINE.
002510     DISPLAY "--- Respond with a zero to quit ---"
002600     PERFORM WITH TEST AFTER UNTIL TEST-VALUE = ZERO
002700       DISPLAY SPACE
002800       DISPLAY "Enter test value:     " with no advancing
002900       ACCEPT TEST-VALUE FREE
003000       IF TEST-VALUE <> ZERO
003100         PERFORM CHOP-TEST
003200       END-IF
003300     END-PERFORM.
003400     STOP RUN.
003500
003600 CHOP-TEST.
003700     MOVE TEST-VALUE TO PIC-S99
003800     MOVE LOW-WORD TO PIC-XX
003900     DISPLAY "PIC-S99: " PIC-S99
004000     DISPLAY "PIC-S94: " PIC-S94
004100     DISPLAY "PIC-94: " PIC-94
004200     MOVE ZERO TO PIC-S99
004300     MOVE PIC-XX TO LOW-WORD
004400     DISPLAY "Logical retrieved value: " PIC-S99.
004500     IF PIC-S94 < 0
004600       MOVE HIGH-VALUES TO HIGH-WORD
004700     END-IF
004800     DISPLAY "Integer retrieved value: " PIC-S99.
004900     MULTIPLY 2 BY PIC-S94 GIVING PIC-S99
005000     DISPLAY "PIC-S94 x 2 : " PIC-S99.