Coding a CICS online program in COBOL

The following code examples are skeleton online programs in Enterprise COBOL. They show examples of how to define and set up addressability to the UIB.

The numbers to the right of the programs refer to the notes that follow them. This kind of program can run in a CICS® environment using DBCTL.

Sample COBOL program that can run in CICS

       Identification Division.
       Program-ID. CBLUIB.
       Environment Division.
       Data Division.
       Working-Storage Section.
         01 Func-Codes.
            05  Psb-Name          Picture X(8) Value 'CBLPSB  '.
            05  Func-PCB          Picture X(4) Value 'PCB '.
            05  Func-TERM         Picture X(4) Value 'TERM'.             				 1 
            05  Func-GHU          Picture X(4) Value 'GHU '.
            05  Func-REPL         Picture X(4) Value 'REPL'.
            05  SSA1              Picture X(9) Value 'AAAA4444 '.
            05  Success-Message   Picture X(40).
            05  Good-Status-Code  Picture XX Value '  '.                         2 
            05  good-return-code  Picture X Value low-Value.
       01  Message0.
           05  Message1           Picture X(38).                                 3 
           05  Message2           Picture XX.
       01  Dli-IO-Area.
           05  Area1              Picture X(3).
           05  Area2              Picture X(37).
             Procedure Division.
      * Schedule the psb and address the uib
           Call 'CBLTDli' using Func-PCB Psb-Name                                4 
                address of Dliuib.
           If Uibfctr is not equal low-Values then
      * Insert error diagnostic code
              Exec CICS return end-exec
           End-if.
           Set address of pcb-addresses to pcbaddr.
      * Issue DL/I Call: get a unique segment
           Set address of pcb1 to pcb-address-list(1).
           Call 'CBLTDli' using Func-GHU Pcb1                                    5 
                Dli-io-area ssa1.
           If uibfctr is not equal good-return-code then
      * Insert error diagnostic code                                             6 
              Exec CICS return end-Exec
           End-if.
           If pcb1-status-code is not equal good-status-code then
      * Insert error diagnostic code
              Exec CICS return end-Exec
           End-if.
      *    Perform segment update activity
           Move 'aaa' to area1.
           Move 'bbb' to area2.
      *    Issue DL/I Call: replace segment at current position                 7 
           Call 'CBLTDli' using Func-REPL Pcb1
                Dli-io-area ssa1
           If uibfctr is not equal good-return-code then
      * Insert error diagnostic code
              Exec CICS return end-Exec
           End-if.
           If pcb1-status-code is not equal good-status-code then
      * Insert error diagnostic code
              Exec CICS return end-Exec
           End-if.
      * Release the psb
           Call 'CBLTDli' using Func-TERM.
      * Other application Function                                              8,9 
           Exec CICS return end-Exec.
           Goback.

Note:

You define each of the DL/I call functions the program uses with a 77-level or 01-level working storage entry. Each picture clause is defined as four alphanumeric characters and has a value assigned for each function. If you want to include the optional parmcount field, initialize count values for each type of call. You can also use the COBOL COPY statement to include these standard descriptions in the program.
A 9-byte area is set up for an unqualified SSA. Before the program issues a call that requires an unqualified SSA, it can either initialize this area with the segment name or move the segment name to this area. If a call requires two or more SSAs, you may need to define additional areas.
An 01-level working storage entry defines I/O areas that are used for passing segments to and from the database. You can further define I/O areas with sub-entries under the 01-level. You can use separate I/O areas for each segment type, or you can define one I/O area that you use for all segments.
One PCB layout is defined in the linkage section. The PCB-ADDRESS-LIST occurs n times, where n is greater than or equal to the number of PCBs in the PSB.
The PCB call schedules a PSB for your program to use. The address of the DLIUIB parameter returns the address of DLIUIB.
This unqualified GHU call retrieves a segment from the database and places it in the I/O area that is referenced by the call. Before issuing the call, the program must initialize the key or data value of the SSA so that it specifies the particular segment to be retrieved.
CICS online programs should test the return code in the UIB before testing the status code in the DB PCB.
The REPL call replaces the segment that was retrieved in the most recent Get Hold call with the data that the program has placed in the I/O area.
The TERM call terminates the PSB the program scheduled earlier. This call is optional and is only issued if a sync point is desired prior to continued processing. The program issues the EXEC CICS RETURN statement when it has finished its processing. If this is a RETURN from the highest-level CICS program, a TERM call and sync point are internally generated by CICS.

