Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

OLQBATCH JCL

185 views
Skip to first unread message

Bill Allen

unread,
Jul 24, 2001, 4:53:48 PM7/24/01
to
Hello Everyone:

Does anyone have a sample of OLQBATCH where you write a flat file of the information retrieved from the database? That you would be willing to share?

Bill Allen

Shaw, Robert

unread,
Jul 24, 2001, 5:43:22 PM7/24/01
to
Bill,
I hope this helps.

EDIT RXS.R141.JCLLIB(BILLALLE) - 01.01 Member BILLALLE
saved
****** ***************************** Top of Data
******************************
000001 //RXSGAOLQ JOB (C70085AA-5103CDPL),RXS,MSGLEVEL=1,CLASS=A,

000002 // MSGCLASS=X,NOTIFY=RXS

000003 //*===========================================================

000004 //* 1/28/01 RXS.R141.JCLLIB(GALOGOLQ2)

000005 //* THIS RUNS AGAINST A LOCAL DATA SET WHICH ONLY HAS 100 REC

000006 //*===========================================================

000007 //FILEPREP EXEC PGM=IEFBR14

000008 //OUTFILE DD DISP=(MOD,DELETE,DELETE),

000009 // DSN=RXS.GALOG2.OLQBATCH.OUTFILE@,

000010 // UNIT=SYSDA,SPACE=(TRK,(1,0),RLSE),

000011 // VOL=SER=G8D017,

000012 // DCB=(RECFM=FB,LRECL=164,BLKSIZE=16400)

000013 //*===========================================================

000014 //OLQB EXEC PGM=OLQBATCH,REGION=0M

==CHG> //STEPLIB DD DISP=SHR,DSN=IDMS.CV05.LOADLIB

000016 // DD DISP=SHR,DSN=IDMS.TEST.LOADLIB

000017 //SYSLST DD SYSOUT=*

000018 //SYSOUT DD SYSOUT=*

000019 //OUTFILE DD DSN=RXS.GALOG2.OLQBATCH.OUTFILE@,

000020 // DISP=(NEW,CATLG),

000021 // UNIT=SYSDA,SPACE=(TRK,(5,1),RLSE),

000022 // VOL=SER=G8D017,

000023 // DCB=(RECFM=FB,LRECL=164,BLKSIZE=16400)

000024 //* *******************************************************

000025 //GUARLOG DD DISP=OLD,DSN=RXS.GSLTDB.GUAR.GUARLOG

000026 //* *******************************************************

000027 //*

000028 //SYSIDMS DD *

==CHG> DMCL=CV05DMCL,XA_SCRATCH=ON,LOCAL=ON,ECHO=ON

000030 //*

000031 //SYSIPT DD *

000032 SET USER RXS

000033 SET ACCESS OLQ

000034 OPT DBKEY INTERRUPT

000035 SET INTERRUPT COUNT 10

000036 SIGNON SS=GSLPSS01 DICTNAME=GSLDICT DBNAME=VDB0

000037 SELECT * FROM GA-LOG -

000038 OUTPUT OUTFILE

000039 BYE

000040 //

****** **************************** Bottom of Data
****************************

Bob Shaw
rs...@raytheon.com
(703) 560-5000 x3046

richar...@apl.com

unread,
Jul 24, 2001, 5:38:54 PM7/24/01
to
see attached jcl


______________________________ Reply Separator _________________________________
Subject: OLQBATCH JCL
Author: "IDMS Public Discussion Forum" <IDM...@LISTSERV.IUASSN.COM> at
internet-gateway
Date: 07/24/2001 4:51 PM

olq1.dat

Harmeson, Steve

unread,
Jul 26, 2001, 6:35:42 AM7/26/01
to
Bill,

Here is an OLQBATCH example that might hellp you:

