/*--+------------------------------------------------------------+--*/
/*--+   PROGRAM ID : $SAVOUTQ                                    +--*/
/*--+ PROGRAM NAME : CL OF SAVE OUTPUT QUEUE.                    +--*/
/*--+------------------------------------------------------------+--*/
/*--+      VERSION : 1.2 (2000/02/28) CHANGED QSPGETF PARM       +--*/
/*--+                1.1 (1999/07/26) ERROR CODE PARM            +--*/
/*--+                1.0 (1999/07/08)                            +--*/
/*--+------------------------------------------------------------+--*/
/*--+ R510以降で使用するためには                               +--*/
/*--+   309行目&SH_SPLNOB2を&SH_SPLNOB4に変更する          +--*/
/*--+------------------------------------------------------------+--*/
PGM PARM(&OUTQANDLIB &FILEANDLIB &MBROPT &USER &FORM &USRDTA)

/*--+------------------------------------------------------------+--*/
/*  + DECLARATION                                                +  */
/*--+------------------------------------------------------------+--*/

/*- COMMAND PARAMETERS FOR THIS PROGRAM ----------------------------*/
DCL VAR(&OUTQANDLIB) TYPE(*CHAR) LEN(  20  )  /* OUTQ AND LIBRARY   */
    DCL VAR(&OUTQ      ) TYPE(*CHAR) LEN(  10  )  /* OUTQ           */
    DCL VAR(&OUTQLIB   ) TYPE(*CHAR) LEN(  10  )  /* LIBRARY        */
DCL VAR(&FILEANDLIB) TYPE(*CHAR) LEN(  20  )  /* FILE AND LIBRARY   */
    DCL VAR(&FILE      ) TYPE(*CHAR) LEN(  10  )  /* FILE           */
    DCL VAR(&FILELIB   ) TYPE(*CHAR) LEN(  10  )  /* LIBRARY        */
DCL VAR(&MBROPT    ) TYPE(*CHAR) LEN(   8  )  /* MEMBER OPTION      */
DCL VAR(&USER      ) TYPE(*CHAR) LEN(  10  )  /* USER               */
DCL VAR(&FORM      ) TYPE(*CHAR) LEN(  10  )  /* FORM TYPE          */
DCL VAR(&USRDTA    ) TYPE(*CHAR) LEN(  10  )  /* USER DATA          */


/*- SHARED VARIABLES FOR THIS PROGRAM ------------------------------*/
DCL VAR(&SH_USRSPC ) TYPE(*CHAR) LEN(  20  ) /* USER SPACE          */+
                                 VALUE('SAVOUTQ   QTEMP     ')

DCL VAR(&SH_MSG    ) TYPE(*CHAR) LEN(  80  ) /* MESSAGE             */
DCL VAR(&SH_MSGDTA ) TYPE(*CHAR) LEN( 256  ) /* MESSAGE DATA        */
DCL VAR(&SH_MBRNUMB) TYPE(*CHAR) LEN(   2  ) /* NUMBER OF MEMBER(B) */
DCL VAR(&SH_MBRNUM ) TYPE(*DEC ) LEN(   7 0) /* NUMBER OF MEMBER    */
DCL VAR(&SH_RMVM   ) TYPE(*CHAR) LEN(   4  ) /* REMOVE MEMBER FLG  */+
                                 VALUE('*ON')

DCL VAR(&SH_STRPOS ) TYPE(*DEC ) LEN(   9 0) /* START POSITION      */
DCL VAR(&SH_OFFSET ) TYPE(*DEC ) LEN(   9 0) /* OFFSET              */
DCL VAR(&SH_OFFSETB) TYPE(*CHAR) LEN(   4  ) /* BIN OF &SH_OFFSET   */
DCL VAR(&SH_LSTCNT ) TYPE(*DEC ) LEN(   9 0) /* NUMBER OF LIST DATA */
DCL VAR(&SH_LSTCNTB) TYPE(*CHAR) LEN(   4  ) /* BIN OF &SH_LSTCNT   */
DCL VAR(&SH_LSTSIZ ) TYPE(*DEC ) LEN(   9 0) /* SIZE OF LIST DATA   */
DCL VAR(&SH_LSTSIZB) TYPE(*CHAR) LEN(   4  ) /* BIN OF &SH_LSTSIZ   */
DCL VAR(&SH_COUNT  ) TYPE(*DEC ) LEN(   7 0) /* COUNTER             */

