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
- The user starts the program by entering transaction id LST1
- 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.
- 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.
- 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
- 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 member01 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 member01 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- Note the CICS ENQ and DEQ to reserve and free the TD queue resource
- You can write a simple spool output program that writes to SYSOUT using the following CICS calls:-
No comments
Post a Comment