CL Import stream files

CLPs can be used to covert ASCII stream files to EBCIDIC files.

Importing stream file data

The Copy From Stream File (CPYFRMIMPF) command copies the data in a stream file to either a database file member or a save file. Optional conversion of the data and reformatting is performed when copying a database file member. Note in the example below the End of Record (EOR) marker is expected to be a single line feed (*LF).

/*********************************************************************/
/* Program Name -ISI070CL                                            */
/*                                                                   */
/* Function     - This program was designed to read a directory and  */
/*                upload a NCOA file from CSG.                       */
/*                                                                   */
/* Programmer   - Steve Croy                      99/99/9999         */
/*********************************************************************/

             PGM

             DCLPRCOPT  DFTACTGRP(*NO) ACTGRP(CSGXMT) +
                          BNDSRVPGM((ISI000SV))

             DCL   VAR(&IMPFOLDER) TYPE(*CHAR) LEN(200)
             DCL   VAR(&ARCFOLDER) TYPE(*CHAR) LEN(200)
             DCL   VAR(&ERRFOLDER) TYPE(*CHAR) LEN(200) /* sac05 */
             DCL   VAR(&MSGKEY)    TYPE(*CHAR) LEN(4)
             DCL   VAR(&PGMNAME)   TYPE(*CHAR) LEN(10)
             DCL   VAR(&FUNCTION)  TYPE(*CHAR) LEN(25)
             DCL   VAR(&PROGRAM)   TYPE(*CHAR) LEN(15)
             DCL   VAR(&SENDER)    TYPE(*CHAR) LEN(80)
             DCL   VAR(&FILEPATH)  TYPE(*CHAR) LEN(200)
             DCL   VAR(&FILENAME)  TYPE(*CHAR) LEN(25)
             DCL   VAR(&JOBTYPE)   TYPE(*CHAR) LEN(1)
             DCL   VAR(&CSGFTP)    TYPE(*CHAR) LEN(15) +
                          VALUE('CSGFTP')
             DCL   VAR(&count)     TYPE(*DEC ) LEN(5 0)
             DCL   VAR(&SYSNAME)   TYPE(*CHAR) LEN(8)
             DCL        VAR(&SUBJECT) TYPE(*CHAR) LEN(50)  /* sac05 */
             dcl        var(&message) type(*char) len(80)  /* sac05 */
             dcl        var(&reason)  type(*char) len(80)  /* sac05 */
             DCL        VAR(&ERROR) TYPE(*LGL) LEN(1) /* sac05 */

             RTVJOBA    TYPE(&JOBTYPE)
             RTVNETA    SYSNAME(&SYSNAME)

/*-------------------------------------------------------------------*/
/* Clear the upload file                                             */
/*-------------------------------------------------------------------*/

             CLRPFM     FILE(PERMGEN)  

/*-------------------------------------------------------------------*/
/* Get the program name                                              */
/*-------------------------------------------------------------------*/

             SNDPGMMSG  MSG(' ') TOPGMQ(*SAME) MSGTYPE(*INFO) +
                          KEYVAR(&MSGKEY)
             RCVMSG     PGMQ(*SAME) MSGTYPE(*INFO) RMV(*YES) +
                          SENDER(&SENDER)
             CHGVAR     VAR(&PGMNAME) VALUE(%SST(&SENDER 56 10))
             CHGVAR     VAR(&PROGRAM) VALUE(&PGMNAME)

/*-------------------------------------------------------------------*/
/* Get the folder where the CSG data is to be Archived               */
/*-------------------------------------------------------------------*/

             CHGVAR     VAR(&FUNCTION) VALUE('IMPFOLDER')
             CALL       PGM(ISI005RP) PARM(&PROGRAM &FUNCTION &IMPFOLDER)
             CHGVAR     VAR(&FUNCTION) VALUE('ARCFOLDER')
             CALL       PGM(ISI005RP) PARM(&PROGRAM &FUNCTION &ARCFOLDER)
             CHGVAR     VAR(&FUNCTION) VALUE('ERRFOLDER') /* sac05 */
             CALL       PGM(ISI005RP) PARM(&PROGRAM &FUNCTION +
                          &ERRFOLDER) /* sac05 */