DCL VAR(&SH_MBR    ) TYPE(*CHAR) LEN(  10  ) /* MEMBER              */
DCL VAR(&SH_SPLF   ) TYPE(*CHAR) LEN(  10  ) /* SPOOLED FILE        */
DCL VAR(&SH_JOB    ) TYPE(*CHAR) LEN(  26  ) /* JOB                 */
    DCL VAR(&SH_JOBNAME) TYPE(*CHAR) LEN(  10  ) /* JOB NAME        */
    DCL VAR(&SH_JOBUSER) TYPE(*CHAR) LEN(  10  ) /* JOB USER        */
    DCL VAR(&SH_JOBNO  ) TYPE(*CHAR) LEN(   6  ) /* JOB NUMBER      */
DCL VAR(&SH_SPLNO  ) TYPE(*CHAR) LEN(   4  ) /* SPOOLED NO.         */
DCL VAR(&SH_SPLNOB2) TYPE(*CHAR) LEN(   2  ) /* SPOOLED NO.(BIN2)   */
DCL VAR(&SH_SPLNOB4) TYPE(*CHAR) LEN(   4  ) /* SPOOLED NO.(BIN4)   */

DCL VAR(&TEMP_7    ) TYPE(*CHAR) LEN(   7  ) /* TEMPORARY  7 BYTES  */
DCL VAR(&TEMP_4B   ) TYPE(*CHAR) LEN(   4  ) /* TEMPORARY BINARY    */


/*- PARAMETERS FOR API ---------------------------------------------*/
/* QUSCRTUS */
                                             /* &SH_USRSPC          */
DCL VAR(&QCR_EXTDAT) TYPE(*CHAR) LEN(  10  ) /* EXTENDED ATTRIBUTE  */
DCL VAR(&QCR_INTSIZ) TYPE(*CHAR) LEN(   4  ) /* INITIAL SIZE(B)     */
DCL VAR(&QCR_INTVAL) TYPE(*CHAR) LEN(   1  ) /* INITIAL VALUE       */
DCL VAR(&QCR_PUBAUT) TYPE(*CHAR) LEN(  10  ) /* PUBLIC AUTHORITY    */
DCL VAR(&QCR_TEXT  ) TYPE(*CHAR) LEN(  50  ) /* TEXT DESCRIPTION    */

/* QUSRTVUS */
                                             /* &SH_USRSPC          */
DCL VAR(&QRT_STRPOS) TYPE(*CHAR) LEN(   4  ) /* START POSITION(B)   */
DCL VAR(&QRT_DTALEN) TYPE(*CHAR) LEN(   4  ) /* LENGTH OF DATA(B)   */
DCL VAR(&QRT_RCVDTA) TYPE(*CHAR) LEN( 256  ) /* RECEIVER VARIABLE   */

/* QUSLSPL */
                                             /* &SH_USRSPC          */
DCL VAR(&QLS_FORMAT) TYPE(*CHAR) LEN(   8  ) /* FORMAT NAME         */
DCL VAR(&QLS_USRNAM) TYPE(*CHAR) LEN(  10  ) /* USER NAME           */
DCL VAR(&QLS_OUTQ  ) TYPE(*CHAR) LEN(  20  ) /* OUTPUT QUEUE        */
DCL VAR(&QLS_FORM  ) TYPE(*CHAR) LEN(  10  ) /* FORM TYPE           */
DCL VAR(&QLS_USRDTA) TYPE(*CHAR) LEN(  10  ) /* USER DATA           */
DCL VAR(&QLS_ERRCD ) TYPE(*CHAR) LEN(      ) /* ERROR CODE          */
DCL VAR(&QLS_JOB   ) TYPE(*CHAR) LEN(  26  ) /* JOB & USR & JOBNO   */
DCL VAR(&QLS_KEY   ) TYPE(*CHAR) LEN(  20  ) /* KEY(B)              */
DCL VAR(&QLS_KEYNUM) TYPE(*CHAR) LEN(   4  ) /* NUMBER OF KEY(B)    */

