You are here:
DBG/400
>
DBG400 Web
>
SourceCodeList
>
RpgleSource
>
RpgleDBG198R4
(08 Jan 2007,
MartinRowe
)
(raw view)
E
dit
A
ttach
<verbatim> ********************************************************************************************** * DBG198R4: Change *outq spoolfiles by CMD parms * Copyright (C) 2006 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 600 Inz('CHGSPLFA FILE(1234567890) - D JOB(123456/1234567890/1234567890) - D SPLNBR(12345)') D CHGFile 10 Overlay(CHGSPLFA:15) D CHGJob 28 Overlay(CHGSPLFA:31) D CHGSplNbr 5 0 Overlay(CHGSPLFA:68) D CMDparms 500 Overlay(CHGSPLFA:75) ********************************************************************************************** * WORK FIELDS: ********************************************************************************************** D P#CmdString S 600 D P#CmdLength S 15 5 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 D P#CMDparms S 500 ********************************************************************************************** * CONSTANTS: ********************************************************************************************** ********************************************************************************************** * FIELD RENAMES: ********************************************************************************************** ********************************************************************************************** * ENTRY PARAMETERS: ********************************************************************************************** C *ENTRY PList C Parm P#File C Parm P#UsrDta C Parm P#User C Parm P#StartNbr C Parm P#EndNbr C Parm P#Status C Parm P#CMDparms ********************************************************************************************** * KEY LISTS: ********************************************************************************************** ********************************************************************************************** * MAINLINE: ********************************************************************************************** * 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 C Eval CMDparms = P#CMDparms * Move the spoolfile to the chosen output queue C Call (E) 'QCMDEXC' C Parm CHGSPLFA P#CmdString C Parm 600 P#CmdLength E002 C EndIf C Read DBG1860W E001 C EndDo * C Eval *INLR = *On C Return ********************************************************************************************** </verbatim> -- Main.MartinRowe - 08 Jan 2007
E
dit
|
A
ttach
|
P
rint version
|
H
istory
: r1
|
B
acklinks
|
V
iew topic
|
Edit
w
iki text
|
M
ore topic actions
Topic revision: r1 - 08 Jan 2007 - 17:03:43 -
MartinRowe
DBG400
Log In
DBG400 Web
Index
Search
Changes
Notifications
Statistics
Site Map
Downloads
Webs
DBG400
Jamaro
Main
Sandbox
Sandtub
System
Send a link to this page
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