AAAC01

STRPDM.COM

/*------------------------------------------------------------*/
/* 1 TO ADD DEFAULTS CHANGE THE NAMES ON THE CHGVAR STATEMENT.*/
/* */
/* A F21 "PRINT LIST" MUST BE EXECUTED BEFORE CALLING THIS CL */
/*------------------------------------------------------------*/

             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/AAAPF) RCDFMT(AAA)

/*DEFAULT SOURCE FILE*/
CHGVAR VAR(&FFILE) VALUE('QRPGLESRC')

/*DEFAULT LIBRARY*/
CHGVAR VAR(&FLIB) VALUE(' ')

/*DEFAULT AS/400 DOCUMENT FOLDER*/
CHGVAR VAR(&TFOLD) VALUE(' ')

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

             DSPFLR     FLR(&TFOLD) OUTPUT(*PRINT)
             MONMSG     MSGID(OFC8006) EXEC(DO)
             CHGVAR     VAR(&TEXT) VALUE('AS/400 FOLDER NOT FOUND')
             GOTO       CMDLBL(RETRY)
             ENDDO

             CLRPFM     FILE(AAAPF)
             CPYSPLF    FILE(QPUOPRTF) TOFILE(*LIBL/AAAPF) +
                          SPLNBR(*LAST)
             MONMSG     MSGID(CPF3303) EXEC(DO)
             CHGVAR     VAR(&TEXT) VALUE('SOURCE PRINT LIST NOT +
                          FOUND, REVIEW REQUIREMENTS AT TOP OF +
                          SCREEN.')
             GOTO       CMDLBL(RETRY)
             ENDDO

READ:       RCVF       RCDFMT(AAA)
             MONMSG     MSGID(CPF0864) EXEC(DO)
             GOTO       CMDLBL(ENDIT)
             ENDDO

             DSPPFM     FILE(&FLIB/&FFILE) MBR(&MEMBER)
             MONMSG     MSGID(CPF9845) EXEC(GOTO CMDLBL(READ))
             MONMSG     MSGID(CPF0001) EXEC(GOTO CMDLBL(READ))

             CHGVAR     VAR(&CHECK) VALUE(%SST(&MEMBER 9 1))
             IF         COND(&CHECK *NE ' ') THEN(DO)
             CHGVAR     VAR(&TDOC) VALUE(%SST(&MEMBER 1 7) *CAT +
                          '@' *TCAT '.TXT')
             ENDDO

             IF         COND(&CHECK *EQ ' ') THEN(DO)
             CHGVAR     VAR(&TDOC) VALUE((&MEMBER) *TCAT '.TXT')
             ENDDO
             CPYTOPCD   FROMFILE(&FLIB/&FFILE) TOFLR(&TFOLD) +
                          FROMMBR(&MEMBER) TODOC(&TDOC) REPLACE(*YES)
             MONMSG     MSGID(CPF0001) EXEC(GOTO CMDLBL(READ))

GOTO CMDLBL(READ)

ENDIT: ENDPGM