新手入门之简单的cics程序
-
cobol代码
PROCESS LIST,MAP,TEST IDENTIFICATION DIVISION. * PROGRAM-ID. DCALC01. * ENVIRONMENT DIVISION. * DATA DIVISION. * WORKING-STORAGE SECTION. * 01 SWITCHES. * 05 VALID-DATA-SW PIC X VALUE 'Y'. 88 VALID-DATA VALUE 'Y'. 88 INVALID-DATA VALUE 'N'. * 01 FLAGS. * 05 SEND-FLAG PIC X. 88 SEND-ERASE VALUE '1'. 88 SEND-ERASE-ALARM VALUE '2'. 88 SEND-DATAONLY VALUE '3'. 88 SEND-DATAONLY-ALARM VALUE '4'. * 01 WORK-AREA. * 05 AA PIC 9(2). 05 BB PIC 9(2). 05 CC PIC X(1). 05 DD PIC 9(4). * 01 COMMUNICATION-AREA. 05 PROCESS-SW PIC X(1). * COPY DTETMS1. * COPY DFHAID. * COPY ATTR. * COPY DFHBMSCA. * LINKAGE SECTION. * 01 DFHCOMMAREA PIC X(01). * PROCEDURE DIVISION. * 0000-PROCESS. * IF EIBCALEN > ZERO MOVE DFHCOMMAREA TO COMMUNICATION-AREA END-IF. * IF PROCESS-SW = '1' MOVE LOW-VALUE TO DTEST01O MOVE -1 TO AAL SET SEND-ERASE TO TRUE PERFORM 1300-SEND-MAP END-IF. * EVALUATE TRUE * WHEN EIBCALEN = ZERO MOVE LOW-VALUE TO DTEST01O SET SEND-ERASE TO TRUE MOVE -1 TO AAL PERFORM 1300-SEND-MAP * WHEN EIBAID = DFHPF3 EXEC CICS RETURN TRANSID('DCAL') END-EXEC * WHEN EIBAID = DFHPF12 MOVE LOW-VALUE TO DTEST01O MOVE -1 TO AAL SET SEND-ERASE TO TRUE PERFORM 1300-SEND-MAP * WHEN EIBAID = DFHCLEAR EXEC CICS RETURN END-EXEC * WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3 CONTINUE * WHEN EIBAID = DFHENTER PERFORM 1000-PROCESS-MAP * WHEN OTHER MOVE LOW-VALUE TO DTEST01O MOVE 'MSG==> THAT KEY IS UNASSIGNED.' TO MSGO MOVE -1 TO AAL SET SEND-DATAONLY-ALARM TO TRUE PERFORM 1300-SEND-MAP * END-EVALUATE. * EXEC CICS RETURN TRANSID('DCAL') COMMAREA(COMMUNICATION-AREA) END-EXEC. * 1000-PROCESS-MAP. * PERFORM 1100-RECEIVE-MAP. PERFORM 1200-EDIT-DATA. IF VALID-DATA-SW NOT = 'N' MOVE AAI TO AA MOVE BBI TO BB MOVE CCI TO CC EVALUATE CC WHEN '+' COMPUTE DD = AA + BB WHEN '-' COMPUTE DD = AA - BB WHEN '*' COMPUTE DD = AA * BB WHEN '/' COMPUTE DD = AA / BB END-EVALUATE SET SEND-ERASE TO TRUE EXEC CICS ENTER TRACEID('100') FROM(DD) END-EXEC MOVE DD TO DDO MOVE -1 TO AAL MOVE DFHBMPRF TO AAA MOVE DFHBMPRF TO BBA MOVE DFHBMPRF TO CCA MOVE '1' TO PROCESS-SW PERFORM 1300-SEND-MAP END-IF. * IF VALID-DATA-SW = 'N' MOVE '2' TO PROCESS-SW SET SEND-DATAONLY-ALARM TO TRUE PERFORM 1300-SEND-MAP END-IF. * 1100-RECEIVE-MAP. * EXEC CICS RECEIVE MAP('DTEST01') MAPSET('DTETMS1') INTO(DTEST01I) END-EXEC. * 1200-EDIT-DATA. * IF AAI NOT NUMERIC MOVE -1 TO AAL MOVE 'MSG==> THE FIRST NUMBER MUST BE NUMERIC.' TO MSGO MOVE 'N' TO VALID-DATA-SW END-IF. * IF BBI NOT NUMERIC MOVE -1 TO BBL MOVE 'MSG==> THE SECOND NUMBER MUST BE NUMERIC.' TO MSGO MOVE 'N' TO VALID-DATA-SW END-IF. * IF CCI = '+' OR '-' OR '*' OR '/' CONTINUE ELSE MOVE -1 TO CCL MOVE 'MSG==> YOU MUST ENTER A MARK.' TO MSGO MOVE 'N' TO VALID-DATA-SW END-IF. * 1300-SEND-MAP. * EVALUATE TRUE WHEN SEND-ERASE EXEC CICS SEND MAP('DTEST01') MAPSET('DTETMS1') FROM(DTEST01O) ERASE CURSOR END-EXEC WHEN SEND-ERASE-ALARM EXEC CICS SEND MAP('DTEST01') MAPSET('DTETMS1') FROM(DTEST01O) ERASE ALARM CURSOR END-EXEC WHEN SEND-DATAONLY-ALARM EXEC CICS SEND MAP('DTEST01') MAPSET('DTETMS1') FROM(DTEST01O) DATAONLY ALARM CURSOR END-EXEC END-EVALUATE. * 9999-TERMINATE-PROGRAM. * EXEC CICS ABEND END-EXEC.map代码
PRINT ON,NOGEN 00000010 DTETMS1 DFHMSD TYPE=MAP,LANG=COBOL,MODE=INOUT,STORAGE=AUTO,SUFFIX=8 00000020 DTEST01 DFHMDI SIZE=(24,80),MAPATTS=(COLOR,OUTLINE),COLUMN=1,LINE=1, *00000030 DATA=FIELD,TIOAPFX=YES,OBFMT=NO 00000040 DFHMDF POS=(3,27),LENGTH=7,INITIAL=' SAMPLE',ATTRB=(ASKIP,BRT) 00000050 DFHMDF POS=(3,36),LENGTH=11,INITIAL=' CALCULATOR', *00000060 ATTRB=(ASKIP,BRT) 00000070 DFHMDF POS=(7,16),LENGTH=22,INITIAL=' FIRST NUMBER-------->', *00000080 ATTRB=(ASKIP,BRT) 00000090 * AA AA 00000100 AA DFHMDF POS=(7,40),LENGTH=2,ATTRB=(UNPROT,NORM,IC), *00000110 OUTLINE=(UNDER) 00000120 DFHMDF POS=(7,43),LENGTH=1,ATTRB=(ASKIP,NORM) 00000130 DFHMDF POS=(10,16),LENGTH=22,INITIAL=' SENCOND NUMBER------>',*00000140 ATTRB=(ASKIP,BRT) 00000150 * BB BB 00000160 BB DFHMDF POS=(10,40),LENGTH=2,ATTRB=(UNPROT,NUM,NORM), *00000170 OUTLINE=(UNDER) 00000180 DFHMDF POS=(10,43),LENGTH=1,ATTRB=(ASKIP,NORM) 00000190 DFHMDF POS=(13,16),LENGTH=22,INITIAL=' OPERTION(+ - * /)--->',*00000200 ATTRB=(ASKIP,BRT) 00000210 * CC CC 00000220 CC DFHMDF POS=(13,40),LENGTH=1,ATTRB=(UNPROT,NORM), *00000230 OUTLINE=(UNDER) 00000240 DFHMDF POS=(13,42),LENGTH=1,ATTRB=(ASKIP,NORM) 00000250 DFHMDF POS=(16,16),LENGTH=22,INITIAL=' RESULT-------------->',*00000260 ATTRB=(ASKIP,BRT) 00000270 * DD DD 00000280 DD DFHMDF POS=(16,40),LENGTH=4,ATTRB=(ASKIP,NORM) 00000290 DFHMDF POS=(16,45),LENGTH=1,ATTRB=(PROT,NORM) 00000300 DFHMDF POS=(19,49),LENGTH=6,INITIAL=' ENTER',ATTRB=(PROT,BRT) 00000310 DFHMDF POS=(20,49),LENGTH=11,INITIAL=' F12 CANCEL', *00000320 ATTRB=(PROT,BRT) 00000330 DFHMDF POS=(21,49),LENGTH=8,INITIAL=' F3 EXIT',ATTRB=(PROT,BRT*00000340 ) 00000350 * MSG MSG 00000360 MSG DFHMDF POS=(23,80),LENGTH=79,ATTRB=(PROT,NORM),COLOR=NEUTRAL 00000370 DFHMDF POS=(24,80),LENGTH=0,ATTRB=(ASKIP,NORM) 00000380 DFHMSD TYPE=FINAL 00000390 END 00000400