FALSE

Page Nav

HIDE

Grid

GRID_STYLE

Sample TDQ Program

A Sample Program Program PROLST5. Overview Lists the contents of a file of product records. Input / Output PRODUCT Product File ...

A Sample Program
Program PROLST5.

Overview Lists the contents of a file of product records.

Input / Output PRODUCT Product File
Process Specifications

  1. The user starts the program by entering transaction id LST1
  1. For each record in the product file, list the product code, description, unit price and quantity on hand. At the end of the listing, list the number of products in the file.
  1. Use a transient data destination to route the output data to a printer. An installation developed utility (a sample is included in this material, program name SAMP6) will be responsible for reading data from the destination and writing to the printer via a batch job submitted from within the CICS region.
  1. Use ASA control characters in the first position of the destination record to control printer spacing. The control characters are
                   Blank   skip one line before printing
                         0    skip two lines before printing
                         -     skip three lines before printing
                         1    skip to the top of next page before printing
  1. CICS ENQ and DEQ are used to reserve the queue to prevent other tasks from making intervening writes while our listing program is running.


    Structure Chart for the product listing program

    The PRODUCT copy member
    01 PRODUCT-MASTER-RECORD.
    *
    05 PRM-PRODUCT-CODE                    PIC X(10).

    05 PRM-PRODUCT-DESCRIPTION     PIC X(20). 
    05 PRM-UNIT-PRICE                            PIC  S9(7)V99 COMP-3.

    05 PRM-QUANTITY-ON-HAND          PIC S9(7) COMP-3.

    *

    The ERRPARM copy member
    01 ERROR-PARAMETERS.
    *
    05 ERR-RESP PIC S9(8) COMP.

    05 ERR-RESP2 PIC S9(8) COMP.

    05 ERR-TRNID PIC X(4).

    05 ERR-RSRCE PIC X(8).


    You must define and install INTra destination L86P before you run this program (PROLST5).
    The Program PROLST5 Transaction-id PRO5

    IDENTIFICATION DIVISION.
    *
    PROGRAM-ID. PROLST5.
    *
    ENVIRONMENT DIVISION.
    *
    DATA DIVISION.
    *
    WORKING-STORAGE SECTION.
    *
    01 SWITCHES.
    *
    05 PRODUCT-EOF-SW PIC X VALUE 'N'.

    88 PRODUCT-EOF VALUE 'Y'.

    *
    01 WORK-FIELDS.
    *
    05 RECORD-COUNT PIC S9(5) VALUE ZERO COMP-3.

    *
    01 PRINT-FIELDS.
    *
    05 LINE-COUNT PIC S99 VALUE 99 COMP-3.

    05 LINES-ON-PAGE PIC S99 VALUE 50 COMP-3.

    05 PAGE-NO PIC S999 VALUE 1 COMP-3.

    05 PRINT-AREA PIC X(133).

    05 LINE-LENGTH PIC S9(4) COMP.

    *
    01 RESPONSE-CODE PIC S9(8) COMP.
    *
    01 HEADING-LINE-1.
    *
    05 HL1-CC PIC X VALUE '1'.

    05 FILLER PIC X(20) VALUE ' PR'.

    05 FILLER PIC X(20) VALUE 'ODUCT LISTING '.

    05 FILLER PIC X(14) VALUE ' PAGE: '.

    05 HL1-PAGE-NO PIC ZZ9.

    *
    01 HEADING-LINE-2.
    *
    05 HL2-CC PIC X VALUE '0'.

    05 FILLER PIC X(20) VALUE ' PRODUCT '.

    05 FILLER PIC X(20) VALUE SPACE.

    05 FILLER PIC X(15) VALUE ' UNIT QTY'.

    *
    01 HEADING-LINE-3.
    *
    05 HL3-CC PIC X VALUE ' '.

    05 FILLER PIC X(20) VALUE ' CODE DESCRIPT'.

    05 FILLER PIC X(20) VALUE 'ION '.

    05 FILLER PIC X(17) VALUE ' PRICE ON HAND'.

    *
    01 PRODUCT-LINE.
    *
    05 PL-CC PIC X VALUE ' '.

    05 PL-PRODUCT-CODE PIC X(10).

    05 FILLER PIC XX VALUE SPACE.

    05 PL-DESCRIPTION PIC X(20).

    05 FILLER PIC XX VALUE SPACE.

    05 PL-UNIT-PRICE PIC Z,ZZZ,ZZZ.99.

    05 FILLER PIC XX VALUE SPACE.

    05 PL-QUANTITY PIC Z,ZZZ,ZZ9.

    *
    01 TOTAL-LINE.
    *
    05 TL-CC PIC X VALUE '-'.

    05 TL-RECORD-COUNT PIC ZZ,ZZ9.

    05 FILLER PIC X(15) VALUE ' RECORDS IN THE'.

    05 FILLER PIC X(15) VALUE ' PRODUCT FILE. '.

    *
    01 COMPLETION-MESSAGE.
    *
    05 FILLER PIC X(15) VALUE 'Inventory listi'.

    05 FILLER PIC X(11) VALUE 'ng printed.'.

    *
    01 PRODUCT-MASTER-RECORD.
    *
    05 PRM-PRODUCT-CODE PIC X(10).

    05 PRM-PRODUCT-DESCRIPTION PIC X(20).

    05 PRM-UNIT-PRICE PIC S9(7)V99 COMP-3.

    05 PRM-QUANTITY-ON-HAND PIC S9(7) COMP-3.

    *
    01 DESTINATION-ID PIC X(4) VALUE 'L86P'.
    *
    01 DESTINATION-ID-LENGTH PIC S9(4) COMP VALUE 4.

    COPY ERRPARM.
    *
    PROCEDURE DIVISION.
    *
    0000-PRODUCE-PRODUCT-LISTING.
    *
    PERFORM 1000-START-PRODUCT-BROWSE.

    EXEC CICS

    ENQ RESOURCE(DESTINATION-ID)

    LENGTH(DESTINATION-ID-LENGTH)

    END-EXEC.

    PERFORM 2000-PRODUCE-PRODUCT-LINE

    UNTIL PRODUCT-EOF.

    PERFORM 3000-PRINT-TOTAL-LINE.

    EXEC CICS

    DEQ RESOURCE(DESTINATION-ID)

    LENGTH(DESTINATION-ID-LENGTH)

    END-EXEC.

    EXEC CICS

    SEND TEXT FROM(COMPLETION-MESSAGE)

    ERASE

    FREEKB

    END-EXEC.

    EXEC CICS

    RETURN

    END-EXEC.

    EXEC CICS

    RETURN

    END-EXEC.

    *
    1000-START-PRODUCT-BROWSE.
    *
    MOVE LOW-VALUE TO PRM-PRODUCT-CODE.

    EXEC CICS

    STARTBR DATASET('PRODUCT')

    RIDFLD(PRM-PRODUCT-CODE)

    GTEQ

    RESP(RESPONSE-CODE)

    END-EXEC.

    IF RESPONSE-CODE = DFHRESP(NOTFND)

    MOVE 'Y' TO PRODUCT-EOF-SW

    ELSE IF RESPONSE-CODE NOT = DFHRESP(NORMAL)

    GO TO 9999-TERMINATE-PROGRAM.

    *
    2000-PRODUCE-PRODUCT-LINE.
    *
    PERFORM 2100-READ-PRODUCT-RECORD.

    IF NOT PRODUCT-EOF

    PERFORM 2200-PRINT-PRODUCT-LINE.

    *
    2100-READ-PRODUCT-RECORD.
    *
    EXEC CICS

    READNEXT DATASET('PRODUCT')

    RIDFLD(PRM-PRODUCT-CODE)

    INTO(PRODUCT-MASTER-RECORD)

    RESP(RESPONSE-CODE)

    END-EXEC.

    IF RESPONSE-CODE = DFHRESP(ENDFILE)

    MOVE 'Y' TO PRODUCT-EOF-SW

    ELSE IF RESPONSE-CODE = DFHRESP(NORMAL)

    ADD 1 TO RECORD-COUNT

    ELSE

    GO TO 9999-TERMINATE-PROGRAM.

    *
    2200-PRINT-PRODUCT-LINE.
    *
    IF LINE-COUNT > LINES-ON-PAGE

    PERFORM 2210-PRINT-HEADING-LINES.

    MOVE PRM-PRODUCT-CODE TO PL-PRODUCT-CODE.

    MOVE PRM-PRODUCT-DESCRIPTION TO PL-DESCRIPTION.

    MOVE PRM-UNIT-PRICE TO PL-UNIT-PRICE.

    MOVE PRM-QUANTITY-ON-HAND TO PL-QUANTITY.

    MOVE PRODUCT-LINE TO PRINT-AREA.

    MOVE LENGTH OF PRODUCT-LINE TO LINE-LENGTH.

    PERFORM 2220-WRITE-QUEUE-RECORD.

    ADD 1 TO LINE-COUNT.

    MOVE SPACE TO PL-CC.

    *
    2210-PRINT-HEADING-LINES.
    *MOVE PAGE-NO TO HL1-PAGE-NO.

    MOVE HEADING-LINE-1 TO PRINT-AREA.

    MOVE LENGTH OF HEADING-LINE-1 TO LINE-LENGTH.

    PERFORM 2220-WRITE-QUEUE-RECORD.

    ADD 1 TO PAGE-NO.

    MOVE HEADING-LINE-2 TO PRINT-AREA.

    MOVE LENGTH OF HEADING-LINE-2 TO LINE-LENGTH. 
    PERFORM 2220-WRITE-QUEUE-RECORD.

    MOVE HEADING-LINE-3 TO PRINT-AREA.

    MOVE LENGTH OF HEADING-LINE-3 TO LINE-LENGTH.

    PERFORM 2220-WRITE-QUEUE-RECORD.
    MOVE '0' TO PL-CC.

    MOVE ZERO TO LINE-COUNT.

    *
    2220-WRITE-QUEUE-RECORD.
    *
    EXEC CICS

    WRITEQ TD QUEUE(DESTINATION-ID)

    FROM(PRINT-AREA)

    LENGTH(LINE-LENGTH)

    END-EXEC.

    *
    3000-PRINT-TOTAL-LINE.
    *MOVE RECORD-COUNT TO TL-RECORD-COUNT.

    MOVE TOTAL-LINE TO PRINT-AREA.

    MOVE LENGTH OF TOTAL-LINE TO LINE-LENGTH.

    PERFORM 2220-WRITE-QUEUE-RECORD.


    *
    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.


    Notes
    1. Note the CICS ENQ and DEQ to reserve and free the TD queue resource

    1. You can write a simple spool output program that writes to SYSOUT using the following CICS calls:-


No comments