/* QDBRTVFD */
DCL VAR(&BRF_RCVVAR) TYPE(*CHAR) LEN( 512  ) /* RECEIVER VARIABLE   */
DCL VAR(&BRF_RCVLEN) TYPE(*CHAR) LEN(   4  ) /* LENGTH OF RCVVAR    */
DCL VAR(&BRF_RTNNAM) TYPE(*CHAR) LEN(  20  ) /* RETURNED FILE NAME  */
DCL VAR(&BRF_FORMAT) TYPE(*CHAR) LEN(   8  ) /* FORMAT NAME         */
DCL VAR(&BRF_FILE  ) TYPE(*CHAR) LEN(  20  ) /* FILE AND LIBRARY    */
DCL VAR(&BRF_RCDFMT) TYPE(*CHAR) LEN(  10  ) /* RECORD FORMAT       */
DCL VAR(&BRF_OVRIDE) TYPE(*CHAR) LEN(   1  ) /* OVERRIDE PROCESSING */
DCL VAR(&BRF_SYSTEM) TYPE(*CHAR) LEN(  10  ) /* SYSTEM              */
DCL VAR(&BRF_FMTTYP) TYPE(*CHAR) LEN(  10  ) /* FORMAT TYPE         */
DCL VAR(&BRF_ERRCD ) TYPE(*CHAR) LEN(      ) /* ERROR CODE          */


/*--+------------------------------------------------------------+--*/
/*  + START OF PROGRAM                                           +  */
/*--+------------------------------------------------------------+--*/

/*--+------------------------------------------------------------+--*/
/*  + INITIALIZE                                                 +  */
/*--+------------------------------------------------------------+--*/

/*- DIVISION OF COMMAND PARAMETER ----------------------------------*/
CHGVAR VAR(&OUTQ      )             VALUE(%SST(&OUTQANDLIB  1 10))
CHGVAR VAR(&OUTQLIB   )             VALUE(%SST(&OUTQANDLIB 11 10))

CHGVAR VAR(&FILE      )             VALUE(%SST(&FILEANDLIB  1 10))
CHGVAR VAR(&FILELIB   )             VALUE(%SST(&FILEANDLIB 11 10))


/*- CHECK OF COMMAND PARAMETER -------------------------------------*/
IF ((&FILELIB *NE '*LIBL'  ) *AND (&FILELIB *NE '*CURLIB')) DO
    CHKOBJ OBJ(&FILELIB) OBJTYPE(*LIB)
        MONMSG MSGID(CPF9801) EXEC(DO)
            RCVMSG MSGQ(*PGMQ) RMV(*YES)
            /* MSG: LIBRARY NOT FOUND */
            SNDPGMMSG MSGID(CPF9810) MSGF(QCPFMSG)       +
                                     MSGDTA(&FILELIB)    +
                                     MSGTYPE(*ESCAPE)
        ENDDO
ENDDO


/*- PARAMETER SETTING ----------------------------------------------*/
/* FOR QUSCRTUS */
CHGVAR VAR(&QCR_EXTDAT)             VALUE(' ')
CHGVAR VAR(%BIN(&QCR_INTSIZ))       VALUE(1024)
CHGVAR VAR(&QCR_INTVAL)             VALUE(' ')
CHGVAR VAR(&QCR_PUBAUT)             VALUE('*ALL')
CHGVAR VAR(&QCR_TEXT  )             VALUE('CREATED BY SAVOUTQ')

/* FOR QUSLSPL */
CHGVAR VAR(&QLS_FORMAT)             VALUE('SPLF0200')
CHGVAR VAR(&QLS_OUTQ  )             VALUE(&OUTQANDLIB)
CHGVAR VAR(&QLS_USRNAM)             VALUE(&USER)
CHGVAR VAR(&QLS_FORM  )             VALUE(&FORM)
CHGVAR VAR(&QLS_USRDTA)             VALUE(&USRDTA)
CHGVAR VAR(%BIN(&QLS_ERRCD   1  4)) VALUE(15)

