DDMCL.CLLE
000100161214/***************LICENSE AND DISCLAIMER*****************************************/
000101161214/* This material contains IBM copyrighted sample programming source code. */
000102161214/* IBM grants you a nonexclusive license to use, execute, display, */
000103161214/* reproduce, distribute and prepare derivative works of this sample code. */
000104161214/* The sample code has not been thoroughly tested under all conditions. IBM, */
000105161214/* therefore, does not warrant or guarantee its reliability, serviceablity, */
000106161214/* or function. All sample code contained herein is provided to you "AS IS." */
000107161214/* ALL IMPLIED WARRANTIES, INCLUDING BUT NOT LIMITED TO THE IMPLIED */
000108161214/* WARRANTIES OF MERCHANTABILLITY AND FITNESS FOR A PARTICULAR PURPOSE, */
000109161214/* ARE EXPRESSLY DISCLAIMED. */
000110161214/* */
000111161214/* make sure to run this before compiling - CRTPF FILE(QTEMP/DDM1) RCDLEN(133)*/
000112161214
000113161214
000114161214 PGM PARM(&LIBNAM)
000115161214 DCL VAR(&LIBNAM) TYPE(*CHAR) LEN(10)
000116161214 DCL VAR(&COUNT) TYPE(*char) LEN(11)
000117161214 DCL VAR(&SNA) TYPE(*CHAR) LEN(37) VALUE('Type . . . . . . . . . . . . : +
000118161214 *SNA')
000119161214 DCL &MSGDTA *CHAR 132 /* Message Data */
000120161214 DCL &MSGF *CHAR 10 /* Message File */
000121161214 DCL &MSGFLIB *CHAR 10 /* Message File Library */
000122161214 DCL &MSGID *CHAR 7 /* ID of any Error Msg rcvd. */
000123161214
000124161214 DCLF FILE(QSYS/QADSPOBJ) RCDFMT(*ALL) OPNID(DSPJOB)
000125161214 DCLF FILE(QTEMP/DDM1) RCDFMT(*ALL) OPNID(DDM1)
000126161214
000127161214 MONMSG CPF0000 EXEC(GOTO Error)
000128161214 CHKOBJ OBJ(QSYS/&LIBNAM) OBJTYPE(*LIB)
000129161214 MONMSG MSGID(CPF9801) CMPDTA(*NONE) EXEC(GOTO ERR)
000130161214
000131161214 DLTF FILE(QTEMP/ddm1)
000132161214 MONMSG MSGID(CPF0000)
000133161214 CRTPF FILE(QTEMP/DDM1) RCDLEN(133)
000134161214
000135161214 DLTF FILE(QTEMP/QADSPOBJ)
000136161214 MONMSG MSGID(CPF0000)
000137161214
000138161214 DSPOBJD OBJ(&LIBNAM/*ALL) OBJTYPE(*FILE) DETAIL(*SERVICE) OUTPUT(*OUTFILE) +
000139161214 OUTFILE(QTEMP/QADSPOBJ)
000140161214 OVRDBF FILE(QADSPOBJ) TOFILE(QTEMP/QADSPOBJ)
000141161214/* REXX script queries outfile */
000142161214/* and counts the number of records that will be processed */
000143161214/* REXX cannot pass back parm values - using LDA to store the the SQL count */
000144161214 STRREXPRC SRCMBR(REXDDMX) SRCFILE(BIMBRA/QREXSRC)
000145161214 RTVDTAARA DTAARA(*LDA (1 11)) RTNVAR(&COUNT)
000146161214 CHGVAR VAR(&COUNT) VALUE(%TRIML(&COUNT ' +'))
000147161214 SNDPGMMSG MSG('Total number of ddm files to process:' *BCAT &COUNT)
000148161214
000149161214 READ: RCVF DEV(*FILE) OPNID(DSPJOB) /* Read entire file */
000150161214 MONMSG MSGID(CPF0864) EXEC(GOTO EOJ) /* EOF - exit */
000151161214
000152161214 IF COND(&DSPJOB_ODOBAT = 'DDMF ') THEN(DO)
000153161214 DSPDDMF FILE(&LIBNAM/&DSPJOB_ODOBNM) OUTPUT(*PRINT)
000154161214 CPYSPLF FILE(QPDSPDDM) TOFILE(QTEMP/DDM1) SPLNBR(*LAST) +
000155161214 JOBSYSNAME(*CURRENT) CRTDATE(*LAST) MBROPT(*REPLACE) +
000156161214 CTLCHAR(*NONE)
000157161214 DLTSPLF FILE(QPDSPDDM) SPLNBR(*LAST) JOBSYSNAME(*CURRENT) CRTDATE(*ONLY)
000158161214 READDDM: RCVF DEV(*FILE) OPNID(DDM1)
000159161214 MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EOJDDM)) /* EOF - exit */
000160161214 IF COND(%SST(&DDM1_DDM1 9 37) *EQ &SNA) THEN(DO)
000161161214 CHGDDMF FILE(&LIBNAM/&DSPJOB_ODOBNM) RMTLOCNAME(*SAME *IP)
000162161214 SNDPGMMSG MSG('Switched SNA to IP for file ' *cat &DSPJOB_ODOBNM)
000163161214 ENDDO
000164161214 GOTO CMDLBL(READDDM)
000165161214
000166161214 EOJDDM: CLOSE OPNID(DDM1)
000167161214 ENDDO
000168161214 GOTO CMDLBL(READ)
000169161214 EOJ: RETURN /* Normal End-of-Job */
000170161214 ERR: SNDPGMMSG MSG('Library not found:' *CAT &LIBNAM)
000171161214 ERROR: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
000172161214 MSGFLIB(&MSGFLIB)
000173161214 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
000174161214 ENDPGM
REXDDM.REXX
000100161213T = 0
000200150430ADDRESS EXECSQL
000300150501Execsql "set option commit=*none, naming=*sys;"
000400161209MyStmt1 = "SELECT count(ODOBAT) FROM qtemp.QADSPOBJ WHERE ODOBAT = 'DDMF'"
000500150501Execsql "declare c1 cursor for s2;"
000600150501Execsql "prepare s2 from :MyStmt1;"
000700150501Execsql "open c1;"
000800161209Execsql "fetch c1 into :T;"
000900150501Execsql "close c1;"
001000161209ADDRESS '*COMMAND'
001100161213'CHGDTAARA DTAARA(*LDA (1 11)) VALUE(&T)'
001200150430EXIT
沒有留言:
張貼留言