//IBMUSERG JOB (1), // 'David Alcock ', // NOTIFY=IBMUSER, // MSGCLASS=X //PROCLIB JCLLIB ORDER=(IGY.V1R2M0.SIGYPROC, /* COBOL */ // CBC.SCBCPRC, /* IBM CPP compiler */ // IEL.V1R1M1.SIELPROC, /* PL/I for OS/390 */ // PLI.V2R3M0.PLIPROC) /* Older PL/I */ //* //** Sample jobstream that obtains the current time as returned by //** various languages: //** //** - IBM: //** - Assembler LE Tested with HLASM v1.3 //** - Assembler non-LE Tested with HLASM v1.3 //** - C/C++ Tested with R6 and R7 //** - COBOL/LE Tested with V1.2 and V2.1 //** - PL/I Tested with V2.3 //** - PL/I for MVS Tested with V1.1 //** - Interpreted: //** - CLIST Tested with TSO/E V2.5 //** - REXX (ISPF) Tested with TSO/E V2.5 & ISPF 3.5/4.3 //** - ISPF Tested with ISPF 4.3 (OS/390 1.2) //** - FORTRAN Tested with V2.5 //** //** - Non-IBM: //** - SAS Tested with V6.0.9 TS455 or higher //** - CA-EasyTrieve Tested with V6.2 //** //** The C program has some non-standard characters: X'AD' and X'BD' //** for the array square brackets. Just leave them alone. //* //********************************************************************* //*** //** Assembler (HLASM) - using LE/370 services //*** //********************************************************************* //ASMLE EXEC PROC=HLASMC,PARM.C='OBJECT,NODECK', // REGION.C=2048K //C.SYSLIB DD DISP=SHR,DSN=CEE.SCEEMAC // DD DSN=SYS1.MACLIB,DISP=SHR //C.SYSPRINT DD SYSOUT=Z <- non-output //C.SYSLIN DD DSN=&&ASMLE,UNIT=SYSDA,DISP=(,PASS), // SPACE=(CYL,(5,5,0)),DCB=BLKSIZE=800 //C.SYSIN DD * TIMEASML TITLE 'TIMEASML - Get the current time in Assembler (LE/370)' * * Name: TIMEASML * * Author: David Alcock * * Written: 2000-02-16 * * Purpose: Shows how to obtain the time in Assembler using * LE/370 services. The IBM supplied CEEIVP source * was used as a template for this program. * * Attributes: Non-reentrant, Non-Authorized * * Requirements: Assembler H and higher and MVS version 4 or higher * * Note: It is unlucky to change R12 or R13! * SPACE 2 * ** Convert assembly date from format "YYYYMMDD" to "YYYY-MM-DD" * LCLC &ASMDATE &ASMDATE SETC '&SYSDATC'(1,4).'-'.'&SYSDATC'(5,2).'-'.'&SYSDATC'(7,2) * ** Standard LE/370 Assembler entry housekeeping * DATEASML CEEENTRY PPA=MAINPPA,AUTO=WORKSIZE USING WORKAREA,R13 * ** Get the Local time and date via CEELOCT * LA R2,LOCT_LILLIAN LA R3,LOCT_SECS LA R4,LOCT_GREG LA R5,00 No FBCode here! Wait for a Signal STM R2,R5,PLIST * LA R1,PLIST L R15,=V(CEELOCT) BALR R14,R15 * ** Print message 1 on SYSOUT * LA R2,MSG1 LA R3,DEST LA R4,FBCODE STM R2,R4,PLIST LA R1,PLIST L R15,=V(CEEMOUT) BALR R14,R15 * ** Print blank line on SYSOUT * LA R2,MSG2 LA R3,DEST LA R4,FBCODE STM R2,R4,PLIST LA R1,PLIST L R15,=V(CEEMOUT) BALR R14,R15 * ** Create a good Message 3 * LA R2,MSG3L Set the size to 80 Chars for the STH R2,TIMEMSGL ...length field LA R15,TIMEMSGV MVC 0(MSG3L,R15),MSG3 MVC MSG3V-MSG3(17,R15),LOCT_GREG "YYYYMMDDHHMMSS999" * 0....+....1....+. MVC TIMEOUT+0(2),LOCT_GREG+8 MVI TIMEOUT+2,C':' MVC TIMEOUT+3(2),LOCT_GREG+10 MVI TIMEOUT+5,C':' MVC TIMEOUT+6(2),LOCT_GREG+12 MVC MSG3F-MSG3(L'TIMEOUT,R15),TIMEOUT * ** Print message 3 on SYSOUT * LA R2,TIMEMSG LA R3,DEST LA R4,FBCODE STM R2,R4,PLIST LA R1,PLIST L R15,=V(CEEMOUT) BALR R14,R15 * ** Print blank line on SYSOUT * LA R2,MSG2 LA R3,DEST LA R4,FBCODE STM R2,R4,PLIST LA R1,PLIST L R15,=V(CEEMOUT) BALR R14,R15 * ** Get the GMT offset information * LA R2,GMTO_HOURS LA R3,GMTO_MINUTES LA R4,GMTO_SECONDS LA R5,00 No FBCode here! Wait for a Signal STM R2,R5,PLIST * LA R1,PLIST L R15,=V(CEEGMTO) BALR R14,R15 * ** Create a good Message 7 * LA R2,MSG7L Set the size to 80 Chars for the STH R2,TIMEMSGL ...length field LA R15,TIMEMSGV MVC 0(MSG7L,R15),MSG7 UNPK MSG7H-MSG7(9,R15),GMTO_HOURS(5) MVZ MSG7H-MSG7(8,R15),=8X'00' TR MSG7H-MSG7(8,R15),=C'0123456789ABCDEF' MVI MSG7H-MSG7+8(R15),C' ' UNPK MSG7M-MSG7(9,R15),GMTO_MINUTES(5) MVZ MSG7M-MSG7(8,R15),=8X'00' TR MSG7M-MSG7(8,R15),=C'0123456789ABCDEF' MVI MSG7M-MSG7+8(R15),C' ' LA R15,MSG7S-MSG7(R15) UNPK 0(9,R15),GMTO_SECONDS(5) MVZ 0(8,R15),=8X'00' TR 0(8,R15),=C'0123456789ABCDEF' UNPK 8(9,R15),GMTO_SECONDS+4(5) MVZ 8(8,R15),=8X'00' TR 8(8,R15),=C'0123456789ABCDEF' MVI 16(R15),C' ' * ** Print message 7 on SYSOUT * LA R2,TIMEMSG LA R3,DEST LA R4,FBCODE STM R2,R4,PLIST LA R1,PLIST L R15,=V(CEEMOUT) BALR R14,R15 * ** Print blank line on SYSOUT * LA R2,MSG2 LA R3,DEST LA R4,FBCODE STM R2,R4,PLIST LA R1,PLIST L R15,=V(CEEMOUT) BALR R14,R15 * ** Print Assembler information on SYSOUT * LA R2,MSG4 LA R3,DEST LA R4,FBCODE STM R2,R4,PLIST LA R1,PLIST L R15,=V(CEEMOUT) BALR R14,R15 * LA R2,MSG5 LA R3,DEST LA R4,FBCODE STM R2,R4,PLIST LA R1,PLIST L R15,=V(CEEMOUT) BALR R14,R15 * LA R2,MSG6 LA R3,DEST LA R4,FBCODE STM R2,R4,PLIST LA R1,PLIST L R15,=V(CEEMOUT) BALR R14,R15 * ** Print blank line on SYSOUT * LA R2,MSG2 LA R3,DEST LA R4,FBCODE STM R2,R4,PLIST LA R1,PLIST L R15,=V(CEEMOUT) BALR R14,R15 * ** Print message on the console * MVC WORKWTO(CONWTOL),CONWTO MVC WORKWTO+4+34(8),TIMEOUT "HH:MM:SS" WTO ,MF=(E,WORKWTO) * ** Terminate the CEL environment and return to the caller * CEETERM RC=0 SPACE 2 ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ** ** Constants ** ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ** SPACE 2 LTORG , MSG1 DC AL2(80) MSG1S DC CL80' ' ORG MSG1S DC C'Assembler calling LE/370 ' DC C'--------------------------' ORG , * MSG2 DC AL2(80) DC CL80' ' * *-Msg 3 is NOT a LE/370 msg, it's moved into TIMEMSGV MSG3 DC CL80' ' ORG MSG3 DC C'Calling CEELOCT (Local) returns: ' MSG3V DC CL17' ' DC C' - Time Formated: ' MSG3F DC C'hh:mm:ss' ORG , MSG3L EQU 80 * MSG4 DC AL2(80),CL80'Environment information:' MSG5 DC AL2(80),CL80'- Date Assembled...........&ASMDATE.' MSG6 DC AL2(80),CL80'- Assembler version........&SYSVER.' * * *-Msg 7 is NOT a LE/370 msg, it's moved into TIMEMSGV MSG7 DC CL80' ' ORG MSG7 DC C'Calling CEEGMTO returns: hours=' MSG7H DC CL8' ' DC C' min=' MSG7M DC CL8' ' DC C' sec=' MSG7S DC CL16' ' ORG , MSG7L EQU 80 * 0....+....1....+....2....+....3....+ CONWTO WTO 'Assembler calling LE/370 returns: hh:mm:ss (Local Time)@ ',MF=L CONWTOL EQU *-CONWTO * DEST DC F'2' The destination is the MSGFILE * MAINPPA CEEPPA , Constants describing the code block DC C'END_OF_DATEASML' Literal at the end of the module DS 0D DATEASMLL EQU *-DATEASML Length of CSECT SPACE 2 ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ** ** Work area and the DSA ** ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ** SPACE 2 WORKAREA DSECT , ORG *+CEEDSASZ Leave space for the DSA fixed part PLIST DS 0D PARM1 DS A PARM2 DS A PARM3 DS A PARM4 DS A PARM5 DS A * GMTO_HOURS DS F Offset from GMT GMTO_MINUTES DS F Offset from GMT GMTO_SECONDS DS D Offset from GMT * LOCT_LILLIAN DS F Lilian Output LOCT_SECS DS D Current local date/time in seconds LOCT_GREG DS CL17 Gregorian output in chars FBCODE DS 3F Space for a 12 byte feedback code * TIMEOUT DS C'HH:MM:SS' * TIMEMSG DS 0D Variable Time message TIMEMSGL DS H TIMEMSGV DS CL255 * WORKWTO DS XL(CONWTOL) Workarea for WTO DS 0D WORKSIZE EQU *-WORKAREA ORG , SPACE 2 ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ** ** DSECTs ** ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ** SPACE 2 CEEDSA Mapping of the Dynamic Save Area CEECAA Mapping of the Common Anchor Area YREGS , END , //XASMLE EXEC CEEWLG,PARM.LKED='LIST,XREF,LET,MAP' //LKED.SYSIN DD DSN=*.ASMLE.C.SYSLIN,DISP=(OLD,DELETE) //LKED.SYSPRINT DD SYSOUT=Z <- non-output //GO.SYSOUT DD SYSOUT=* //ASMLEDEL EXEC PGM=IEFBR14 //DELIT DD DSNAME=&&GOSET,DISP=(OLD,DELETE) //********************************************************************* //*** //** Assembler (HLASM) - Non-LE //*** //********************************************************************* //ASMNLE EXEC HLASMCLG //C.SYSPRINT DD SYSOUT=Z <- non-output //*.STEPLIB DD DISP=SHR,DSN=ASMA.SASMMOD1, //*UNIT=3390,VOL=SER=OSV26C //C.SYSIN DD * TIMEASMN TITLE 'TIMEASMN - Get the current date in Assembler (non-LE)' * * Name: TIMEASMN * * Author: David Alcock * * Written: 2000-02-16 * * Purpose: Shows local and GMT time in Assembler * * Attributes: Non-reentrant, Non-Authorized * * Requirements: HLASM or higher * PRINT NOGEN YREGS , CVT DSECT=YES,LIST=NO PRINT GEN * ** Convert assembly date from format "YYYYMMDD" to "YYYY-MM-DD" * LCLC &ASMDATE &ASMDATE SETC '&SYSDATC'(1,4).'-'.'&SYSDATC'(5,2).'-'.'&SYSDATC'(7,2) EJECT , * ** Standard ESA entry housekeeping * TIMEASM CSECT , BAKR R14,0 Save regs LAE R12,0(R15,0) Get base register USING TIMEASM,R12 Get addressibility * ** Obtain the time via the TIME SVC And format it * TIME DEC STCM R0,B'1111',DOUBLE Save time from TIME macro * UNPK MSG3H(9),DOUBLE(5) > MVZ MSG3H(8),=8X'00' >> Hex convert TR MSG3H(8),=C'0123456789ABCDEF' > MVI MSG3H+8,C' ' Fix *- 01234567 01234567 *-"HHMMSSTH" to "HH:MM:SS" MVC MSG3C(2),MSG3H MVI MSG3C+2,C':' MVC MSG3C+3(2),MSG3H+2 MVI MSG3C+5,C':' MVC MSG3C+6(2),MSG3H+4 * ** Obtain the time via the STCK instruction and format it * STCK STCKCONI Get it *-This system doesn't have the STCKE support in HLASM yet *=====> STCKE STCKCONIE Get it * ** Format the time from the STCK instruction * STCKCONV STCKVAL=STCKCONI, Convert this TOD Stamp @ CONVVAL=STCKCONO, ..Into these date/time areas @ TIMETYPE=DEC, ..Output time format @ DATETYPE=YYYYMMDD, ..Output Date format @ MF=(E,PARMLIST) LTR R15,R15 STCKCONV worked? BNZ E$STCKC Failed, ABEND me * UNPK MSG5H(9),STCKCONO(5) MVZ MSG5H(8),=8X'00' TR MSG5H(8),=C'0123456789ABCDEF' UNPK MSG5H+8(9),STCKCONO+4(5) MVZ MSG5H+8(8),=8X'00' TR MSG5H+8(8),=C'0123456789ABCDEF' MVI MSG5H+16,C' ' * MVC MSG5C(2),MSG5H MVI MSG5C+2,C':' MVC MSG5C+3(2),MSG5H+2 MVI MSG5C+5,C':' MVC MSG5C+6(2),MSG5H+4 * LA R0,2 LA R1,STCKCONI LA R15,MSG5BV F$M5 DS 0H UNPK 0(9,R15),0(5,R1) MVZ 0(8,R15),=8X'00' TR 0(8,R15),=C'0123456789ABCDEF' MVI 8(R15),C' ' LA R1,4(R1) LA R15,9(R15) BCT R0,F$M5 * ** Format the time from the STCKE instruction * *-This system doesn't have the STCKE support in HLASM yet AGO .STCKEX STCKCONV STCKEVAL=STCKCONIE, Convert this TOD Stamp @ CONVVAL=STCKCONO, ..Into these date/time areas @ TIMETYPE=DEC, ..Output time format @ DATETYPE=YYYYMMDD, ..Output Date format @ MF=(E,PARMLIST) LTR R15,R15 STCKCONV worked? BNZ E$STCKC Failed, ABEND me * UNPK MSG6H(9),STCKCONO(5) MVZ MSG6H(8),=8X'00' TR MSG6H(8),=C'0123456789ABCDEF' UNPK MSG6H+8(9),STCKCONO+4(5) MVZ MSG6H+8(8),=8X'00' TR MSG6H+8(8),=C'0123456789ABCDEF' MVI MSG6H+16,C' ' * MVC MSG6C(2),MSG6H MVI MSG6C+2,C':' MVC MSG6C+3(2),MSG6H+2 MVI MSG6C+5,C':' MVC MSG6C+6(2),MSG6H+4 * LA R0,4 LA R1,STCKCONIE LA R15,MSG6BV F$M6 DS 0H UNPK 0(9,R15),0(5,R1) MVZ 0(8,R15),=8X'00' TR 0(8,R15),=C'0123456789ABCDEF' MVI 8(R15),C' ' LA R1,4(R1) LA R15,9(R15) BCT R0,F$M6 .STCKEX ANOP , @#$@#$@#$@#$@#$@#$@#$@#$@#&@#(*$&#@*($&#@$_#$*__ B DAVE BC 12,DAVE BC 12,DAVE * BC 3,DAVE BC 3,DAVE DAVE DS 0H * ** Let's adjust the STCK output for GMT * LM R2,R3,STCKCONI Get STCK output (local time) *-Adapted from SYS1.V2R5M0.SHASSRC(HASCSRIC): L R5,CVTPTR -> CVT L R5,CVTEXT2-CVTMAP(,R5) -> CVT Exxtension LM R14,R15,CVTLDTO-CVTXTNT2(R5) Time zone diff LM R6,R7,CVTLSO-CVTXTNT2(R5) Get leap seconds ALR R3,R15 Add low order time offset BC 12,CG$NOVER Branch if no overflow AL R2,=F'1' Carry the 1 CG$NOVER DS 0H ALR R2,R14 Add high order words SLR R3,R7 Minus low-order leap seconds BC 3,CG$BORRW Branch if no borrow BCTR R2,0 Subtract one for borrow CG$BORRW DS 0H SLR R2,R6 Minus high-order leap seconds STM R2,R3,STCKCONI Save TOD adjusted for GMT * STCKCONV STCKVAL=STCKCONI, Convert this TOD Stamp @ CONVVAL=STCKCONO, ..Into these date/time areas @ TIMETYPE=DEC, ..Output time format @ DATETYPE=YYYYMMDD, ..Output Date format @ MF=(E,PARMLIST) LTR R15,R15 STCKCONV worked? BNZ E$STCKC Failed, ABEND me * UNPK MSG10H(9),STCKCONO(5) MVZ MSG10H(8),=8X'00' TR MSG10H(8),=C'0123456789ABCDEF' UNPK MSG10H+8(9),STCKCONO+4(5) MVZ MSG10H+8(8),=8X'00' TR MSG10H+8(8),=C'0123456789ABCDEF' MVI MSG10H+16,C' ' * MVC MSG10C(2),MSG10H MVI MSG10C+2,C':' MVC MSG10C+3(2),MSG10H+2 MVI MSG10C+5,C':' MVC MSG10C+6(2),MSG10H+4 * LA R0,2 LA R1,STCKCONI LA R15,MSG10BV F$M10 DS 0H UNPK 0(9,R15),0(5,R1) MVZ 0(8,R15),=8X'00' TR 0(8,R15),=C'0123456789ABCDEF' MVI 8(R15),C' ' LA R1,4(R1) LA R15,9(R15) BCT R0,F$M10 * ** Print messages on console * MVC WTOMSG1+4+28(L'MSG3C),MSG3C WTO ,MF=(E,WTOMSG1) MVC WTOMSG2+4+28(L'MSG5C),MSG5C WTO ,MF=(E,WTOMSG2) MVC WTOMSG3+4+28(L'MSG10C),MSG10C WTO ,MF=(E,WTOMSG3) * ** Print messages on SYSPRINT file * OPEN (SYSPRINT,(OUTPUT)) PUT SYSPRINT,MSG1 PUT SYSPRINT,MSG2 Blank line PUT SYSPRINT,MSG3 * PUT SYSPRINT,MSG2 Blank line PUT SYSPRINT,MSG5B PUT SYSPRINT,MSG5 STCK * PUT SYSPRINT,MSG2 Blank line PUT SYSPRINT,MSG10B GMT PUT SYSPRINT,MSG10 GMT * PUT SYSPRINT,MSG2 Blank line PUT SYSPRINT,MSG6B PUT SYSPRINT,MSG6 STCKE * PUT SYSPRINT,MSG2 Blank line PUT SYSPRINT,MSG7 PUT SYSPRINT,MSG8 PUT SYSPRINT,MSG9 PUT SYSPRINT,MSG2 Blank line CLOSE (SYSPRINT) * ** Standard ESA exit housekeeping code * SPACE 2 EXIT DS 0H SLR R15,R15 Set return code PR , Return to caller SPACE 1 * ** Error: a macro failed. ABEND so we can look in dump for clues * E$CONVT ABEND 1,DUMP E$STCKC ABEND 2,DUMP * ** Variables * DOUBLE DS D DOUBLE2 DS D PARMLIST DS 20F DS 0D STCKCONI DS D STCKCONIE DS 2D STCKCONO DS CL16 * CONVTODW DS 0F CT_TIME DS XL4 DS XL4 CT_DATE DS XL4 DS XL4 * MSG1 DC CL80' ' ORG MSG1 Redefine CL80 area DC C'Assembler (Non-LE) --------------------------------' ORG , MSG2 DC CL80' ' MSG3 DC CL80' ' ORG MSG3 Redefine CL80 area DC C'TIME macro returns: ' MSG3H DC C'xxxxxxxx' DC C' - Formatted: ' MSG3C DC C'hh:mm:ss' DC C' (local)' ORG , MSG5 DC CL80' ' ORG MSG5 Redefine CL80 area DC C'STCK - STCKCON macro returns: ' MSG5H DC C'xxxxxxxxyyyyyyyy' DC C' - Formatted: ' MSG5C DC C'hh:mm:ss' DC C' (local)' ORG , MSG5B DC CL80' ' ORG MSG5B Redefine CL80 area DC C'STCK returned: ' MSG5BV DC C'xxxxxxxx xxxxxxxx' DC C' for local time' ORG , MSG6 DC CL80' ' ORG MSG6 Redefine CL80 area DC C'STCKE - STCKCON macro returns: ' MSG6H DC C'xxxxxxxxyyyyyyyy' DC C' - Formatted: ' MSG6C DC C'hh:mm:ss' DC C' (local)' ORG , MSG6B DC CL80' ' ORG MSG6B Redefine CL80 area DC C'STCKE returned: ' MSG6BV DC C'xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx' DC C' for local time' ORG , MSG10 DC CL80' ' ORG MSG10 Redefine CL80 area DC C'STCK - STCKCON macro returns: ' MSG10H DC C'xxxxxxxxyyyyyyyy' DC C' - Formatted: ' MSG10C DC C'hh:mm:ss' DC C' (GMT)' ORG , MSG10B DC CL80' ' ORG MSG10B Redefine CL80 area DC C'STCK converted to: ' MSG10BV DC C'xxxxxxxx xxxxxxxx' DC C' for GMT time' ORG , * MSG7 DC CL80'Environment information:' MSG8 DC CL80'- Date Assembled...........&ASMDATE.' MSG9 DC CL80'- Assembler version........&SYSVER.' * * 0....+....1....+....2....+.... WTOMSG1 WTO 'Assembler (non-LE) returns: hh:mm:ss (via TIME SVC opti@ on - DEC option)',MF=L WTOMSG2 WTO 'Assembler (non-LE) returns: hh:mm:ss (via STCK)', @ MF=L WTOMSG3 WTO 'Assembler (non-LE) returns: hh:mm:ss (after STCK is con@ verted via CVT TimeZone)',MF=L * SYSPRINT DCB DDNAME=SYSPRINT, @ DSORG=PS,MACRF=PM,RECFM=F,LRECL=80 * LTORG , DS 0D TIMEASML EQU *-TIMEASM Trivia about module length END , //L.SYSPRINT DD SYSOUT=Z <- non-output //G.SYSPRINT DD SYSOUT=* //********************************************************************* //*** //** Assemble the sample program to be used by IBM C/C++ to display //** information on the JOB LOG (console). //*** //********************************************************************* //ASMDYNW EXEC PROC=HLASMC,PARM.C='OBJECT,NODECK', // REGION.C=2048K //C.SYSLIB DD DISP=SHR,DSN=CEE.SCEEMAC // DD DSN=SYS1.MACLIB,DISP=SHR //C.SYSPRINT DD SYSOUT=Z <- non-output //C.SYSLIN DD DSN=&&DYNWTO,UNIT=SYSDA,DISP=(,PASS), // SPACE=(CYL,(5,5,0)),DCB=BLKSIZE=800 //C.SYSIN DD * ** Sample code from manual: SC09-2362-00 C/C++ Programming Guide DYNWTO CSECT DYNWTO AMODE 31 DYNWTO RMODE ANY PRINT GEN EDCPRLG ALWAYS INCLUDE C PROLOG L 6,=A(ACTMSG) SET SVC35.ACTMSG TO DYN MSG LA 7,76 LEN(WTO MESSAGE)-SET MAX 76 L 5,0(,1) PARM1 IS LENGTH OF DYN MSG L 5,0(,5) O 5,=X'40000000' 1ST BYTE - PAD CHAR (' ') L 4,4(,1) PARM2 IS DYN MSG ADDR MVCL 6,4 COPY DYNMSG TO SVC35 STRUCT CNOP 0,4 BAL 1,BARNDMSG BRANCH AROUND SVC35 STRUCT DC AL2(80) TEXT LENGTH (76+4) DC B'1000000000000000' MCSFLAGS ACTMSG DC CL76' ' ARBITRARY SIZE OF 76 DC B'0000000000000000' DESCRIPTOR CODES DC B'0100000000000000' ROUTING CODES BARNDMSG DS 0H SVC 35 ISSUE SVC 35 EDCEPIL END //********************************************************************* //*** *** //** IBM C/C++ compiler ** //*** *** //********************************************************************* //IBMCPP EXEC CBCCLG,CPARM='SOURCE,MEMORY,OPTFILE(DD:CCOPT)', // LPARM='AMODE=31,MAP' //COMPILE.SYSIN DD * /* | Name: DATEC/CPP | | Author: David Alcock | | Purpose: Sample C/C++ program that shows the current date with a | a 4 digit year in a few different ways. */ #include #include #ifdef __IBMCPP__ /* IBM C/C++ compiler */ #define os390cpp_idatet 21010 #if (__IBMCPP__ > os390cpp_idatet) #include #include #include #endif #endif /* | The IBM manual has the following #pragma line for the sample dynwto | program which didn't work for me, I got the "extern" thing to work. | | #pragma linkage(dynwto,OS) */ extern "OS" { void dynwto(int, char *); } main() { #ifdef __IBMCPP__ /* IBM C/C++ compiler */ #if (__IBMCPP__ > os390cpp_idatet) IDate Day1; #endif #endif struct tm *newtime; time_t ltime; char TimeStr[100]; time_t theTime; int ConsoleMsgL; char ConsoleMsg[100]; /*------------------------------------------------------------------- | Print starting message ----------------------------------------------------------------- */ printf("C/C++ --------------------------------------------- \n \n"); /*------------------------------------------------------------------- | strftime() - place time and date info into a string ----------------------------------------------------------------- */ time(&theTime); strftime( TimeStr, 100, "%T", localtime(&theTime) ); printf("strftime via option %%T returns: %s \n \n",TimeStr); /*------------------------------------------------------------------- | localtime() ----------------------------------------------------------------- */ time(<ime); newtime = localtime(<ime); printf("localtime() and asctime() returns: %s \n",asctime(newtime)); /*------------------------------------------------------------------- | IDate - Available in IBM C/C++ compiler at OS/390 1.2 and higher ----------------------------------------------------------------- */ #ifdef __IBMCPP__ /* IBM C/C++ compiler */ #if (__IBMCPP__ > os390cpp_idatet) Day1=IDate::today(); cout << "IDate::today() w/asString('%c') returns: " << Day1.asString("%c") << endl; cout << "IDate::today() w/asString('%H:%M:%S') returns: " << Day1.asString("%H:%M:%S") << endl; #endif #endif /*------------------------------------------------------------------- | Display the time on the console | | The IBM-supplied dynwto assembler program is invoked to do this ----------------------------------------------------------------- */ strcpy(ConsoleMsg,"C/C++ returns: "); strcat(ConsoleMsg,TimeStr); strcat(ConsoleMsg," via strftime/%T"); ConsoleMsgL = strlen(ConsoleMsg); dynwto(ConsoleMsgL,ConsoleMsg); /* Invoke DYNWTO assembler prog */ /*------------------------------------------------------------------- | Compiler information ----------------------------------------------------------------- */ printf("\n \n Environment information: \n"); printf("- Date Compiled............%s \n",__DATE__); printf("- Time Compiled............%s \n",__TIME__); #ifdef __IBMCPP__ /* IBM C/C++ compiler */ printf("- Compiler.................%d \n",__IBMCPP__); printf(" PVRRM \n"); #endif /*------------------------------------------------------------------- | The end ----------------------------------------------------------------- */ printf("\n"); return(0); } //COMPILE.SYSPRINT DD SYSOUT=Z <- non-output //COMPILE.SYSOUT DD SYSOUT=Z <- non-output //COMPILE.SYSCPRT DD SYSOUT=Z <- non-output //COMPILE.CCOPT DD * SEARCH('CBC.SCLBH.+','CEE.SCEEH.+') /* //PLKED.SYSPRINT DD SYSOUT=Z <- non-output //PLKED.SYSOUT DD SYSOUT=Z <- non-output //LKED.SYSPRINT DD SYSOUT=Z <- non-output //LKED.SYSIN DD DISP=(OLD,DELETE),DSN=&&DYNWTO //GO.LOADSET DD DISP=(OLD,DELETE),DSN=&&LOADSET //CPPDEL EXEC PGM=IEFBR14 //DELIT DD DSNAME=&&GOSET,DISP=(OLD,DELETE) //********************************************************************* //*** *** //** COBOL for MVS ** //*** *** //********************************************************************* //COBMVS1 EXEC IGYWCLG,REGION=8M,LIBPRFX='CEE' //COBOL.SYSPRINT DD SYSOUT=Z <- non-output //COBOL.SYSIN DD * *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* Identification Division. *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* Program-ID. TIMECOBM. Author. David Alcock . Date Written. Feb 17, 2000. Date Compiled. * This program shows one way of obtaining the current time * using LE/COBOL Environment Division. *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* Data Division. *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* Working-Storage Section. * Current_Date (Gregorian) 01 WS-HHMMSSTH. 05 WS-FT-HH pic 99. 05 WS-FT-MM pic 99. 05 WS-FT-SS pic 99. 05 WS-FT-TH pic 99. * When_Compiled 01 WS-WC-YYYYMMDD pic 9(8). *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* Procedure Division. *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* BEGIN. * Obtain time Accept WS-HHMMSSTH from TIME. Display 'LE/COBOL ---------------------------------------' '---'. Display ' '. Display '"ACCEPT Time" returns: ' WS-HHMMSSTH ' - Formated: ' WS-FT-HH ':' WS-FT-MM ':' WS-FT-SS . Display ' HHMMSSTH'. Display ' '. * Display the time on the console Display 'LE/COBOL returns: ' WS-FT-HH ':' WS-FT-MM ':' WS-FT-SS upon console. * ** Obtain and display the date the program was compiled * Move Function When-Compiled(1:8) to WS-WC-YYYYMMDD. Display ' '. Display ' - - -' . Display ' '. Display 'Environment information:'. Display '- Date Compiled............' WS-WC-YYYYMMDD. Display ' yyyymmdd'. Display ' '. * ** All good things must come to an end * Stop run. //LKED.SYSPRINT DD SYSOUT=Z <- non-output //GO.STEPLIB DD DISP=SHR,DSN=SYS1.SCEERUN //GO.SYSOUT DD SYSOUT=* //GO.SYSDBOUT DD SYSOUT=* //GO.CEEDUMP DD SYSOUT=* //COBMVS1D EXEC PGM=IEFBR14 //DELIT DD DSNAME=&&GOSET,DISP=(OLD,DELETE) //********************************************************************* //*** *** //** PL/I (older one) ** //*** *** //********************************************************************* //PL1 EXEC PLIXCLG, // LKLBDSN='PLI.V2R3M0.PLIBASE' //PLI.SYSPRINT DD SYSOUT=Z <- non-output //PLI.SYSLIN DD DSN=&&LOADSET,DISP=(MOD,PASS),UNIT=SYSDA, // SPACE=(80,(250,100)) //PLI.SYSIN DD * /* Name: TIMEPLI */ /* Author: David Alcock */ /* Purpose: Sample PL/I program to show how to get a 4 digit year. */ /* */ /* PL/I Version 2 Release 3 contains the DATETIME function which */ /* returns YYYYMMDDHHMMSSttt as an atomic command. */ TIMEPLI: PROCEDURE OPTIONS(MAIN) REORDER; DECLARE TOD CHARACTER(17); DECLARE HH CHARACTER(2); DECLARE MM CHARACTER(2); DECLARE SS CHARACTER(2); TOD = DATETIME(); PUT SKIP LIST ('PL/I ---------------------------------------' || '-------'); PUT SKIP LIST (' '); PUT SKIP LIST ('DATETIME() returns: ' || TOD); PUT SKIP LIST (' yyyymmddhhmmssttt'); PUT SKIP LIST (' Date----Time-----'); PUT SKIP LIST (' '); HH = SUBSTR(TOD,9,2); MM = SUBSTR(TOD,11,2); SS = SUBSTR(TOD,13,2); PUT SKIP LIST ('Formated time is ' || HH || ':' || MM || ':' || SS); /* Display the DATETIME() string on the console. */ DISPLAY ('PL/I returns: ' || HH || ':' || MM || ':' || SS); STOP; END; //LKED.SYSLIB DD // DD DISP=SHR,DSN=PLI.V2R3M0.PLIBASE // DD DISP=SHR,DSN=PLI.V2R3M0.SIBMBASE //LKED.SYSPRINT DD SYSOUT=Z <- non-output //GO.SYSPRINT DD SYSOUT=* //GO.PLIDUMP DD SYSOUT=* //PL1DEL EXEC PGM=IEFBR14 //DELIT DD DSNAME=&&GOSET,DISP=(OLD,DELETE) //********************************************************************* //*** *** //** 5688-235 IBM PL/I for MVS & VM ** //*** *** //********************************************************************* //PL1N EXEC IEL1CLG, // LIBPRFX='CEE' //PLI.STEPLIB DD // DD DISP=SHR,DSN=SYS1.SCEERUN //PLI.SYSPRINT DD SYSOUT=Z <- non-output //PLI.SYSLIN DD DSN=&&LOADSET,DISP=(MOD,PASS),UNIT=SYSDA, // SPACE=(80,(250,100)) //PLI.SYSIN DD * /* Name: TIMEPLI */ /* Author: David Alcock */ /* Purpose: Sample PL/I program to show how to get a 4 digit year. */ /* */ /* PL/I Version 2 Release 3 contains the DATETIME function which */ /* returns YYYYMMDDHHMMSSttt as an atomic command. */ TIMEPLI: PROCEDURE OPTIONS(MAIN) REORDER; DECLARE TOD CHARACTER(17); DECLARE HH CHARACTER(2); DECLARE MM CHARACTER(2); DECLARE SS CHARACTER(2); TOD = DATETIME(); PUT SKIP LIST ('PL/I ---------------------------------------' || '-------'); PUT SKIP LIST (' '); PUT SKIP LIST ('DATETIME() returns: ' || TOD); PUT SKIP LIST (' yyyymmddhhmmssttt'); PUT SKIP LIST (' Date----Time-----'); PUT SKIP LIST (' '); HH = SUBSTR(TOD,9,2); MM = SUBSTR(TOD,11,2); SS = SUBSTR(TOD,13,2); PUT SKIP LIST ('Formated time is ' || HH || ':' || MM || ':' || SS); /* Display the DATETIME() string on the console. */ DISPLAY ('PL/I returns: ' || HH || ':' || MM || ':' || SS); STOP; END; //LKED.SYSPRINT DD SYSOUT=Z <- non-output //GO.STEPLIB DD DISP=SHR,DSN=SYS1.SCEERUN //PL1NDEL EXEC PGM=IEFBR14 //DELIT DD DSNAME=&&GOSET,DISP=(OLD,DELETE) //********************************************************************* //*** *** //** CLIST ** //*** *** //********************************************************************* //* //** Create a PDS with our time display CLIST //* //CLISTCPY EXEC PGM=IEBGENER //SYSIN DD DUMMY //SYSPRINT DD SYSOUT=Z <- non-output //SYSUT1 DD * PROC 0 /* Name: TIMECLST */ /* Author: David Alcock */ /* Purpose: Sample CLIST that shows the current time */ CONTROL ASIS WRITE &STR(CLIST----------------------------------------------) WRITE &STR() WRITE &STR(&&SYSTIME returns:) &SYSTIME /* Display the time on the console */ WRITE &str( hh:mm:ss) SEND 'CLIST returns: &SYSTIME userid:' EXIT CODE(0) //SYSUT2 DD DSN=&&CLIST(TIMECLST), // DISP=(,PASS),UNIT=SYSALLDA, // DCB=(LRECL=80,BLKSIZE=8800,RECFM=FB), // SPACE=(TRK,(5,5,5)) //* //** Execute TIMECLST & show the current time //* //CLIST EXEC PGM=IKJEFT01,TIME=1439,DYNAMNBR=100 //SYSPROC DD DISP=(OLD,DELETE),DSN=&&CLIST //SYSTSPRT DD SYSOUT=* //SYSTSIN DD * TIMECLST /* Invoke the TIMECLST CLIST */ /* //********************************************************************* //*** *** //** REXX ** //*** *** //********************************************************************* //* //** Create a PDS with our REXX time display exec //* //REXXCPY EXEC PGM=IEBGENER //SYSIN DD DUMMY //SYSPRINT DD SYSOUT=Z <- non-output //SYSUT1 DD * /* REXX | Name: TIMEREXX | Author: David Alcock | Purpose: Sample Rexx exec that shows the current time | */ say "REXX ----------------------------------------------" say " " say "TIME() returns: "time() say "TIME(C) returns: "time('C') say "TIME(L) returns: "time('L') /*------------------------------------------------------------------- | Display the information on the console ----------------------------------------------------------------- */ "SEND 'REXX returns: "time()" userid:'" /*------------------------------------------------------------------- | TSO information ----------------------------------------------------------------- */ say " " say "Environment information:" say "- SYSTSOE.................."sysvar(systsoe) exit 0 //SYSUT2 DD DSN=&&REXX(TIMEREXX), // DISP=(,PASS),UNIT=SYSALLDA, // DCB=(LRECL=80,BLKSIZE=8800,RECFM=FB), // SPACE=(TRK,(5,5,5)) //* //** Execute TIMEREXX & show the current time //* //REXX EXEC PGM=IKJEFT01,TIME=1439,DYNAMNBR=100 //SYSEXEC DD DISP=(OLD,DELETE),DSN=&&REXX //SYSTSPRT DD SYSOUT=* //SYSTSIN DD * TIMEREXX /* Invoke the TIMEREXX rexx exec */ /* //********************************************************************* //*** *** //** ISPF batch ** //*** *** //********************************************************************* //* //** Create a PDS with our REXX (calling ISPF) time display exec //* //ISPFCPY EXEC PGM=IEBGENER //SYSIN DD DUMMY //SYSPRINT DD SYSOUT=Z <- non-output //SYSUT1 DD * /* REXX | Name: TIMEISPF | Author: David Alcock | Purpose: Sample Rexx exec that shows the current time | using ISPF services. */ say "ISPF (Batch Rexx exec) ----------------------------" say " " address ISPEXEC "vget (ZTIME ZTIMEL ZENVIR)" say "System variable ZTIME returns: "ztime say "System variable ZTIMEL returns: "ztimel address TSO "SEND 'ISPF returns: "ztimel" userid:'" /*------------------------------------------------------------------- | ISPF information ----------------------------------------------------------------- */ say " " say "Environment information:" say "- ZENVIR..................."zenvir /*------------------------------------------------------------------- | The end ----------------------------------------------------------------- */ exit 0 //SYSUT2 DD DSN=&&ISPF(TIMEISPF), // DISP=(,PASS),UNIT=SYSALLDA, // DCB=(LRECL=80,BLKSIZE=8800,RECFM=FB), // SPACE=(TRK,(5,5,5)) //* //** Execute TIMEISPF & show the current time //* //ISPF EXEC PGM=IKJEFT01,TIME=1439,DYNAMNBR=100, // PARM='ISPSTART CMD(%TIMEISPF)' //STEPLIB DD DISP=SHR,DSN=ISP.SISPLOAD //SYSHELP DD DISP=SHR,DSN=SYS1.HELP //SYSIN DD DUMMY //SYSPROC DD DISP=SHR,DSN=ISP.SISPCLIB //SYSEXEC DD DISP=(OLD,DELETE),DSN=&&ISPF // DD DISP=SHR,DSN=ISP.SISPEXEC //*SPLLIB DD DISP=SHR,DSN=ISP.SISPLOAD //* DD DISP=SHR,DSN=ISP.SISPLPA //ISPPLIB DD DISP=SHR,DSN=ISP.SISPPENU //ISPMLIB DD DISP=SHR,DSN=ISP.SISPMENU //*ISPTABL would normally be allocate here and the library would be //* the first entry in the ISPTLIB concatenation //ISPTLIB DD DISP=SHR,DSN=ISP.SISPTENU //ISPSLIB DD DISP=SHR,DSN=ISP.SISPSENU //ISPPROF DD DISP=(,PASS),UNIT=SYSDA,DSN=&&PROF, // DCB=(LRECL=80,BLKSIZE=6320,RECFM=FB), // SPACE=(CYL,(5,0,24)) //ISPCTL1 DD UNIT=VIO,SPACE=(CYL,(1,1)),DISP=NEW, // DCB=(LRECL=80,BLKSIZE=8000,RECFM=FB) //ISPCTL2 DD UNIT=VIO,SPACE=(CYL,(1,1)),DISP=NEW, // DCB=(LRECL=80,BLKSIZE=8000,RECFM=FB) //ISPLST1 DD UNIT=VIO,SPACE=(CYL,(1,1)),DISP=NEW, // DCB=(LRECL=121,BLKSIZE=4840,RECFM=FBA) //ISPLST2 DD UNIT=VIO,SPACE=(CYL,(1,1)),DISP=NEW, // DCB=(LRECL=121,BLKSIZE=4840,RECFM=FBA) //ISPLOG DD SYSOUT=Z, <- non-output // DCB=(LRECL=125,BLKSIZE=129,RECFM=VBA) //* //SYSPRINT DD SYSOUT=Z <- non-output //SYSTERM DD SYSOUT=Z <- non-output //SYSTSPRT DD SYSOUT=* //SYSTSIN DD DUMMY //VDSBYPAS DD DUMMY // // //* Start of dummied ones //********************************************************************* //*** *** //** VS FORTRAN ** //*** *** //********************************************************************* //FORTRAN EXEC VSF2CLG //FORT.SYSPRINT DD SYSOUT=Z <- non-output //FORT.SYSTERM DD SYSOUT=Z <- non-output //FORT.SYSIN DD * @PROCESS FREE !****************************************************************** ! Name: DATEFORT ! Author: David Alcock ! Written: 03-APR-1998 ! Purpose: Show how to get the date in VS FORTRAN using the ! "CALL DATIMX" service subroutine which is in the 8th ! element of the integer array. ! Modified: 27-APR-1998 - David Alcock - Generate a TSO SEND ! command with the current date. The source was changed ! to be "free-format" to allow the continued line. !****************************************************************** INTEGER NOW(14) CALL DATIMX(NOW) WRITE(6,100) WRITE(6,101) WRITE(6,102)NOW(8) WRITE(6,103) WRITE(6,101) 100 FORMAT('VS FORTRAN ----------------------------------------') 101 FORMAT(' ') 102 FORMAT('"CALL DATIMX(now)" returns 4 digit year in arg 8: ',I4) 103 FORMAT(' yyyy') !****************************************************************** ! Since FORTRAN doesn't give is a "DISPLAY UPON CONSOLE"-like ! function, we will create a TSO command with this information ! to be executed in the next step. !****************************************************************** WRITE(7,104)NOW(8) 104 FORMAT('SEND ''FORTRAN returns: ',I4,- ' userid:'' ') END //LKED.SYSPRINT DD SYSOUT=Z <- non-output //GO.FT06F001 DD SYSOUT=*,DCB=(RECFM=FB) //GO.FT07F001 DD DSN=&&FORTRAN, // DISP=(,PASS),UNIT=VIO, // DCB=(LRECL=80,BLKSIZE=8800,RECFM=FB), // SPACE=(TRK,(1,1)) //GO.SYSIN DD * //GO.SYSUDUMP DD SYSOUT=* //* //** This step takes the "SEND" command created from the Fortran step //** above and executes it. //* //FORTJOB EXEC PGM=IKJEFT01,TIME=1,DYNAMNBR=5 //SYSTSPRT DD SYSOUT=Z <- non-output //SYSTSIN DD DISP=(OLD,DELETE),DSN=&&FORTRAN //********************************************************************* //*** *** //** SAS V609 TS455 or higher ** //*** *** //********************************************************************* //SAS EXEC SAS609, // OPTIONS='SVC11SCREEN' <- Tell SAS to Use SVC 11,not STCK //SAS609.SASLOG DD SYSOUT=Z <- non-output //SAS609.SASLIST DD SYSOUT=Z <- non-output //SAS609.SYSOUT DD SYSOUT=* //SAS609.TSOCMD DD DSN=&&SAS, // DISP=(,PASS),UNIT=SYSDA,SPACE=(TRK,(1,1)), // DCB=(LRECL=80,BLKSIZE=8800,RECFM=FB) //SAS609.SYSIN DD * /* -------------------------------------------------------------- */ /* Name: DATESAS */ /* Author: David Alcock */ /* Purpose: Sample SAS programs that show the current date with */ /* a 4 digit year. */ /* -------------------------------------------------------------- */ data _null_; file sysout notitle; today = today() ; put @2 'SAS -----------------------------------------------'; put @2 ' .'; put @2 'today() function returns: '; put @2 '- yymmdd10. ------' today yymmdd10. ; put @2 ' yyyy-mm-dd'; put @2 '- mmddyy10. ------' today mmddyy10. ; put @2 ' mm-dd-yyyy'; put @2 '- year4. ---------' today year4.; put @2 ' yyyy'; put @2 '- yymon7. --------' today yymon7. ; put @2 ' yyyyMMM'; put @2 '- yymmd7. --------' today yymmd7. ; put @2 ' yyyy-mm'; put @2 ' .'; put @2 'Note: date() is an alias for today() and there are many many'; put @2 ' other possible date formats other than the ones shown'; /* -------------------------------------------------------------- */ /* Since SAS doesn't give us a function to send a message to the */ /* Job log, I'm going to create a TSO command to send the SAS */ /* date to the Job log in the next step */ /* -------------------------------------------------------------- */ data _null_; file tsocmd notitle; today = today() ; put @2 'SEND ''SAS returns: ' today yymmdd10. ' userid: '' ' ; //* //** This step takes the "SEND" command created from the SAS step //** above and executes it. //* //SASJOB EXEC PGM=IKJEFT01,TIME=1,DYNAMNBR=5 //SYSTSPRT DD SYSOUT=Z <- non-output //SYSTSIN DD DISP=(OLD,DELETE),DSN=&&SAS //********************************************************************* //*** *** //** EasyTrieve Plus 6.2 or higher ** //*** *** //********************************************************************* //EZTP EXEC PGM=EZTPA00,REGION=4M //*TEPLIB DD DISP=SHR,DSN=SYS3.SYS.EZTP.CAILIB <- Easytrieve 6.2 //MACROS DD DUMMY //SYSIN DD * * * Name: DATEEZTP * * Author: David Alcock * * Written: 07-APR-1998 * * Purpose: Shows how to obtain a 4 digit date in EasyTrieve Plus * * Attributes: Non-reentrant, Non-Authorized * * Requirements: EasyTrieve Plus 6.2 or higher * FILE SYSOUT VB(80 84) FILE TSOCMD VB(80 84) DEFINE TODAY W 11 A JOB INPUT NULL TODAY = SYSDATE-LONG DISPLAY SYSOUT 'EasyTrieve ----------------------------------------' DISPLAY SYSOUT ' ' DISPLAY SYSOUT 'SYSDATE-LONG returns:' TODAY DISPLAY SYSOUT ' mm/dd/yyyy' DISPLAY SYSOUT ' ' * ** For some bizare reason, I have to put some garbage ("xxxxxx") ** at the start of the record sent to the TSO step below. ** ** Do you need it on your system? * DISPLAY TSOCMD 'xxxxxx SEND ''Easytrieve returns: ' + SYSDATE-LONG ' userid: '' ' STOP //SYSPRINT DD SYSOUT=Z <- non-output //SYSOUT DD SYSOUT=*,DCB=(LRECL=80,BLKSIZE=84,RECFM=VB) //TSOCMD DD DSN=&&EZTP, // DISP=(,PASS),UNIT=SYSDA,SPACE=(TRK,(1,1)), // DCB=(LRECL=80,BLKSIZE=84,RECFM=VB) //* //** This step takes the "SEND" command created from the EasyTrieve //** step above and executes it. //* //EZTPJOB EXEC PGM=IKJEFT01,TIME=1,DYNAMNBR=5 //SYSTSPRT DD SYSOUT=Z <- non-output //SYSTSIN DD DISP=(OLD,DELETE),DSN=&&EZTP // //