cobol+cics实例练习

2009年05月19日 | 9:48 上午分类：大型机｜Mainframe | 标签：CICS、cobol实例、cursor、mapset、大型机资料、翻页 | 129 views

这个程序主要作用是从数据库中读取相关的学生信息，运用了cursor的fetch，由于返回结果很多，一个屏幕显示不了，需要添加翻页功能，既按F7和F8可以实现前翻和后翻的效果。在CICS中mapset上可以看到。

IDENTIFICATION DIVISION.
*
PROGRAM-ID. SECADD.
*
ENVIRONMENT DIVISION.
*
DATA DIVISION.
*
WORKING-STORAGE SECTION.
*
01 SWITCHES.
*
05 VALID-DATA-SW          PIC X(01)     VALUE ‘Y’.
88 VALID-DATA                        VALUE ‘Y’.
05   END-OF-ACCID-SW        PIC X   VALUE ‘N’.
88 END-OF-ACCID               VALUE ‘Y’.
*
01 FLAGS.
*
05 DISPLAY-FLAG        PIC X(01).
88 DISPLAY-NEW-ECINFO          VALUE ’1′.
88 DISPLAY-SPACES                VALUE ’2′.
88 DISPLAY-LOW-VALUES            VALUE ’3′.
05 SEND-FLAG           PIC X(01).
88 SEND-ERASE                    VALUE ’1′.
88 SEND-DATAONLY                 VALUE ’2′.
88 SEND-DATAONLY-ALARM           VALUE ’3′.
*
01 WORK-FIELDS.
*
05 ECINFO-SUB   PIC S9(4) COMP.
*
01 COMMUNICATION-AREA.
05 CA-TS-RECORD-COUNT             PIC   S9(4) COMP.
05 CA-FIRST-RECORD-ON-DISPLAY     PIC   S9(4) COMP.
*
01 RESPONSE-CODE                  PIC S9(8) COMP.
*
01 TEMPORARY-STORAGE-FIELDS.
05 TS-QUEUE-NAME.
10 TS-TERMINAL-ID     PIC X(4).
10 FILLER             PIC X(4) VALUE ‘ECIF’.
05 TS-ITEM-NUMBER         PIC S9(4) COMP VALUE ZERO.
*
01 ELECTIVE-COURSE-INFO.
*
77 CTYPEX   PIC   X(01) VALUE ’1′.
*
01 PERSONAL-COURSE-INFO.
*
COPY DFHAID.
*
COPY ERRPARM.
*
EXEC SQL
INCLUDE ECINFO
END-EXEC.
*
EXEC SQL
INCLUDE PECINFO
END-EXEC.
*
EXEC SQL
INCLUDE CINFO
END-EXEC.
*
EXEC SQL
INCLUDE CTINFO
END-EXEC.
*
EXEC SQL
INCLUDE THINFO
END-EXEC.