CHGVAR VAR(%BIN(&TEMP_4B  ))        VALUE(201)      /* SPOOLED FILE */
CHGVAR VAR(%SST(&QLS_KEY     1  4)) VALUE(&TEMP_4B)
CHGVAR VAR(%BIN(&TEMP_4B  ))        VALUE(202)      /* JOB NAME     */
CHGVAR VAR(%SST(&QLS_KEY     5  4)) VALUE(&TEMP_4B)
CHGVAR VAR(%BIN(&TEMP_4B  ))        VALUE(203)      /* USER NAME    */
CHGVAR VAR(%SST(&QLS_KEY     9  4)) VALUE(&TEMP_4B)
CHGVAR VAR(%BIN(&TEMP_4B  ))        VALUE(204)      /* JOB NO.      */
CHGVAR VAR(%SST(&QLS_KEY    13  4)) VALUE(&TEMP_4B)
CHGVAR VAR(%BIN(&TEMP_4B  ))        VALUE(205)      /* SPLF NO.     */
CHGVAR VAR(%SST(&QLS_KEY    17  4)) VALUE(&TEMP_4B)
CHGVAR VAR(%BIN(&QLS_KEYNUM))       VALUE(5)

/* FOR QDBRTVFD */
CHGVAR VAR(%BIN(&BRF_RCVLEN))       VALUE(512)
CHGVAR VAR(&BRF_FILE  )             VALUE(&FILEANDLIB)
CHGVAR VAR(&BRF_FORMAT)             VALUE('FILD0100')
CHGVAR VAR(&BRF_OVRIDE)             VALUE('0')
CHGVAR VAR(&BRF_SYSTEM)             VALUE('*FILETYPE')
CHGVAR VAR(&BRF_FMTTYP)             VALUE('*INT')
CHGVAR VAR(%BIN(&BRF_ERRCD   1  4)) VALUE(15)


/*- CREATION OF USER SPACE -----------------------------------------*/
CHKOBJ OBJ(%SST(&SH_USRSPC 11 10)/%SST(&SH_USRSPC 1 10)) +
       OBJTYPE(*USRSPC)
    MONMSG MSGID(CPF9801) EXEC(DO)
        RCVMSG MSGQ(*PGMQ) RMV(*YES)
        CALL PGM(QUSCRTUS) PARM(&SH_USRSPC   +
                                &QCR_EXTDAT  +
                                &QCR_INTSIZ  +
                                &QCR_INTVAL  +
                                &QCR_PUBAUT  +
                                &QCR_TEXT    )
    ENDDO

/*- SET OF SPOOLED LIST INTO THE USER SPACE ------------------------*/
CALL PGM(QUSLSPL) PARM(&SH_USRSPC  +
                       &QLS_FORMAT +
                       &QLS_USRNAM +
                       &QLS_OUTQ   +
                       &QLS_FORM   +
                       &QLS_USRDTA +
                       &QLS_ERRCD  +
                       &QLS_JOB    +
                       &QLS_KEY    +
                       &QLS_KEYNUM )

    IF (%SST(&QLS_ERRCD  9  7) *EQ 'CPF9801') DO
        /* MSG: OUTPUT QUEUE IN LIBRARY NOT FOUND */
        SNDPGMMSG MSGID(CPF3357) MSGF(QCPFMSG)       +
                                 MSGDTA(&OUTQANDLIB) +
                                 MSGTYPE(*ESCAPE)
    ENDDO

    IF (%SST(&QLS_ERRCD  9  7) *EQ 'CPF9810') DO
        /* MSG: LIBRARY NOT FOUND */
        SNDPGMMSG MSGID(CPF9810) MSGF(QCPFMSG)       +
                                 MSGDTA(&OUTQLIB)    +
                                 MSGTYPE(*ESCAPE)
    ENDDO


/*- RETRIEVE HEADER INFORMATION OF LIST FROM USER SPACE ------------*/
CHGVAR VAR(%BIN(&QRT_STRPOS)) VALUE(125)
CHGVAR VAR(%BIN(&QRT_DTALEN)) VALUE( 16)

CALL PGM(QUSRTVUS) PARM(&SH_USRSPC  +
                        &QRT_STRPOS +
                        &QRT_DTALEN +
                        &QRT_RCVDTA )