//SRH00SC1 JOB 45-SS-ADO-00SS,TCV1-SRH00,CLASS=E,MSGCLASS=X,
//**********************************************************************
//* INVOKING OLQ SCAN LOOKING IN DICTIONARY..:DICTMFG ON TCV1 *
//* LOOKING AT ALL MODULES MATCHING THE NAME.:A***M1D***** *
//* SEARCHING MODULE SOURCE FOR THE FOLLOWING: *
//* STRING 1: RESTART *
//* STRING 2: DEADLOCK *
//**********************************************************************
//FORMAT EXEC PGM=IDMSBCF,REGION=0M,TIME=100
//* TEST CV STEPLIBS
//STEPLIB DD DSN=FDOCV.TCVDBA.LOADLIB,DISP=SHR
// DD DSN=FDOCV.TCVIDMS.LOADLIB,DISP=SHR
//SYS001 DD DSN=&WRK1WORK,UNIT=SYSDA,SPACE=(CYL,(5,1))
//SYS002 DD DSN=&WRK2WORK,UNIT=SYSDA,SPACE=(CYL,(5,1))
//SYS003 DD DSN=&WRK3WORK,UNIT=SYSDA,SPACE=(CYL,(5,1))
//SYSIDMS DD DSN=FDOCV.TSO.APPPARM(DICTMFG),DISP=SHR
//DICTDB DD DSN=FDODD.TCV1.DICTDB,DISP=SHR
//DMSGDB DD DSN=FDODD.TCV1.DMSGDB,DISP=SHR
//DLODDB DD DSN=FDODD.TCV1.DLODDB,DISP=SHR
//TST1DD DD DSN=FDODD.TCV.TST1DD,DISP=SHR
//TSTDCLOD DD DSN=FDODD.TCV1.TSTDCLOD,DISP=SHR
//MFGDLOD DD DSN=FDODD.TCV.DCLODMFG,DISP=SHR
//DICTMFG DD DSN=FDODD.TCV.DICTMFG,DISP=SHR
//J1JRNL DD DUMMY
//J2JRNL DD DUMMY
//J3JRNL DD DUMMY
//J4JRNL DD DUMMY
//J5JRNL DD DUMMY
//J6JRNL DD DUMMY
//SYSJRNL DD DUMMY
//DSCRDB DD DSN=&SCRATCH,DISP=(,PASS),UNIT=VIO,
// SPACE=(9076,(8000)),BUFNO=50
//SYSLST DD SYSOUT=S,HOLD=YES
//SYSOUT DD SYSOUT=S,HOLD=YES
//SYSIPT DD *
CONNECT TO SYSTEM;
FORMAT FILE SYSTEM.DSCRDB;
//*
//SCAN EXEC PGM=OLQBATCH,REGION=0M,TIME=100
//DSCRDB DD DSN=&SCRATCH,DISP=(OLD,PASS)
//SYSIDMS DD *
ECHO=ON
XA_SCRATCH=ON
DICTNAME=SYSTEM
DBNAME=DICTMFG
DMCL=GLBLDMCL
//*
//STEPLIB DD DSN=FDOCV.TCVDBA.LOADLIB,DISP=SHR
// DD DSN=FDOCV.TCVIDMS.LOADLIB,DISP=SHR
//SYS001 DD DSN=&WRK1WORK,UNIT=SYSDA,SPACE=(CYL,(5,1))
//SYS002 DD DSN=&WRK2WORK,UNIT=SYSDA,SPACE=(CYL,(5,1))
//SYS003 DD DSN=&WRK3WORK,UNIT=SYSDA,SPACE=(CYL,(5,1))
//SYSIDMS DD DSN=FDOCV.TSO.APPPARM(DICTMFG),DISP=SHR
//DICTDB DD DSN=FDODD.TCV1.DICTDB,DISP=SHR
//DMSGDB DD DSN=FDODD.TCV1.DMSGDB,DISP=SHR
//DLODDB DD DSN=FDODD.TCV1.DLODDB,DISP=SHR
//TST1DD DD DSN=FDODD.TCV.TST1DD,DISP=SHR
//TSTDCLOD DD DSN=FDODD.TCV1.TSTDCLOD,DISP=SHR
//MFGDLOD DD DSN=FDODD.TCV.DCLODMFG,DISP=SHR
//DICTMFG DD DSN=FDODD.TCV.DICTMFG,DISP=SHR
//J1JRNL DD DUMMY
//J2JRNL DD DUMMY
//J3JRNL DD DUMMY
//J4JRNL DD DUMMY
//J5JRNL DD DUMMY
//J6JRNL DD DUMMY
//SYSJRNL DD DUMMY
//SYSOUT DD SYSOUT=*
//SYSPCH DD DUMMY
//SYSLST DD DSN=FDOCV.PUNCHLIB.SRCLIB(SCAN),DISP=SHR,
// DCB=(LRECL=133)
//SYSIPT DD *
SET USER=IDMSNL PASSWORD=XXXXXX
SCAN 'DICTMFG' 'A***M1D*****' 'RESTART' -
'DEADLOCK'