*
EXEC SQL
INCLUDE SQLCA
END-EXEC.
*
EXEC SQL
DECLARE ECINFO1 CURSOR FOR
SELECT C.CID,CName,CTime,CAddr,TName,
CHour,CCredit,ToNum,LNum
FROM CN0010.ECINFO AS E,CN0010.CINFO AS C,
CN0010.THINFO AS T,CN0010.CTINFO AS CT
WHERE C.CID = E.CID AND C.CID = CT.CID AND CT.TID = T.TID
AND C.CTYPE = :CTYPEX
END-EXEC.
*
LINKAGE SECTION.
*
01 DFHCOMMAREA    PIC X(04).
*   02   SNO   PIC X(13).
*
PROCEDURE DIVISION.
*
0000-PROCESS-ECINFO-INQUIRY.
*
EVALUATE TRUE
*
*        WHEN EIBCALEN > ZERO
*            MOVE DFHCOMMAREA TO SNO
*            MOVE LOW-VALUE TO SECMPA1O
*            MOVE ‘SECA’ TO TRANID1O
*            SET SEND-ERASE TO TRUE
*            PERFORM 1600-SEND-INQUIRY-MAP
WHEN EIBCALEN = ZERO
MOVE LOW-VALUE TO SECMPA1O
MOVE ‘SECA’ TO TRANID1O
SET SEND-ERASE TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
MOVE ‘SECA’ TO EIBTRNID
PERFORM 1200-DELETE-TS-QUEUE
PERFORM 1300-SELECT-ECINFO-ROW
PERFORM 1400-DISPLAY-INQUIRY-RESULTS
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
*
WHEN EIBAID = DFHCLEAR
MOVE LOW-VALUE TO SECMPA1O
MOVE ‘SECA’ TO TRANID1O
PERFORM 1300-SELECT-ECINFO-ROW
PERFORM 1400-DISPLAY-INQUIRY-RESULTS
SET SEND-ERASE TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
*
WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3
CONTINUE
*
WHEN EIBAID = DFHPF3 OR DFHPF12
EXEC CICS
XCTL PROGRAM(‘SECMENU’)
END-EXEC
*
WHEN EIBAID = DFHPF7 OR DFHPF8
PERFORM 2000-DISPLAY-SCROLLED-DATA
*
WHEN EIBAID = DFHENTER
PERFORM 1000-DISPLAY-SELECTED-ECINFO
*
WHEN OTHER
MOVE LOW-VALUE TO SECMPA1O
MOVE ‘Invalid key pressed.’ TO MSG1O
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
*
END-EVALUATE.
*
EXEC CICS
RETURN TRANSID(‘SECA’)
COMMAREA(COMMUNICATION-AREA)
END-EXEC.
*
1000-DISPLAY-SELECTED-ECINFO.
*
PERFORM 1100-RECEIVE-INQUIRY-MAP
*        MOVE ‘Y’ TO VALID-DATA-SW
PERFORM 1500-ADD-ECINFO-CID
IF VALID-DATA
PERFORM 1510-ADD-ECINFO-INSERT
END-IF.
*
1100-RECEIVE-INQUIRY-MAP.
*
EXEC CICS
RECEIVE MAP(‘SECMPA1′)
MAPSET(‘SECSTA1′)
INTO(SECMPA1I)
END-EXEC.
*
INSPECT SECMPA1I
REPLACING ALL ‘_’ BY SPACE.
*
1200-DELETE-TS-QUEUE.
*
MOVE EIBTRMID TO TS-TERMINAL-ID.
EXEC CICS
DELETEQ TS QUEUE(TS-QUEUE-NAME)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
AND RESPONSE-CODE NOT = DFHRESP(QIDERR)
EXEC CICS
ABEND
END-EXEC.
*
1300-SELECT-ECINFO-ROW.
*
EXEC SQL
SELECT   C.CID,CName,CTime,CAddr,TName,
CHour,CCredit,ToNum,LNum
INTO   :CCID, :CName, :CTime, :CAddr, :TName,
:CHour, :CCredit, :ToNum, :LNum
FROM CN0010.ECINFO AS E,CN0010.CINFO AS C,
CN0010.THINFO AS T,CN0010.CTINFO AS CT
WHERE C.CID=E.CID AND C.CID=CT.CID AND CT.TID=T.TID
AND C.CTYPE = :CTYPEX AND E.LNum > 0
END-EXEC.
*
IF SQLCODE = 100
MOVE ‘That course information does not exist.’ TO MSG1O
ELSE
IF SQLCODE NOT = 0
SET DISPLAY-NEW-ECINFO TO TRUE
*            PERFORM 9999-TERMINATE-PROGRAM
END-IF
END-IF.
*
1400-DISPLAY-INQUIRY-RESULTS.
*
EVALUATE TRUE
WHEN DISPLAY-NEW-ECINFO
PERFORM 1410-OPEN-ECINFO-CURSOR
PERFORM 1420-FORMAT-ECINFO-LINE
*                VARYING ECINFO-SUB FROM 1 BY 1
*                UNTIL ECINFO-SUB > 12
PERFORM 1440-CLOSE-ECINFO-CURSOR
*            MOVE SPACE        TO MSG1O
SET SEND-DATAONLY TO TRUE
WHEN DISPLAY-SPACES
SET SEND-DATAONLY-ALARM TO TRUE
WHEN DISPLAY-LOW-VALUES
SET SEND-DATAONLY-ALARM TO TRUE
END-EVALUATE.
PERFORM 1600-SEND-INQUIRY-MAP.
*
1410-OPEN-ECINFO-CURSOR.
*
EXEC SQL
OPEN ECINFO1
END-EXEC.
*
IF SQLCODE NOT = 0
PERFORM 9999-TERMINATE-PROGRAM
END-IF.
*
1420-FORMAT-ECINFO-LINE.
*
MOVE 1 TO     CA-TS-RECORD-COUNT
PERFORM 1430-FETCH-NEXT-ECINFO
VARYING ECINFO-SUB FROM 1 BY 1
UNTIL SQLCODE = 100.
*
1430-FETCH-NEXT-ECINFO.
*
EXEC SQL
FETCH ECINFO1
INTO     :CCID, :CName, :CTime, :CAddr, :TName,
:CHour, :CCredit, :ToNum, :LNum
END-EXEC.
*
EVALUATE SQLCODE
WHEN 0
MOVE   CCID      TO     CIDX,
MOVE   CName    TO     CNameX,
MOVE   CTime    TO      CTimeX,
MOVE   CAddr    TO      CAddrX,
MOVE   TName    TO     TNameX,
MOVE   CHour    TO     CHourX,
MOVE CCredit   TO     CCreditX,
MOVE   CCredit TO     CCreditX,
MOVE    ToNum   TO     ToNumX
MOVE   LNum     TO     LNumX
*           MOVE ELECTIVE-COURSE-INFO TO SEC(ECINFO-SUB)
END-EVALUATE
*
EXEC CICS
WRITEQ TS QUEUE(TS-QUEUE-NAME)
FROM(ELECTIVE-COURSE-INFO)
END-EXEC
ADD 1 TO    CA-TS-RECORD-COUNT.
*
1440-CLOSE-ECINFO-CURSOR.
*
EXEC SQL
CLOSE ECINFO1
END-EXEC
*
MOVE 1 TO ECINFO-SUB, TS-ITEM-NUMBER
CA-FIRST-RECORD-ON-DISPLAY
MOVE LOW-VALUE TO ELECTIVE-COURSE-INFO
PERFORM 2010-MOVE-ROW-DATA-TO-MAP
VARYING ECINFO-SUB FROM 1 BY 1
UNTIL ECINFO-SUB > 5
*
IF SQLCODE NOT = 0
PERFORM 9999-TERMINATE-PROGRAM
END-IF.
*
2000-DISPLAY-SCROLLED-DATA.
*
MOVE DFHCOMMAREA   TO COMMUNICATION-AREA.
MOVE EIBTRMID      TO TS-TERMINAL-ID.
MOVE LOW-VALUE     TO SECMPA1O.
MOVE SPACE         TO MSG1O
IF CA-TS-RECORD-COUNT = 0
MOVE ‘No record found!.’ TO MSG1O
ELSE
IF EIBAID = DFHPF7
IF CA-FIRST-RECORD-ON-DISPLAY > 5
SUBTRACT 5 FROM CA-FIRST-RECORD-ON-DISPLAY
END-IF
ELSE
IF CA-FIRST-RECORD-ON-DISPLAY + 4 < CA-TS-RECORD-COUNT