CHGVAR VAR(&SH_LSTCNTB) VALUE(%SST(&QRT_RCVDTA  9 4))
CHGVAR VAR(&SH_LSTCNT ) VALUE(%BIN(&SH_LSTCNTB))

IF (&SH_LSTCNT = 0) DO                                   /* NO DATA */
    CHGVAR VAR(&SH_MSG    )  VALUE('NO SPOOLED OUTPUT '     *BCAT +
                                   'FILES IN OUTQ '         *BCAT +
                                   &OUTQ                    *BCAT +
                                   'IN LIBRARY '            *BCAT +
                                   &OUTQLIB                       )

    SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG)    +
                             MSGDTA(&SH_MSG)  +
                             MSGTYPE(*ESCAPE)
ENDDO

CHGVAR VAR(&SH_OFFSETB)       VALUE(%SST(&QRT_RCVDTA  1 4))
CHGVAR VAR(&SH_OFFSET )       VALUE(%BIN(&SH_OFFSETB))
CHGVAR VAR(&SH_LSTSIZB)       VALUE(%SST(&QRT_RCVDTA 13 4))
CHGVAR VAR(&SH_LSTSIZ )       VALUE(%BIN(&SH_LSTSIZB))

CHGVAR VAR(&SH_STRPOS )       VALUE(&SH_OFFSET + 1)
CHGVAR VAR(%BIN(&QRT_STRPOS)) VALUE(&SH_STRPOS)
CHGVAR VAR(%BIN(&QRT_DTALEN)) VALUE(&SH_LSTSIZ)



/*- CHECK OF NUMBER OF MEMBERS -------------------------------------*/
IF (&MBROPT *EQ '*ADD') DO
    CHGVAR VAR(&SH_MBRNUM ) VALUE(0)

    CALL PGM(QDBRTVFD) PARM(&BRF_RCVVAR +
                            &BRF_RCVLEN +
                            &BRF_RTNNAM +
                            &BRF_FORMAT +
                            &BRF_FILE   +
                            &BRF_RCDFMT +
                            &BRF_OVRIDE +
                            &BRF_SYSTEM +
                            &BRF_FMTTYP +
                            &BRF_ERRCD  )

    IF (%SST(&BRF_ERRCD  9  7) *EQ '       ') DO
        CHGVAR VAR(&SH_MBRNUMB) VALUE(%SST(&BRF_RCVVAR 48  2))
        CHGVAR VAR(&SH_MBRNUM ) VALUE(%BIN(&SH_MBRNUMB))
    ENDDO
ENDDO


CHGVAR VAR(&SH_COUNT)  VALUE(0)

/*--+------------------------------------------------------------+--*/
/*  + M A I N                                                    +  */
/*--+------------------------------------------------------------+--*/
#_READ_:

CHGVAR VAR(&SH_COUNT ) VALUE(&SH_COUNT  + 1)            /* COUNT UP */
CHGVAR VAR(&SH_MBRNUM) VALUE(&SH_MBRNUM + 1)

#_RELOAD_:
/*- RETRIEVE LIST DATA FROM USER SPACE -----------------------------*/
CALL PGM(QUSRTVUS) PARM(&SH_USRSPC  +
                        &QRT_STRPOS +
                        &QRT_DTALEN +
                        &QRT_RCVDTA )

/*- SET OF MAIN API PARAMETER FROM RECEIVED DATA -------------------*/
CHGVAR VAR(&SH_SPLF   ) VALUE(%SST(&QRT_RCVDTA  21  10))
CHGVAR VAR(&SH_JOBNAME) VALUE(%SST(&QRT_RCVDTA  49  10))
CHGVAR VAR(&SH_JOBUSER) VALUE(%SST(&QRT_RCVDTA  77  10))
CHGVAR VAR(&SH_JOBNO  ) VALUE(%SST(&QRT_RCVDTA 105   6))
CHGVAR VAR(&SH_SPLNOB4) VALUE(%SST(&QRT_RCVDTA 129   4))


CHGVAR VAR(%SST(&SH_JOB      1 10)) VALUE(&SH_JOBNAME)
CHGVAR VAR(%SST(&SH_JOB     11 10)) VALUE(&SH_JOBUSER)
CHGVAR VAR(%SST(&SH_JOB     21  6)) VALUE(&SH_JOBNO  )

