**********************************************************************************************
      * DBG197R4: Action output queue spool files (Delete/Hold/Release/Save)
      * Copyright (C) 2003  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  XXXSPLF                      80    Inz('XXXSPLF FILE(1234567890) -
     D                                     JOB(123456/1234567890/1234567890) -
     D                                     SPLNBR(12345)')
     D   XXXAction                    3    Overlay(XXXSPLF:1)
     D   XXXFile                     10    Overlay(XXXSPLF:14)
     D   XXXJob                      28    Overlay(XXXSPLF:30)
     D   XXXSplNbr                    5  0 Overlay(XXXSPLF:67)
      *
     D Command2        DS
     D  CHGSPLFA                    100    Inz('CHGSPLFA FILE(1234567890) -
     D                                     JOB(123456/1234567890/1234567890) -
     D                                     SPLNBR(12345) SAVE(*YES)')
     D   CHGFile                     10    Overlay(CHGSPLFA:15)
     D   CHGJob                      28    Overlay(CHGSPLFA:31)
     D   CHGSplNbr                    5  0 Overlay(CHGSPLFA:68)
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D PeCmdString     S            256
     D PeCmdLength     S             15  5
 ??? D PeQualOutq      S             20
     D PeFile          S             10
     D PeUsrDta        S             10
     D PeUser          S             10
     D PeStartNbr      S              5  0
     D PeEndNbr        S              5  0
     D PeStatus        S              6
     D PeAction        S              3
      **********************************************************************************************
      * CONSTANTS:
      **********************************************************************************************
      **********************************************************************************************
      * FIELD RENAMES:
      **********************************************************************************************
      **********************************************************************************************
      * ENTRY PARAMETERS:
      **********************************************************************************************
     C     *ENTRY        PList
     C                   Parm                    PeFile
     C                   Parm                    PeUsrDta
     C                   Parm                    PeUser
     C                   Parm                    PeStartNbr
     C                   Parm                    PeEndNbr
     C                   Parm                    PeStatus
     C                   Parm                    PeAction
      **********************************************************************************************
      * KEY LISTS:
      **********************************************************************************************
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
      * Strip trailing generic '*' from file so correct match is made
B001 C                   If        PeFile > *blanks
B002 C                   If        %SubSt(PeFile : %Len(%Trim(PeFile)) : 1) =
     C                             '*'
     C                   Eval      %SubSt(PeFile : %Len(%Trim(PeFile)) : 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        (PeFile = ' ' Or %Trim(PeFile) =
     C                             %SubSt(SPLNAME : 1 : %Len(%Trim(PeFile))))
     C                             And (PeUser = ' ' Or PeUser = SPLUSERPRF)
     C                             And (PeUsrDta = ' ' Or %Trim(PeUsrDta) =
     C                             %SubSt(SPLUSRDTA : 1 :
     C                                    %Len(%Trim(PeUsrDta))))
     C                             And (PeStartNbr = 0 Or PeStartNbr <= SPLNBR)
     C                             And (PeEndNbr = 99999 Or PeEndNbr >= SPLNBR)
     C                             And (PeStatus = '*ALL' Or
     C                                  PeStatus = SPLSTATUS)
      * CHGSPLFA SAVE(*YES)
B003 C                   If        PeAction = 'SAV'
     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      Command2      PeCmdString
     C                   Parm      100           PeCmdLength
      * DLTSPLF//HLDSPLF/RLSSPLF
X003 C                   Else
     C                   Eval      XXXFile = SPLNAME
     C                   Eval      XXXJob = SPLJOBNBR + '/' +
     C                             %Trim(SPLUSERPRF) + '/' +
     C                             %Trim(SPLJOBNAME)
     C                   Eval      XXXSplNbr = SPLNBR
     C                   Eval      XXXAction = PeAction
      * Move the spoolfile to the chosen output queue
     C                   Call (E)  'QCMDEXC'
     C                   Parm      Command1      PeCmdString
     C                   Parm      80            PeCmdLength
E003 C                   EndIf
E002 C                   EndIf
     C                   Read      DBG1860W
E001 C                   EndDo
      *
     C                   Eval      *INLR = *On
     C                   Return
      **********************************************************************************************