<verbatim> ********************************************************************************************** * 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 ********************************************************************************************** </verbatim>
This topic: DBG400
>
SourceCodeList
>
RpgleSource
>
RpgleDBG194R4
Topic revision: r2 - 01 Oct 2014 - 19:37:01 -
UnknownUser
Copyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400?
Send feedback