Эбберс М. Введение в современные мейнфреймы: основы z/OS
Подождите немного. Документ загружается.
Программа COBOL-CICS-DB2
Исходный код
Определение карты
Это определение находится в разделе TMAP01 библиотеки LUISM.TEST.SAMPLIB.
PRINT NOGEN
TMAPSET DFHMSD TYPE=&SYSPARM, x
LANG=COBOL, x
MODE=INOUT, x
TERM=3270-2, x
CTRL=FREEKB, x
STORAGE=AUTO, x
TIOAPFX=YES
TMAP01 DFHMDI SIZE=(24,80), x
LINE=1, x
COLUMN=1, x
MAPATTS=COLOR
DFHMDF POS=(1,1), x
LENGTH=9, x
ATTRB=(NORM,PROT), x
COLOR=BLUE, x
INITIAL='ABCD txid'
DFHMDF POS=(1,26), x
LENGTH=28, x
ATTRB=(NORM,PROT), x
COLOR=GREEN, x
INITIAL='Average salary by department'
DFHMDF POS=(9,1), x
LENGTH=41, x
ATTRB=(NORM,PROT), x
INITIAL='Type a department number and press enter.'
DFHMDF POS=(11,1), x
LENGTH=18, x
ATTRB=(NORM,PROT), x
COLOR=GREEN, x
INITIAL='Department number:'
DPTONO DFHMDF POS=(11,20), x
LENGTH=3, x
542 ПриложениеE
Программадляпрактическойработы 543
ATTRB=(NORM,UNPROT,IC), x
COLOR=TURQUOISE, x
INITIAL='___'
DFHMDF POS=(11,24), x
LENGTH=1, x
ATTRB=ASKIP
DFHMDF POS=(13,1), x
LENGTH=18, x
ATTRB=(NORM,PROT), x
COLOR=GREEN, x
INITIAL='Average salary($):'
AVGSAL DFHMDF POS=(13,20), x
LENGTH=11, x
ATTRB=(NORM,PROT), X
COLOR=TURQUOISE
MSGLINE DFHMDF POS=(23,1), x
LENGTH=78, x
ATTRB=(BRT,PROT), x
COLOR=BLUE
DFHMDF POS=(23,79), x
LENGTH=1, x
ATTRB=(DRK,PROT,FSET), x
INITIAL=' '
DFHMDF POS=(24,1), x
LENGTH=7, x
ATTRB=(NORM,PROT), x
COLOR=RED, x
INITIAL='F3=Exit'
DFHMSD TYPE=FINAL
END
Код программы
Эта программа находится в разделе XYZ2 библиотеки LUISM.TEST.SAMPLIB.
IDENTIFICATION DIVISION.
*------------------------------------------------------------
* COBOL-CICS-DB2 PROGRAM ZSCHOLAR RESIDENCY
* OBTAINS THE AVERAGE SALARY OF EMPLOYEES OF A GIVEN DEPART.
*-----------------------------------------------------------
*-----------------------
PROGRAM-ID. XYZ2.
/
ENVIRONMENT DIVISION.
*--------------------
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
*-------------
FILE SECTION.
/
*-------------
WORKING-STORAGE SECTION.
***************************************************
* WORKAREAS *
***************************************************
01 SWITCH.
05 DATA-IS PIC X VALUE 'Y'.
88 DATA-IS-O VALUE 'Y'.
05 SEND-IND PIC X.
88 SEND-IND-ERASE VALUE '1'.
88 SEND-IND-DATAO VALUE '2'.
88 SEND-IND-ALARM VALUE '3'.
01 COMMUNICATION-AREA PIC X.
01 MSGLINET.
02 MSGSQLC PIC X(8).
02 FILLER PIC X.
02 MSGREST PIC X(69).
***************************************************
* DB2 HOST VARIABLES DECLARATION *
***************************************************
01 WORKDEPT-HV PIC X(3).
01 SALARY-HV PIC X(11).
01 SALARY-IN PIC S9(4) COMP-5.
***************************************************
* SQLCA DECLARATION *
***************************************************
EXEC SQL INCLUDE SQLCA END-EXEC.
***************************************************
* DFHAID *
***************************************************
544 ПриложениеЕ
Программадляпрактическойработы 545
COPY DFHAID.
***************************************************
* MAP COPY *
***************************************************
COPY MAPONL.
***************************************************
* DECLARE OF DB2 TABLE *
***************************************************
EXEC SQL
DECLARE DSN8810.EMP TABLE
(EMPNO CHAR(6) NOT NULL,
FIRSTNAME VARCHAR(12) NOT NULL,
MIDINIT CHAR(1) NOT NULL,
LASTNAME VARCHAR(15) NOT NULL,
WORKDEPT CHAR(3) ,
PHONENO CHAR(4) ,
HIREDATE DATE ,
JOB CHAR(8) ,
EDLEVEL SMALLINT ,
SEX CHAR(1) ,
BIRTHDATE DATE ,
SALARY DECIMAL(9,2) ,
BONUS DECIMAL(9,2) ,
COMM DECIMAL(9,2) )
END-EXEC.
************************************************************
LINKAGE SECTION.
************************************************************
01 DFHCOMMAREA PIC X.
/
PROCEDURE DIVISION USING DFHCOMMAREA.
************************************************************
* MAIN ROGRAM ROUTINE
************************************************************
MAINLINE.
************************************************************
* 2000-PROCESS
************************************************************
2000-PROCESS.
EVALUATE TRUE
546 ПриложениеЕ
WHEN EIBCALEN = ZERO
MOVE LOW-VALUE TO TMAP01O
SET SEND-IND-ERASE TO TRUE
PERFORM 2000-10-SEND
WHEN EIBAID = DFHCLEAR
MOVE LOW-VALUE TO TMAP01O
SET SEND-IND-ERASE TO TRUE
PERFORM 2000-10-SEND
WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3
CONTINUE
WHEN EIBAID = DFHPF3
EXEC CICS RETURN
END-EXEC
GOBACK
WHEN EIBAID = DFHENTER
PERFORM 2000-00-PROCESS
WHEN OTHER
MOVE LOW-VALUE TO TMAP01O
MOVE 'WRONG KEY' TO MSGLINEO
SET SEND-IND-ALARM TO TRUE
PERFORM 2000-10-SEND
END-EVALUATE.
*
EXEC CICS RETURN TRANSID('ABCD')
COMMAREA(COMMUNICATION-AREA)
END-EXEC.
GOBACK.
2000-00-PROCESS.
EXEC CICS RECEIVE MAP('TMAP01')
MAPSET('TMAPSET')
INTO(TMAP01I)
END-EXEC.
IF DPTONOL = ZERO OR DPTONOI = SPACE
MOVE 'N' TO DATA-IS
MOVE 'ENTER A VALID DEPARTMENT NUMBER' TO MSGLINEO
END-IF.
IF DATA-IS-O
MOVE DPTONOI TO WORKDEPT-HV
PERFORM 2000-01-DB2
END-IF.
Программадляпрактическойработы 547
IF DATA-IS-O
SET SEND-IND-DATAO TO TRUE
PERFORM 2000-10-SEND
ELSE
SET SEND-IND-ALARM TO TRUE
PERFORM 2000-10-SEND
END-IF.
*
2000-01-DB2.
EXEC SQL SELECT CHAR(DECIMAL(SUM(SALARY),9,2))
INTO :SALARY-HV :SALARY-IN
FROM DSN8810.EMP
WHERE WORKDEPT=:WORKDEPT-HV END-EXEC.
IF SQLCODE = 0
THEN
IF SALARY-IN = -1
THEN
MOVE 'N' TO DATA-IS
MOVE 'NO EMPLOYEES EXIST IN THIS DEPARTMENT' TO MSGLINEO
MOVE SPACES TO AVGSALO
ELSE
MOVE SALARY-HV TO AVGSALO
MOVE SPACES TO MSGLINEO
END-IF
ELSE
MOVE '0' TO DATA-IS
MOVE SPACES TO AVGSALO
MOVE 'SQLSTATE' TO MSGSQLC
MOVE SQLSTATE TO MSGREST
MOVE MSGLINET TO MSGLINEO
END-IF.
*
2000-10-SEND.
EVALUATE TRUE
WHEN SEND-IND-ERASE
EXEC CICS SEND MAP('TMAP01')
MAPSET('TMAPSET')
FROM (TMAP01O)
ERASE
END-EXEC
WHEN SEND-IND-DATAO
EXEC CICS SEND MAP('TMAP01')
MAPSET('TMAPSET')
FROM (TMAP01O)
DATAONLY
END-EXEC
WHEN SEND-IND-ALARM
EXEC CICS SEND MAP('TMAP01')
MAPSET('TMAPSET')
FROM (TMAP01O)
DATAONLY
ALARM
END-EXEC
END-EVALUATE.
Подготовительные задания
Ассемблирование и компоновка карты
Это задание находится в разделе MAPASSEM библиотеки LUISM.TEST.SAMPLIB. Обе
вызываемые процедуры находятся в SYS1.PROCLIB.
//LUISM01 JOB (999,POK),'BMS Compilation',
// CLASS=A,MSGCLASS=T,MSGLEVEL=(1,1)
//***************************************************************
//* ASSEMBLE MAP SET *
//***************************************************************
//STEP01 EXEC PROC=DFHASMV1,PARM.ASSEM='SYSPARM(MAP)'
//SYSLIN DD DSN=LUISM.OBJETO,DCB=(LRECL=80),
// SPACE=(2960,(10,10)),UNIT=SYSDA,DISP=(NEW,PASS)
//SYSIN DD DSN=LUISM.TEST.SAMPLIB(TMAP01),DISP=SHR
/*
//***************************************************************
//* LINK EDIT *
//***************************************************************
//STEP02 EXEC PROC=DFHLNKV1,PARM='LIST,LET,XREF'
//SYSLIN DD DSN=LUISM.OBJETO,DISP=(OLD,DELETE)
// DD *
MODE RMODE(ANY)
NAME TMAPSET(R)
/*
548 ПриложениеE
Программадляпрактическойработы 549
Генерирование файла копии карты
Это задание находится в разделе MAPCOPYGM библиотеки LUISM.TEST.SAMPLIB.
//LUISM02 JOB (999,POK),'BMS COPY',
// CLASS=A,MSGCLASS=T,MSGLEVEL=(1,1)
//***************************************************************
//* MAP COPY GENERATION *
//***************************************************************
//STEP01 EXEC PROC=DFHASMV1,PARM.ASSEM='SYSPARM(DSECT)'
//SYSLIN DD DSN=LUISM.TEST.SAMPLIB(MAPCOPY),DISP=OLD
//SYSIN DD DSN=LUISM.TEST.SAMPLIB(TMAP01),DISP=SHR
/*
Подготовка программы
Это задание находится в разделе CICSDB2P библиотеки LUISM.TEST.SAMPLIB.
//LUISM03 JOB (999,POK),'Cobol-CICS-DB2',
// CLASS=A,MSGCLASS=T,MSGLEVEL=(1,1)
//***************************************************************
//* DB2 precompile, CICS translation, COBOL compile, pre-link,
//* and link edit. Also DB2 Bind. *
//***************************************************************
//***************************************************************
//* DB2 Precompile *
//***************************************************************
//PC EXEC PGM=DSNHPC,PARM='HOST(IBMCOB)'
//SYSIN DD DSN=LUISM.TEST.SAMPLIB(XYZ2),DISP=SHR
//DBRMLIB DD DISP=SHR,
// DSN=DB8HU.DBRMLIB.DATA(XYZ2)
//STEPLIB DD DISP=SHR,DSN=DB8H8.SDSNEXIT
// DD DISP=SHR,DSN=DB8H8.SDSNLOAD
//SYSCIN DD DSN=&&DSNHOUT,DISP=(MOD,PASS),UNIT=SYSDA,
// SPACE=(800,(500,500))
//SYSLIB DD DISP=SHR,DSN=DB8HU.SRCLIB.DATA
//SYSPRINT DD SYSOUT=*
//SYSTERM DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//SYSUT1 DD SPACE=(800,(500,500),,,ROUND),UNIT=VIO
//SYSUT2 DD SPACE=(800,(500,500),,,ROUND),UNIT=VIO
/*
//***************************************************************
//* CICS Translator *
//***************************************************************
550 ПриложениеЕ
//TRN EXEC PGM=DFHECP1$,
// COND=(4,LT,PC)
//STEPLIB DD DSN=CICSTS23.CICS.SDFHLOAD,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSPUNCH DD DSN=&&SYSCIN,
// DISP=(MOD,PASS),UNIT=SYSDA,
// DCB=BLKSIZE=400,
// SPACE=(400,(400,100))
//SYSUDUMP DD SYSOUT=*
//SYSIN DD DSN=&&DSNHOUT,DISP=(OLD,DELETE)
//*
//***************************************************************
//* Compile *
//***************************************************************
//COB EXEC PGM=IGYCRCTL,
// PARM=(NOSEQUENCE,QUOTE,RENT,'PGMNAME(LONGUPPER)'),
// COND=(4,LT,TRN)
//SYSPRINT DD SYSOUT=*
//SYSLIB DD DSN=CICSTS23.CICS.SDFHCOB,DISP=SHR
// DD DSN=CICSTS23.CICS.SDFHMAC,DISP=SHR
// DD DSN=CICSTS23.CICS.SDFHSAMP,DISP=SHR
// DD DSN=LUISM.TEST.SAMPLIB,DISP=SHR
//SYSTERM DD SYSOUT=*
//SYSLIN DD DSN=&&LOADSET,DISP=(MOD,PASS),UNIT=VIO,
// SPACE=(800,(500,500))
//SYSIN DD DSN=&&SYSCIN,DISP=(OLD,DELETE)
//SYSUT1 DD SPACE=(800,(500,500),,,ROUND),UNIT=VIO
//SYSUT2 DD SPACE=(800,(500,500),,,ROUND),UNIT=VIO
//SYSUT3 DD SPACE=(800,(500,500),,,ROUND),UNIT=VIO
//SYSUT4 DD SPACE=(800,(500,500),,,ROUND),UNIT=VIO
//SYSUT5 DD SPACE=(800,(500,500),,,ROUND),UNIT=VIO
//SYSUT6 DD SPACE=(800,(500,500),,,ROUND),UNIT=VIO
//SYSUT7 DD SPACE=(800,(500,500),,,ROUND),UNIT=VIO
//***************************************************************
//* Prelink *
//***************************************************************
//PLKED EXEC PGM=EDCPRLK,COND=(4,LT,COB)
//STEPLIB DD DISP=SHR,DSN=CEE.SCEERUN
//SYSMSGS DD DISP=SHR,
// DSN=CEE.SCEEMSGP(EDCPMSGE)
Программадляпрактическойработы 551
//SYSIN DD DSN=&&LOADSET,DISP=(OLD,DELETE)
//SYSMOD DD DSN=&&PLKSET,UNIT=SYSDA,DISP=(MOD,PASS),
// SPACE=(32000,(30,30)),
// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3200)
//SYSDEFSD DD DUMMY
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSTERM DD SYSOUT=*
//***************************************************************
//* Linkedit *
//***************************************************************
//LKED EXEC PGM=IEWL,PARM='LIST,XREF',
// COND=(4,LT,PLKED)
//SYSLIB DD DISP=SHR,DSN=CEE.SCEELKED
// DD DISP=SHR,DSN=DB8H8.SDSNLOAD
// DD DISP=SHR,DSN=CICSTS23.CICS.SDFHLOAD
// DD DISP=SHR,DSN=ISP.SISPLOAD
// DD DISP=SHR,DSN=GDDM.SADMMOD
//SYSLMOD DD DSN=CICSTS23.CICS.SDFHLOAD(XYZ2),
// DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD SPACE=(1024,(50,50)),UNIT=VIO
//SYSLIN DD DSN=&&PLKSET,DISP=(OLD,DELETE)
// DD DDNAME=SYSIN
//CICSLOAD DD DSN=CICSTS23.CICS.SDFHLOAD,
// DISP=SHR
//SYSIN DD *
INCLUDE CICSLOAD(DSNCLI)
MODE RMODE(ANY)
NAME XYZ2(R)
/*
//***************************************************************
//* Bind *
//***************************************************************
//BIND EXEC PGM=IKJEFT01,DYNAMNBR=20,COND=(4,LT,LKED)
//STEPLIB DD DSN=DB8H8.SDSNLOAD,DISP=SHR
//DBRMLIB DD DSN=DB8HU.DBRMLIB.DATA,DISP=SHR
//SYSUDUMP DD SYSOUT=*
//SYSTSPRT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*