/* +
 PRCFLST:   Process each row of a DSPFD outfile member (list). The given       +
            command is executed using relevant values from the row.            +
                                                                               +
            A command is supplied ated, chosen rows can be deleted to remove   +
            unneeded details. Multiple lists can be appended to a single       +
            member or each list can be kept separate. Lists may be built in    +
            QTEMP, in a separate user library or all in the same list file.    +
*/

 pgm   ( +
         &pCmd        +
         &pLstNam     +
         &pqLstF      +
         &pPrcErr     +
         &pErrAct     +
       )

   dcl   &pCmd        *char  6002
   dcl   &pLstNam     *char    10
   dcl   &pqLstF      *char    20
   dcl   &pPrcErr     *char     4
   dcl   &pErrAct     *char    10


   dcl   &LstF        *char    10
   dcl   &LstFLib     *char    10

   dcl   &PrcErr      *char     4
   dcl   &ErrAct      *char    10

   dcl   &PrcCmd      *char  6000
   dcl   &PrcCmdLen   *dec  (   5 0 )

   dcl   &Type        *char     1
   dcl   &Reply       *char     1

   dcl   &parm10      *char    10

   dcl   &CStkCtr         *char      4
   dcl   &CStkIDLen       *char      4
   dcl   &RSNM0100        *char     29


   dclf  QADSPOBJ


/*                                                           */
/* Global message monitor...                                 */
/*                                                           */

   monmsg    ( cpf0000 cpf9999 ) exec( goto Std_Err )


/*                                                                  */
/*  Copy parm values into local variables...                        */
/*                                                                  */
   chgvar      &LstF              %sst( &pqLstF  1 10 )
   chgvar      &LstFLib           %sst( &pqLstF 11 10 )

   if ( &LstF *eq '*DFT' )  +
      Qsys/rtvdtaara  dtaara( VLDFTOBJ ) rtnvar( &LstF )


   chgvar      &PrcCmdLen         %bin( &pCmd  1 2 )
   chgvar      &PrcCmd            %sst( &pCmd  3 &PrcCmdLen )

   chgvar      &PrcErr                  &pPrcErr
   chgvar      &ErrAct                  &pErrAct


   Qsys/ovrdbf    QADSPOBJ  tofile( &LstFLib/&LstF ) +
                    mbr( &pLstNam )

Nxt_LstObj:

   rcvf
   monmsg    ( cpf0864 ) exec( goto  End_LstObj )


/*                                                                  */
/*  Search/replace any @@Os...                                      */
/*                                                                  */

   callprc    RPLSST   ( +
                         &PrcCmd      +
                         &PrcCmdLen   +
                         '@@O       ' +
                         &ODOBNM      +
                       )


/*                                                                  */
/*  Search/replace any @@Ls...                                      */
/*                                                                  */

   callprc    RPLSST   ( +
                         &PrcCmd      +
                         &PrcCmdLen   +
                         '@@L       ' +
                         &ODLBNM      +
                       )


/*                                                                  */
/*  Search/replace any @@Ts...                                      */
/*                                                                  */
   /* The parm is *char(1); &ODOBTP is only *char(8)... */
   chgvar      &parm10                ( &ODOBTP *cat '  ' )

   callprc    RPLSST   ( +
                         &PrcCmd      +
                         &PrcCmdLen   +
                         '@@T       ' +
                         &parm10      +
                       )


/*                                                                  */
/*  Process the command for this list entry...                      */
/*                                                                  */
   PRCCMD      CMD( &PrcCmd ) CMDLEN( &PrcCmdLen )

/*                                                                  */
/*  For prompted commands, was <F12> pressed? If so, does that      */
/*    mean we should cancel processing the remainder of the list?   */
/*                                                                  */
   monmsg    ( cpf6801 )  exec( do )

      Qsys/rtvjoba  type( &Type )

      if ( &Type *eq '0' )  +
         chgvar  &Reply                 'Y'
      else  +
         Qsys/sndusrmsg  msgid( CPF9898 ) msgf( QCPFMSG ) +
                           msgdta( +
                                   'Cancel remaining list (Y/{N})?' +
                                 ) +
                           values( Y N ) dft( N ) msgrpy( &Reply ) +
                           trntbl( QSYSTRNTBL )


      if ( &Reply *eq 'Y' )  +
         goto  End_LstObj

   enddo

/*                                                                  */
/*  Errors will jump us to Std_Err unless we requested we said      */
/*    processing should continue...                                 */
/*                                                                  */
   monmsg    ( cpf0000 cpf9999 mch0000)  exec( do )
      if ( &PrcErr *eq '*NO' )  +
         goto  Std_Err
   enddo


   goto      Nxt_LstObj


End_LstObj:

   Qsys/dltovr file( QADSPOBJ )

   return


Std_Err:

   /* Move any *DIAG messages up the stack...        */

   Qsys/call  pgm( QSYS/QMHMOVPM ) parm( +
                                         '    '          +
                                         '*DIAG     '    +
                                         x'00000001'     +
                                         '*         '    +
                                         x'00000001'     +
                                         x'00000000'     +
                                       )
   Qsys/monmsg     ( CPF0000 MCH0000 )

   /* Resend any *ESCAPE messages up the stack...     */

   chgvar    %bin( &CStkCtr   )        2
   Qsys/monmsg     ( CPF0000 MCH0000 )
   chgvar    %bin( &CStkIDLen )        1
   Qsys/monmsg     ( CPF0000 MCH0000 )

   chgvar    &RSNM0100               ( &CStkCtr     *CAT +
                                       '*NONE     *NONE     ' *CAT +
                                       &CStkIDLen   *CAT +
                                       '*'               +
                                     )
   Qsys/monmsg     ( CPF0000 MCH0000 )


   Qsys/call  pgm( QSYS/QMHRSNEM ) parm( +
                                         '    '          +
                                         x'00000000'     +
                                         &RSNM0100       +
                                         x'0000001D'     +
                                         'RSNM0100 '     +
                                         '*               ' +
                                         x'00000000'     +
                                       )
   Qsys/monmsg     ( CPF0000 MCH0000 )

   return

endpgm