MSout.cbl

以下是 MSout.cbl 中的代码:

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.    
相关任务
课程 1.1:选择资源适配器