* $$ JOB JNM=COBJOURN,CLASS=A,DISP=D * $$ PUN DISP=I,CLASS=4,DEST=* // JOB COBJOURN - CICS and BATCH COBOL Program Example * * Step 1. CICS Translate * // SETPARM LELIB='PRD2.SCEEBASE' // ASSGN SYSIPT,SYSRDR // EXEC IESINSRT $ $$ JOB JNM=COBJOURN,CLASS=4,DISP=D // JOB COBJOURN - COBOL/VSE Compile /* ***************************************************************** */ /* Set Parms: */ /* */ /* LELIB - LE/VSE Installation Library */ /* COBLIB - COBOL Compiler 1.1.0 library */ /* CATLIB - Sublibrary to catalog testcase PHASE */ /* */ /* Library definitions : */ /* */ /* PRD2.SCEEBASE - LE/VSE Installation Library */ /* PRD2.PROD - COBOL Compiler 1.1.0 library */ /* PRD2.CONFIG - Sublibrary to catalog testcase PHASE */ /* */ /* ***************************************************************** */ // SETPARM LELIB='PRD2.SCEEBASE' // SETPARM COBLIB='PRD2.PROD' // SETPARM CATLIB='PRD2.CONFIG' cat library batch and cics execution * * STEP 2 - COMPILE COBOL/VSE MAIN ROUTINE WITH LE/VSE * - Sample COBOL program for CICS and BATCH * // LIBDEF *,SEARCH=(&LELIB,&COBLIB,&CATLIB) // LIBDEF PHASE,CATALOG=&CATLIB // OPTION CATAL,XREF,ERRS PHASE COBJOURN,* INCLUDE DFHELII /* // OPTION LOG,NOLISTX /* EXEC PGM=IGYCRCTL,SIZE=512K /* CBL RES,RENT,APOST,NOMAP,NOSEQ,NODYNAM,LIB,TEST(ALL,SYM),LIST // EXEC PGM=IGYCRCTL,SIZE=IGYCRCTL,PARM='SD(&CATLIB(COBJOURN))' * $$ END // OPTION NODUMP,DECK // LIBDEF *,SEARCH=(&LELIB,PRD1.BASE) // EXEC DFHECP1$,SIZE=512K,PARM='CICS' ****************************************************** CBL RENT,APOST,NOMAP,NOSEQ,NODYNAM,TEST(ALL,SYM,SEP),LIB,LIST CBL XOPTS(COBOL3) IDENTIFICATION DIVISION. PROGRAM-ID. COBJOURN. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. Working-Storage Section. 01 bit-value PIC S9(9) BINARY. 01 bit-result PIC S9(9) BINARY. 01 bit-number PIC S9(9) BINARY. 01 sys-inf PIC S9(9) BINARY. 01 env-inf PIC S9(9) BINARY. 01 mem-id PIC S9(9) BINARY. 01 gpid PIC S9(9) BINARY. 01 Read-Msg PIC X(40) VALUE ' I will now EC READ IESCNTL'. 01 End-Msg PIC X(40) VALUE 'Case Study complete.Back to CICS'. 01 exec-invoke-msg PIC X(40) Value ' Called via EXEC CICS services '. 01 trans-invoke-msg PIC X(40) Value ' Called via CICS Transaction '. 01 MSG-LEN PIC S9(5) COMP VALUE 40. 01 FC. 02 Condition-Token-Value. COPY CEEIGZCT. 03 Case-1-Condition-ID. 04 Severity PIC S9(4) BINARY. 04 Msg-No PIC S9(4) BINARY. 03 Case-2-Condition-ID REDEFINES Case-1-Condition-ID. 04 Class-Code PIC S9(4) BINARY. 04 Cause-Code PIC S9(4) BINARY. 03 Case-Sev-Ctl PIC X. 03 Facility-ID PIC XXX. 02 I-S-Info PIC S9(9) BINARY. 01 Environ PIC X. 88 CICS VALUE X'01'. 88 BATCH VALUE X'02'. 01 START-MSG PIC X(40) VALUE ' Case Study - BEGINS.'. 01 FINI-MSG PIC X(40) VALUE ' Case Study - COMPLETE.'. 01 CICS-MSG PIC X(40) VALUE ' CICS environment detected.'. 01 RAND-MSG PIC X(40) VALUE ' Calling CEERAND0 .....'. 01 CICS-Areas PIC X. 88 eibblk VALUE X'01'. 88 commarea VALUE X'02'. 01 Invoke PIC X. 88 cics-call VALUE X'01'. 88 trans-call VALUE X'02'. 01 caller PIC X(8). 01 blanks-8 PIC X(8) VALUE ' '. 01 EIB-PTR USAGE IS POINTER. 01 Enclave-delay-service PIC X(8). 01 delay-value PIC S9(9) COMP. 01 seed PIC S9(9) BINARY. 01 Rand-Num COMP-2. 01 RandNum PIC S9(4) COMP. 01 CEERAN0 PIC X(8) VALUE 'CEERAN0'. 01 REC-LEN PIC XX VALUE '12'. 01 REC-KEY PIC X(12). 01 Test-Addr PIC S9(9) COMP. Linkage Section. 01 dfhcommarea. 03 My-commarea-data Pic x(64). 01 Record-in. 03 Rec-recieved Pic x(1000). PROCEDURE DIVISION. Move low-values to FC. Move zero to return-code. Display '-------------------------------------------------'. Display ' Sample CICS and BATCH Case Study begins'. Perform 0300-Check-Env thru 0300-Check-Env-Exit. ***** * ***** * ------------------------------------------------------------ ***** * Mainline processing based upon execution environment ***** * ------------------------------------------------------------ ***** * Evaluate True When CICS Perform 0200-cics thru 0200-cics-Exit When BATCH Perform 0200-Batch thru 0200-Batch-Exit When OTHER Display 'Unknown enviroment detected. Exiting' Move 8 to return-code End-Evaluate. If return-code = 0 then Display ' Sample Case Study has completed successfully.' Display '-------------------------------------------------' else Display ' Last return-code value : ' return-code end-if. If BATCH then DISPLAY 'Case Study - COMPLETE' UPON CONSOLE Stop Run End-if. If CICS then EXEC CICS WRITE OPERATOR TEXT(FINI-MSG) TEXTLENGTH(MSG-LEN) END-EXEC EXEC CICS RETURN END-EXEC End-if. GOBACK. 0200-Batch. DISPLAY 'Case Study - BEGINS.' UPON CONSOLE. ***** * ------------------------------------------------------------ ***** * Handle program execution in the BATCH Environment ***** * ------------------------------------------------------------ Display ' BATCH enviroment detected.' Upon Console. ***** * ------------------------------------------------------------ ***** * Make a Dynamic call in the batch environment ***** * ------------------------------------------------------------ Move zero to seed. Call CEERAN0 Using Seed, Rand-num, fc. If CEE000 of fc then Compute RandNum = (Rand-Num * 100) End-compute Display ' Random Number generated is : ' Randnum else Display ' CEERAND0 failed with msg CEE' msg-no of fc end-if ***** * ----------------------------------------------------------- ***** * ***** * Function: CEE5TSTG - Test access to a specified storage ***** * address. ***** * ***** * In this example, CEE5TSTG is called to test access permission ***** * to low-core. ***** * ***** * ------------------------------------------------------------ Move zero to Test-Addr. Call 'CEE5TSTG' USING Test-Addr, fc. If CEE3Q1 of fc Then Display ' **WARNING** Incompatiable TRAP option set.' Display ' See Msg CEE' msg-no of fc Go To 0200-batch-exit else If Not CEE000 of fc Then Display ' Access specified in Msg CEE' msg-no of fc Display ' only permitted to Addr ' Test-Addr Go To 0200-batch-exit End-If. If CEE000 of fc Then Display ' All Access is permitted to ' Test-Addr End-If. 0200-Batch-Exit. Exit. 0200-cics. Display ' Addressing CICS dfheiblk.'. EXEC CICS ADDRESS EIB(EIB-PTR) END-EXEC. Set Address of dfheiblk to EIB-PTR. Set eibblk to True. EXEC CICS WRITE OPERATOR TEXT(START-MSG) TEXTLENGTH(MSG-LEN) END-EXEC ***** * ------------------------------------------------------------ ***** * Handle program execution in the CICS Environment ***** * ------------------------------------------------------------ EXEC CICS WRITE OPERATOR TEXT(CICS-MSG) TEXTLENGTH(MSG-LEN) END-EXEC If EIBCALEN > 0 then Display ' CICS dfhcommarea available.' Set commarea to True Display ' Retrieved EIBCALEN = ' EIBCALEN Else Display ' No CICS dfhcommarea available.' End-if EXEC CICS ASSIGN INVOKINGPROG(caller) end-exec if caller NOT = blanks-8 then Set cics-call to True EXEC CICS SEND TEXT FROM(exec-invoke-msg) FREEKB ERASE WAIT End-Exec else Set trans-call to True EXEC CICS SEND TEXT FROM(trans-invoke-msg) FREEKB ERASE WAIT End-Exec end-if ***** * ------------------------------------------------------------ ***** * Make a Static call in the CICS environment ***** * ------------------------------------------------------------ Move 2 to delay-value. CALL 'CEE5DLY' USING delay-value fc. If NOT CEE000 of fc then Display '** ERROR ** Delay failed with Msg:' Msg-no of fc end-if ***** * ------------------------------------------------------------ ***** * Make a Dynamic call in the CICS environment ***** * ------------------------------------------------------------ EXEC CICS SEND TEXT FROM(RAND-MSG) FREEKB ERASE WAIT End-Exec Move zero to seed. Call CEERAN0 Using Seed, Rand-num, fc. If CEE000 of fc then Compute RandNum = (Rand-Num * 100) End-compute Display ' Random Number generated is : ' RandNum else Display ' CEERAND0 failed with Msg: CEE' msg-no of fc end-if EXEC CICS DELAY FOR SECONDS(1) END-EXEC. ***** * ------------------------------------------------------------ ***** * Read the IESCNTL VSAM file in the CICS environment ***** * ------------------------------------------------------------ EXEC CICS SEND TEXT FROM(READ-MSG) FREEKB ERASE WAIT END-EXEC. EXEC CICS IGNORE CONDITION NOTFND END-EXEC. Move Spaces To REC-KEY. Move 'APDTVSEIES' To REC-KEY. EXEC CICS READ FILE('IESCNTL') SET(ADDRESS OF RECORD-IN) LENGTH(REC-LEN) RIDFLD(REC-KEY) END-EXEC. EXEC CICS DELAY FOR SECONDS(2) END-EXEC. EXEC CICS SEND CONTROL ERASE FREEKB END-EXEC. EXEC CICS SEND TEXT FROM(END-MSG) FREEKB ERASE WAIT END-EXEC. 0200-cics-exit. Exit. ***** * ------------------------------------------------------------ ***** * Extract Execution environment information ***** * ------------------------------------------------------------ 0300-Check-Env. Display ' '. Move zero to bit-value. Move zero to bit-result. Display ' Call CEE5INF to determine environment.'. ***** * ***** * Call CEE5INF LE Service to get environment information ***** * Call 'CEE5INF' Using sys-inf, env-inf, mem-id, gpid, fc. If not CEE000 of fc then Display 'CEE5INF Failed with MSG CEE' Msg-No of FC UPON CONSOLE Stop Run End-if ***** * ***** * Determine Execution Environment ***** * Move 31 to bit-value. Call 'CEESITST' Using sys-inf, bit-value, fc, bit-result. If not CEE000 then Display 'CEESITST Failed with MSG CEE' Msg-No of FC UPON CONSOLE Stop Run end-if If bit-result = 1 then Display ' Running under CICS.' Set CICS to True Else Display ' Running under BATCH.' Set BATCH to True End-if. 0300-Check-Env-Exit. Exit. /* // ASSGN SYSIPT,SYSRDR // EXEC IESINSRT /* // IF $RC GT 4 THEN // GOTO $EOJ * * STEP 3 - LINKEDT MODULE * /* /* ENTRY COBJOURN // EXEC LNKEDT,SIZE=512K /* // IF $RC GT 2 THEN // GOTO $EOJ $ $$ LST CLASS=A,DISP=D * * STEP 4 - RUN TESTCASE in BATCH * ON $ABEND GOTO FINISH ON $CANCEL GOTO FINISH ON $RC > 15 CONTINUE // OPTION PARTDUMP,NOSYSDUMP /* DATE DD/MM/YY // LIBDEF *,SEARCH=(&LELIB,&CATLIB,PRD1.BASE) // ASSGN SYS004,SYSIPT // EXEC COBJOURN,SIZE=COBJOURN /* /. FINISH // EXEC LISTLOG #& $ $$ EOJ * $$ END // EXEC LISTLOG /& * $$ EOJ