**********************************************************************************************
      * DBG194R4: Move output queue
      * Copyright (C) 2001  Martin Rowe   <martin@dbg400.net>
      *
      * This program is free software; you can redistribute it and/or modify
      * it under the terms of the GNU General Public License as published by
      * the Free Software Foundation; either version 2 of the License, or
      * (at your option) any later version.
      *
      * This program is distributed in the hope that it will be useful,
      * but WITHOUT ANY WARRANTY; without even the implied warranty of
      * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      * GNU General Public License for more details.
      *
      * You should have received a copy of the GNU General Public License
      * along with this program; if not, write to the Free Software
      * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
      **********************************************************************************************
     H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT)
      **********************************************************************************************
      * FILES:
      **********************************************************************************************
     FDBG1860W  IF   E             DISK
      **********************************************************************************************
      * ARRAYS:
      **********************************************************************************************
      **********************************************************************************************
      * DATA STRUCTURES:
      **********************************************************************************************
     D SDS#DS         SDS
     D  SDS#Pgm                      10    OVERLAY(SDS#DS:1)
     D  SDS#User                     10    OVERLAY(SDS#DS:254)
      *
     D Command1        DS
     D  CHGSPLFA                    120    INZ('CHGSPLFA FILE(1234567890) -
     D                                     JOB(123456/1234567890/1234567890) -
     D                                     SPLNBR(12345) -
     D                                     OUTQ(1234567890/1234567890)')
     D   CHGFile                     10    OVERLAY(CHGSPLFA:15)
     D   CHGJob                      28    OVERLAY(CHGSPLFA:31)
     D   CHGSplNbr                    5  0 OVERLAY(CHGSPLFA:68)
     D   CHGOutQ                     21    OVERLAY(CHGSPLFA:80)
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D P#CmdString     S            256
     D P#CmdLength     S             15  5
     D P#QualOutq      S             20
     D P#File          S             10
     D P#UsrDta        S             10
     D P#User          S             10
     D P#StartNbr      S              5  0
     D P#EndNbr        S              5  0
     D P#Status        S              6
      **********************************************************************************************
      * CONSTANTS:
      **********************************************************************************************
      **********************************************************************************************
      * FIELD RENAMES:
      **********************************************************************************************
      **********************************************************************************************
      * ENTRY PARAMETERS:
      **********************************************************************************************
     C     *ENTRY        PLIST
     C                   PARM                    P#QualOutq
     C                   PARM                    P#File
     C                   PARM                    P#UsrDta
     C                   PARM                    P#User
     C                   PARM                    P#StartNbr
     C                   PARM                    P#EndNbr
     C                   PARM                    P#Status
      **********************************************************************************************
      * KEY LISTS:
      **********************************************************************************************
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
     C                   EVAL      CHGOutQ =
     C                             %TRIM(%SUBST(P#QualOutq : 11 : 10)) + '/' +
     C                             %TRIM(%SUBST(P#QualOutq : 1 : 10))
      * Strip trailing generic '*' from file so correct match is made
B001 C                   IF        P#File > *blanks
B002 C                   IF        %SUBST(P#File : %LEN(%TRIM(P#File)) : 1) =
     C                             '*'
     C                   EVAL      %SUBST(P#File : %LEN(%TRIM(P#File)) : 1) =
     C                             ' '
E002 C                   ENDIF
E001 C                   ENDIF
      * Loop through *OUTFILE for requested *OUTQ
     C     1             SETLL     DBG1860W
     C                   READ      DBG1860W
      *
B001 C                   DOW       NOT %EOF(DBG1860W)
      * If the restriction criteria are empty or match the starting characters of the target field
      * File name & user data can be generic - user is an exact match
B002 C                   IF        (P#File = ' ' OR %TRIM(P#File) =
     C                             %SUBST(SPLNAME : 1 : %LEN(%TRIM(P#File))))
     C                             AND (P#User = ' ' OR P#User = SPLUSERPRF)
     C                             AND (P#UsrDta = ' ' OR %TRIM(P#UsrDta) =
     C                             %SUBST(SPLUSRDTA : 1 :
     C                                    %LEN(%TRIM(P#UsrDta))))
     C                             AND (P#StartNbr = 0 OR P#StartNbr <= SPLNBR)
     C                             AND (P#EndNbr = 99999 OR P#EndNbr >= SPLNBR)
     C                             AND (P#Status = '*ALL' OR
     C                                  P#Status = SPLSTATUS)
     C                   EVAL      CHGFile = SPLNAME
     C                   EVAL      CHGJob = SPLJOBNBR + '/' +
     C                             %TRIM(SPLUSERPRF) + '/' +
     C                             %TRIM(SPLJOBNAME)
     C                   EVAL      CHGSplNbr = SPLNBR
      * Move the spoolfile to the chosen output queue
     C                   CALL (E)  'QCMDEXC'
     C                   PARM      CHGSPLFA      P#CmdString
     C                   PARM      120           P#CmdLength
E002 C                   ENDIF
     C                   READ      DBG1860W
E001 C                   ENDDO
      *
     C                   EVAL      *INLR = *on
     C                   RETURN
      **********************************************************************************************