SCAN is a QFILE that searches modules/process code for whatever text you are
looking for, in this case I searched all module source code in DICTMFG
dictionary for RESTART and DEADLOCK and wrote the output to SYSLST DD file.

Steve Harmeson

-----Original Message-----
From: Bill Allen [mailto:ARCH...@AOL.COM]
Sent: Tuesday, July 24, 2001 3:52 PM
To: IDM...@LISTSERV.IUASSN.COM
Subject: OLQBATCH JCL

Hello Everyone:

Does anyone have a sample of OLQBATCH where you write a flat file of the

information retrieved from the database? That you would be willing to share?

Bill Allen

Russell W. Gove

unread,
Jul 26, 2001, 9:27:38 AM7/26/01
to
Bill,
The following ASM program will convert the flat file to a tab delimited
format. Save the SYSLST report output of OLQBATCH and feed it into this as
ddname SYSIN, Feed the output file in as ddname SYSUT1 with LRECL=500. Ouput
goes to SYSUT2 (RECFM=VB,lrecl=240). Character strings are placed in quotes,
trailing spaces are removed and numeric data is unpacked and the implied
decimal is added. Hope you can use it.

Russ


FLOTAB START 0
* RWG111292 DELIMIT WITH TAB CHAR
BEGIN SAVE (14,12)
BALR 3,0
USING *,3,4,5
START LM 4,5,BASEADDR
B EXEC
BASEADDR DC A(START+4096)
DC A(START+8192)
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9 NEXT POSITION IN OUTPUT RECORD
R10 EQU 10
R11 EQU 11 # BYTES OUTPUT
R12 EQU 12
EXEC ST 13,SAVE+4
LA 13,SAVE
* * REFORMAT A FLAT FILE WITH FIXED AND PACKED DATA
* * TO LOOK LIKE A LOTUS WORKSHEET
*
* ******************************
* ** STEP 1 . READ FILE DEFINITION
* ******************************
EXTRACT TIOTLOC,FIELDS=TIOT
L R8,TIOTLOC
USING TIOT,R8
MVC CRPTJOB,TIOCNJOB
DROP R8
OPEN (SYSUT1,INPUT)
** GET SYSUT1 DATASET NAME FOR CONTYROL REPORT
RDJFCB (SYSUT1)
L R8,JFCBADR
USING JFCB,R8
MVC CRPTDSNM,JFCBDSNM
DROP R8
*
OPEN (SNAPDD,OUTPUT)
OPEN (SYSIN,INPUT,SYSOUT,OUTPUT)
PUT SYSOUT,CRPTJLIN
** GET SYSIN LRECL TO DETERMINE CONTROL CARD FORMAT
LH 10,SYSIN+82
CVD 10,CNTLRECL
** GET SYSUT1 LRECL & BLKSIZE FOR CONTROL REPORT
LH 10,SYSUT1+62
CVD 10,INBLKSZ
UNPK CRPTBSZ,INBLKSZ
MVZ CRPTBSZ+5(1),CRPTBSZ+1
LH 10,SYSUT1+82
CVD 10,INLRECL
UNPK CRPTLRL,INLRECL
MVZ CRPTLRL+5(1),CRPTLRL+1
PUT SYSOUT,CRPTDCB
*
PUT SYSOUT,HDG1
ZAP FTROWS,=P'0' INIT # OF ROWS IN FIELD TABLE
LA R8,FTABLE REG R8 IS OFFSET IN FLD TABLE
READDEF GET SYSIN,SYSIN133
CP CNTLRECL,=P'80'
BE INPUT80
MVC SYSIN133(117),SYSIN133+16 IF INPUT 133 SHIFT LEFT 16
INPUT80 EQU *
CLC FLDIND,=C'OUTFILE '
BNE READDEF
CLC FTYPE,=C'CHARACTER '
BE GOTFLD
CLC FTYPE,=C'UNSIGNED ZONE '
BE GOTFLD
CLC FTYPE,=C'SIGNED PACKED '
BE GOTFLD
B READDEF
GOTFLD EQU *
MVC CFNAME,FNAME MOVE FIELD NAME TO CTL RPT
MVC CFOFFSET,FOFFSET MOVE OFFSET TO CTLRPT
MVC CFLEN,FLEN MOVE FLD LEN TO SYSOUT
MVC CFTYPE,FTYPE MOVE FLD TYPR TO SYSOUT
MVC CFDEC,FDEC MOVE # DECS TO SYSOUT
PUT SYSOUT,CRPTDET WRITE CONTROL REPORT
PACK ENDPOS,FOFFSET
PACK FLENPACK,FLEN
AP ENDPOS,FLENPACK
CP ENDPOS,INLRECL
BL FLDOK
PUT SYSOUT,CRPTERR3
CLOSE (SYSOUT,,SYSIN)
ABEND 8,REASON=3
FLDOK EQU *
CP FTROWS,=PL2'100'
BL NOTATMAX
PUT SYSOUT,CRPTERR4
CLOSE (SYSOUT,,SYSIN)
ABEND 8,REASON=3
NOTATMAX EQU *
MVC 0(32,R8),FNAME SAVE FLD NAME
MVC 32(15,R8),FTYPE SAVE FLD TYPE
PACK DBLEWORD,FOFFSET OFFSET .. PACK
CVB R9,DBLEWORD CONVERT
ST R9,52(R8) STORE
PACK DBLEWORD,FLEN LENGTH .. PACK
CVB R9,DBLEWORD CONVERT
ST R9,56(R8) STORE
CLC FTYPE,=C'UNSIGNED ZONE ' DECIMALS ?
BE GOTDECS YES, GO TO DECIMAL ROUTINE
CLC FTYPE,=C'SIGNED PACKED ' DECIMALS ?
BE GOTDECS YES, GO TO DECIMAL ROUTINE
MVC 60(4,R8),=F'0' NO, STORE 0 AS DECIMALS
B DECEND & BRANCH AROUND DECIMAL RTN
GOTDECS EQU *
PACK DBLEWORD,FDEC #DECIMAL, PACK
CVB R9,DBLEWORD CONVERT
ST R9,60(R8) STORE
DECEND EQU *
AP FTROWS,=P'1' ADD 1 TO NBR OF TABLE ENTRIES
LA R8,64(R8) POINT AT NEXT ENTRY
B READDEF
ENDDEF EQU *
CLOSE SYSIN
CP FTROWS,=P'0'
BNE MAINLINE
PUT SYSOUT,CRPTERR5
CLOSE (SYSOUT)
ABEND 8,REASON=5
***** MAINLINE
***** R10=INREC ADDR
*****
MAINLINE OPEN (SYSUT2,OUTPUT)
LA 10,INREC R10 POINTS TO INPUT
LA R9,OUTREC RR9 HAS NEXT POS IN OP
B GETREC
PUTREC EQU *
AP OUTRECS,=P'1'
LA R11,OUTREC
SR R9,R11
CVD R9,ORECL
UNPK CRPTLRL,ORECL
MVZ CRPTLRL+5(1),CRPTLRL+1
PUT SYSOUT,CRPTDCB
PUT SYSOUT,OUTREC
CP ORECL,=PL2'240'
BL RECOK
PUT SYSOUT,CRPTERR2
CLOSE (SYSOUT,,SYSIN)
ABEND 8,REASON=2
RECOK EQU *
AH R9,=H'4' ADD LENGHT OF REC DESCRIPTOR TO RECL
STH R9,OUTRCB1
PUT SYSUT2,OUTRCB1
AP OUTBYTE,ORECL
GETREC GET SYSUT1,INREC
AP INRECS,=P'1'
MVI OUTREC,C' '
MVC OUTREC+1(239),OUTREC
LA R9,OUTREC
LA R8,FTABLE
BAL 12,MOVEFLD
ZAP OFLDS,=P'1'
NEXTFLD EQU *
CP OFLDS,FTROWS
BE PUTREC
MVI 0(R9),C',' DELIMIT WITH TAB CHAR RWG111292
AH R9,=H'1' POINT TO NEXT POS IN OPREC
CH R9,=H'240'
BNH OVERFLO
BAL 12,MOVEFLD
AP OFLDS,=P'1'
B NEXTFLD
MOVEFLD EQU * DETERMINE FIELD TYPE
CLC 32(15,R8),=C'CHARACTER '
BE MOVECHAR
CLC 32(15,R8),=C'UNSIGNED ZONE '
BE MOVEZONE
CLC 32(15,R8),=C'SIGNED PACKED '
BE MOVEPACK
* LA R8,64(R8) POINT TO NEXT FIELD TABLE ENTRY
* BR 12
MVC CRPTFTYP,15(R8)
PUT SYSOUT,CRPTERR1
ABEND 8,REASON=1
MOVECHAR EQU * MOVE CHARACTER
MVI 0(R9),C'"' MOVE IN OPENING QUOTE
AH R9,=H'1' POINT TO NEXT POS
LA R6,INREC 6 HOLDS START OF I/P REC
A R6,52(R8) ADD OFSET TO GET START OF FLD
LR R7,R6 7 HOLDS START OF FIELD
CLC 56(4,R8),=F'1' IS THIS A ONE BYTE FIELD
BNE BIGFIELD
SR R7,R7 SET FIELD LEN TO 1
AH R7,=H'1'
B MOVE1 MOVE IT
BIGFIELD A R7,56(R8) ADD LENGTH TO GET STRT OF NEXT FLD
SH R7,=H'1' SUB 1 TO GET TO END OF YHIS FLD
CHARCOMP CLI 0(R7),C' ' DOES R7 POINT TO BLANK
BNE CHARFND YES... FOUND LAST NON BLANK
SH R7,=H'1' NO ... LOK AT PREV CHAR
CR R7,R6 IS IT FIRST CHAR
BNE CHARCOMP NO, GO TEST IT FOR BLANKS
CHARFND EQU *
SR R7,R6 R7 NOW HOLDS LAST NONBLANK
AH R7,=H'1' R7 NOW 1ST NON BLANK
**
MOVE1 STH R7,OLEN FIELD LENGTH NOW IN OLEN
MVC CHARMOVE+1(1),OLEN+1 MOVE LENGHT INTO MOVE INST
CHARMOVE MVC 0(0,R9),0(R6)
AR R9,R7 ADD # POS MOVED TO OUTREC POSITION
MVI 0(R9),C'"' ADD CLOSING QUOTE
AH R9,=H'1' INCREMENT POSITION
LA R8,64(R8) POINT TO NEXT FIELD TABLE ENTRY
BR R12 RETURN TO PROCESS IT
MOVEZONE EQU *
LA R6,INREC 6 HOLDS START OF I/P REC
A R6,52(R8) ADD OFSET TO GET START OF FLD
LR R7,R6 7 HOLDS START OF FIELD
A R7,56(R8) ADD LENGTH TO GET STRT OF NEXT FLD
S R7,60(R8) SUBTRACT # DECS TO GET DECIMAL SPOT
SH R7,=H'1' SUB 1 TO GET TO ONES POSITION
COMPZONE CLI 0(R6),C'0' DOES R7 POINT TO 0
BNE DIGIFND NO , GOT FIRST NON ZERO
AH R6,=H'1' YES .. LOK AT NEXT CHAR
CR R7,R6 IS IT LAST CHAR
BNE COMPZONE NO, GO TEST IT FOR ZERO
DIGIFND EQU * R6 IS 1ST NON ZERO
SR R7,R6 R7 IS # POS TO MOVE
AH R7,=H'1' ADD 1 TO GET TO DEC. POSITION
STH R7,OLEN OLEN NOW HAS # OF POS
MVC DIGIMOVE+1(1),OLEN+1 MOVE LENGHT INTO MOVE INST
DIGIMOVE MVC 0(0,R9),0(6)
AR R9,R7 ADD # POS MOVED TO OUTREC POSITION
CLC 60(4,R8),=F'0' SEE IF THERE ARE NO DECIMAL POS
BE NODECI
MVI 0(R9),C'.' INSERT DECIMAL
AH R9,=H'1' ADD 1 TO OUTPUT POS
* MOVE DECIMALS
LA R6,INREC 6 HOLDS START OF I/P REC
A R6,52(R8) ADD OFSET TO GET START OF FLD
A R6,56(R8) ADD LEN TO 6 FOR STRT OF NEXT FLD
LR R7,R6 NOW POINTS TO START OF NEXT FLD
SH R7,=H'1' NOW POINTS TO END OF THIS FLD
S R6,60(R8) SUB # DECS FROM 6 TO GET DECIMAL SPOT
DECICOMP CLI 0(R7),C'0' DOES R7 POINT TO ZERO
BNE DECIFND YES... FOUND LAST NON ZERO
SH R7,=H'1' NO ... LOK AT PREV CHAR
CR R7,R6 IS IT DECIMAL PLACE
BNE DECICOMP NO, GO TEST IT FOR BLANKS
DECIFND EQU *
SR R7,R6 R7 NOW HOLDS LAST NON ZERO
AH R7,=H'1' R7 NOW 1ST ZERO
STH R7,OLEN FIELD LENGTH NOW IN OLEN
MVC DECIMOVE+1(1),OLEN+1 MOVE LENGHT INTO MOVE INST
DECIMOVE MVC 0(0,R9),0(R6)
AR R9,R7 ADD # POS MOVED TO OUTREC POSITION
NODECI LA R8,64(R8) POINT TO NEXT FIELD TABLE ENTRY
BR 12 RETURN TO PROCESS IT
MOVEPACK EQU *
LA R6,INREC START OF I/P REC
A R6,52(R8) START OF FIELD
L R10,56(R8) LOAD FLD LEN IN R10
SH R10,=H'1' SET DOWN BY ON FOR MOVE
ST R10,WRKLEN
MVN PCKZAP+1(1),WRKLEN+3 SET LENGTH OF FIELD
MVC WORK4,0(R6)
PCKZAP ZAP WORKPACK+0(8),0(0,R6)
UNPK UNPKAREA,WORKPACK
MVZ UNPKAREA+15(1),=C'1'
CP WORKPACK,=P'0'
BH POSITIVE
MVI 0(R9),C'-'
AH R9,=H'1'
POSITIVE EQU *
MVZ UNPKAREA+15(1),=C'1'
LA R6,UNPKAREA
LR R7,R6
AH R7,=H'15'
S R7,60(R8)
CMPPACK EQU *
CLI 0(R6),C'0'
BNE FNDPACK
AH R6,=H'1'
CR R7,R6
BNE CMPPACK
FNDPACK EQU *
SR R7,R6
AH R7,=H'1'
ST R7,OLEN
MVC PCKMOVE+1(1),OLEN+3
PCKMOVE MVC 0(0,R9),0(R6)
AR R9,R7 POINT R9 TO NEXT POSITOION IN OP REC
CLC 60(4,R8),=F'0'
BE NODECPK
MVI 0(R9),C'.'
AH R9,=H'1'
* MOVE DECIMALS
LA R6,UNPKAREA
AH R6,=H'15'
LR R7,R6
S R6,60(R8)
AH R6,=H'1'
PKDECCMP EQU *
CLI 0(R7),C'0'
BNE PKDECFND
SH R7,=H'1'
CR R7,R6
BNE PKDECCMP
PKDECFND EQU *
SR R7,R6
ST R7,OLEN
MVC PKDECMOV+1(1),OLEN+3
PKDECMOV MVC 0(0,R9),0(R6)
AR R9,R7
AH R9,=H'1'
NODECPK EQU *
LA R8,64(R8)
BR R12
OVERFLO EQU *
PUT SYSOUT,CRPTERR2
CLOSE SYSOUT
ABEND 8,REASON=2
ENDUT1 EQU *
CLOSE (SYSUT1,,SYSUT2)
CLOSE (SNAPDD)
UNPK CRPTRIP,INRECS
MVZ CRPTRIP+8(1),CRPTRIP+1
UNPK CRPTROP,OUTRECS
MVZ CRPTROP+8(1),CRPTROP+1
UNPK CRPTBOP,OUTBYTE
MVZ CRPTBOP+14(1),CRPTBOP+1
PUT SYSOUT,CRPTRCNT
PUT SYSOUT,CRPTEND
CLOSE (SYSOUT)
SR 15,15 * SET COND CODE TO 0
L 13,SAVE+4
RETURN (14,12),RC=(0)
****************** DATA DEFINITIONS ****************************
SAVE DS 18F
SYSIN DCB DSORG=PS,MACRF=GM, X
DDNAME=SYSIN, X
EODAD=ENDDEF
SYSOUT DCB DSORG=PS,RECFM=FBA,MACRF=PM,LRECL=133, X
DDNAME=SYSOUT
SYSUT1 DCB DSORG=PS,MACRF=GM, X
DDNAME=SYSUT1, X
EODAD=ENDUT1, X
EXLST=JFCBADR
SNAPDD DCB DSORG=PS,RECFM=VBA,MACRF=W,LRECL=125,BLKSIZE=882, X
DDNAME=SNAPDD
SYSUT2 DCB DSORG=PS,RECFM=VB,MACRF=PM,LRECL=240, X
DDNAME=SYSUT2
***
*** CONTROL CARD RECORD LAYOUT
***
SYSIN133 DS 0CL133
FLDIND DS CL8
DS CL2
FNAME DS CL30
DS CL3
FOFFSET DS ZL4
DS CL3
FLEN DS ZL4
DS CL3
FDEC DS CL4
DS CL3
FTYPE DS CL15
DS CL33
DS CL16
DS CL35
***
*** WORK FIELDS
***
FTROWS DS PL2 FIELD TABLE, # ROWS
OLEN DS F OUTPUT RECORD LENGTH
OFLDS DS PL2 # OUTPUT FIELDS
ENDPOS DC PL5'0'
INRECS DC PL5'0'
OUTRECS DC PL5'0'
OUTBYTE DC PL8'0'
ORECL DS 1D LENHTH OF CURRENT RECORD BEING WRITTEN
CNTLRECL DS 1D TO GET LRECL OF CNTLCARD FILE
INLRECL DS 1D WORKAREA FOR DCB LRECL & BLKSIZE
INBLKSZ DS 1D WORKAREA FOR DCB LRECL & BLKSIZE
WORKPACK DS PL8 WORKAREA -- PACKED
FLENPACK DS PL3 WORK AREA TO PACK FIELD LENGTH INTO
DBLEWORD DS D WORKAREA -- DBLEWORD
DBLEONE DC 1D'1' CONSTANT DOUBLEWORD ONE
WRKLEN DS F WORKAREA -- FULLWORD
WORK4 DS CL4 WARKAREA -- 4CHAR
UNPKAREA DS CL16 -- 16 CHAR FOR UNPACK
DISPLAYF DS CL32
FTABLE DS 100CL64 FIELD TBLE -- 100 ENTRIES , 64 BYTES LONG
INREC DS CL500
OUTRCB1 DS 1H
OUTRCB2 DC 1H'0'
OUTREC DS CL240
SYSOUTR DS CL133
****
**** CONTROL REPORT HEADINGS
****
HDG1 DS 0CL133
DC CL1'1'
DC CL4' '
DC CL32'FIELD NAME'
DC CL4' '
DC CL8'OFFSET'
DC CL4' '
DC CL8'LENGTH'
DC CL4' '
DC CL16'TYPE'
DC CL4' '
DC CL4'DEC.'
DC CL44' '
CNOP 0,4
****
**** CONTROL REPORT DETAIL LINE
****
CRPTDET DS 0CL133
DC CL5' '
CFNAME DC CL32' '
DC CL4' '
CFOFFSET DC CL4' '
DC CL8' '
CFLEN DC CL4' '
DC CL8' '
CFTYPE DC CL16' '
DC CL4' '
CFDEC DC CL4' '
DC CL44' '
****
**** FILEN NAME LINE
**** JOB XXXXXXXX REFORMATTING FILE XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
****
CRPTJLIN DS 0CL133
DC CL1'0'
DC CL5'JOB '
CRPTJOB DC CL8' '
DC CL19' REFORMATTING FILE '
CRPTDSNM DC CL32' '
DC CL68' '
****
**** DCB MESSAGE LINE
**** INPUT FILE LRECL=XXXXX,BLKSIZE=XXXXX
****
CRPTDCB DS 0CL133
DC CL1'0'
DC CL19'INPUT FILE LRECL = '
CRPTLRL DC CL6' '
DC CL11',BLKSIZE = '
CRPTBSZ DC CL6' '
DC CL90' '
****
**** RECORD COUNT LINE
**** XXXXXXXXX RECORDS INPUT, XXXXXXXXX RECORDS, XXXXXXXXXXXXXXX BYTES
****
CRPTRCNT DS 0CL133
DC CL1'0'
CRPTRIP DC CL9' '
DC CL16' RECORDS INPUT, '
CRPTROP DC CL9' '
DC CL10' RECORDS, '
CRPTBOP DC CL15' '
DC CL13' BYTES OUTPUT'
DC CL60' '
CRPTEND DC CL133'0PROGRAM ENDING'
CRPTERR1 DS 0CL133
DC CL39'0INTERNAL ERROR, INVALID FIELD TYPE -- '
CRPTFTYP DS CL15
DC CL79' '
CRPTERR2 DC CL133'0ERROR--OUTPUT RECORD EXCEEDED 240 BYTE MAXIMUM'
CRPTERR3 DC CL133'0ERROR--OUTPUT FIELD EXTENDS BEYOND END OF RECORD'
CRPTERR4 DC CL133'0ERROR--ONLY 99 OUTPUT FIELDS CAN BE SELECTED'
CRPTERR5 DC CL133'0ERROR--CONTROL CARDS SELECTED NO FIELDS'
TIOTLOC DC A(0)
JFCBADR DS 0F
DC X'87'
DC AL3(JFCBUF)
DS 0D
JFCBUF DS CL176
TIOT DSECT
IEFTIOT1
JFCB DSECT
IEFJFCBN LIST=YES
CNOP 0,4
THEEND DC CL32'*************END****************'
END BEGIN