ADD 5 TO CA-FIRST-RECORD-ON-DISPLAY
END-IF
END-IF
MOVE CA-FIRST-RECORD-ON-DISPLAY TO TS-ITEM-NUMBER
PERFORM 2010-MOVE-ROW-DATA-TO-MAP
VARYING ECINFO-SUB FROM 1 BY 1
UNTIL ECINFO-SUB > 5
SET SEND-ERASE TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP.
*
2010-MOVE-ROW-DATA-TO-MAP.
*
IF TS-ITEM-NUMBER <= CA-TS-RECORD-COUNT
EXEC CICS
READQ TS QUEUE(TS-QUEUE-NAME)
INTO (ELECTIVE-COURSE-INFO)
ITEM(TS-ITEM-NUMBER)
END-EXEC
MOVE ELECTIVE-COURSE-INFO TO SEC(ECINFO-SUB)
ADD 1 TO TS-ITEM-NUMBER
ELSE
MOVE SPACE TO SEC(ECINFO-SUB).
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP.
*
1500-ADD-ECINFO-CID.
*
IF     CID1L = 0
OR   CID1I = SPACE
MOVE ‘N’ TO VALID-DATA-SW
MOVE ‘Please input the CID ‘ TO MSG1O
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
ELSE
IF    CID1L < 10
MOVE ‘N’ TO VALID-DATA-SW
MOVE ‘The CID is wrong ‘ TO MSG1O
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
END-IF
*
EXEC SQL
SELECT CID INTO :ECID
FROM CN0010.ECINFO
WHERE CID = :CID1I
END-EXEC
IF SQLCODE NOT = 0
MOVE ‘N’ TO VALID-DATA-SW
MOVE ‘The CID is wrong ‘ TO MSG1O
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
END-IF.
*
1510-ADD-ECINFO-INSERT.
*
MOVE   CID1I TO PECIDY
MOVE   ’123456789123′   TO SNOY
EXEC SQL
INSERT INTO CN0010.PECINFO
(CID,SID)
VALUES (:PECIDY, :SNOY)
END-EXEC
*
EVALUATE SQLCODE
WHEN 0
MOVE ‘ADD COURSE SUCCESSFULLY’ TO MSG1O
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
*
EXEC SQL
UPDATE CN0010.ECINFO
SET LNum = LNum – 1
WHERE CID = :CID1I
END-EXEC
WHEN OTHER
MOVE ‘The course may have existed or CID is wrong’ to MSG1O O
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
END-EVALUATE.
*
1600-SEND-INQUIRY-MAP.
*
MOVE ‘SECA’ TO TRANID1O
EVALUATE TRUE
WHEN SEND-ERASE
EXEC CICS
SEND MAP(‘SECMPA1′)
MAPSET(‘SECSTA1′)
FROM(SECMPA1O)
ERASE
END-EXEC
WHEN SEND-DATAONLY
EXEC CICS
SEND MAP(‘SECMPA1′)
MAPSET(‘SECSTA1′)
FROM(SECMPA1O)
DATAONLY
END-EXEC
WHEN SEND-DATAONLY-ALARM
EXEC CICS
SEND MAP(‘SECMPA1′)
MAPSET(‘SECSTA1′)
FROM(SECMPA1O)
DATAONLY
ALARM
END-EXEC
END-EVALUATE.
*
9999-TERMINATE-PROGRAM.
*
MOVE EIBRESP TO ERR-RESP.
MOVE EIBRESP2 TO ERR-RESP2.
MOVE EIBTRNID TO ERR-TRNID.
MOVE EIBRSRCE TO ERR-RSRCE.
*
EXEC CICS
XCTL PROGRAM(‘SYSERR’)
COMMAREA(ERROR-PARAMETERS)
END-EXEC.