|
View previous topic :: View next topic
|
| Author |
Message |
finnesard_mark
New User
Joined: 07 Feb 2006
Posts: 3
|
|
|
|
| How can I obtain the Physical name of a Data Set assigned in the JCL from within a Cobol program |
|
| Back to top |
|
 |
Gautam512
Active User
Joined: 05 Oct 2005
Posts: 308
Location: Vizag / US
|
|
|
|
Hi,
Using the DD name used in the cobol program , with that dd name we can get the Dataset name from the JCL. |
|
| Back to top |
|
|
finnesard_mark
New User
Joined: 07 Feb 2006
Posts: 3
|
|
|
|
| I am looking for an Assembler sub-routine that can retrieve the File Name to be included in an E-Mail to the end user. This is to tell them were they may find the results of a JAVA application that triggers a batch DB2/IMS job. |
|
| Back to top |
|
|
DavidatK
Active Member
Joined: 22 Nov 2005
Posts: 700
Location: Troy, Michigan USA
|
|
|
|
finnesard_mark,
I remembered a post addressing this subject, looked around and found it.
I tried this code and it does work, at least at the software level I'm currently at. Take a look at the link below.
Previous Post
Best of luck,
Dave |
|
| Back to top |
|
|
mmwife
Super Moderator
Joined: 30 May 2003
Posts: 1592
|
|
|
|
Hi Mark,
The code below was submitted by Charlie Hottle. The code in the JFCB-INFO pgraph is what you're looking for.
| Code: |
ID DIVISION.
PROGRAM-ID. COBPTR.
AUTHOR. CHARLIE HOTTEL.
DATE-WRITTEN. 08/22/01.
DATE-COMPILED.
*---------------------------------------------------------------*
* VS COBOL II POINTER FEATURE EXAMPLE *
* USING MVS CONTROL BLOCKS *
*---------------------------------------------------------------*
* BASED ON ARTICLE "THE POINTER FEATURE OF VS COBOL II" BY *
* ANNE PETICOLAS IN ENTERPRISE SYSTEMS JOURNAL, MARCH 1991. *
*---------------------------------------------------------------*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TEST-FILE ASSIGN TO DD1.
DATA DIVISION.
FILE SECTION.
FD TEST-FILE
LABEL RECORDS STANDARD
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
DATA RECORD IS TEST-REC.
01 TEST-REC PIC X(80).
/
WORKING-STORAGE SECTION.
TEST***01 WS-TEST PIC S9(9) COMP VALUE ZERO.
01 WS-WORK PIC S9(9) COMP.
01 WS-RIGHT-HEX-DIGIT PIC S9(4) COMP.
01 WS-LEN PIC S9(4) COMP.
01 WS-LENGTH REDEFINES WS-LEN PIC X(02).
01 WS-FLAG PIC S9(4) COMP.
01 WS-FLAG1 REDEFINES WS-FLAG PIC X(02).
01 WS-TCB-ADDRESS-POINTER.
05 WS-TCB-ADDR-POINTER USAGE IS POINTER.
01 WS-TIOT-SEG-POINT.
05 WS-TIOT-SEG-POINTER USAGE IS POINTER.
05 WS-TIOT-SEG-PNT REDEFINES WS-TIOT-SEG-POINTER
PIC S9(9) COMP.
01 WS-JFCB-POINT.
05 WS-JFCB-POINTER USAGE IS POINTER.
05 WS-JFCB-PTR REDEFINES WS-JFCB-POINTER
PIC S9(9) COMP.
05 WS-JFCB-POINT-RED REDEFINES WS-JFCB-PTR.
07 FILLER PIC X.
07 WS-JFCB-LOW-3 PIC X(3).
01 WS-POINT.
05 WS-POINTER USAGE IS POINTER.
05 WS-PTR REDEFINES WS-POINTER
PIC S9(9) COMP.
05 WS-POINT-RED REDEFINES WS-PTR.
07 FILLER PIC X.
07 WS-LOW-3 PIC X(3).
01 WS-SWA-POINT.
05 WS-SWA-POINTER USAGE IS POINTER.
05 WS-SWA-PTR REDEFINES WS-SWA-POINTER
PIC S9(9) COMP.
05 WS-SWA-POINT-RED REDEFINES WS-SWA-PTR.
07 FILLER PIC X.
07 WS-SWA-LOW-3 PIC X(3).
01 WS-QMAT-POINT.
05 WS-QMAT-POINTER USAGE IS POINTER.
05 WS-QMAT-PTR REDEFINES WS-QMAT-POINTER
PIC S9(9) COMP.
/
01 WS-UCB-POINT.
05 WS-UCB-POINTER USAGE IS POINTER.
05 WS-UCB-POINT-RED REDEFINES WS-UCB-POINTER.
07 FILLER PIC X.
07 WS-UCB-LOW-3 PIC X(3).
01 WS-DEB-POINT.
05 WS-DEB-POINTER USAGE IS POINTER.
05 WS-DEB-POINT-RED REDEFINES WS-DEB-POINTER.
07 FILLER PIC X.
07 WS-DEB-LOW-3 PIC X(3).
01 WS-DCB-POINT.
05 WS-DCB-POINTER USAGE IS POINTER.
05 WS-DCB-POINT-RED REDEFINES WS-DCB-POINTER.
07 FILLER PIC X.
07 WS-DCB-LOW-3 PIC X(3).
01 WS-CVT-ADDRESS-POINTER.
05 WS-CVT-ADDR-POINTER USAGE IS POINTER.
01 WS-ASCB-ADDRESS-POINTER.
05 WS-ASCB-ADDR-POINTER USAGE IS POINTER.
01 WS-ASSB-ADDRESS-POINTER.
05 WS-ASSB-ADDR-POINTER USAGE IS POINTER.
01 WS-JSAB-ADDRESS-POINTER.
05 WS-JSAB-ADDR-POINTER USAGE IS POINTER.
/
01 F-TEMP PIC S999V9.
01 C-TEMP PIC S999V9.
01 EF-TEMP PIC -ZZ9.9.
01 EC-TEMP PIC -ZZ9.9.
/
*---------------------------------------------------------------*
* PUT THE STATEMENTS BELOW IN AN ASSEMBLER PROGRAM TO LOCATE *
* THE DISPLACEMENTS OF THE SYMBOLS. THESE LINES WERE SHIFTED *
* TO THE RIGHT TO MAKE COBOL COMMENTS. SHIFT THEM BACK TO THE *
* LEFT SO THAT THE WORD 'TITLE' IS IN COLUMN 10. *
*---------------------------------------------------------------*
* TITLE 'PREFIX STORAGE AREA' *
* IHAPSA LIST=YES *
* TITLE 'TASK CONTROL BLOCK' *
* IKJTCB LIST=YES *
* TITLE 'SECONDARY TASK CONTROL BLOCK' *
* IHASTCB LIST=YES *
* TITLE 'DATA EXTENT BLOCK' *
* IEZDEB LIST=YES *
* TITLE 'DATA CONTROL BLOCK' *
* DCBDS DSECT *
* DCBD DSORG=PS *
* TITLE 'UNIT CONTROL BLOCK' *
* UCBDS DSECT *
* IEFUCBOB *
* TITLE 'TASK I/O TABLE' *
* TIOTDS DSECT *
* IEFTIOT1 *
* TITLE 'JOB FILE CONTROL BLOCK' *
* JFCBDS DSECT *
* IEFJFCBN LIST=YES *
* TITLE 'COMMUNICATION VECTOR TABLE' *
* CVT DSECT=YES,LIST=YES *
* TITLE 'SUBSYSTEM COMMUNICATION VECTOR TABLE' *
* IEFJSCVT *
* TITLE 'JOB STEP CONTROL BLOCK' *
* IEZJSCB *
* TITLE 'SWA QUEUE AREA' *
* IEFQMNGR *
* TITLE 'JES COMMUNICATION TABLE' *
* IEFJESCT *
* TITLE 'JSAB' *
* IAZJSAB DSECT=YES,LIST=YES *
* TITLE 'ASCB' *
* IHAASCB DSECT=YES,LIST=YES *
* TITLE 'ASSB' *
* IHAASSB LIST=YES *
* TITLE 'ASXB' *
* IHAASXB *
* TITLE 'ACEE' *
* IHAACEE *
* TITLE 'VSAM ACB' *
* IFGACB DSECT=YES *
* TITLE 'REMOTE AREAS' *
*---------------------------------------------------------------*
/
LINKAGE SECTION.
*---------------------------------------------------------------*
* SYS1.MACLIB(IHAPSA) X'21C' = DECIMAL 540 *
* X'224' = DECIMAL 548 *
*---------------------------------------------------------------*
01 PSA.
05 FILLER PIC X(540).
05 TCB-PTR USAGE IS POINTER.
05 FILLER PIC X(04).
05 ASCB-PTR USAGE IS POINTER.
01 PSA-ASM REDEFINES PSA.
05 FILLER PIC X(540).
05 PSATOLD USAGE IS POINTER.
05 FILLER PIC X(04).
05 PSAAOLD USAGE IS POINTER.
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IKJTCB) HAS A 32 BYTE PREFIX AREA *
*---------------------------------------------------------------*
01 TCB-POINTER USAGE IS POINTER.
01 TCB.
05 FILLER PIC X(08).
05 DEB-ADDR USAGE IS POINTER.
05 TIOT-POINTER USAGE IS POINTER.
05 FILLER PIC X(164).
05 JSCB-POINTER USAGE IS POINTER.
05 FILLER PIC X(128).
05 STCB-POINTER USAGE IS POINTER.
01 TCB-ASM REDEFINES TCB.
05 FILLER PIC X(08).
05 TCBDEB USAGE IS POINTER.
05 TCBTIO USAGE IS POINTER.
05 FILLER PIC X(164).
05 TCBJSCB USAGE IS POINTER.
05 FILLER PIC X(128).
05 TCBSTCB USAGE IS POINTER.
/
*---------------------------------------------------------------*
* SYS1.MACLIB(CVT) *
*---------------------------------------------------------------*
01 CVT-POINTER USAGE IS POINTER.
01 CVT.
05 FILLER PIC X(296).
05 JESCT-POINTER USAGE IS POINTER.
01 CVT-ASM REDEFINES CVT.
05 FILLER PIC X(296).
05 CVTJESCT USAGE IS POINTER.
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IEFJESCT) *
*---------------------------------------------------------------*
01 JESCT.
05 FILLER PIC X(24).
05 JESSSCVT-POINTER USAGE IS POINTER.
01 JESCT-ASM REDEFINES JESCT.
05 FILLER PIC X(24).
05 JESSSCT USAGE IS POINTER.
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IEFJSCVT) *
*---------------------------------------------------------------*
01 SSCVT.
05 SSCVT-EYE-CATCHER PIC X(04).
05 NEXT-SSCVT USAGE IS POINTER.
05 SUBSYSTEM-NAME PIC X(04).
01 SSCVT-ASM REDEFINES SSCVT.
05 SSCTID PIC X(04).
05 SSCTSCTA USAGE IS POINTER.
05 SSCTSNAM PIC X(04).
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IEFTIOT1) *
*---------------------------------------------------------------*
01 TIOT.
05 JOB-NAME PIC X(08).
05 JOB-PROC PIC X(08).
05 JOB-STEP PIC X(08).
01 TIOT-ASM REDEFINES TIOT.
05 TIOCSTPN PIC X(08).
05 TIOCPSTN PIC X(08).
05 TIOCSJSTN PIC X(08).
01 TIOT-SEG.
05 TIO-LEN PIC X.
05 FILLER PIC X(03).
05 DD-NAME PIC X(08).
05 SWA-V-ADDR PIC X(03).
05 FILLER PIC X(02).
05 UCB-ADDR PIC X(03).
01 TIOENTRY REDEFINES TIOT-SEG.
05 TIOELNGH PIC X.
05 FILLER PIC X(03).
05 TIOEDDNM PIC X(08).
05 TIOEJFCB PIC X(03).
05 FILLER PIC X(02).
05 TIOEFSRT PIC X(03).
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IEFJFCBN) *
*---------------------------------------------------------------*
01 JFCB.
05 DS-NAME PIC X(44).
05 FILLER PIC X(74).
05 VOL-SER PIC X(06).
01 JFCB-ASM REDEFINES JFCB.
05 JFCBDSNM PIC X(44).
05 FILLER PIC X(74).
05 JFCBVOLS PIC X(06).
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IEZDEB) DEB HAS A 36 BYTE PREFIX AREA *
*---------------------------------------------------------------*
01 DEB.
05 FILLER PIC X(05).
05 NEXT-DEB-ADDR PIC X(03).
05 FILLER PIC X(17).
05 DCB-ADDR PIC X(03).
01 DEB-ASM REDEFINES DEB.
05 FILLER PIC X(05).
05 DEBDEBB PIC X(03).
05 FILLER PIC X(17).
05 DEBDCB PIC X(03).
/
*---------------------------------------------------------------*
* SYS1.MACLIB(DCBD) *
*---------------------------------------------------------------*
01 DCB.
05 FILLER PIC X(17).
05 DEVICE-TYPE PIC X.
88 DISK-3380-X2E VALUE X'2E'.
88 DISK-3390-X2F VALUE X'2F'.
05 FILLER PIC X(08).
05 DSORG PIC X(02).
05 FILLER PIC X(08).
05 RECFM PIC X(02).
05 FILLER PIC X(02).
05 DDNAME PIC X(08).
05 FILLER PIC X(14).
05 BLKSIZE PIC S9(4) COMP.
05 FILLER PIC X(18).
05 LRECL PIC S9(4) COMP.
01 DCB-ASM REDEFINES DCB.
05 FILLER PIC X(17).
05 DCBDEVT PIC X.
05 FILLER PIC X(08).
05 DCBDSORG PIC X(02).
05 FILLER PIC X(08).
05 DCBRECFM PIC X(02).
05 FILLER PIC X(02).
05 DCBDDNAM PIC X(08).
05 FILLER PIC X(14).
05 DCBBLKSI PIC S9(4) COMP.
05 FILLER PIC X(18).
05 DCBLRECL PIC S9(4) COMP.
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IEZJSCB) *
*---------------------------------------------------------------*
01 JSCB.
05 FILLER PIC X(244).
05 QMPL-POINTER USAGE IS POINTER.
01 JSCB-ASM REDEFINES JSCB.
05 FILLER PIC X(244).
05 JSCBQMPI USAGE IS POINTER.
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IEFQMNGR) *
*---------------------------------------------------------------*
01 QMPL.
05 FILLER PIC X(24).
05 QMAT-POINTER USAGE IS POINTER.
01 QMPL-ASM REDEFINES QMPL.
05 FILLER PIC X(24).
05 QMADD USAGE IS POINTER.
01 QMAT.
05 FILLER PIC X(12).
05 QMAT-NEXT-POINTER USAGE IS POINTER.
01 SWA.
05 JFCB-ADDR USAGE IS POINTER.
/
*---------------------------------------------------------------*
* SYS1.MODGEN(IHASTCB) *
*---------------------------------------------------------------*
01 STCB.
05 FILLER PIC X(188).
05 JSAB-POINTER USAGE IS POINTER.
01 STCB-ASM REDEFINES STCB.
05 FILLER PIC X(188).
05 STCBJSAB USAGE IS POINTER.
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IAZJSAB) *
*---------------------------------------------------------------*
01 JSAB.
05 JSAB-EYE-CATCHER PIC X(04).
05 JSAB-NEXT-PTR USAGE IS POINTER.
05 FILLER PIC X(05).
05 JSAB-FLAG1 PIC X.
05 FILLER PIC X(02).
05 COMPONENT PIC X(04).
05 JOB-ID PIC X(08).
05 JOB-NBR PIC X(08).
05 FILLER PIC X(08).
05 USERID PIC X(08).
01 JSAB-ASM REDEFINES JSAB.
05 JSABID PIC X(04).
05 JSABNEXT USAGE IS POINTER.
05 FILLER PIC X(05).
05 JSABFLG1 PIC X.
05 FILLER PIC X(02).
05 JSABSCID PIC X(04).
05 JSABJBID PIC X(08).
05 JSABJBNM PIC X(08).
05 FILLER PIC X(08).
05 JSABUSID PIC X(08).
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IHAASCB) *
*---------------------------------------------------------------*
01 ASCB-POINTER USAGE IS POINTER.
01 ASCB.
05 FILLER PIC X(108).
05 ASXB-POINTER USAGE IS POINTER.
05 FILLER PIC X(224).
05 ASSB-POINTER USAGE IS POINTER.
01 ASCB-ASM REDEFINES ASCB.
05 FILLER PIC X(336).
05 ASCBASSB USAGE IS POINTER.
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IHAASSB) *
*---------------------------------------------------------------*
01 ASSB.
05 FILLER PIC X(168).
05 JSAB-POINTER USAGE IS POINTER.
01 ASSB-ASM REDEFINES ASSB.
05 FILLER PIC X(168).
05 ASSBJSAB USAGE IS POINTER.
/
*---------------------------------------------------------------*
* SYS1.MODGEN(IHAASXB) *
*---------------------------------------------------------------*
01 ASXB.
05 FILLER PIC X(200).
05 ACEE-POINTER USAGE IS POINTER.
/
*---------------------------------------------------------------*
* SYS1.MACLIB(IHAACEE) *
*---------------------------------------------------------------*
01 ACEE.
05 FILLER PIC X(021).
05 ACEEUSRI PIC X(008).
/
PROCEDURE DIVISION.
PERFORM JOB-STEP-NAME.
PERFORM SUBSYSTEM-NAMES.
PERFORM JFCB-INFO.
PERFORM DCB-INFO.
PERFORM JSAB-INFO.
PERFORM DEGREE-TABLE.
GOBACK.
/
JOB-STEP-NAME.
*---------------------------------------------------------------*
* JOB NAME AND STEP NAME *
* PSA + X'21C' -> TCB -> TIOT *
*---------------------------------------------------------------*
MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
SET ADDRESS OF TCB TO TCB-POINTER.
SET ADDRESS OF TIOT TO TIOT-POINTER.
DISPLAY 'JOB NAME=' JOB-NAME
' JOB PROC=' JOB-PROC
' JOB STEP=' JOB-STEP.
DISPLAY ' '.
/
SUBSYSTEM-NAMES.
*---------------------------------------------------------------*
* DISPLAY SUBSYSTEM NAMES FROM SSCVT CHAIN *
* CVT -> JSECT -> SSCVT *
*---------------------------------------------------------------*
MOVE X'00000010' TO WS-CVT-ADDRESS-POINTER.
SET ADDRESS OF CVT-POINTER TO WS-CVT-ADDR-POINTER.
SET ADDRESS OF CVT TO CVT-POINTER.
SET ADDRESS OF JESCT TO JESCT-POINTER.
SET ADDRESS OF SSCVT TO JESSSCVT-POINTER.
DISPLAY 'SUBSYSTEM NAME=' SUBSYSTEM-NAME.
PERFORM UNTIL NEXT-SSCVT IS = NULL
SET ADDRESS OF SSCVT TO NEXT-SSCVT
DISPLAY 'SUBSYSTEM NAME=' SUBSYSTEM-NAME
END-PERFORM.
DISPLAY ' '.
/
JFCB-INFO.
*---------------------------------------------------------------
* FIND DDNAMES AND ASSOCIATED DSNAMES
* PSA+X'21C' -> TCB -> TIOT -> TIOT SEG -> SWAREQ(SVA) -> JFCB
*---------------------------------------------------------------
MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
SET ADDRESS OF TCB TO TCB-POINTER.
SET ADDRESS OF TIOT TO TIOT-POINTER.
SET WS-TIOT-SEG-POINTER TO TIOT-POINTER.
ADD 24 TO WS-TIOT-SEG-PNT.
SET ADDRESS OF TIOT-SEG TO WS-TIOT-SEG-POINTER.
PERFORM UNTIL TIO-LEN = LOW-VALUES
MOVE ALL LOW-VALUES TO WS-POINT
MOVE ALL LOW-VALUES TO WS-JFCB-POINT
MOVE ALL LOW-VALUES TO WS-SWA-POINT
MOVE SWA-V-ADDR TO WS-SWA-LOW-3
PERFORM SWAREQ
SET ADDRESS OF JFCB TO WS-POINTER
DISPLAY 'DDNAME=' DD-NAME
DISPLAY 'DSNAME=' DS-NAME
DISPLAY 'VOL=SER=' VOL-SER
DISPLAY '********************************************'
MOVE ZERO TO WS-LEN
MOVE TIO-LEN TO WS-LENGTH(2:1)
ADD WS-LEN TO WS-TIOT-SEG-PNT
SET ADDRESS OF TIOT-SEG TO WS-TIOT-SEG-POINTER
END-PERFORM.
/
SWAREQ.
DIVIDE WS-SWA-PTR BY 16
GIVING WS-WORK
REMAINDER WS-RIGHT-HEX-DIGIT.
IF WS-RIGHT-HEX-DIGIT NOT = 15
COMPUTE WS-PTR = WS-SWA-PTR + 16
ELSE
MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER
SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER
SET ADDRESS OF TCB TO TCB-POINTER
SET ADDRESS OF JSCB TO JSCB-POINTER
SET ADDRESS OF QMPL TO QMPL-POINTER
SET ADDRESS OF QMAT TO QMAT-POINTER
SET WS-QMAT-POINTER TO QMAT-POINTER
PERFORM UNTIL WS-SWA-PTR <= 65536
SET WS-QMAT-POINTER TO QMAT-NEXT-POINTER
SET ADDRESS OF QMAT TO QMAT-NEXT-POINTER
COMPUTE WS-SWA-PTR = WS-SWA-PTR - 65536
END-PERFORM
COMPUTE WS-PTR = WS-SWA-PTR + WS-QMAT-PTR + 1
SET ADDRESS OF SWA TO WS-POINTER
SET WS-POINTER TO JFCB-ADDR
COMPUTE WS-PTR = WS-PTR + 16
END-IF.
/
DCB-INFO.
*---------------------------------------------------------------*
* DISPLAY DCB INFORMATION *
* PSA+X'21C' - > TCB -> DEB -> DCB *
*---------------------------------------------------------------*
OPEN INPUT TEST-FILE.
MOVE ALL LOW-VALUES TO WS-DEB-POINT.
MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
SET ADDRESS OF TCB TO TCB-POINTER.
SET WS-DEB-POINTER TO DEB-ADDR.
PERFORM UNTIL WS-DEB-POINTER IS = NULL
SET ADDRESS OF DEB TO WS-DEB-POINTER
MOVE ALL LOW-VALUES TO WS-DCB-POINT
MOVE DCB-ADDR TO WS-DCB-LOW-3
SET ADDRESS OF DCB TO WS-DCB-POINTER
TEST***********DISPLAY 'DCB-PTR=' WS-DCB-POINTER
DISPLAY ' DDNAME=' DDNAME
DISPLAY ' DSORG=' DSORG
DISPLAY ' RECFM=' RECFM
DISPLAY 'BLKSIZE=' BLKSIZE
DISPLAY ' LRECL=' LRECL
IF DISK-3380-X2E
DISPLAY 'DEVICE-TYPE=3380'
DISPLAY '**************************************'
ELSE IF DISK-3390-X2F
DISPLAY 'DEVICE-TYPE=3390'
DISPLAY '**************************************'
ELSE
DISPLAY 'DEVICE-TYPE=????'
DISPLAY 'DEVICE-TYPE=' DEVICE-TYPE
DISPLAY '**************************************'
END-IF
END-IF
TEST***********DIVIDE WS-LEN BY WS-TEST GIVING WS-WORK
MOVE NEXT-DEB-ADDR TO WS-DEB-LOW-3
END-PERFORM.
CLOSE TEST-FILE.
/
JSAB-INFO.
SET WS-JSAB-ADDR-POINTER TO NULL.
*---------------------------------------------------------------*
* DISPLAY JSAB INFORMATION *
* PSA+X'21C' - > TCB -> STCB -> JSAB *
*---------------------------------------------------------------*
MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
SET ADDRESS OF TCB TO TCB-POINTER.
SET ADDRESS OF STCB TO STCB-POINTER.
IF JSAB-POINTER OF STCB IS NOT = NULL
SET ADDRESS OF JSAB TO JSAB-POINTER OF STCB
SET WS-JSAB-ADDR-POINTER TO JSAB-POINTER OF STCB
END-IF.
*---------------------------------------------------------------*
* PSA+X'224' - > ASCB -> ASSB -> JSAB *
* -> ASXB -> ACEE *
*---------------------------------------------------------------*
IF WS-JSAB-ADDR-POINTER IS = NULL
MOVE X'00000224' TO WS-ASCB-ADDRESS-POINTER
SET ADDRESS OF ASCB-POINTER TO WS-ASCB-ADDR-POINTER
SET ADDRESS OF ASCB TO ASCB-POINTER
IF ASXB-POINTER IS NOT = NULL
SET ADDRESS OF ASXB TO ASXB-POINTER
SET ADDRESS OF ACEE TO ACEE-POINTER
DISPLAY 'USERID FROM ACEE = ' ACEEUSRI
DISPLAY '**************************************'
END-IF
IF ASSB-POINTER IS NOT = NULL
SET ADDRESS OF ASSB TO ASSB-POINTER
SET WS-ASSB-ADDR-POINTER TO ASSB-POINTER
IF JSAB-POINTER OF ASSB IS NOT = NULL
SET ADDRESS OF JSAB TO JSAB-POINTER OF ASSB
SET WS-JSAB-ADDR-POINTER TO JSAB-POINTER OF ASSB
END-IF
END-IF
END-IF.
*---------------------------------------------------------------*
* IF JSAB-FLAG1 > 127 THE JSAB IS INVALID *
*---------------------------------------------------------------*
IF WS-JSAB-ADDR-POINTER IS = NULL
CONTINUE
ELSE
MOVE ZERO TO WS-FLAG
MOVE JSAB-FLAG1 TO WS-FLAG1(2:1)
PERFORM UNTIL WS-FLAG <= 127 OR
WS-JSAB-ADDR-POINTER IS = NULL OR
JSAB-EYE-CATCHER NOT = 'JSAB'
SET WS-JSAB-ADDR-POINTER TO JSAB-NEXT-PTR
SET ADDRESS OF JSAB TO WS-JSAB-ADDR-POINTER
MOVE ZERO TO WS-FLAG
MOVE JSAB-FLAG1 TO WS-FLAG1(2:1)
END-PERFORM
END-IF.
IF WS-JSAB-ADDR-POINTER IS NOT = NULL
DISPLAY 'EYE-CATCHER=' JSAB-EYE-CATCHER
DISPLAY ' COMPONENT=' COMPONENT
DISPLAY ' JOB ID=' JOB-ID
DISPLAY ' JOB NUMBER=' JOB-ID
DISPLAY ' USERID=' USERID
ELSE
DISPLAY 'JSAB INFORMATION NOT FOUND'
END-IF.
/
DEGREE-TABLE.
DISPLAY '**************************************'
DISPLAY 'FARENHEIT CENTIGRADE'
PERFORM VARYING F-TEMP FROM -20 BY 1
UNTIL F-TEMP > 105
COMPUTE C-TEMP = (5 * (F-TEMP - 32)) / 9
MOVE F-TEMP TO EF-TEMP
MOVE C-TEMP TO EC-TEMP
DISPLAY EF-TEMP ' ' EC-TEMP
END-PERFORM. |
|
|
| Back to top |
|
|
finnesard_mark
New User
Joined: 07 Feb 2006
Posts: 3
|
|
|
|
| Thank You all for your help. I am testing the DDNAME program (DAVEatK linked to) and making minor enhancements. |
|
| Back to top |
|
|
|
|