/*-------------------------------------------------------------------*/
/* Read the files in the folder and move them to archive             */
/*-------------------------------------------------------------------*/

             DLTF       FILE(QTEMP/CSGADRWF) /* sac01 */
             MONMSG     MSGID(CPF0000) /* sac01 */

             CRTPF      FILE(QTEMP/CSGADRWF) RCDLEN(553) TEXT('CSG: +
                          Work file for ascii imports') +
                          SIZE(*NOMAX) /* sac01 */

             CHGVAR     VAR(&COUNT) VALUE(0)
             CLRPFM     FILE(CSGADRPF)

 LIST:       CALL       PGM(ISI010RP) PARM(&IMPFOLDER)

 READ:       DOUNTIL    COND(&FILEPATH *EQ '*****')
             CALL       PGM(ISI020RP) PARM(&FILEPATH)
             IF         COND(&FILEPATH *NE '*****') THEN(DO)

/*-------------------------------------------------------------------*/
/* Copy the current file to the NCOA address file.                   */
/*-------------------------------------------------------------------*/

             CHGATR     OBJ(&FILEPATH) ATR(*CCSID) VALUE(1252) /* +
                          sac04 */

             CHGVAR     VAR(&ERROR) VALUE('0')
             CPYFRMSTMF FROMSTMF(&FILEPATH) +
                          TOMBR('/QSYS.LIB/QTEMP.LIB/CSGADRWF.FILE/CS+
                          GADRWF.MBR') MBROPT(*REPLACE) +
                          STMFCCSID(*STMF) ENDLINFMT(*LF) 

/*-------------------------------------------------------------------*/
/* Move the data files to archive                                    */
/*-------------------------------------------------------------------*/

 ARCHIVE:    MOVE       OBJ(&FILEPATH) TODIR(&ARCFOLDER) +
                          TOCCSID(*CALC) DTAFMT(*TEXT)

             MONMSG     MSGID(CPFA0A0) EXEC(DO)
             CALLSUBR   SUBR(EXCEPTION)
             CHGVAR     VAR(&ERROR) VALUE('1')
             ENDDO

             IF         COND(&ERROR *NE '1') THEN(DO)
             CPYFRMIMPF FROMFILE(CSGADRWF) TOFILE(CSGADRPF) +
                          RCDDLM(*LF) STRDLM(*NONE) FLDDLM('|') +
                          RPLNULLVAL(*FLDDFT)
              CHGVAR     VAR(&COUNT) VALUE(&COUNT + 1)
             ENDDO      
             ENDDO

 ENDREAD:    ENDDO

/*-------------------------------------------------------------------*/
/* Once the directory has been cleared, invoke the program to        */
/* process the return data.                                          */
/*-------------------------------------------------------------------*/

             IF         COND(&COUNT *LT 1) THEN(GOTO CMDLBL(TERMINATE))

/*-------------------------------------------------------------------*/
/* Process the return file                                           */
/*-------------------------------------------------------------------*/

             CALL       PGM(ISI075RP)
             CALL       PGM(PAA2000R) 
             CALL       PGM(ISI077RP) 

 TERMINATE:
             DLTF       FILE(QTEMP/CSGADRWF) 
             MONMSG     MSGID(CPF0000)       

             CALL       PGM(ISI079RP) 

             RETURN

 /*-----------------------------------------------------------------*/
 /* subroutine added to manage file exceptions                      */
 /*-----------------------------------------------------------------*/

 ERRFILE:    SUBR       SUBR(EXCEPTION)

             CHGVAR     VAR(&SUBJECT) VALUE(' ')
             CHGVAR     VAR(&message) VALUE(' ')
             CHGVAR     VAR(&reason) VALUE(' ')

             CALLSUBR   SUBR(ARCHIVESR)

             CHGVAR     VAR(&SUBJECT) VALUE('CSG COA file error')
             CHGVAR     VAR(&MESSAGE) VALUE('Error attempting to +
                          move object to archive COA folder.')
             CHGVAR     VAR(&REASON) VALUE('Check the job log of +
                          CSGSDRCHG for details.')

             CALL       PGM(CSG415CL) PARM(&SUBJECT &MESSAGE &REASON)

             ENDSUBR

/*==================================================================*/
/* move file to archive                                             */
/*==================================================================*/

             SUBR       SUBR(ARCHIVESR)
 RETRY:
             CHGVAR     VAR(&ERROR) VALUE('0')
             MOV        OBJ(&FILEPATH) TODIR(&ARCFOLDER)
             MONMSG     MSGID(CPFA0A0) EXEC(DO)
             CHGVAR     VAR(&ERROR) VALUE('1')
             CALL       PGM(CSG305RP) PARM(&FILEPATH &ARCFOLDER)
             ENDDO
             IF         COND(&ERROR) THEN(GOTO CMDLBL(RETRY))

             ENDSUBR

             ENDPGM 

Import using delimited stream files

In the sample below the import statement is directed at inbound data that has a column-delimiter. The CPYFRMIMPT has a parameter that allows a developer to specify the character used as a delimiter. In the case of the stream file below, the columns in the row are delimited by “|”.

/*********************************************************************/
/* Program Name -ISI071CL                                            */
/*                                                                   */
/* Function     - This program was designed to read a directory and  */
/*                create update mail trace data inbound.             */
/*                                                                   */
/* Programmer   - Steve Croy                      99/99/9999         */
/*********************************************************************/
/*********************************************************************/
/*                   Modification log                                */
/*                                                                   */
/*   Date    Programmer      Description                             */
/*********************************************************************/

             PGM

             DCLPRCOPT  DFTACTGRP(*NO) ACTGRP(TRACE) +
                          BNDSRVPGM((ISI000SV))

             DCL   VAR(&IMPFOLDER) TYPE(*CHAR) LEN(200)
             DCL   VAR(&ARCFOLDER) TYPE(*CHAR) LEN(200)
             DCL   VAR(&MSGKEY)    TYPE(*CHAR) LEN(4)
             DCL   VAR(&PGMNAME)   TYPE(*CHAR) LEN(10)
             DCL   VAR(&FUNCTION)  TYPE(*CHAR) LEN(25)
             DCL   VAR(&PROGRAM)   TYPE(*CHAR) LEN(15)
             DCL   VAR(&SENDER)    TYPE(*CHAR) LEN(80)
             DCL   VAR(&FILEPATH)  TYPE(*CHAR) LEN(200)
             DCL   VAR(&FILENAME)  TYPE(*CHAR) LEN(25)
             DCL   VAR(&JOBTYPE)   TYPE(*CHAR) LEN(1)
             DCL   VAR(&JOBDATE)   TYPE(*CHAR) LEN(6)   /* sac01 */
             DCL   VAR(&SYSNAME)   TYPE(*CHAR) LEN(8)
             DCL        VAR(&LIBRARY) TYPE(*CHAR) LEN(10) +
                          VALUE('*LIBL')

             DCL   VAR(&EXCEPTION) TYPE(*CHAR) LEN(25)  /* sac01 */
             DCL   VAR(&DOCUMENT)  TYPE(*CHAR) LEN(15)  /* sac01 */
             DCL   VAR(&EXPFOLDER) TYPE(*CHAR) LEN(200) /* sac01 */
             DCL   VAR(&ERRPATH)   TYPE(*CHAR) LEN(200) /* sac01 */
             DCL   VAR(&ERRNAME)   TYPE(*CHAR) LEN(17)  /* sac01 */
             DCL   VAR(&ERRFOLDER) TYPE(*CHAR) LEN(200) /* sac02 */
             DCL        VAR(&SCANREC) TYPE(*DEC) LEN(10 0)
             DCL        VAR(&XREFREC) TYPE(*DEC) LEN(10 0)
             DCL        VAR(&POS) TYPE(*UINT) LEN(2)
             DCL        VAR(&SUBJECT) TYPE(*CHAR) LEN(50)  /* sac02 */
             dcl        var(&message) type(*char) len(80)  /* sac02 */
             dcl        var(&reason)  type(*char) len(80)  /* sac02 */
             dcl        var(&ERROR)   type(*LGL)  len(1)   /* sac02 */

             RTVJOBA    TYPE(&JOBTYPE) DATE(&JOBDATE)
             RTVNETA    SYSNAME(&SYSNAME)

/*-------------------------------------------------------------------*/
/* Get the program name                                              */
/*-------------------------------------------------------------------*/

             SNDPGMMSG  MSG(' ') TOPGMQ(*SAME) MSGTYPE(*INFO) +
                          KEYVAR(&MSGKEY)
             RCVMSG     PGMQ(*SAME) MSGTYPE(*INFO) RMV(*YES) +
                          SENDER(&SENDER)
             CHGVAR     VAR(&PGMNAME) VALUE(%SST(&SENDER 56 10))
             CHGVAR     VAR(&PROGRAM) VALUE(&PGMNAME)

/*-------------------------------------------------------------------*/
/* Get the folder where the CSG mail trace data is located           */
/*-------------------------------------------------------------------*/

             CHGVAR     VAR(&PROGRAM) VALUE(&PGMNAME)
             CHGVAR     VAR(&FUNCTION) VALUE('IMPFOLDER')
             CALL       PGM(ISI005RP) PARM(&PROGRAM &FUNCTION &IMPFOLDER)
             CHGVAR     VAR(&FUNCTION) VALUE('ARCFOLDER')
             CALL       PGM(ISI005RP) PARM(&PROGRAM &FUNCTION &ARCFOLDER)
             CHGVAR     VAR(&FUNCTION) VALUE('ERRFOLDER') /* sac02 */
             CALL       PGM(ISI005RP) PARM(&PROGRAM &FUNCTION +
                          &ERRFOLDER) /* sac02 */

/*-------------------------------------------------------------------*/
/* Read the files in the folder and move them to archive             */
/*-------------------------------------------------------------------*/

 LIST:       CALL       PGM(ISI010RP) PARM(&IMPFOLDER)

 READ:       DOUNTIL    COND(&FILEPATH *EQ '*****')
             CALL       PGM(ISI020RP) PARM(&FILEPATH)

/*-------------------------------------------------------------------*/
/* Copy the current file to the mail trace file                      */
/*-------------------------------------------------------------------*/

 STRCOPY:    IF         COND(&FILEPATH *NE '*****') THEN(DO)

             CLRPFM     FILE(CSGIMBWF)
             DLTF       FILE(QTEMP/DUPSCANS) /* sac01 */
             MONMSG     MSGID(CPF0000) /* sac01 */
             DLTF       FILE(QTEMP/NOPOXREF) /* sac01 */
             MONMSG     MSGID(CPF0000) /* sac01 */
             CHGVAR     VAR(&SCANREC) VALUE(0) /* sac01 */
             CHGVAR     VAR(&XREFREC) VALUE(0) /* sac01 */

             CPYFRMIMPF FROMSTMF(&FILEPATH) TOFILE(CSGIMBWF) +
                          RCDDLM(*LF) STRDLM(*NONE) FLDDLM('|') +
                          RPLNULLVAL(*FLDDFT)

             EXECSQL    STMT('SELECT +
                          count(*),IMZIPP,IMROUT,IMZIPC,imddtm FROM +
                          csgimbwf GROUP BY +
                          imzipp,imrout,imzipc,imddtm  HAVING +
                          count(*) > 1') OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/DUPSCANS) /* sac01 */

             RTVMBRD    FILE(DUPSCANS) NBRCURRCD(&SCANREC) /* sac01 */
             IF         COND(&SCANREC *GT 0) THEN(DO) /* sac01 */
             CALLSUBR   SUBR(EXCEPTION) /* sac01 */
             GOTO       CMDLBL(ENDCOPY) /* sac01 */
             ENDDO      /* sac01 */

             EXECSQL    STMT('select distinct aa.imdesc, bb.uspcod +
                          from  csgimbwf aa left join csgpocpf bb +
                          on aa.imdesc = bb.uspdsc   where +
                          bb.uspcod is null') OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/NOPOXREF) /* sac01 */

             RTVMBRD    FILE(NOPOXREF) NBRCURRCD(&XREFREC) /* sac01 */
             IF         COND(&XREFREC *GT 0) THEN(DO) /* sac01 */
             CALLSUBR   SUBR(EXCEPTION) /* sac01 */
             GOTO       CMDLBL(ENDCOPY) /* sac01 */
             ENDDO      /* sac01 */

             MOV        OBJ(&FILEPATH) TODIR(&ARCFOLDER)
             MONMSG     MSGID(CPFA0A0) EXEC(DO)
             CHGVAR     VAR(&SUBJECT) VALUE(' ')
             CHGVAR     VAR(&message) VALUE(' ')
             CHGVAR     VAR(&reason)  VALUE(' ')
             CALLSUBR   SUBR(ARCHIVESR)
             ENDDO

             CALL       PGM(ISI071RP)

 ENDCOPY:    ENDDO
 ENDREAD:    ENDDO

 TERMINATE:
             RETURN

 /*-----------------------------------------------------------------*/
 /* Exception subroutine added to manage file exceptions            */
 /*-----------------------------------------------------------------*/
 ERRFILE:    SUBR       SUBR(EXCEPTION)

             CHGVAR     VAR(&DOCUMENT) VALUE('POLICY')
             CHGVAR     VAR(&EXCEPTION) VALUE('EXCEPTION')
             CALL       PGM(ISI005RP) PARM(&DOCUMENT &EXCEPTION +
                          &EXPFOLDER)

             MOV        OBJ(&FILEPATH) TODIR(&EXPFOLDER)

             CHGVAR     VAR(&DOCUMENT) VALUE('CSGFTP')
             CHGVAR     VAR(&EXCEPTION) VALUE('OUTBOUNDFOLDER')
             CALL       PGM(ISI005RP) PARM(&DOCUMENT &EXCEPTION +
                          &ERRFOLDER)

             CHGVAR     VAR(&POS) VALUE(%SCAN('.7640' &FILEPATH))
             CHGVAR     VAR(&ERRNAME) VALUE(%SST(&FILEPATH &POS 18))

             IF COND(&SCANREC *GT 0) THEN(DO)
             CHGVAR     VAR(&ERRFOLDER) VALUE(&ERRFOLDER *TCAT +
                          'DUPSCANS' *TCAT &ERRNAME *TCAT '.TXT')
             CPYTOIMPF  FROMFILE(DUPSCANS) TOSTMF(&ERRFOLDER) +
                          MBROPT(*REPLACE) STMFCCSID(1252) +
                          RCDDLM(*CRLF) STRDLM(*NONE) FLDDLM('|')
             ENDDO

             IF COND(&XREFREC *GT 0) THEN(DO)
             CHGVAR     VAR(&ERRFOLDER) VALUE(&ERRFOLDER *TCAT +
                          'NOPOXREF' *TCAT &ERRNAME *TCAT '.TXT')
             CPYTOIMPF  FROMFILE(NOPOXREF) TOSTMF(&ERRFOLDER) +
                          MBROPT(*REPLACE) STMFCCSID(1252) +
                          RCDDLM(*CRLF) STRDLM(*NONE) FLDDLM('|')
             ENDDO

             ENDSUBR

/*==================================================================*/
/* move file to archive                                             */
/*==================================================================*/

             SUBR       SUBR(ARCHIVESR)
 RETRY:
             CHGVAR     VAR(&ERROR) VALUE('0')
             MOV        OBJ(&FILEPATH) TODIR(&ARCFOLDER)
             MONMSG     MSGID(CPFA0A0) EXEC(DO)
             CHGVAR     VAR(&ERROR) VALUE('1')
             CALL       PGM(CSG305RP) PARM(&FILEPATH &ARCFOLDER)
             ENDDO
             IF         COND(&ERROR) THEN(GOTO CMDLBL(RETRY))

             CHGVAR     VAR(&SUBJECT) VALUE('Return file error +
                          occurred')
             CHGVAR     VAR(&MESSAGE) VALUE('Error occurred when +
                          attempting to move to the archive +
                          folder.')
             CHGVAR     VAR(&REASON) VALUE('Check the job log of +
                          CSGIMBTRC for details.')
             CALL       PGM(CSG415CL) PARM(&SUBJECT &MESSAGE &REASON)

             ENDSUBR

             ENDPGM