View previous topic :: View next topic
|
Author |
Message |
jpbeaud
New User
Joined: 28 Sep 2005 Posts: 1
|
|
|
|
Hello,
Il woluld like to know if there exists a way to get in a COBOL program the DSName of a file from its DDNAme.
Thank you, |
|
Back to top |
|
|
Kevin
Active User
Joined: 25 Aug 2005 Posts: 234
|
|
|
|
I found this code through an Internet search. It worked just fine on my (z/OS V1R4) system:
Code: |
IDENTIFICATION DIVISION.
PROGRAM-ID. PROGXX.
INSTALLATION.
AUTHOR. KEVIN.
DATE-WRITTEN. 11/07/2005.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 TCB-ADDRESS-POINTER.
05 TCB-ADDR-POINTER USAGE IS POINTER.
01 TIOT-SEG-POINT.
05 TIOT-SEG-POINTER USAGE IS POINTER.
05 TIOT-SEG-PNT REDEFINES TIOT-SEG-POINTER
PIC S9(9) COMP.
01 JFCB-POINT.
05 JFCB-POINTER USAGE IS POINTER.
05 JFCB-POINT-RED REDEFINES JFCB-POINTER.
10 FILLER PIC X.
10 JFCB-LOW-3 PIC X(3).
LINKAGE SECTION.
01 DDNAME-DSN-ARRAY.
05 DDNAME-DSN OCCURS 100 TIMES INDEXED BY NDX1.
10 DDA-DDNAME PIC X(8).
10 DDA-DSN PIC X(44).
01 TCB-POINTER USAGE IS POINTER.
01 TCB.
05 FILLER PIC X(12).
05 TIOT-POINTER USAGE IS POINTER.
01 TIOT-START PIC X(24).
01 TIOT-SEG.
05 TIO-LEN PIC X.
05 FILLER PIC X(3).
05 DD-NAME PIC X(8).
05 JFCB-ADDR PIC X(3).
01 JFCB.
05 FILLER PIC X(16).
05 DS-NAME PIC X(44).
PROCEDURE DIVISION USING DDNAME-DSN-ARRAY.
MOVE LOW-VALUES TO JFCB-POINT.
MOVE X'0000021C' TO TCB-ADDRESS-POINTER.
SET ADDRESS OF TCB-POINTER TO TCB-ADDR-POINTER.
SET ADDRESS OF TCB TO TCB-POINTER.
SET ADDRESS OF TIOT-START TO TIOT-POINTER.
SET TIOT-SEG-POINTER TO TIOT-POINTER.
ADD 24 TO TIOT-SEG-PNT.
SET ADDRESS OF TIOT-SEG TO TIOT-SEG-POINTER.
SET NDX1 TO 1.
PERFORM UNTIL TIO-LEN = LOW-VALUES OR NDX1 > 100
MOVE DD-NAME TO DDA-DDNAME(NDX1)
MOVE JFCB-ADDR TO JFCB-LOW-3
SET ADDRESS OF JFCB TO JFCB-POINTER
MOVE DS-NAME TO DDA-DSN(NDX1)
DISPLAY DDA-DDNAME(NDX1) DDA-DSN(NDX1)
ADD 20 TO TIOT-SEG-PNT
SET ADDRESS OF TIOT-SEG TO TIOT-SEG-POINTER
SET NDX1 UP BY 1
END-PERFORM.
GOBACK.
|
This is the discussion group page where I found it:
groups.google.com/group/comp.lang.cobol/browse_thread/thread/85e935011cdff787/24ecab6b49c46c74%2324ecab6b49c46c74?sa=X&oi=groupsr&start=0&num=3 |
|
Back to top |
|
|
Kevin
Active User
Joined: 25 Aug 2005 Posts: 234
|
|
|
|
Of course, if you don't feel comfortable using storage blocks, you could just as easily start a TSO session and invoke a CLIST or REXX Exec that uses the standard LISTDSI function to accomplish the same thing:
Code: |
IDENTIFICATION DIVISION.
PROGRAM-ID. MYPROG.
INSTALLATION.
AUTHOR. SUPERK.
DATE-WRITTEN. 11/08/2005.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INPUT-FILE ASSIGN TO UT-S-SYSUT1
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL.
SELECT TEMP-FILE ASSIGN TO UT-S-RESULT
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD INPUT-FILE
LABEL RECORD STANDARD
BLOCK 0 RECORDS
RECORDING MODE F
RECORD CONTAINS 80 CHARACTERS.
01 INPUT-RECORD PIC X(80).
FD TEMP-FILE
LABEL RECORD STANDARD
BLOCK 0 RECORDS
RECORDING MODE F
RECORD CONTAINS 80 CHARACTERS.
01 TEMP-RECORD PIC X(80).
WORKING-STORAGE SECTION.
01 FILLER.
05 WS-DUMMY PIC S9(8) COMP.
05 WS-RETURN-CODE PIC S9(8) COMP.
05 WS-REASON-CODE PIC S9(8) COMP.
05 WS-INFO-CODE PIC S9(8) COMP.
05 WS-CPPL-ADDRESS PIC S9(8) COMP.
05 WS-FLAGS PIC X(4) VALUE X'00010001'.
05 WS-BUFFER PIC X(256).
05 WS-LENGTH PIC S9(8) COMP VALUE 256.
PROCEDURE DIVISION.
CALL 'IKJTSOEV' USING WS-DUMMY WS-RETURN-CODE WS-REASON-CODE
WS-INFO-CODE WS-CPPL-ADDRESS.
IF WS-RETURN-CODE > ZERO
DISPLAY 'IKJTSOEV FAILED, RETURN-CODE=' WS-RETURN-CODE
' REASON-CODE=' WS-REASON-CODE 'INFO-CODE=' WS-INFO-CODE
MOVE WS-RETURN-CODE TO RETURN-CODE
STOP RUN.
MOVE '%GETDSN SYSUT1 RESULT' TO WS-BUFFER.
CALL 'IKJEFTSR' USING WS-FLAGS WS-BUFFER WS-LENGTH
WS-RETURN-CODE WS-REASON-CODE WS-DUMMY.
IF WS-RETURN-CODE > ZERO
DISPLAY 'IKJEFTSR FAILED, RETURN-CODE=' WS-RETURN-CODE
' REASON-CODE=' WS-REASON-CODE
MOVE WS-RETURN-CODE TO RETURN-CODE
STOP RUN.
DISPLAY '%GETDSN WORKED ! '.
OPEN INPUT TEMP-FILE.
READ TEMP-FILE.
DISPLAY TEMP-RECORD.
CLOSE TEMP-FILE.
MOVE ZEROS TO RETURN-CODE.
STOP RUN.
|
REXX Exec 'GETDSN':
Code: |
/* REXX GETDSN */
Parse Upper Arg ddname outdd .
rc = LISTDSI(ddname 'FILE')
"ALLOC DD("outdd") NEW REU UNIT(VIO) RECFM(F B) LRECL(80)"
Push SYSDSNAME
"EXECIO 1 DISKW "outdd" (FINIS"
Exit 0
|
Calling JCL:
Code: |
//*
//STEP0001 EXEC PGM=MYPROG
//STEPLIB DD DISP=SHR,DSN=&SYSUID..COBOL.LOAD
//SYSPROC DD DISP=SHR,DSN=&SYSUID..REXX
//SYSUT1 DD DISP=SHR,DSN=input dataset ...
//SYSOUT DD SYSOUT=*
//SYSTSPRT DD SYSOUT=*
//SYSTSIN DD DUMMY
//*
|
|
|
Back to top |
|
|
|