IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

Edit Pictures: Sample Program


IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
easebourne_ironfist

New User


Joined: 04 Mar 2013
Posts: 13
Location: Hyderabad

PostPosted: Fri Apr 26, 2013 8:48 am
Reply with quote

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
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> COBOL Programming

 


Similar Topics
Topic Forum Replies
No new posts Using API Gateway from CICS program CICS 0
No new posts DB2 Event passed to the Application P... DB2 1
No new posts How to pass the PARM value to my targ... COBOL Programming 8
No new posts REXX code to expand copybook in a cob... CLIST & REXX 2
No new posts Query on edit primary command CLIST & REXX 5
Search our Forums:

Back to Top