VIEWMFFC
来源：互联网 发布：cydia 网络超时 编辑：程序博客网 时间：2024/05/16 19:34
/**************************************************************/
/* PROGRAM ID : VIEWMFFC */
/* PURPOSE : VIEW MAINFRAME FILE ACCORDING TO COPYBOOK */
/* CALLED BY : */
/* CALLING : CBL2DDS */
/* DATE : JUL/27/2004 */
/* WRITTEN : GRACE.GUO RON.YANG */
/* */
/* CODE DATE(YYMD) REASON */
/* ------- ---------- ------------------------------------*/
/* JZ01 05/01/15 HANDLE SELECTING RECORD RANGE */
/* FIX BUG */
/**************************************************************/
/*JZ01 PGM PARM(&FILE &LIB &MBR &CPYBKMBR &CPYBKFILE +
&CPYBKLIB) */
/*JZ01*/ PGM PARM(&FILE &LIB &MBR &CPYBKMBR &CPYBKFILE +
&CPYBKLIB &FROMRCDBIN &TORCDBIN)
DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MBR) TYPE(*CHAR) LEN(10)
DCL VAR(&CPYBKMBR) TYPE(*CHAR) LEN(10)
DCL VAR(&CPYBKFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&CPYBKLIB) TYPE(*CHAR) LEN(10)
/*JZ01*/ DCL VAR(&FROMRCDCHR) TYPE(*CHAR) LEN(10)
/*JZ01*/ DCL VAR(&TORCDCHR) TYPE(*CHAR) LEN(10)
/*JZ01*/ DCL VAR(&FROMRCDDEC) TYPE(*DEC) LEN(15)
/*JZ01*/ DCL VAR(&TORCDDEC) TYPE(*DEC) LEN(15)
/*JZ01*/ DCL VAR(&FROMRCDBIN) TYPE(*CHAR) LEN(4)
/*JZ01*/ DCL VAR(&TORCDBIN) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGMBR) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGLIB) TYPE(*CHAR) LEN(10)
/*JZ01*/ DCL VAR(&MSGTXT) TYPE(*CHAR) LEN(3000)
/*JZ01*/ DCL VAR(&RCD#) TYPE(*DEC) LEN(10 0)
/*JZ01*/ CHGVAR VAR(&FROMRCDDEC) VALUE(%BIN(&FROMRCDBIN))
/*JZ01*/ CHGVAR VAR(&TORCDDEC) VALUE(%BIN(&TORCDBIN))
/*JZ01*/ CHGVAR VAR(&FROMRCDCHR) VALUE(&FROMRCDDEC)
/*JZ01*/ IF COND(&TORCDDEC *EQ -1) THEN(DO)
/*JZ01*/ CHGVAR VAR(&TORCDCHR) VALUE('*END')
/*JZ01*/ ENDDO
/*JZ01*/ ELSE CMD(DO)
/*JZ01*/ CHGVAR VAR(&TORCDCHR) VALUE(&TORCDDEC)
/*JZ01*/ ENDDO
/*JZ01*/ RTVMBRD FILE(&LIB/&FILE) NBRCURRCD(&RCD#)
/*JZ01*/ IF COND(&TORCDDEC *EQ -1) THEN(DO)
/*JZ01*/ CHGVAR VAR(&TORCDDEC) VALUE(&RCD#)
/*JZ01*/ ENDDO
/*JZ01*/ CHGVAR VAR(&RCD#) VALUE(&TORCDDEC - &FROMRCDDEC)
/*JZ01*/ IF COND((&RCD# *GE 100000) *OR +
(&RCD# *LE 0)) THEN(DO)
/*JZ01*/ SNDPGMMSG MSG('SELECTED RECORDS ARE GREATE THAN 99999 +
OR LESS THAN 1')
/*JZ01*/ GOTO CMDLBL(#ENDP)
/*JZ01*/ ENDDO
/*JZ01*/ DLTF FILE(QTEMP/&FILE)
/*JZ01*/ MONMSG MSGID(CPF2105) EXEC(GOTO CMDLBL(#NEXT))
/*JZ01*/ MONMSG MSGID(CPF0601 CPF2114 CPF2189 CPF3203) +
EXEC(DO)
/*JZ01*/ SNDPGMMSG MSG('DELETE QTEMP FILE ERROR !')
/*JZ01*/ GOTO CMDLBL(#ENDP)
/*JZ01*/ ENDDO
/*JZ01*/ #NEXT: DLTF FILE(QTEMP/CPY2DDS)
/*JZ01*/ MONMSG MSGID(CPF2105) EXEC(GOTO CMDLBL(#NEXT1))
/*JZ01*/ MONMSG MSGID(CPF0601 CPF2114 CPF2189 CPF3203) +
EXEC(DO)
/*JZ01*/ SNDPGMMSG MSG('DELETE QTEMP/CPY2DDS ERROR !')
/*JZ01*/ GOTO CMDLBL(#ENDP)
/*JZ01*/ ENDDO
/*JZ01*/ #NEXT1:
/*CHECK COPY BOOK MEMBER, NOT EQUAL *BLANL */
/* IF COND(&CPYBKMBR *EQ ' ') THEN(DO) */
/* SNDPGMMSG MSG('COPY BOOK MEMBER NOT ALLOWED EMPTY!') */
/* GOTO CMDLBL(#ENDP) */
/* ENDDO */
/*CHECK MEMBER MUST BE EXIST */
CHGVAR VAR(&MSGMBR) VALUE(&MBR)
CHGVAR VAR(&MSGFILE) VALUE(&FILE)
CHGVAR VAR(&MSGLIB) VALUE(&LIB)
CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(&MBR)
MONMSG MSGID(CPF9801) EXEC(DO)
GOTO CMDLBL(#MSG9801)
ENDDO
MONMSG MSGID(CPF9802) EXEC(DO)
GOTO CMDLBL(#MSG9802)
ENDDO
MONMSG MSGID(CPF9810) EXEC(DO)
GOTO CMDLBL(#MSG9810)
ENDDO
MONMSG MSGID(CPF9815) EXEC(DO)
GOTO CMDLBL(#MSG9815)
ENDDO
MONMSG MSGID(CPF9820) EXEC(DO)
GOTO CMDLBL(#MSG9820)
ENDDO
MONMSG MSGID(CPF9830) EXEC(DO)
GOTO CMDLBL(#MSG9830)
ENDDO
MONMSG MSGID(CPF9899) EXEC(DO)
GOTO CMDLBL(#MSG9899)
ENDDO
/*CHECK COPY BOOK MEMBER: MUST EXIST, UNLESS EQ 'DUMMY' */
IF COND(&CPYBKMBR *NE 'DUMMY') THEN(DO)
CHGVAR VAR(&MSGMBR) VALUE(&CPYBKMBR)
CHGVAR VAR(&MSGFILE) VALUE(&CPYBKFILE)
CHGVAR VAR(&MSGLIB) VALUE(&CPYBKLIB)
CHKOBJ OBJ(&CPYBKLIB/&CPYBKFILE) OBJTYPE(*FILE) +
MBR(&CPYBKMBR)
MONMSG MSGID(CPF9801) EXEC(DO)
GOTO CMDLBL(#MSG9801)
ENDDO
MONMSG MSGID(CPF9802) EXEC(DO)
GOTO CMDLBL(#MSG9802)
ENDDO
MONMSG MSGID(CPF9810) EXEC(DO)
GOTO CMDLBL(#MSG9810)
ENDDO
MONMSG MSGID(CPF9815) EXEC(DO)
GOTO CMDLBL(#MSG9815)
ENDDO
MONMSG MSGID(CPF9820) EXEC(DO)
GOTO CMDLBL(#MSG9820)
ENDDO
MONMSG MSGID(CPF9830) EXEC(DO)
GOTO CMDLBL(#MSG9830)
ENDDO
MONMSG MSGID(CPF9899) EXEC(DO)
GOTO CMDLBL(#MSG9899)
ENDDO
ENDDO
OVRDBF FILE(MFFILE) TOFILE(&LIB/&FILE) +
MBR(&MBR)
/* IF COPY BOOK MEMBER = 'DUMMY', THEN NO COPY BOOK EXIST */
IF COND(&CPYBKMBR *EQ 'DUMMY') THEN(DO)
/*JZ01 CPYF FROMFILE(MFFILE) TOFILE(QTEMP/&FILE) +
TOMBR(&MBR) CRTFILE(*YES) */
/*JZ01*/ CPYF FROMFILE(MFFILE) TOFILE(QTEMP/&FILE) +
TOMBR(&MBR) CRTFILE(*YES) +
FROMRCD(&FROMRCDCHR) TORCD(&TORCDCHR)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSG('COPY FILE' *BCAT &FILE *BCAT +
'TO QTEMP FAILED!')
GOTO CMDLBL(#ENDJOB)
ENDDO
ENDDO
/* ELSE COPY FILE TO QTEMP ACCORDING TO DDS */
ELSE DO
/* CREATE SOURCE FILE IN QTEMP */
CRTSRCPF FILE(QTEMP/CPY2DDS) RCDLEN(112)
MONMSG MSGID(CPF0000) EXEC(DO)
/* SNDPGMMSG MSG('CREATE SRC_PF CPY2DDS IN QTEMP FAILED') */
/* GOTO CMDLBL(#ENDJOB) */
ENDDO
/* CALL PGM TO CONVERT COPYBOOK TO DDS */
/*JZ01*/ RMVMSG CLEAR(*ALL)
/*JZ01*/ CHGVAR VAR(&MSGTXT) VALUE(' ')
CBL2DDS INMBR(&CPYBKMBR) INFILE(&CPYBKFILE) +
INLIB(&CPYBKLIB) +
OUTMBR(&CPYBKMBR) OUTFILE(CPY2DDS) +
OUTLIB(QTEMP) +
REPLACE(Y)
/*JZ01*/ RCVMSG MSGTYPE(*PRV) MSGKEY(*TOP) MSG(&MSGTXT)
/*JZ01*/ IF COND(&MSGTXT *NE ' ') THEN(DO)
/*JZ01 MONMSG MSGID(CPF0000) EXEC(DO) */
SNDPGMMSG MSG('COMMAND CBL2DDS FAILED!')
SNDPGMMSG MSG('CONVERT COPYBOOK TO DDS FAILED!')
GOTO CMDLBL(#ENDJOB)
ENDDO
/* RETRIVE THE MEMBER NAME OF BROWSED FILE. IF *FIRST */
IF COND(&MBR *EQ '*FIRST') THEN(DO)
RTVMBRD FILE(&LIB/&FILE) MBR(&MBR) +
RTNMBR(&MBR)
ENDDO
CRTPF FILE(QTEMP/&FILE) SRCFILE(QTEMP/CPY2DDS) +
SRCMBR(&CPYBKMBR) MBR(&MBR)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSG('CREATE PF ' *BCAT &FILE *CAT '/' +
*CAT &MBR *BCAT 'IN QTEMP FAILED!')
GOTO CMDLBL(#ENDJOB)
ENDDO
/* COPY FLAT FILE'D DATA TO NEW CREATED PF */
/*JZ01 CPYF FROMFILE(MFFILE) TOFILE(QTEMP/&FILE) +
MBROPT(*REPLACE) FMTOPT(*NOCHK) */
/*JZ01*/ CPYF FROMFILE(MFFILE) TOFILE(QTEMP/&FILE) +
MBROPT(*REPLACE) FROMRCD(&FROMRCDCHR) +
TORCD(&TORCDCHR) FMTOPT(*NOCHK)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSG('COPY FILE' *BCAT &FILE *BCAT +
'TO QTEMP FAILED!')
GOTO CMDLBL(#ENDJOB)
ENDDO
ENDDO
/* RUN QUERY TO BROWSE THE DATA */
/* RUNQRY QRY(*NONE) QRYFILE((QTEMP/&FILE)) */
/* START DBU UTILITIES */
DBU FILE(QTEMP/&FILE) DBUTYP(*FILE) MBR(&MBR)
GOTO CMDLBL(#ENDJOB)
/* PROCESSING DISPLAY MESSAGE OF CHECKING OBJECT */
#MSG9801: SNDPGMMSG MSG('OBJECT' *BCAT &MSGFILE *BCAT +
'IN LIBRARY' *BCAT &MSGLIB *BCAT 'NOT FOUND!')
GOTO CMDLBL(#ENDP)
#MSG9802: SNDPGMMSG MSG('NOT AUTHORIZED TO OBJECT' +
*BCAT &MSGFILE *BCAT 'IN' *BCAT &MSGLIB *BCAT +
'!')
GOTO CMDLBL(#ENDP)
#MSG9810: SNDPGMMSG MSG('LIBRARY' *BCAT &MSGLIB *BCAT 'NOT FOUND!')
GOTO CMDLBL(#ENDP)
#MSG9815: SNDPGMMSG MSG('MEMBER' *BCAT &MSGMBR *BCAT 'FILE' *BCAT +
&MSGFILE *BCAT 'IN LIBRARY' *BCAT &MSGLIB +
*BCAT 'NOT FOUND!')
GOTO CMDLBL(#ENDP)
#MSG9820: SNDPGMMSG MSG('NOT AUTHORIZED TO USE LIBRARY' +
*BCAT &MSGLIB *BCAT '!')
GOTO CMDLBL(#ENDP)
#MSG9830: SNDPGMMSG MSG('CANNOT ASSIGN LIBRARY' +
*BCAT &MSGLIB *BCAT '!')
GOTO CMDLBL(#ENDP)
#MSG9899: SNDPGMMSG MSG('ERROR OCCURRED DURING PROCESSING OF +
COMMAND!')
GOTO CMDLBL(#ENDP)
#ENDJOB: DLTOVR FILE(MFFILE)
/*JZ01*/ MONMSG MSGID(CPF0000)
DLTF FILE(QTEMP/&FILE)
/*JZ01*/ MONMSG MSGID(CPF0000)
IF COND(&CPYBKMBR *NE 'DUMMY') THEN(DO)
DLTF FILE(QTEMP/CPY2DDS)
/*JZ01*/ MONMSG MSGID(CPF0000)
ENDDO
#ENDP: ENDPGM
