|
the following is source:
/* TAATAPD - Check Save Tape - CHKSAVTAP */
/*PARMS PGM(TAATAPDC) PRDLIB(TAATOOL) */
/* */
/* The Check Save Tape command performs a read of a tape , */
/* created by a save command. Nothing is done with the data. */
/* The command acts only as a sanity check to help determine */
/* if the tape is still usable. Note that a successful */
/* completion will not ensure that the tape can be restored */
/* properly. It only ensures that the tape can be read. */
/* */
/* The CPP is TAATAPDC. */
/* */
CMD PROMPT('Check Save Tape - TAA')
PARM KWD(DEV) TYPE(*NAME) LEN(10) +
MIN(1) EXPR(*YES) PROMPT('Device')
PARM KWD(PRTSUM) TYPE(*CHAR) LEN(4) DFT(*NO) +
RSTD(*YES) VALUES('*YES' '*NO') +
PROMPT('Printed summary')
PARM KWD(INQMSG) TYPE(*CHAR) LEN(4) DFT(*YES) +
RSTD(*YES) VALUES('*YES' '*NO') +
PROMPT('Inquiry msg if not 1st tape')
/* TAATAPDC - CPP for CHKSAVTAP - Check save tape */
PGM PARM(&DEV &PRTSUM &INQMSG)
DCL &DEV *CHAR LEN(10)
DCL &PRTSUM *CHAR LEN(4)
DCL &INQMSG *CHAR LEN(4)
DCL &INQMSGRPY *CHAR LEN(10)
DCL &LABEL *CHAR LEN(17)
DCL &VOLID *CHAR LEN(6)
DCL &KEYVAR *CHAR LEN(4)
DCL &COUNT *DEC LEN(5 0)
DCL &COUNTA *CHAR LEN(22)
DCL &FILENBR *CHAR LEN(1) VALUE('1')
DCL &SEQNBRA *CHAR LEN(10)
DCL &SYSNAM *CHAR LEN(8)
DCL &RQSCDE *CHAR LEN(8)
DCL &ERRORSW *LGL /* Standard error */
DCL &MSGID *CHAR LEN(7) /* Standard error */
DCL &MSG *CHAR LEN(512) /* Standard error */
DCL &MSGDTA *CHAR LEN(512) /* Standard error */
DCL &MSGF *CHAR LEN(10) /* Standard error */
DCL &MSGFLIB *CHAR LEN(10) /* Standard error */
DCL &KEYVAR *CHAR LEN(4) /* Standard error */
DCL &KEYVAR2 *CHAR LEN(4) /* Standard error */
DCL &RTNTYPE *CHAR LEN(2) /* Standard error */
MONMSG MSGID(CPF0000) EXEC(GOTO STDERR1) /* Std err */
/* Create a dummy file in QTEMP which is */
/* used to allow CPYF to think it is */
/* performing a real copy. */
DLTF FILE(QTEMP/QTTCPYDST)
MONMSG MSGID(CPF2105) EXEC(DO) /* No file */
CRTPF FILE(QTEMP/QTTCPYDST) RCDLEN(32760)
ENDDO /* No file */
RTVJOBA INQMSGRPY(&INQMSGRPY)
RMVMSG CLEAR(*ALL)
RTVNETA SYSNAME(&SYSNAM)
CHGVAR &SEQNBRA '*FIRST'
CHKTAP: /* Check next tape label */
/* If INQMSG(*NO) was specified, no message */
/* should occur if the tape mounted is */
/* not the first volume. */
/* To achieve this, the message CPA4034 */
/* is duped into TAAMSGF in TAATOOL and */
/* the default is set to I = Ignore. */
/* For the first file read from the tape, */
/* an OVRMSGF is used to point to TAAMSGF */
/* and the system reply list is set to */
/* default. */
/* For the 2nd file, the defaults are put */
/* back (The old INQMSGRPY is returned */
/* and the OVR is deleted). */
IF (&INQMSG *EQ '*NO') DO /* No inquiry message */
IF (&FILENBR *EQ '2') DO /* Second tape file */
CHGJOB INQMSGRPY(&INQMSGRPY)
DLTOVR FILE(QCPFMSG)
CHGVAR &FILENBR '3'
ENDDO /* Second tape file */
IF (&FILENBR *EQ '1') DO /* First file on tape */
OVRMSGF MSGF(QCPFMSG) TOMSGF(TAATOOL/TAAMSGF)
CHGJOB INQMSGRPY(*DFT)
CHGVAR &FILENBR '2'
ENDDO /* First file on tape */
ENDDO /* No inquiry message */
/* Check tape for sequence number */
CHKTAP DEV(&DEV) SEQNBR(&SEQNBRA) ENDOPT(*LEAVE)
MONMSG MSGID(CPF6734) EXEC(GOTO ENDTAPE)
/* Receive the completion message and */
/* extract the file label ID and Seq nbr. */
RCVMSG: RCVMSG PGMQ(*SAME) MSGTYPE(*COMP) +
RMV(*NO) KEYVAR(&KEYVAR) MSGDTA(&MSGDTA) +
MSGID(&MSGID)
IF (&MSGID *EQ 'CPC6779') DO /* CHKTAP msg */
CHGVAR &LABEL %SST(&MSGDTA 27 17)
CHGVAR &VOLID %SST(&MSGDTA 11 6)
CHGVAR &SEQNBRA %SST(&MSGDTA 17 10)
RMVMSG MSGKEY(&KEYVAR)
GOTO OVRTAPF
ENDDO /* CHKTAP msg */
IF (&MSGID *NE ' ') GOTO RCVMSG
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGTYPE(*ESCAPE) +
MSGDTA('The CPC6779 completion message +
could not be found from CHKTAP')
OVRTAPF: OVRTAPF FILE(QTAPE) DEV(&DEV) +
VOL(*NONE) REELS(*SL) SEQNBR(&SEQNBRA) +
RCDLEN(*CALC) BLKLEN(*CALC) RCDBLKFMT(*U) +
ENDOPT(*LEAVE) SECURE(*YES)
OVRDBF FILE(QTTCPYDST) +
TOFILE(QTEMP/QTTCPYDST) SECURE(*YES)
CPYF FROMFILE(QTAPE) +
TOFILE(QTTCPYDST) MBROPT(*REPLACE) +
FROMRCD(999999999)
/* Eliminate excess messages in job log */
RCV2: RCVMSG PGMQ(*SAME) MSGTYPE(*INFO) RMV(*NO) +
KEYVAR(&KEYVAR) MSGID(&MSGID)
IF (&MSGID *EQ ' ') DO /* No CPF2993 */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGTYPE(*ESCAPE) +
MSGDTA('The CPF2993 information message +
could not be found')
ENDDO /* No CPF2993 */
IF (&MSGID *NE 'CPF2993') GOTO RCV2
RMVMSG MSGKEY(&KEYVAR)
RCV3: RCVMSG PGMQ(*SAME) MSGTYPE(*COMP) RMV(*NO) +
KEYVAR(&KEYVAR) MSGID(&MSGID)
IF (&MSGID *EQ ' ') DO /* No CPC2957 */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGTYPE(*ESCAPE) +
MSGDTA('The CPC2957 completion message +
could not be found')
ENDDO /* No CPC2957 */
IF (&MSGID *NE 'CPC2957') GOTO RCV3
RMVMSG MSGKEY(&KEYVAR)
/* Count for final message */
CHGVAR &COUNT (&COUNT + 1)
CHGVAR &MSG ('Label ' *CAT &LABEL *TCAT ' found on +
volume ' *CAT &VOLID *TCAT +
' at sequence ' *CAT &SEQNBRA)
/* Send message to job log if PRTSUM(*NO) */
IF (&PRTSUM *EQ '*NO') DO /* No summary */
SNDPGMMSG MSG(&MSG)
ENDDO /* No summary */
/* Always send as a status message */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) TOPGMQ(*EXT) +
MSGDTA(&MSG) MSGTYPE(*STATUS)
IF (&PRTSUM *EQ '*YES') DO /* Print summary */
CHGVAR &RQSCDE 'DETAIL'
OVRPRTF FILE(QPRINT) USRDTA(CHKSAVTAP) +
SPLFNAME(TAPEFILES) SECURE(*YES)
CALL PGM(TAATAPDR) PARM(&RQSCDE &LABEL &VOLID +
&SEQNBRA &SYSNAM)
ENDDO /* Print summary */
CHGVAR &SEQNBRA '*NEXT'
GOTO CHKTAP /* Loop back for next file */
ENDTAPE: /* All files have been read */
/* Clear escape message */
RCVMSG MSGTYPE(*EXCP)
CHKTAP DEV(&DEV) ENDOPT(*REWIND)
IF (&PRTSUM *EQ '*YES') DO /* Print summary */
CHGVAR &RQSCDE 'FINAL'
CALL PGM(TAATAPDR) PARM(&RQSCDE &LABEL &VOLID +
&SEQNBRA &SYSNAM)
ENDDO /* Print summary */
/* Send summary message and return */
EDTVAR CHROUT(&COUNTA) NUMINP(&COUNT)
DLTF FILE(QTEMP/QTTCPYDST)
IF (&PRTSUM *EQ '*NO') DO /* Simple msg */
SNDPGMMSG MSG('CHKSAVTAP completed normally with ' +
*CAT &COUNTA *TCAT ' files read.') +
MSGTYPE(*COMP)
ENDDO /* Simple msg */
IF (&PRTSUM *EQ '*YES') DO /* Complex msg */
SNDPGMMSG MSG('CHKSAVTAP completed normally with ' +
*CAT &COUNTA *TCAT ' files read. +
Output to spooled file TAPEFILES.') +
MSGTYPE(*COMP)
ENDDO /* Complex msg */
RMVMSG CLEAR(*ALL)
RETURN /* Normal end of program */
STDERR1: /* Standard error handling routine */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
CHGVAR &ERRORSW '1' /* Set to fail on error */
RCVMSG MSGTYPE(*EXCP) RMV(*NO) KEYVAR(&KEYVAR)
STDERR2: RCVMSG MSGTYPE(*PRV) MSGKEY(&KEYVAR) RMV(*NO) +
KEYVAR(&KEYVAR2) MSG(&MSG) +
MSGDTA(&MSGDTA) MSGID(&MSGID) +
RTNTYPE(&RTNTYPE) MSGF(&MSGF) +
SNDMSGFLIB(&MSGFLIB)
IF (&RTNTYPE *NE '02') GOTO STDERR3
IF (&MSGID *NE ' ') SNDPGMMSG +
MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
IF (&MSGID *EQ ' ') SNDPGMMSG +
MSG(&MSG) MSGTYPE(*DIAG)
RMVMSG MSGKEY(&KEYVAR2)
STDERR3: RCVMSG MSGKEY(&KEYVAR) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) +
SNDMSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM
: D.BALE@handleman.com [mailto:D.BALE@handleman.com]
: 2001/02/13 AM 04:04
: MIDRANGE-L@midrange.com
: CHKSAVTAP - Urgent!!
This is an URGENT request.
Does anyone have the v3r1 version of CHKSAVTAP? If so, would they be willing
to send me the source code for it? If you can, please (obviously) send it
directly to me at D.Bale@Handleman.com
This is intended to run on our V4R4 box, although I have a V3R2 box with the
QUSRTOOL library on it, IBM stripped it of most of the useful tools in V3R2
and we haven't been able to locate our copy of the V3R1 backup, if we even
still have it.
TIA!
Dan Bale
IT - AS/400
Handleman Company
248-362-4400 Ext. 4952
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
