STRPDM.COM

/*------------------------------------------------------------*/
/* PROGRAM NAME: AA2C01                                       */
/* 1 CREATE AN OUTFILE WITH THE NAME AA2PF BEFORE COMPILING   */
/*   PROGRAMS.                                                */
/*------------------------------------------------------------*/

 
             PGM
             DCL        VAR(&FFILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&FLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&TFOLD) TYPE(*CHAR) LEN(10)
             DCL        VAR(&CHECK) TYPE(*CHAR) LEN(1)
             DCL        VAR(&TDOC) TYPE(*CHAR) LEN(12)
             DCL        VAR(&TEXT) TYPE(*CHAR) LEN(75)
             DCLF       FILE(*LIBL/AA2PF) RCDFMT(DOCDTL)
 
             /*DEFAULT SOURCE FILE*/
             CHGVAR     VAR(&FFILE) VALUE('QRPGLESRC')
 
             /*DEFAULT LIBRARY*/
             CHGVAR     VAR(&FLIB) VALUE('         ')
 
             /*DEFAULT AS/400 DOCUMENT FOLDER*/
             CHGVAR     VAR(&TFOLD) VALUE('         ')
 
/*------------------------------------------------------------*/
/*   DISPLAY PROMPT SCREEN.                                   */
/*------------------------------------------------------------*/
 RETRY:      CALL       PGM(AAAR01) PARM(&FFILE &FLIB &TFOLD &TEXT)
             IF         COND(&FFILE *EQ 'NONE') THEN(GOTO +
                          CMDLBL(ENDIT))
 
             CHGVAR     VAR(&TEXT) VALUE(*BLANKS)
 
             CHKOBJ     OBJ(&FLIB/&FFILE) OBJTYPE(*FILE)
             MONMSG     MSGID(CPF9801) EXEC(DO)
             CHGVAR     VAR(&TEXT) VALUE('SOURCE FILE NOT FOUND')
             GOTO       CMDLBL(RETRY)
             ENDDO
 
             MONMSG     MSGID(CPF9810) EXEC(DO)
             CHGVAR     VAR(&TEXT) VALUE('LIBRARY NOT FOUND')
             GOTO       CMDLBL(RETRY)
             ENDDO
 
/*------------------------------------------------------------*/
/*   CREATE OUTFILE FOR NAMES OF DOCUMENTS IN FOLDER          */
/*------------------------------------------------------------*/
             DSPFLR     FLR(&TFOLD) TYPE(*DOC) OUTPUT(*OUTFILE) +
                          OUTFILE(&FLIB/AA2PF)
             MONMSG     MSGID(OFC8006) EXEC(DO)
             CHGVAR     VAR(&TEXT) VALUE('AS/400 FOLDER NOT FOUND')
             GOTO       CMDLBL(RETRY)
             ENDDO
/*------------------------------------------------------------*/
/*   STRIP THE .TXT FROM ANY DOCUMENT NAMES                   */
/*------------------------------------------------------------*/
             CALL       PGM(AA2R02)
 
/*------------------------------------------------------------*/
/*   COPY ALL DOCUMENTS TO SOURCE FILE                        */
/*------------------------------------------------------------*/
 READ:       RCVF       RCDFMT(DOCDTL)
             MONMSG     MSGID(CPF0864) EXEC(DO)
             GOTO       CMDLBL(ENDIT)
             ENDDO
 
             CPYFRMPCD  FROMFLR(&TFOLD) TOFILE(&FLIB/&FFILE) +
                          FROMDOC(&DOCNAM) TOMBR(&DOCTYP)
             MONMSG     MSGID(CPF0001) EXEC(GOTO CMDLBL(READ))
 

             GOTO       CMDLBL(READ)
 
 ENDIT:      ENDPGM