Bill Allen <ARCH...@aol.com>
07/24/01 04:51 PM

To: IDM...@LISTSERV.IUASSN.COM
cc:

Harmeson, Steve

unread,
Jul 27, 2001, 11:25:54 AM7/27/01
to
I have had some requests for the qfile we use to scan all or some (using
wildcard of *) modules in a dictionary for any text. An example would be if
I wanted to scan for text PART-MASTER in all modules that begin will
CSFCD**** within dictionary DICTMFG the parms passed to the batch OLQ job
would be this:

//SYSIPT DD *
SET USER=IDMSNL PASSWORD=xxxxxx
SCAN 'DICTMFG' 'CSFD****' 'PART-MASTER'
//*

Here is the QFILE source:

ADD QFILE NAME IS SCAN VERSION IS 1
COMMENTS 'SCAN MODULE-67 FOR TEXT'
MODULE SOURCE FOLLOWS
&DBN='' &MM='***' &STR1='' &STR2='¬¬¬' &STR3='¬¬¬' -
&STR4='¬¬¬' &STR5='¬¬¬' &STR6='¬¬¬' &STR7='¬¬¬' &STR8='¬¬¬' -
&STR9='¬¬¬'
SIG DICTNAME='' SS=IDMSNWKA DBN='&DBN'
OPT=ALL HEA ECH NOF FUL WHO INT OLQ NOP NOC VER NOD PIC COD NOS
SELECT -
MODULE-067.MOD-NAME-067 -
MODULE-067.MOD-VER-067 -
TEXT-088.* FROM -
MODULE-067,TEXT-088 WHERE -
(MODULE-TEXT) AND -
((TEXT-088.SOURCE-088 CONTAINS '&STR1' OR -
TEXT-088.SOURCE-088 CONTAINS '&STR2' OR -
TEXT-088.SOURCE-088 CONTAINS '&STR3' OR -
TEXT-088.SOURCE-088 CONTAINS '&STR4' OR -
TEXT-088.SOURCE-088 CONTAINS '&STR5' OR -
TEXT-088.SOURCE-088 CONTAINS '&STR6' OR -
TEXT-088.SOURCE-088 CONTAINS '&STR7' OR -
TEXT-088.SOURCE-088 CONTAINS '&STR8' OR -
TEXT-088.SOURCE-088 CONTAINS '&STR9') AND -
MODULE-067.MOD-NAME-067 MATCHES '&MM')
PAGE HEADER BLANK LINES AFTER 1 -
LINE 1 'PROCESS SOURCE SCAN' CENTER -
LINE 1 '$EDATE' LEFT -
LINE 1 'STRING=&STR1' RIGHT
PAGE FOOTER BLANK LINES BEFORE 1
EDIT MOD-NAME-067 -
ALIGN LEFT SPARSE -
OLQHEADER 'MODULE' -
PICTURE 'X(32)'
EDIT MOD-VER-067 -
ALIGN RIGHT SPARSE -
OLQHEADER 'VERSION' -
PICTURE '-ZZZZ9'
EDIT IDD-SEQ-088 -
ALIGN RIGHT SPARSE -
OLQHEADER 'LINE NUMBER' -
PICTURE '-ZZZZZZ9'
EDIT SOURCE-088 -
ALIGN LEFT -
OLQHEADER 'SOURCE LINE' -
PICTURE 'X(75)'
SORT -
ON MOD-NAME-067 AND -
ON MOD-VER-067 AND -
ON IDD-SEQ-088
DISPLAY SPREAD EVEN COLUMNS = MOD-NAME-067 -
MOD-VER-067 IDD-SEQ-088 SOURCE-088
MSEND .

This should work in 12.0 to 14.1, I haven't tried it in 15.0.

Steve Harmeson

-----Original Message-----
From: Bill Allen [mailto:ARCH...@AOL.COM]
Sent: Tuesday, July 24, 2001 3:52 PM
To: IDM...@LISTSERV.IUASSN.COM

0 new messages