John Swidorski
asked on
Problems Extracting User-specified Data from IBMi Spool Files using APIs
I am attempting to receive data from a data quue that is attached to an outq.
From there I take some of that information and use QUSLSPL API to get the List of Spool files that meet the criteria of what was found from the RCVDTAQ API.
I then create the pointer using QUSPTRUS API to a user space that I created previous and attempt to run the spool list. when I do this is not working as expected. Basically the follow IF fails on NUMBER-LIST-ENTRIES being equal to 0.
I have referenced this link with a COBOL example.
https://www.ibm.com/support/knowledgecenter/en/ssw_ibm_i_73/apiref/cmnKeysCOBOL.htmhttps://www.ibm.com/suppor
I can provide more code if necessary.
From there I take some of that information and use QUSLSPL API to get the List of Spool files that meet the criteria of what was found from the RCVDTAQ API.
I then create the pointer using QUSPTRUS API to a user space that I created previous and attempt to run the spool list. when I do this is not working as expected. Basically the follow IF fails on NUMBER-LIST-ENTRIES being equal to 0.
IF (INFORMATION-STATUS OF QUS-GENERIC-HEADER-0100 = "C" (14)
OR INFORMATION-STATUS OF QUS-GENERIC-HEADER-0100 = "P")
AND NUMBER-LIST-ENTRIES OF QUS-GENERIC-HEADER-0100 > 0 (16)
*
* address current list entry
*
SET ADDRESS OF STRING-SPACE TO SPCPTR,
SET ADDRESS OF QUS-SPLF0200 TO
ADDRESS OF STRING-SPACE((OFFSET-LIST-DATA
OF QUS-GENERIC-HEADER-0100 + 1):1), (18)
*
* and process all of the entries
*
PERFORM PROCES
NUMBER-LIST-ENTRIES OF QUS-GENERIC-HEADER-0100 TIMES, (20)
ELSE
DISPLAY "List data not valid. **** THIS IS WHAT EXECUTES!!!!" I have referenced this link with a COBOL example.
https://www.ibm.com/support/knowledgecenter/en/ssw_ibm_i_73/apiref/cmnKeysCOBOL.htmhttps://www.ibm.com/suppor
I can provide more code if necessary.
Gary Patterson, CISSP
Please post code and a COBOL formatted dump at the point of failure.
ASKER
The actually code does not abort. But it seems to not be completely created for processing.
CL to PRocess whole thing
Code to create User Spaces
Code to Process Data Queue
Sorry I don't have a dump. The code DOES NOT abort, it just doesn't fully process the spool file. I get an error condition where the API doesn't believe there is anything in the spool file to process.
Display lines 314, 315, and 322.
IS C
NLE 000000000
LIST DATA NOT VALID
CL to PRocess whole thing
/*********************************************************************/
/* O. R. S. */
/* ONLINE REPORTING SYSTEM */
/* */
/* EMMXORS */
/* */
/*********************************************************************/
/* THIS IS THE FIRST PROGRAM TO START UP THE O.R.S. SYSTEM. IT */
/* WILL CALL OTHER PROGRAMS IN THE SYSTEM AS NECESSARY. */
/*********************************************************************/
/* MODIFICATION LOG */
/*********************************************************************/
/* 03/08/2002 - Robert C. Richard - Created. */
/*********************************************************************/
/* 06/24/2003 - Robert C. Richards - Added error checking routine */
/* in accorance with stopping ORS from adding any more DB2 records*/
/* if the FTP is failing for any reason. */
/*********************************************************************/
/* Change Identifier: JDS1 */
/* Date of Change : 07/30/2008 */
/* Client/SIR#/SER# : */
/* CMS Project #(s) : */
/* Programmer : John D. Swidorski */
/* Re-compiled only : No */
/* Tech Description : Add MONMSG for CPF3344. */
/* : File xxxxxxxxx number y no longer in the */
/* : system. */
/*********************************************************************/
/* Change Identifier: JDS2 */
/* Date of Change : 06/20/2017 */
/* Client/SIR#/SER# : */
/* CMS Project #(s) : */
/* Programmer : John D. Swidorski */
/* Re-compiled only : No */
/* Tech Description : Modify ORS to work in separate environments. */
/* : */
/* : */
/*********************************************************************/
PGM
/* JDS2 */ DCLPRCOPT
DCL VAR(&DATAQUEUE) TYPE(*CHAR) LEN(10)
DCL VAR(&LIBRARY) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBUSER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNUM) TYPE(*CHAR) LEN(6)
DCL VAR(&SPLFNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&SPLFNUM) TYPE(*CHAR) LEN(4)
DCL VAR(&USERDATA) TYPE(*CHAR) LEN(10)
DCL VAR(&DATETIME) TYPE(*CHAR) LEN(14)
DCL VAR(&NETNAME) TYPE(*CHAR) LEN(86)
DCL VAR(&MODE) TYPE(*CHAR) LEN(1)
DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10)
/* Start of FTP Utility Variables */
DCL VAR(&INFO) TYPE(*CHAR) LEN(93)
/* JDS2 */ DCL VAR(&FTPSTATUS) TYPE(*CHAR) LEN(04)
/* End of FTP Utility Variables */
/* JDS1 */
/* File xxxxxxxxx number y no longer in the system error message */
MONMSG MSGID(CPF3344)
CHGVAR VAR(&DATAQUEUE) VALUE(' ')
CHGVAR VAR(&LIBRARY) VALUE(' ')
CHGVAR VAR(&JOBNAME) VALUE(' ')
CHGVAR VAR(&JOBUSER) VALUE(' ')
CHGVAR VAR(&JOBNUM) VALUE(' ')
CHGVAR VAR(&SPLFNAME) VALUE(' ')
CHGVAR VAR(&SPLFNUM) VALUE(' ')
/* CHGVAR VAR(&LIBRARY) VALUE('MMUTILITYT') */
/* JDS2 Get Library for Processing */
/* JDS2 CALL PGM(EMMU003) PARM(' ' '1' &LIBRARY) */
/* JDS2 */ CHGVAR VAR(&LIBRARY) VALUE('MMUTILITYT')
START:
/* JDS2 */ DLTUSRSPC USRSPC(&LIBRARY/ORSUSERSPC)
MONMSG MSGID(CPF2105)
/* JDS2 */ CALL PGM(BMMXORS100) PARM('ORSUSERSPC' &LIBRARY)
/* JDS2 */ CHGVAR VAR(&LIBRARY) VALUE('MMUTILITY')
/* Continuously loop through the Data Queues, First the */
LOOP:
CALL PGM(BMMXORS110) PARM(&DATAQUEUE &LIBRARY +
&JOBNAME &JOBUSER &JOBNUM &SPLFNAME +
&SPLFNUM &USERDATA &DATETIME &OUTQ &MODE +
&DATAQUEUE)
CALL PGM(BMMXORS200) PARM(&JOBNAME &JOBUSER +
&JOBNUM &USERDATA &SPLFNAME &DATETIME +
&NETNAME &MODE &SPLFNUM)
CHGVAR VAR(%SST(&INFO 1 17)) VALUE('CPYSPLFORS')
CHGVAR VAR(%SST(&INFO 18 76)) VALUE(&NETNAME)
CPYSPLF FILE(&SPLFNAME) TOFILE(CPYORS) +
JOB(&JOBNUM/&JOBUSER/&JOBNAME) +
SPLNBR(&SPLFNUM) CTLCHAR(*FCFC)
MONMSG MSGID(CPD0078) EXEC(GOTO CMDLBL(LOOP))
MONMSG MSGID(CPD0085) EXEC(GOTO CMDLBL(LOOP))
MONMSG MSGID(CPF0001) EXEC(GOTO CMDLBL(LOOP))
CALL PGM(BMMXORS500)
IF COND(&JOBNUM *EQ ' ') THEN(GOTO CMDLBL(LOOP))
/* FTP the File to the Network */
/* JDS2 */ CALL PGM(*LIBL/EMMXORSFTP) PARM(&INFO &FTPSTATUS)
/* JDS2 */ IF COND(&FTPSTATUS *EQ 'FAIL') THEN(GOTO CMDLBL(END))
CHGVAR VAR(&SPLFNAME) VALUE(' ')
GOTO CMDLBL(LOOP)
END: ENDPGM Code to create User Spaces
IDENTIFICATION DIVISION.
PROGRAM-ID. BMMXORS100.
*****************************************************************
* O. R. S. *
* ONLINE REPORTING SYSTEM *
* *
* BMMXORS100 *
* *
*****************************************************************
* THIS PROGRAM WILL CALL THE APPROPRIATE API TO CREATE A USER *
* SPACE FOR THE ONLINE REPORTING SYSTEM. *
*****************************************************************
* CCYYMMDD - MODIFICATION LOG *
*****************************************************************
* 20020508 - CREATED BY ROBERT C. RICHARDS *
*****************************************************************
* Change Identifier: JDS1 *
* Date of Change : 06/20/2017 *
* Client/SIR#/SER# : SR20170615.48716 *
* Task : 48732 *
* Programmer : John D. Swidorski *
* Re-compiled only : No *
* Tech Description : Modify ORS to work in separate environment *
* : Pass in LK-DATAQUEUE, LK-LIBRARY. *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
******API-QUSCRTUS WORKING STORAGE AREA START*****
01 CRTUS-SPACE-NAME.
02 CRTUS-DATAQ PIC X(10) VALUE "ORSUSERSPC".
02 CRTUS-LIBRARY PIC X(10) VALUE "MMUTILITY ".
01 CRTUS-EXTENTION PIC X(10) VALUE "PF ".
01 CRTUS-SIZE-BIN PIC S9(09) VALUE 2000 BINARY.
01 CRTUS-INTIAL PIC X(01) VALUE " ".
01 CRTUS-AUTHORITY PIC X(10) VALUE "*ALL ".
01 CRTUS-DESCRIPTION PIC X(50) VALUE "ORS WORK AREA".
01 CRTUS-REPLACE PIC X(10) VALUE "*YES".
01 CRTUS-ERROR PIC X(100) VALUE " ".
******API-QUSCRTUS WORKING STORAGE AREA END*******
JDS1 LINKAGE SECTION.
JDS1 01 LK-DATAQUEUE PIC X(10).
JDS1 01 LK-LIBRARY PIC X(10).
JDS1 PROCEDURE DIVISION USING LK-DATAQUEUE LK-LIBRARY.
0000-MAIN-PROCESS.
JDS1 MOVE LK-DATAQUEUE TO CRTUS-DATAQ.
JDS1 MOVE LK-LIBRARY TO CRTUS-LIBRARY.
*****CALL API TO CREATE USER AREA FOR THE QUSLSPL-API
CALL "QUSCRTUS" USING CRTUS-SPACE-NAME
CRTUS-EXTENTION
CRTUS-SIZE-BIN
CRTUS-INTIAL
CRTUS-AUTHORITY
CRTUS-DESCRIPTION
CRTUS-REPLACE
CRTUS-ERROR. Code to Process Data Queue
IDENTIFICATION DIVISION.
PROGRAM-ID. BMMXORS110.
*****************************************************************
* O. R. S. *
* ONLINE REPORTING SYSTEM *
* *
* BMMXORS110 *
* *
*****************************************************************
* THIS PROGRAM WILL RECEIVE THE NEXT RECORD IN THE DATAQUEUE *
* THAT IS PASSED TO IT. IT WILL PASS BACK THE NECESSARY DATA *
* TO COPY THE SPOOLFILE. *
*****************************************************************
* CCYYMMDD - MODIFICATION LOG *
*****************************************************************
* 20020308 - CREATED BY ROBERT C. RICHARDS *
*****************************************************************
* 08/31/2004 - Changed By Dirk McDonald (DAM1) *
* Changed the size of the data that we get from *
* the user space. This space holds spool file *
* information for each job. The more reports that *
* are in the a job the larger the data space we *
* will have to retrieve from the user space. *
* Note: This should be changed to retrieve the *
* size of the users space by using another *
* API called QUSRUSAT but for now we just *
* doubled the size. *
*****************************************************************
* Change Identifier: JDS1 *
* Date of Change : 06/20/2017 *
* Client/SIR#/SER# : SR20170615.48716 *
* Task : 48732 *
* Programmer : John D. Swidorski *
* Re-compiled only : No *
* Tech Description : Modify ORS to work in separate environment *
* : Comment out rolling of following fields. *
* : They will be read from DMXX903. *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
JDS1 SELECT DATA-QUEUE-FILE
| ASSIGN TO DATABASE-DMXX903
| ORGANIZATION INDEXED
| ACCESS DYNAMIC
| RECORD KEY EXTERNALLY-DESCRIBED-KEY
| WITH DUPLICATES
JDS1 FILE STATUS DATA-QUEUE-FILE-STATUS.
DATA DIVISION.
FILE SECTION.
JDS1 FD DATA-QUEUE-FILE
| LABEL RECORDS ARE STANDARD.
| 01 DATA-QUEUE-RECORD.
JDS1 COPY DDS-ALL-FORMATS OF DMXX903.
WORKING-STORAGE SECTION.
JDS1 77 DATA-QUEUE-FILE-STATUS PIC X(2).
01 SUB PIC S9(04).
01 SUB4 PIC S9(04).
01 SUB5 PIC S9(04).
01 COUNTER PIC S9(04).
01 SPL-COUNT PIC S9(04).
01 WK-DATA.
05 WK-SPLFNAME PIC X(10).
05 WK-SPLFNUMBER PIC X(06).
05 WK-OUTQ PIC X(10).
05 WK-USERDATA PIC X(10).
01 SPLF0200-DATA.
02 DATA-NUM-FIELDS PIC X(04).
02 LENGTH-OF-FIELD-DATA PIC X(04).
02 DATA-KEY-FIELD PIC X(04).
02 DATA-TYPE-OF-DATA PIC X(01).
02 DATA-RESERVE-PARTYOF3 PIC X(03).
02 FIELD-LENGTH PIC X(04).
02 DATA-FILEER1 PIC X(50).
******API-QRCVDTAQ WORKING STORAGE AREA START*****
01 DATALENGTH PIC 9(05) VALUE 128.
01 WAITTIME PIC 9(05) COMP-3
VALUE 5.
01 DATAQDATA.
06 D-FUNCTION PIC X(10).
06 D-RECTYPE PIC X(02).
06 D-JOBNAME PIC X(10).
06 D-JOBUSER PIC X(10).
06 D-JOBNUMBER PIC X(06).
06 D-SPLFNAME PIC X(10).
06 D-BSPLF PIC 9(08) USAGE IS COMP-4.
06 D-OUTQ PIC X(20).
06 D-REST PIC X(56).
******API-QRCVDTAQ WORKING STORAGE AREA END*******
01 D-BSPLF-09 PIC 9(4).
******API-QUSPTRUS WORKING STORAGE AREA START*****
01 TRUS-SPACE.
02 TRUS-USRSPC PIC X(10) VALUE "ORSUSERSPC".
02 TRUS-LIBRARY PIC X(10) VALUE "*LIBL ".
01 TRUS-POINTER USAGE IS POINTER.
01 TRUS-ERROR PIC X(100) VALUE " ".
******API-QUSPTRUS WORKING STORAGE AREA END*******
******API-QUSLSPL WORKING STORAGE AREA START*****
01 LSPL-SPACE-NAME.
02 LSPL-USRSPC PIC X(10) VALUE "ORSUSERSPC".
02 LSPL-LIBRARY PIC X(10) VALUE "*LIBL".
01 LSPL-FORMAT PIC X(08) VALUE "SPLF0200".
01 LSPL-USER-NAME PIC X(10) VALUE " ".
JDS1 * (I) Queue and Library - Coded QGPL
| 01 LSPL-OUTQ-NAME.
| 02 LSPL-QOUTQQ PIC X(10) VALUE " ".
JDS1 02 LSPL-QLIBRARY PIC X(10) VALUE "QGPL".
01 LSPL-FORM PIC X(10) VALUE "*ALL ".
JDS1 * (I) User Data - Blank
JDS1 01 LSPL-USER-DATA PIC X(10) VALUE " ".
JDS1 * (I/O) Error Message, If Any
01 LSPL-ERROR PIC X(100) VALUE " ".
JDS1 * (I) Qualified Job Name - Blank
| 01 LSPL-Q-JOBNAME.
| 02 LSPL-JOBNAME PIC X(10) VALUE " ".
| 02 LSPL-JOBUSER PIC X(10) VALUE " ".
| 02 LSPL-JOBNUMBER PIC X(06) VALUE " ".
| * (I) Keys for the fields to return
| 01 LSPL-KEYS-RETURNED.
| 02 LSPL-KEY-SPLFNAME PIC S9(09) COMP-4 VALUE 201.
| 02 LSPL-KEY-SPLFNUM PIC S9(09) COMP-4 VALUE 205.
| 02 LSPL-KEY-OUTQNAME PIC S9(09) COMP-4 VALUE 206.
| 02 LSPL-KEY-USERDATA PIC S9(09) COMP-4 VALUE 209.
| * (I) Number of fields to return
| 01 LSPL-KEYS-COUNT.
JDS1 02 LSPL-NUMBER-KEYS PIC S9(09) COMP-4 VALUE 4.
******API-QUSLSPL WORKING STORAGE AREA END*******
******API-QUSRTVUS WORKING STORAGE AREA START*****
01 RTVUS-SPACE-NAME.
02 RTVUS-DATAQ PIC X(10) VALUE "ORSUSERSPC".
02 RTVUS-LIBRARY PIC X(10) VALUE "*LIBL ".
01 RTVUS-START-BIN-01.
02 RTVUS-START-BIN PIC 9(08) COMP-4 VALUE 65.
01 RTVUS-SIZE-BIN-01.
DAM1 * 02 RTVUS-SIZE-BIN PIC 9(08) COMP-4 VALUE 3000.
DAM1 02 RTVUS-SIZE-BIN PIC 9(08) COMP-4 VALUE 6000.
01 RTVUS-DATA.
02 GHEADERSIZE PIC X(04).
02 RELEASE-LEVEL PIC X(04).
02 FORMAT-NAME PIC X(08).
02 API-USED PIC X(10).
02 DATE-AND-TIME PIC X(13).
02 INFO-STATUS PIC X(01).
02 USER-SPACE-SIZE PIC X(04).
02 INPUT-OFFSET PIC X(04).
02 INPUT-SIZE PIC X(04).
02 HEADER-OFFSET PIC X(04).
02 HEADER-SIZE PIC X(04).
02 LIST-DATA-OFFSET PIC X(04).
02 LIST-DATA-SIZE PIC X(04).
02 LIST-ENTRIES PIC X(04).
02 EACH-ENTRY-SIZE PIC X(04).
02 CCSID PIC X(04).
02 COUNTRYID PIC X(02).
02 LANGUAGEID PIC X(03).
02 SUBSET-LIST-IND PIC X(01).
02 RESERVED PIC X(42).
02 FILLER PIC X(10000).
01 RTVUS-ERROR PIC X(100) VALUE " ".
******API-QUSRTVUS WORKING STORAGE AREA END*******
******CALUCULATIONS AREA START********************
01 RTVUS-START-09 PIC S9(08).
01 LIST-ENTRIES-09 PIC S9(04).
01 LIST-ENTRIES-BIN-FIL.
02 LIST-ENTRIES-X PIC X(04).
01 LIST-ENTRIES-BIN-FIL2 REDEFINES
LIST-ENTRIES-BIN-FIL.
02 LIST-ENTRIES-BIN PIC 9(08) COMP-4.
01 LIST-DATA-OFFSET-09 PIC S9(04).
01 LIST-DATA-OFFSET-BIN-FIL.
02 LIST-DATA-OFFSET-X PIC X(04).
01 LIST-DATA-OFFSET-BIN-FIL2 REDEFINES
LIST-DATA-OFFSET-BIN-FIL.
02 LIST-DATA-OFFSET-BIN PIC 9(08) COMP-4.
01 EACH-ENTRY-SIZE-09 PIC S9(04).
01 EACH-ENTRY-SIZE-BIN-FIL.
02 EACH-ENTRY-SIZE-X PIC X(04).
01 EACH-ENTRY-SIZE-BIN-FIL2 REDEFINES
EACH-ENTRY-SIZE-BIN-FIL.
02 EACH-ENTRY-SIZE-BIN PIC 9(08) COMP-4.
01 LENGTH-OF-FIELD-DATA-09 PIC S9(04).
01 LENGTH-OF-FIELD-DATA-BIN-FIL.
02 LENGTH-OF-FIELD-DATA-X PIC X(04).
01 LENGTH-OF-FIELD-DATA-BIN-FIL2 REDEFINES
LENGTH-OF-FIELD-DATA-BIN-FIL.
02 LENGTH-OF-FIELD-DATA-BIN PIC 9(08) COMP-4.
01 FIELD-LENGTH-09 PIC S9(04).
01 FIELD-LENGTH-BIN-FIL.
02 FIELD-LENGTH-X PIC X(04).
01 FIELD-LENGTH-BIN-FIL2 REDEFINES
FIELD-LENGTH-BIN-FIL.
02 FIELD-LENGTH-BIN PIC 9(08) COMP-4.
01 SPLFNUM-09 PIC S9(04).
01 SPLFNUM-BIN-FIL.
02 SPLFNUM-X PIC X(04).
01 SPLFNUM-BIN-FIL2 REDEFINES
SPLFNUM-BIN-FIL.
02 SPLFNUM-BIN PIC 9(08) COMP-4.
******CALUCULATIONS AREA END**********************
LINKAGE SECTION.
COPY QUSGEN OF QSYSINC-QLBLSRC.
* String to Map User Space Oftsets into
01 STRING-SPACE PIC X(32000).
* List Spool Files API include. These includes will be
* mapped over a User Space. The include is copied into the
* source so that we can define the variable length portion
* of QUS-KEY-INFO.
01 QUS-KEY-INFO.
05 LEN-FIELD-INFO-RETD PIC S9(00009) BINARY.
05 KEY-FIELD-FOR-FIELD-RETD PIC S9(00009) BINARY.
05 TYPE-OF-DATA PIC X(00001).
05 RESERV3 PIC X(00003).
05 DLENGTH PIC S9(00009) BINARY.
05 DFIELD PIC X(00100).
01 QUS-SPLF0200.
05 NUM-FIELDS-RETD PIC S9(00009) BINARY.
05 KEY-INFO.
09 LEN-FIELD-INFO-RETD PIC S9(00009) BINARY.
09 KEY-FIELD-FOR-FIELD-RETD PIC S9(00009) BINARY.
09 TYPE-OF-DATA PIC X(00001).
09 RESERV3 PIC X(00003).
09 DLENGTH PIC S9(00009) BINARY.
09 DFIELD PIC X(00001).
09 RESERVED PIC X(00001).
01 LK-DATAQUEUE PIC X(10).
01 LK-LIBRARY PIC X(10).
01 LK-JOBNAME PIC X(10).
01 LK-JOBUSER PIC X(10).
01 LK-JOBNUMBER PIC X(06).
01 LK-SPLFNAME PIC X(10).
01 LK-SPLFNUM PIC X(04).
01 LK-USERDATA PIC X(10).
01 LK-DATETIME PIC X(14).
01 LK-OUTQ PIC X(10).
01 LK-CLMODE PIC X(01).
01 LK-CLDATAQ PIC X(10).
PROCEDURE DIVISION USING LK-DATAQUEUE
LK-LIBRARY
LK-JOBNAME
LK-JOBUSER
LK-JOBNUMBER
LK-SPLFNAME
LK-SPLFNUM
LK-USERDATA
LK-DATETIME
LK-OUTQ
LK-CLMODE
LK-CLDATAQ.
0000-MAIN-PROCESS.
JDS1 OPEN INPUT DATA-QUEUE-FILE
MOVE RTVUS-START-BIN TO RTVUS-START-09
INITIALIZE DATAQDATA
D-BSPLF-09
SPL-COUNT
SUB
SUB4
SUB5
RTVUS-DATA.
MOVE 1 TO COUNTER
JDS1 MOVE " " TO LK-CLDATAQ.
JDS1 * Retrieve Data Queue
PERFORM 2000-QRCVDTAQ-API UNTIL DATAQDATA(1:6) = "*SPOOL"
JDS1 * List Spooled Files, using data from Retrieve Data Queue
PERFORM 3000-QUSLSPL-API.
* If valid information was returned
SET ADDRESS OF QUS-GENERIC-HEADER-0100 TO TRUS-POINTER.
IF STRUCTURE-RELEASE-LEVEL OF QUS-GENERIC-HEADER-0100
NOT EQUAL "0100"
display "UNKNOWN GENERIC HEADER"
STOP RUN.
display "IS " INFORMATION-STATUS OF QUS-GENERIC-HEADER-0100
display "NLE " number-list-entries OF QUS-GENERIC-HEADER-0100
IF (INFORMATION-STATUS OF QUS-GENERIC-HEADER-0100 = "C"
OR INFORMATION-STATUS OF QUS-GENERIC-HEADER-0100 = "P")
AND NUMBER-LIST-ENTRIES OF QUS-GENERIC-HEADER-0100 > 0
* address current list entry
SET ADDRESS OF STRING-SPACE TO TRUS-POINTER
SET ADDRESS OF QUS-SPLF0200 TO
ADDRESS OF STRING-SPACE((OFFSET-LIST-DATA
OF QUS-GENERIC-HEADER-0100 + 1):1)
* and process all of the entries
PERFORM PROCES
NUMBER-LIST-ENTRIES OF QUS-GENERIC-HEADER-0100 TIMES
ELSE
display "LIST DATA NOT VALID"
STOP RUN.
JDS1 CLOSE DATA-QUEUE-FILE
GOBACK.
2000-QRCVDTAQ-API.
JDS1 * IF LK-CLMODE = "M"
| * MOVE "D" TO LK-CLMODE
| * MOVE "ORSDAYQ " TO LK-CLDATAQ
| * MOVE "DAYTEMP " TO LK-OUTQ
| * ELSE
| * MOVE "M" TO LK-CLMODE
| * MOVE "ORSMONTHQ " TO LK-CLDATAQ
JDS1 * MOVE "ME " TO LK-OUTQ.
JDS1 PERFORM E100-START-DATA-QUEUE-FILE THROUGH E100-READ-EXIT
*****CALL API TO RECIEVE DATA QUEUE CREATED BY ATTACHED OUTQUEUE
CALL "QRCVDTAQ" USING LK-DATAQUEUE
LK-LIBRARY
DATALENGTH
DATAQDATA
WAITTIME.
MOVE D-JOBNAME TO LK-JOBNAME
MOVE D-JOBUSER TO LK-JOBUSER
MOVE D-JOBNUMBER TO LK-JOBNUMBER
MOVE D-SPLFNAME TO LK-SPLFNAME
MOVE D-BSPLF TO D-BSPLF-09
MOVE D-BSPLF-09 TO LK-SPLFNUM.
* display "DQ " DATAQDATA.
* display "DL " datalength.
3000-QUSLSPL-API.
JDS1 MOVE D-JOBUSER TO LSPL-USER-NAME.
JDS1 MOVE LK-OUTQ TO LSPL-QOUTQQ.
jds display " USER/OUTQ " D-JOBUSER " " LK-OUTQ.
***CALL API TO GET INTERNAL JOB IDENTIFIER AND INTERNAL SPOOL ID
CALL "QUSLSPL" USING LSPL-SPACE-NAME
LSPL-FORMAT
LSPL-USER-NAME
LSPL-OUTQ-NAME
LSPL-FORM
LSPL-USER-DATA
LSPL-ERROR
JDS1 LSPL-Q-JOBNAME
JDS1 LSPL-KEYS-RETURNED
JDS1 LSPL-KEYS-COUNT.
display "SPL SPC " lspl-space-name.
display "SPL USRD " lspl-user-data.
display "SPL ERR " lspl-error.
display "SPL KEYS " lspl-keys-returned.
display "SPL CNT " lspl-keys-count.
* Get a resolved pointer to the User Space for performance
CALL "QUSPTRUS" USING TRUS-SPACE TRUS-POINTER TRUS-ERROR.
JDS1 * Get FTP Server Fields
JDS1 E100-START-DATA-QUEUE-FILE.
| IF LK-CLDATAQ = " "
| MOVE LK-CLDATAQ TO DATAQUEUE OF DATA-QUEUE-FILE
| START DATA-QUEUE-FILE
| KEY NOT < EXTERNALLY-DESCRIBED-KEY
| INVALID KEY
| MOVE SPACES TO LK-CLDATAQ
| GO TO E100-START-DATA-QUEUE-FILE
| END-START.
| E100-START-EXIT.
JDS1 EXIT.
|
JDS1 E100-READ-DATA-QUEUE-FILE.
| READ DATA-QUEUE-FILE NEXT RECORD
| AT END
| MOVE SPACES TO LK-CLDATAQ
| GO TO E100-START-DATA-QUEUE-FILE.
|
| MOVE DATAQUEUE OF DATA-QUEUE-RECORD TO LK-CLDATAQ.
| MOVE DATAQUEUE OF DATA-QUEUE-RECORD TO LK-DATAQUEUE.
| MOVE OUTQ OF DATA-QUEUE-RECORD TO LK-OUTQ.
| MOVE MODE-DDS OF DATA-QUEUE-RECORD TO LK-CLMODE.
| E100-READ-EXIT.
JDS1 EXIT.
PROCES.
* address the first variable length record for this entry
SET ADDRESS OF QUS-KEY-INFO TO ADDRESS OF
QUS-SPLF0200(5:).
* process all variable length records associated with this entry
PERFORM PROCES2 NUM-FIELDS-RETD TIMES.
* WRITE LIST-LINE FROM PRTLIN.
* after each entry, increment to the next entry
SET ADDRESS OF STRING-SPACE TO ADDRESS OF QUS-SPLF0200.
SET ADDRESS OF QUS-SPLF0200 TO ADDRESS OF STRING-SPACE
((SIZE-EACH-ENTRY OF QUS-GENERIC-HEADER-0100 + 1):1).
* Process each variable length record based on key
PROCES2.
display " key # " KEY-FIELD-FOR-FIELD-RETD OF QUS-KEY-INFO
display " l " DLENGTH OF QUS-KEY-INFO
display " "
* extract Spooled File Name
IF KEY-FIELD-FOR-FIELD-RETD OF QUS-KEY-INFO = 201
MOVE DFIELD OF QUS-KEY-INFO(1:DLENGTH OF QUS-KEY-INFO)
TO WK-SPLFNAME
DISPLAY "************** " WK-SPLFNAME.
* extract Spooled File Number
IF KEY-FIELD-FOR-FIELD-RETD OF QUS-KEY-INFO = 205
MOVE DFIELD OF QUS-KEY-INFO(1:DLENGTH OF QUS-KEY-INFO)
TO WK-SPLFNUMBER
DISPLAY "************** " WK-SPLFNUMBER
* extract Output Queue
IF KEY-FIELD-FOR-FIELD-RETD OF QUS-KEY-INFO = 206
MOVE DFIELD OF QUS-KEY-INFO(1:DLENGTH OF QUS-KEY-INFO)
TO WK-OUTQ
DISPLAY "************** " WK-OUTQ
* Extract User-specified Data
IF KEY-FIELD-FOR-FIELD-RETD OF QUS-KEY-INFO = 209
MOVE DFIELD OF QUS-KEY-INFO(1:DLENGTH OF QUS-KEY-INFO)
TO WK-USERDATA
DISPLAY "************** " WK-USERDATA.
* address next variable length entry
SET ADDRESS OF STRING-SPACE TO ADDRESS OF QUS-KEY-INFO.
SET ADDRESS OF QUS-KEY-INFO TO
ADDRESS OF STRING-SPACE(
LEN-FIELD-INFO-RETD OF QUS-KEY-INFO + 1:1). Sorry I don't have a dump. The code DOES NOT abort, it just doesn't fully process the spool file. I get an error condition where the API doesn't believe there is anything in the spool file to process.
Display lines 314, 315, and 322.
IS C
NLE 000000000
LIST DATA NOT VALID
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks Gary. Fixed after digging into the code. It was old, old code and had a problem in general. API works like a charm.