Sample call-level OS/VS COBOL program for CICS online (obsolete with Enterprise COBOL)

       Identification Division.                                            NOTES
		 Program-ID. CBLUIB.
       Environment Division.
       Data Division.
       Working-Storage Section.
         01 Func-Codes.
            05  Psb-Name          Picture X(8) Value 'CBLPSB  '.         	 1 
            05  Func-PCB          Picture X(4) Value 'PCB '.
            05  Func-TERM         Picture X(4) Value 'TERM'.
            05  Func-GHU          Picture X(4) Value 'GHU '.
            05  Func-REPL         Picture X(4) Value 'REPL'.
            05  SSA1              Picture X(9) Value 'AAAA4444 '.        	 2 
            05  Success-Message   Picture X(40).
            05  Good-Status-Code  Picture XX   Value '  '.
            05  Good-Return-Code  Picture X    Value low-Value.
       01  Message0.
           05  Message1           Picture X(38).
           05  Message2           Picture XX.
       01  Dli-IO-Area.                                                 	 3 
           05  Area1              Picture X(3).
           05  Area2              Picture X(37).
       Linkage Section.                                                  	 4 
       01  BllCells.
           05 FIller              Picture S9(8) Comp-5.
           05 Uib-Ptr             Picture S9(8) Comp-5.
           05 B-Pcb-Ptrs          Picture S9(8) Comp-5.
           05 Pcb1-Ptr            Picture S9(8) Comp-5.
           Copy DliUib.                                                  	 5,6 
       01  Overlay-Dliuib Redefines Dliuib.
           05  Pcbaddr usage is pointer.
           05  Filler             Picture XX.
       01  Pcb-Ptrs.
           05 B-Pcb1-Ptr          Picture 9(8)  Comp-5.
       01  Pcb1.                                                        	 7 
           05 Pcb1-Dbd-Name       Picture X(8).
           05 Pcb1-Seg-Level      Picture XX.
           05 Pcb1-Status-Code    Picture XX.
           05 Pcb1-PROC-OPT       Picture XXXX.
           05 FIller              Picture S9(5) Comp-5.
           05 Pcb1-Seg-Name       Picture X(8).
           05 Pcb1-Len-KFB        Picture S9(5) Comp-5.
           05 Pcb1-NU-ENSeg       Picture S9(5) Comp-5.
           05 Pcb1-KEY-FB         Picture X(256).
       Procedure Division.                                               	 8 
           Call 'CBLTDLI' using Func-PCB Psb-Name Uib-ptr.
           If Uibfctr is not equal low-values then
      *       Insert error diagnostic Code
              Exec CICS Return end-Exec
           End-if.
           Move Uibpcbal to B-Pcb-Ptrs.
           Move B-Pcb1-Ptr to Pcb1-Ptr.

      *       Issue DL/I Call: get a unique segment                      	 9 
           Call 'CBLTDLI' using Func-GHU Pcb1
               Dli-io-area ssa1.
           Service reload Uib-ptr
           If Uibfctr is not equal Good-Return-Code then                 	 10 
      *       Insert error diagnostic Code
              Exec CICS Return end-Exec
           End-if.

           If Pcb1-Status-Code is not equal Good-Status-Code then
      *       Insert error diagnostic Code
              Exec CICS Return end-Exec
           End-if.


      *       Perform segment update activity
           Move 'aaa' to area1.
           Move 'bbb' to area2.
      *       Issue DL/I Call: replace segment at current position       	 11 
           Call 'CBLTDLI' using Func-REPL Pcb1
                Dli-io-area ssa1.
           If Uibfctr is not equal Good-Return-Code then
      *       Insert error diagnostic Code
              Exec CICS Return end-Exec
           End-if.

           If Pcb1-Status-Code is not equal Good-Status-Code then
      *       Insert error diagnostic Code
              Exec CICS Return end-Exec
           End-if.

      *    Release the PSB
           Call 'CBLTDLI' using Func-TERM.                              	 12,13 
             Exec CICS Return end-Exec.

Note:

You define each of the DL/I call functions the program uses with a 77-level or 01-level working storage entry. Each picture clause is defined as four alphanumeric characters and has a value assigned for each function. If you want to include the optional parmcount field, you can initialize count values for each type of call. You can also use the COBOL COPY statement to include these standard descriptions in the program.
A 9-byte area is set up for an unqualified SSA. Before the program issues a call that requires an unqualified SSA, it can either initialize this area with the segment name or move the segment name to this area. If a call requires two or more SSAs, you may need to define additional areas.
An 01-level working storage entry defines I/O areas that are used for passing segments to and from the database. You can further define I/O areas with 02-level entries. You can use separate I/O areas for each segment type, or you can define one I/O area to use for all segments.
The linkage section must start with a definition of this type to provide addressability to a parameter list that will contain the addresses of storage that is outside the working storage of the application program. The first 02-level definition is used by CICS to provide addressability to the other fields in the list. A one-to-one correspondence exists between the other 02-level names and the 01-level data definitions in the linkage section.
The COPY DLIUIB statement will be expanded.
The UIB returns the address of an area that contains the PCB addresses. The definition of PCB pointers is necessary to obtain the actual PCB addresses. Do not alter the addresses in the area.
The PCBs are defined in the linkage section.
The PCB call schedules a PSB for your program to use.
This unqualified GHU call retrieves a segment from the database and places it in the I/O area that is referenced by the call. Before issuing the call, the program must initialize the key or data value of the SSA so that it specifies the particular segment to be retrieved.
CICS online programs should test the return code in the UIB before testing the status code in the DB PCB.
The REPL call replaces the segment that was retrieved in the most recent Get Hold call with the data that the program has placed in the I/O area.
The TERM call terminates the PSB that the program scheduled earlier. This call is optional and is only issued if a sync point is desired prior to continued processing.
The program issues the EXEC CICS RETURN statement when it has finished its processing. If this is a return from the highest-level CICS program, a TERM call and sync point are internally generated by CICS.

Related reading: For more information about installing application programs, see CICS Transaction Server for z/OS® CICS Application Programming Guide.