easebourne_ironfist
New User
Joined: 04 Mar 2013 Posts: 13 Location: Hyderabad
|
|
|
|
Not sure if its of much use to anybody .but i think some might find it interesting .
Code: |
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. PICTURES.
000300*===============================================================
003900*===============================================================
004000 ENVIRONMENT DIVISION.
004100 CONFIGURATION SECTION.
004200 SOURCE-COMPUTER. IBM-370 .
004400 OBJECT-COMPUTER. IBM-370 .
005300 DATA DIVISION.
007100 WORKING-STORAGE SECTION.
008400 01 WS-SIMPLE-INSERTION.
008401* [, B 0 /]. THESE ARE EDIT SYMBOLS .
008402 05 SIMPLE-A PIC 999,999 .
008403 05 SIMPLE-B PIC 9(3),9(3) .
008404 05 SIMPLE-C PIC ZZZ,ZZZ .
008405 05 SIMPLE-D PIC ***,*** .
008406 05 SIMPLE-E PIC ***,*** .
008407 05 SIMPLE-F PIC 99B99B99 .
008408 05 SIMPLE-G PIC 99/99/99 .
008409 05 SIMPLE-H PIC 990099 .
008600 01 WS-SPECIAL-INSERTION.
008700* [.] PERIOD OPERATOR IS THE EDIT SYMBOLS .
008810 05 SPECIAL-A PIC 999.99 .
008820 05 SPECIAL-B PIC 999.9 .
008830 05 SPECIAL-C PIC 99.99 .
008840 05 SPECIAL-D PIC 999.99 .
008900 01 WS-FIXED-INSERTION.
009000* [+ - CR DB $] . THESE ARE EDIT SYMBOLS .
009010 05 FIXED-A PIC -999 .
009020 05 FIXED-B PIC 999- .
009030 05 FIXED-C PIC -999 .
009040 05 FIXED-D PIC +9(5) .
009050 05 FIXED-E PIC +9(3) .
009060 05 FIXED-F PIC 999+ .
009070 05 FIXED-G PIC 9(4)CR .
009071 05 FIXED-H PIC 9(4)CR .
009080 05 FIXED-I PIC 9(4)DB .
009090 05 FIXED-J PIC 9(4)DB .
009091 05 FIXED-K PIC $99999 .
009092 05 FIXED-L PIC $ZZZZZ .
009200 01 WS-FLOATING-INSERTION.
009300* [+ - $] . THESE ARE EDIT SYMBOLS .
009400 05 FLOATING-A PIC 999,999 .
009410 05 FLOATING-B PIC 9(3),9(3) .
009420 05 FLOATING-C PIC ZZZ,ZZZ .
009430 05 FLOATING-D PIC ***,*** .
009440 05 FLOATING-E PIC ***,*** .
009450 05 FLOATING-F PIC 99B99B99 .
009460 05 FLOATING-G PIC 99/99/99 .
009470 05 FLOATING-H PIC 990099 .
009500 01 WS-SUPPRESSION-AND-REPLACEMENT.
009600* [Z *] . THESE ARE EDIT SYMBOLS .
009700 05 SUP-REPL-A PIC ZZ,999 .
009800 05 SUP-REPL-B PIC ZZ,999 .
009900 05 SUP-REPL-C PIC ZZ,999 .
010000 05 SUP-REPL-D PIC ZZ,999 .
010100 05 SUP-REPL-E PIC **,**9 .
010200 05 SUP-REPL-F PIC **,**9 .
010300 05 SUP-REPL-G PIC **,*** .
010400 05 SUP-REPL-H PIC $**,**9.99 .
030300
030400/
030500 PROCEDURE DIVISION.
030510 PARA-EDIT-PICTURES-MOVE .
030550 MOVE 123456 TO SIMPLE-A .
030560 MOVE 000078 TO SIMPLE-B .
030570 MOVE 000078 TO SIMPLE-C .
030580 MOVE 000178 TO SIMPLE-D .
030590 MOVE 002178 TO SIMPLE-E .
030591 MOVE 120183 TO SIMPLE-F .
030592 MOVE 120183 TO SIMPLE-G .
030593 MOVE 031245 TO SIMPLE-H .
030596 MOVE 12345 TO SPECIAL-A.
030597 MOVE 02345 TO SPECIAL-B.
030598 MOVE 71234 TO SPECIAL-C.
030599 MOVE 2456 TO SPECIAL-D.
030602 MOVE -123 TO FIXED-A.
030603 MOVE -123 TO FIXED-B.
030604 MOVE +123 TO FIXED-C.
030605 MOVE +12345 TO FIXED-D.
030606 MOVE -123 TO FIXED-E.
030607 MOVE -123 TO FIXED-F.
030608 MOVE +1234 TO FIXED-G.
030609 MOVE -1234 TO FIXED-H.
030610 MOVE +1234 TO FIXED-I.
030611 MOVE -1234 TO FIXED-J.
030612 MOVE 1234 TO FIXED-K.
030613 MOVE 0000 TO FIXED-L.
030616 MOVE 123456 TO FLOATING-A.
030617 MOVE 000078 TO FLOATING-B.
030618 MOVE 000078 TO FLOATING-C.
030619 MOVE 000178 TO FLOATING-D.
030620 MOVE 002178 TO FLOATING-E.
030621 MOVE 120183 TO FLOATING-F.
030622 MOVE 120183 TO FLOATING-G.
030623 MOVE 031245 TO FLOATING-H.
030626 MOVE 12345 TO SUP-REPL-A.
030627 MOVE 01234 TO SUP-REPL-B.
030628 MOVE 00123 TO SUP-REPL-C.
030629 MOVE 00012 TO SUP-REPL-D.
030630 MOVE 05678 TO SUP-REPL-E.
030631 MOVE 00567 TO SUP-REPL-F.
030632 MOVE 00000 TO SUP-REPL-G.
030633 MOVE 00043.45 TO SUP-REPL-H.
030640 PARA-EDIT-PICTURES-DISPLAY.
030700 DISPLAY "WS-SIMPLE-INSERTION.".
030800 DISPLAY "SIMPLE-A PIC 999,999 VALUE 123456 " SIMPLE-A .
030810 DISPLAY "SIMPLE-B PIC 9(3),9(3) VALUE 000078 " SIMPLE-B .
030820 DISPLAY "SIMPLE-C PIC ZZZ,ZZZ VALUE 000078 " SIMPLE-C .
030830 DISPLAY "SIMPLE-D PIC ***,*** VALUE 000178 " SIMPLE-D .
030840 DISPLAY "SIMPLE-E PIC ***,*** VALUE 002178 " SIMPLE-E .
030850 DISPLAY "SIMPLE-F PIC 99B99B99 VALUE 120183 " SIMPLE-F .
030860 DISPLAY "SIMPLE-G PIC 99/99/99 VALUE 120183 " SIMPLE-G .
030870 DISPLAY "SIMPLE-H PIC 990099 VALUE 031245 " SIMPLE-H .
030900 DISPLAY "WS-SPECIAL-INSERTION.".
031020 DISPLAY "SPECIAL-A PIC 999.99 VALUE 12345 " SPECIAL-A.
031030 DISPLAY "SPECIAL-B PIC 999.9 VALUE 02345 " SPECIAL-B.
031040 DISPLAY "SPECIAL-C PIC 99.99 VALUE 71234 " SPECIAL-C.
031050 DISPLAY "SPECIAL-D PIC 999.99 VALUE 2456 " SPECIAL-D.
031100 DISPLAY "WS-FIXED-INSERTION".
031202 DISPLAY "FIXED-A PIC -999 VALUE -123 " FIXED-A.
031203 DISPLAY "FIXED-B PIC 999- VALUE -123 " FIXED-B.
031204 DISPLAY "FIXED-C PIC -999 VALUE +123 " FIXED-C.
031205 DISPLAY "FIXED-D PIC +9(5) VALUE +12345 " FIXED-D.
031206 DISPLAY "FIXED-E PIC +9(3) VALUE -123 " FIXED-E.
031207 DISPLAY "FIXED-F PIC 999+ VALUE -123 " FIXED-F.
031208 DISPLAY "FIXED-G PIC 9(4)CR VALUE +1234 " FIXED-G.
031209 DISPLAY "FIXED-H PIC 9(4)CR VALUE -1234 " FIXED-H.
031210 DISPLAY "FIXED-I PIC 9(4)DB VALUE +1234 " FIXED-I.
031211 DISPLAY "FIXED-J PIC 9(4)DB VALUE -1234 " FIXED-J.
031212 DISPLAY "FIXED-K PIC $99999 VALUE 1234 " FIXED-K.
031213 DISPLAY "FIXED-L PIC $ZZZZZ VALUE 0000 " FIXED-L.
031214 DISPLAY "WS-FLOATING-INSERTION.".
031217 DISPLAY "FLOATING-A PIC 999,999 VALUE 123456 "
031218- FLOATING-A .
031219 DISPLAY "FLOATING-B PIC 9(3),9(3) VALUE 000078 "
031220- FLOATING-B .
031221 DISPLAY "FLOATING-C PIC ZZZ,ZZZ VALUE 000078 "
031222- FLOATING-C .
031223 DISPLAY "FLOATING-D PIC ***,*** VALUE 000178 "
031224- FLOATING-D .
031225 DISPLAY "FLOATING-E PIC ***,*** VALUE 002178 "
031226- FLOATING-E .
031227 DISPLAY "FLOATING-F PIC 99B99B99 VALUE 120183 "
031228- FLOATING-F .
031229 DISPLAY "FLOATING-G PIC 99/99/99 VALUE 120183 "
031230- FLOATING-G .
031231 DISPLAY "FLOATING-H PIC 990099 VALUE 031245 "
031232- FLOATING-H .
031233 DISPLAY "WS-SUPPRESSION-AND-REPLACEMENT.".
031234 DISPLAY "SUP-REPL-A PIC ZZ,999 VALUE 12345 "
031235- SUP-REPL-A.
031236 DISPLAY "SUP-REPL-B PIC ZZ,999 VALUE 01234 "
031237- SUP-REPL-B.
031238 DISPLAY "SUP-REPL-C PIC ZZ,999 VALUE 00123 "
031239- SUP-REPL-C.
031240 DISPLAY "SUP-REPL-D PIC ZZ,999 VALUE 00012 "
031241- SUP-REPL-D.
031242 DISPLAY "SUP-REPL-E PIC **,**9 VALUE 05678 "
031243- SUP-REPL-E.
031244 DISPLAY "SUP-REPL-F PIC **,**9 VALUE 00567 "
031245- SUP-REPL-F.
031246 DISPLAY "SUP-REPL-G PIC **,*** VALUE 00000 "
031247- SUP-REPL-G.
031248 DISPLAY "SUP-REPL-H PIC $**,**9.99 VALUE 00043.45"
031249- SUP-REPL-H.
031250 STOP RUN . |
Output :
Code: |
WS-SIMPLE-INSERTION.
SIMPLE-A PIC 999,999 VALUE 123456 123,456
SIMPLE-B PIC 9(3),9(3) VALUE 000078 000,078
SIMPLE-C PIC ZZZ,ZZZ VALUE 000078 78
SIMPLE-D PIC ***,*** VALUE 000178 ****178
SIMPLE-E PIC ***,*** VALUE 002178 **2,178
SIMPLE-F PIC 99B99B99 VALUE 120183 12 01 83
SIMPLE-G PIC 99/99/99 VALUE 120183 12/01/83
SIMPLE-H PIC 990099 VALUE 031245 120045
WS-SPECIAL-INSERTION.
SPECIAL-A PIC 999.99 VALUE 12345 345.00
SPECIAL-B PIC 999.9 VALUE 02345 345.0
SPECIAL-C PIC 99.99 VALUE 71234 34.00
SPECIAL-D PIC 999.99 VALUE 2456 456.00
WS-FIXED-INSERTION
FIXED-A PIC -999 VALUE -123 -123
FIXED-B PIC 999- VALUE -123 123-
FIXED-C PIC -999 VALUE +123 123
FIXED-D PIC +9(5) VALUE +12345 +12345
FIXED-E PIC +9(3) VALUE -123 -123
FIXED-F PIC 999+ VALUE -123 123-
FIXED-G PIC 9(4)CR VALUE +1234 1234
FIXED-H PIC 9(4)CR VALUE -1234 1234CR
FIXED-I PIC 9(4)DB VALUE +1234 1234
FIXED-J PIC 9(4)DB VALUE -1234 1234DB
FIXED-K PIC $99999 VALUE 1234 $01234
FIXED-L PIC $ZZZZZ VALUE 0000
WS-FLOATING-INSERTION.
FLOATING-A PIC 999,999 VALUE 123456 123,456
FLOATING-B PIC 9(3),9(3) VALUE 000078 000,078
FLOATING-C PIC ZZZ,ZZZ VALUE 000078 78
FLOATING-D PIC ***,*** VALUE 000178 ****178
FLOATING-E PIC ***,*** VALUE 002178 **2,178
FLOATING-F PIC 99B99B99 VALUE 120183 12 01 83
FLOATING-G PIC 99/99/99 VALUE 120183 12/01/83
FLOATING-H PIC 990099 VALUE 031245 120045
WS-SUPPRESSION-AND-REPLACEMENT.
SUP-REPL-A PIC ZZ,999 VALUE 12345 12,345
SUP-REPL-B PIC ZZ,999 VALUE 01234 1,234
SUP-REPL-C PIC ZZ,999 VALUE 00123 123
SUP-REPL-D PIC ZZ,999 VALUE 00012 012
SUP-REPL-E PIC **,**9 VALUE 05678 *5,678
SUP-REPL-F PIC **,**9 VALUE 00567 ***567
SUP-REPL-G PIC **,*** VALUE 00000 ******
SUP-REPL-H PIC $**,**9.99 VALUE 00043.45$****43.45 |
|
|