Back to tutorial

MSOut.cbl

      IDENTIFICATION DIVISION.
      program-id. pgm1.
      ENVIRONMENT DIVISION.                                             
      CONFIGURATION SECTION.                                            
      DATA DIVISION. 
      *
      *    IMS TOC Connector for Java, Multi-segment Output Example
      *
      *********************************************************************/ 
      *                                                                   */ 
      * (c) Copyright IBM Corp. 1998                                      */ 
      * All Rights Reserved                                               */ 
      * Licensed Materials - Property of IBM                              */ 
      *                                                                   */ 
      * DISCLAIMER OF WARRANTIES.                                         */ 
      *                                                                   */ 
      * The following (enclosed) code is provided to you solely for the   */ 
      * purpose of assisting you in the development of your applications. */ 
      * The code is provided "AS IS." IBM MAKES NO WARRANTIES, EXPRESS OR */ 
      * IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF   */ 
      * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, REGARDING   */ 
      * THE FUNCTION OR PERFORMANCE OF THIS CODE.                         */ 
      * IBM shall not be liable for any damages arising out of your use   */ 
      * of the generated code, even if they have been advised of the      */ 
      * possibility of such damages.                                      */ 
      *                                                                   */ 
      * DISTRIBUTION.                                                     */ 
      *                                                                   */ 
      * This generated code can be freely distributed, copied, altered,   */ 
      * and incorporated into other software, provided that:              */ 
      *   - It bears the above Copyright notice and DISCLAIMER intact     */ 
      *   - The software is not for resale                                */ 
      *                                                                   */ 
      *********************************************************************/
      *
        LINKAGE SECTION.
	                                                   
        01  INPUT-MSG.                                                     
            02  IN-LL          PICTURE S9(3) COMP.                         
            02  IN-ZZ          PICTURE S9(3) COMP.                         
            02  IN-TRCD        PICTURE X(5).                               
            02  IN-DATA1       PICTURE X(6).
            02  IN-DATA2       PICTURE X(6).
						  
        01  OUTPUT-MSG.                                                   
            02  OUT-ALLSEGS  PICTURE X(99) VALUE SPACES.

        01  OUTPUT-SEG1.
            02  OUT-LL       PICTURE S9(3) COMP VALUE +0.                 
            02  OUT-ZZ       PICTURE S9(3) COMP VALUE +0.                  
            02  OUT-DATA1    PICTURE X(12) VALUE SPACES.

        01  OUTPUT-SEG2.
            02  OUT-LL       PICTURE S9(3) COMP VALUE +0.                 
            02  OUT-ZZ       PICTURE S9(3) COMP VALUE +0.                  
            02  OUT-DATA1    PICTURE X(13) VALUE SPACES.
            02  OUT-DATA2    PICTURE X(14) VALUE SPACES.

        01  OUTPUT-SEG3.
            02  OUT-LL       PICTURE S9(3) COMP VALUE +0.                 
            02  OUT-ZZ       PICTURE S9(3) COMP VALUE +0.                  
            02  OUT-DATA1    PICTURE X(15) VALUE SPACES.
            02  OUT-DATA2    PICTURE X(16) VALUE SPACES.
            02  OUT-DATA3    PICTURE X(17) VALUE SPACES.                     		   		
                        
        PROCEDURE DIVISION.    

Back to tutorial