プライバシーポリシー サイトマップ
Copyright (C) 2011 株式会社カルテック・エスキューブ All Rights Reserved.ＰＬ／Ｉ言語をＣＯＢＯＬに変換します。
以下にＰＬ／Ｉ言語からＣＯＢＯＬ言語に変換した例を掲載します。
* PROCESS INC,NEST,GRAPHIC ;
SAMPPLI : PROC OPTIONS(MAIN) ; /** SAMPLE START ***/
%PAGE;
/*--- FOR RDB ------------------------------------------------------*/
EXEC SQL INCLUDE SQLCA ; /* SQL ﾚﾝﾗｸｲｷ */
EXEC SQL INCLUDE SAMPTBL;
EXEC SQL INCLUDE SAMP2TB;
EXEC SQL WHENEVER SQLERROR GO TO #DB2ERR;
EXEC SQL WHENEVER SQLWARNING GO TO #DB2WAR;
DCL DATE ENTRY RETURNS(CHAR(6)) ; /* SYS DATE */
%PAGE;
DCL CARDFL FILE RECORD SEQUENTIAL INPUT ;
DCL OUTFILE FILE RECORD SEQUENTIAL OUTPUT ;
DCL 1 CARDR ,
3 R0001 CHAR ( 1) ,
3 R0002 CHAR ( 1) ,
3 R0003 CHAR ( 1) ,
3 R0004 CHAR ( 1) ,
3 R0005 CHAR ( 1) ,
3 R0006 CHAR ( 75) ;
DCL 1 OUTREC , /* ｼｭﾂﾘｮｸ ﾌｧｲﾙ */
3 A0001 CHAR ( 7) ,
3 A0002 CHAR ( 4) ,
3 A0003 CHAR ( 10) ,
%PAGE;
/*********************************************************************/
/* WORK DECLARE */
/*********************************************************************/
DCL 1 WORK_AREA ,
3 WK_DATE CHAR (10) , /* ﾋｽﾞｹ */
3 WK_TIME CHAR (08) , /* ｼﾞｶﾝ */
3 WK_TMS CHAR (26) , /* ﾀｲﾑｽﾀﾝﾌﾟ */
3 WK_CHAR CHAR (90) , /* ﾓｼﾞ ﾍﾝｽｳ */
3 SW_ERR CHAR (02) INIT ('OF') , /* ERROR SW */
3 SW_LEAVE CHAR (02) INIT ('OF') ; /* LEAVE SW */
DCL 1 WORK_PIC ,
3 WK_CNT PIC '99' INIT (1) , /* ｶｳﾝﾄ */
3 WK_PIC4 PIC '(4)9' ;
/*********************************************************************/
/* MAIN PROCEDURE */
/*********************************************************************/
%SKIP;
OPEN FILE(CARDFL ) ,
FILE(OUTFILE) ;
CALL INIT_100 ;
CALL U_100_READ ;
DO WHILE(SW_SAMP2TB_EOF = 'OF' ) ;
CALL EDIT_OUTFILE ;
WRITE FILE(OUTFILE) FROM(OUTREC) ;
CALL U_100_READ ;
END;
CLOSE FILE(CARDFL ) ,
FILE(OUTFILE) ;
%PAGE;
/*********************************************************************/
/* INIT ｼｮﾘ */
/*********************************************************************/
INIT_100 : PROC ;
IF SUBSTR(DATE,1,2) > '90' THEN
WK_DATE = '19' || SUBSTR(DATE,1,2) || /* ｼｮﾘ ﾋｽﾞｹ */
'-' || SUBSTR(DATE,3,2) ||
'-' || SUBSTR(DATE,5,2) ;
ELSE
WK_DATE = '20' || SUBSTR(DATE,1,2) ||
'-' || SUBSTR(DATE,3,2) ||
'-' || SUBSTR(DATE,5,2) ;
WK_TIME = SUBSTR(TIME,1,2) || ':' || /* ｼｮﾘ ｼﾞｶﾞﾝ */
SUBSTR(TIME,3,2) || ':' ||
SUBSTR(TIME,5,2) ;
WK_TMS = WK_DATE || '-' || /* ﾀｲﾑｽﾀﾝﾌﾟ */
SUBSTR(WK_TIME,1,2) || '.' ||
SUBSTR(WK_TIME,4,2) || '.' ||
SUBSTR(WK_TIME,7,2) || '.000000' ;
%SKIP;
READ FILE(CARDFL) INTO(CARDR) ;
%SKIP;
SAMPAREA(*) = '' ;
EXEC SQL DECLARE SAMPCSR CURSOR FOR
SELECT Z0001 ,
Z0002
FROM SAMPTBL
WHERE Z0003 = '2304'
ORDER BY Z0001 ;
EXEC SQL OPEN SAMPCSR ;
IF SQLCODE = 0 THEN
DO ;
EXEC SQL FETCH SAMPCSR INTO :DCLSAMPTBL.Z0001 ,
:DCLSAMPTBL.Z0002 ;
DO WHILE( SQLCODE = 0 );
END ;
END ;
EXEC SQL CLOSE SAMPCSR ;
END INIT_100 ;
%PAGE;
/********************************************************************/
/* SAMP2TB READ */
/********************************************************************/
U_100_READ : PROC ;
EXEC SQL FETCH SAMP2TB_C
INTO :DCLSAMP2TB.A0001 ,
:DCLSAMP2TB.A0002 ,
:DCLSAMP2TB.A0003 ,
:DCLSAMP2TB.A0100 ,
:DCLSAMP2TB.A0101 ,
:DCLSAMP2TB.A0102 ;
IF SQLCODE = 0 THEN;
ELSE SW_SAMP2TB_EOF = 'ON' ;
%SKIP;
END U_100_READ ;
%PAGE;
/*********************************************************************/
/* ｼｭﾂﾘｮｸ ﾍﾝｼｭｳ */
/*********************************************************************/
EDIT_OUTFILE : PROC ;
OUTREC = '' ;
OUTREC.A0001 = DCLSAMP2TB.A0001 ;
OUTREC.A0002 = DCLSAMP2TB.A0002 ;
OUTREC.A0003 = DCLSAMP2TB.A0003 ;
OUTREC.A0100 = DCLSAMP2TB.A0100 ;
OUTREC.A0101 = DCLSAMP2TB.A0101 ;
OUTREC.A0102 = DCLSAMP2TB.A0102 ;
%SKIP;
END EDIT_OUTFILE ;
END SAMPPLI;
* ** SAMPPLI START ***
EJECT
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMPPLI.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARDFL ASSIGN TO DISK-CARDFL
FILE STATUS CARDFL-FS.
SELECT OUTFILE ASSIGN TO DISK-OUTFILE
FILE STATUS OUTFILE-FS.
DATA DIVISION.
FILE SECTION.
FD CARDFL.
01 CARDFL-REC PIC X(080).
FD OUTFILE.
01 OUTFILE-REC PIC X(132).
WORKING-STORAGE SECTION.
*---------------------------------------------------------------
* 作業域
*---------------------------------------------------------------
EJECT
01 CARDR.
03 R0001 PIC X(1).
03 R0002 PIC X(1).
03 R0003 PIC X(1).
03 R0004 PIC X(1).
03 R0005 PIC X(1).
03 R0006 PIC X(75).
* * ｼｭﾂﾘｮｸ ﾌｧｲﾙ *
01 OUTREC.
03 A0001 PIC X(7).
03 A0002 PIC X(4).
03 A0003 PIC X(10).
中略
EJECT
* ***************************************************************
* * WORK DECLARE *
* ***************************************************************
01 WORK-AREA.
* * ﾋｽﾞｹ *
03 WK-DATE PIC X(10).
* * ｼﾞｶﾝ *
03 WK-TIME PIC X(08).
* * ﾀｲﾑｽﾀﾝﾌﾟ *
03 WK-TMS PIC X(26).
* * ﾓｼﾞ ﾍﾝｽｳ *
03 WK-CHAR PIC X(90).
* * ERROR SW *
03 SW-ERR PIC X(02) VALUE 'OF'.
* * LEAVE SW *
03 SW-LEAVE PIC X(02) VALUE 'OF'.
01 WORK-PIC.
* * ｶｳﾝﾄ *
03 WK-CNT PIC 99 VALUE 1.
03 WK-PIC4 PIC (4)9.
中略
EJECT
LINKAGE SECTION.
EJECT
PROCEDURE DIVISION.
EJECT
* *--- FOR DB2 -------------------------------------------------*
* * SQL ﾚﾝﾗｸｲｷ *
EXEC SQL INCLUDE SQLCA
END-EXEC.
EXEC SQL INCLUDE SAMPTBL
END-EXEC.
EXEC SQL INCLUDE SAMP2TB
END-EXEC.
EXEC SQL WHENEVER SQLERROR GO TO DB2ERR--C
END-EXEC.
EXEC SQL WHENEVER SQLWARNING GO TO DB2WAR--C
END-EXEC.
EJECT
* ***************************************************************
* * MAIN PROCEDURE (0.0) *
* ***************************************************************
SKIP1
OPEN INPUT CARDFL.
OPEN OUTPUT OUTFILE.
PERFORM INIT-100 .
PERFORM U-100-READ .
PERFORM TEST BEFORE UNTIL NOT (SW-SAMP2TB-EOF = 'OF' )
PERFORM EDIT-OUTFILE
WRITE OUTFILE-REC FROM OUTREC
PERFORM U-100-READ
END-PERFORM.
CLOSE CARDFL .
CLOSE OUTFILE.
EJECT
* ***************************************************************
* * INIT ｼｮﾘ *
* ***************************************************************
INIT-100 SECTION.
INIT-100-START.
* * ｼｮﾘ ﾋｽﾞｹ *
IF DATE(1:2) > '90' THEN
STRING '19' DATE(1:2)
'-' DATE(3:2)
'-' DATE(5:2) DELIMITED BY SIZE INTO
WK-DATE
ELSE
STRING '20' DATE(1:2)
'-' DATE(3:2)
'-' DATE(5:2) DELIMITED BY SIZE INTO
WK-DATE
END-IF.
* * ｼｮﾘ ｼﾞｶﾞﾝ *
STRING TIME(1:2) ':'
TIME(3:2) ':'
TIME(5:2) DELIMITED BY SIZE INTO WK-TIME.
* * ﾀｲﾑｽﾀﾝﾌﾟ *
STRING WK-DATE '-'
WK-TIME(1:2) '.'
WK-TIME(4:2) '.'
WK-TIME(7:2) '.000000' DELIMITED BY SIZE
INTO WK-TMS.
SKIP1
READ CARDFL INTO CARDR .
SKIP1
*
INITIALIZE SAMPAREA.
EXEC SQL DECLARE SAMPCSR CURSOR FOR
SELECT Z0001 ,
Z0002
FROM SAMPTBL
WHERE Z0003 = '2304'
ORDER BY Z0001
END-EXEC.
EXEC SQL OPEN SAMPCSR
END-EXEC.
IF SQLCODE = 0 THEN
EXEC SQL FETCH SAMPCSR INTO :DCLBHZ100T.Z0001 ,
:DCLBHZ100T.Z0002
END-EXEC
PERFORM TEST BEFORE UNTIL NOT ( SQLCODE = 0 )
中略
END-PERFORM
EXEC SQL CLOSE SAMPCSR
END-EXEC
ELSE
END-IF.
INIT-100-END. EXIT.
EJECT
* ***************************************************************
* * SAMP2TB READ *
* ***************************************************************
U-100-READ SECTION.
U-100-READ-START.
EXEC SQL FETCH SAMP2TB-C
INTO :DCLSAMP2TB.A0001 ,
:DCLSAMP2TB.A0002 ,
:DCLSAMP2TB.A0003 ,
中略
:DCLSAMP2TB.A0100 ,
:DCLSAMP2TB.A0101 ,
:DCLSAMP2TB.A0102
END-EXEC.
IF SQLCODE = 0 THEN
CONTINUE
ELSE
MOVE 'ON' TO SW-SAMP2TB-EOF
END-IF.
SKIP1
U-100-READ-END. EXIT.
EJECT
* ***************************************************************
* * ｼｭﾂﾘｮｸ ﾍﾝｼｭｳ *
* ***************************************************************
EDIT-OUTFILE SECTION.
EDIT-OUTFILE-START.
INITIALIZE OUTREC .
MOVE A0001 OF DCLSAMP2TB TO A0001 OF OUTREC.
MOVE A0002 OF DCLSAMP2TB TO A0002 OF OUTREC.
MOVE A0003 OF DCLSAMP2TB TO A0003 OF OUTREC.
中略
MOVE A0100 OF DCLSAMP2TB TO A0100 OF OUTREC.
MOVE A0101 OF DCLSAMP2TB TO A0101 OF OUTREC.
MOVE A0102 OF DCLSAMP2TB TO A0102 OF OUTREC.
SKIP1
EDIT-OUTFILE-END. EXIT.
SAMPPLI-END. GOBACK.
プライバシーポリシー サイトマップ
Copyright (C) 2011 株式会社カルテック・エスキューブ All Rights Reserved.