CHGVAR VAR(&SH_SPLNO  )             VALUE(%BIN(&SH_SPLNOB4))
CHGVAR VAR(%BIN(&SH_SPLNOB2))       VALUE(&SH_SPLNO)


CHGVAR VAR(&TEMP_7    ) VALUE(&SH_MBRNUM)
CHGVAR VAR(&SH_MBR    ) VALUE('SPL' *CAT &TEMP_7)

/*- EXECUTION OF MAIN API OR PROGRAM -------------------------------*/
CALL PGM(QSPGETF) PARM(&SH_SPLF    +
                       &FILEANDLIB +
                       &SH_JOB     +
                       &SH_SPLNOB2 +
                       &SH_MBR     )

    MONMSG MSGID(CPF4102 CPF3370) EXEC(DO)
        RCVMSG MSGQ(*PGMQ) RMV(*YES) MSGDTA(&SH_MSGDTA)
        CHGVAR VAR(&SH_MSG    )  VALUE('FILE '              *BCAT +
                                       &FILE                *BCAT +
                                       'IN LIBRARY '        *BCAT +
                                       &FILELIB             *BCAT +
                                       'WAS INCORRECT'            )
        /* MSG: FILE IN LIBRARY WAS INCORRECT */
        SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG)    +
                                 MSGDTA(&SH_MSG)  +
                                 MSGTYPE(*ESCAPE)
    ENDDO

    MONMSG MSGID(CPF3303) EXEC(DO)
        RCVMSG MSGQ(*PGMQ) RMV(*YES) MSGDTA(&SH_MSGDTA)
        /* MSG: SPOOLED FILE NOT FOUND IN JOB */
        SNDPGMMSG MSGID(CPF3303) MSGF(QCPFMSG)      +
                                 MSGDTA(&SH_MSGDTA) +
                                 MSGTYPE(*DIAG  )
        GOTO #_NEXT_
    ENDDO
    MONMSG MSGID(CPF3342) EXEC(DO)
        RCVMSG MSGQ(*PGMQ) RMV(*YES) MSGDTA(&SH_MSGDTA)
        /* MSG: JOB NOT FOUND */
        SNDPGMMSG MSGID(CPF3342) MSGF(QCPFMSG)      +
                                 MSGDTA(&SH_MSGDTA) +
                                 MSGTYPE(*DIAG  )
        GOTO #_NEXT_
    ENDDO

    /*- REMOVE OF MEMBER FROM FILE ---------------------------------*/
    IF (&MBROPT *EQ '*REPLACE') DO
        IF (&SH_RMVM *EQ '*ON') DO
            RMVM FILE(&FILELIB/&FILE) MBR(*ALL)
                MONMSG MSGID(CPF32CF +
                             CPF32C3 +
                             CPF320A +
                             CPF3203 +
                             CPF3220 +
                             CPF3273 +
                             CPF7301 +
                             CPF7303 +
                             CPF7310 )
            CHGVAR VAR(&SH_RMVM   )  VALUE('*OFF')
            GOTO #_RELOAD_
        ENDDO
    ENDDO



CHGVAR VAR(&SH_MSGDTA )  VALUE(&SH_MBR *CAT &FILEANDLIB)
/* MSG: MEMBER ADDED TO FILE IN LIBRARY */
SNDPGMMSG MSGID(CPC7305) MSGF(QCPFMSG)      +
                         MSGDTA(&SH_MSGDTA) +
                         MSGTYPE(*COMP  )



#_NEXT_:
/*- SET OF NEXT POSITION FOR USER SPACE ----------------------------*/
CHGVAR VAR(&SH_STRPOS)        VALUE(&SH_STRPOS + &SH_LSTSIZ)
CHGVAR VAR(%BIN(&QRT_STRPOS)) VALUE(&SH_STRPOS)

IF (&SH_LSTCNT = &SH_COUNT) GOTO #_EXIT_                  /* AT END */


GOTO #_READ_
/* */
/*--+------------------------------------------------------------+--*/
/*  + END OF PROGRAM                                             +  */
/*--+------------------------------------------------------------+--*/
#_EXIT_:
ENDPGM