IDENTIFICATION DIVISION. PROGRAM-ID. RSP3C. ****************************************************************** * RSP3C - STD INPUT PIPES PROCEDURE * * * * THIS SAMPLE STORED PROCEDURE WAS WRITTEN TO USE A "STD" INPUT * * AND OUTPUT PIPE FOR ILLUSTRATION. IT REQUIRES AT LEAST ONE * * DATA RECORD TO BE PASSED TO IT WHEN INVOKED. * * AN EXAMPLE OF INVOKING IT: * * * * USE PROCEDURE WITH DATA RSP3C ; * * THIS IS THE FIRST AND ONLY DATA RECORD * * ; * * * * DATA RECORDS ARE SET FOR UP TO 55 CHARS IN LENGTH. ALL * * DATA RECORDS WILL BE RETURNED THROUGH THE OUTPUT PIPE AS * * VERIFICATION. * * * ****************************************************************** ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION.
******************************************************************
* ONE POINTER IS USED FOR BOTH INPUT AND OUTPUT RECORD AREA
* IN THIS CASE BECAUSE THE RECORDS WILL BE THE SAME LENGTH.
******************************************************************
01 SAMPLE-POINTER.
10 PARTSPOINTER USAGE IS POINTER.
******************************************************************
* SWITCHES FOR RECORD PROCESSING CONTROL. *
******************************************************************
01 WS-SWITCHES.
10 WS-MORE-RECORDS-IN-SW PIC X(01) VALUE 'Y'.
88 MORE-RECORDS-IN VALUE 'Y'.
88 NO-MORE-RECORDS-IN VALUE 'N'.
10 WS-ERROR-HAPPENED-SW PIC X(01) VALUE 'N'.
88 ERROR-HAPPENED VALUE 'Y'.
88 NO-ERROR-YET VALUE 'N'.
******************************************************************
* A NUMBER FOR INCRIMENTING. *
******************************************************************
01 WS-VARIABLES.
05 WS-INCRINUM PIC 99 VALUE ZEROES.
05 INREC-CTR PIC S9(8) COMP VALUE 0.
05 WS-DIS-NUM PIC 9(4) VALUE ZEROES.
01 MESSAGES.
05 ERROR1-MSG.
07 ERROR1-TEXT1 PIC X(19) VALUE
'ERROR WITH CALL TO '.
07 ERROR1-CALL PIC X(10) VALUE SPACES.
07 ERROR1-TEXT2 PIC X(14) VALUE
' - SPRC CODE: '.
07 ERROR1-SPRC PIC X(03) VALUE SPACES.
******************************************************************
* OUTPUT RECORD DESCRIPTIONS. *
******************************************************************
01 WS-OUTPUT-REC.
10 WS-OUT-MSG-AREA.
15 FILLER PIC X(07) VALUE 'REC#-> '.
15 WS-OUT-MSG-NUM PIC X(02) VALUE SPACES.
15 FILLER PIC X(01) VALUE ':'.
10 WS-OUT-SOME-DATA PIC X(45) VALUE SPACES.
01 WS-OUT-DATA-MSG.
10 FILLER PIC X(55) VALUE
'**--> THE FOLLOWING IS A LIST OF THE DATA RECORDS SENT.'.
* THIS SWITCH IS USED FOR TESTING IF RPC CALL
77 RSPRPC-SWITCH PIC S9(4) COMP VALUE 0.
88 RPC-CALL VALUE 0.
01 COMMAREA-POINTER USAGE IS POINTER.
LINKAGE SECTION.
**************************************************************
* THE LINKAGE SECTION DEFINES MASKS FOR DATA AREAS THAT ARE
* PASSED BETWEEN THIS PROGRAM AND MAINFRAMECONNECT.
**************************************************************
01 DFHCOMMAREA.
05 NOT-USED PIC X(1).
******************************************************************
* THIS IS THE ACTUAL SPAREA POINTER AND DEFINITION *
******************************************************************
01 LWKCOMMAREA.
COPY SPAREAC.
**************************************************************
* THIS AREA IS USED FOR BOTH INPUT AND OUTPUT BECAUSE BOTH
* TYPES OF RECORDS ARE THE SAME LENGTH IN THIS CASE.
**************************************************************
01 WS-INPUT-REC.
10 WS-INPUT-DATA.
15 WS-INPUT-1ST-5 PIC X(05).
15 FILLER PIC X(40).
10 WS-INPUT-REST PIC X(10).
PROCEDURE DIVISION.
000-MAIN-PROCESSING.
PERFORM 100-INITIALIZE THRU 100-EXIT.
IF NO-ERROR-YET
PERFORM 500-PROCESS-I-O THRU 500-EXIT.
PERFORM 900-WRAP-UP THRU 900-EXIT.
EXEC CICS
RETURN
END-EXEC.
GOBACK.
000-EXIT.
EXIT.
100-INITIALIZE.
******************************************************
* IF THIS IS A RPC CALL, CALL RPSETUP TO INITIALIZE SPAREA
* AND OPEN SERVER (TRANSACTION ROUTER SERVICE)
* IF THIS IS A RSP CALL, SPAREA IS PASSED IN THE COMMAREA.
* (DIRECTCONNECT).
* FOR TRACING, MOVE 'Y' TO SPTRCOPT
******************************************************
MOVE EIBCALEN TO RSPRPC-SWITCH.
IF RPC-CALL
EXEC CICS GETMAIN
SET (COMMAREA-POINTER)
FLENGTH (LENGTH OF LWKCOMMAREA)
END-EXEC
SET ADDRESS OF LWKCOMMAREA TO COMMAREA-POINTER
CALL 'RPSETUP' USING SPAREA
ELSE
SET ADDRESS OF LWKCOMMAREA TO ADDRESS OF DFHCOMMAREA.
MOVE 'OK' TO SPSTATUS.
SET MORE-RECORDS-IN TO TRUE.
******************************************************************
* ALLOCATE A BLOCK OF STORAGE TO BE USED FOR THE DATA
* SET POINTER VARIABLE TO ADDRESS OF ALLOCATED STORAGE
******************************************************************
EXEC CICS
GETMAIN SET(PARTSPOINTER)
FLENGTH(55)
END-EXEC.
SET ADDRESS OF WS-INPUT-REC TO PARTSPOINTER.
PERFORM 110-OPEN-INPUT-PIPE THRU 110-EXIT.
IF NO-ERROR-YET
PERFORM 120-OPEN-OUTPUT-PIPE THRU 120-EXIT.
100-EXIT.
EXIT.
110-OPEN-INPUT-PIPE.
******************************************************************
* OPEN THE INPUT PIPE. *
******************************************************************
MOVE 'INPUT' TO SPMODE.
MOVE 'STD' TO SPFORMAT.
MOVE 55 TO SPMAXLEN.
CALL 'OPENPIPE' USING SPAREA.
******************************************************************
* IF OPEN FAILED, THEN ISSUE AN ERROR MESSAGE. *
******************************************************************
IF SPRC NOT = '000'
SET ERROR-HAPPENED TO TRUE
MOVE 'OPENPIPE' TO ERROR1-CALL
PERFORM 800-DO-MESSAGE THRU 800-EXIT.
110-EXIT.
EXIT.
120-OPEN-OUTPUT-PIPE.
******************************************************************
* AFTER A SUCCESSFUL OPENPIPE FOR OUTPUT: HEADER, TABLE, AND
* COLUMN IXF RECORDS ARE GENERATED AND SENT TO APPC.
******************************************************************
MOVE 'OUTPUT' TO SPMODE.
MOVE 'STD' TO SPFORMAT.
MOVE 55 TO SPMAXLEN.
CALL 'OPENPIPE' USING SPAREA.
******************************************************************
* IF OPEN FAILED, THEN ISSUE AN ERROR MESSAGE. *
******************************************************************
IF SPRC NOT = '000'
SET ERROR-HAPPENED TO TRUE
MOVE 'OPENPIPE' TO ERROR1-CALL
PERFORM 800-DO-MESSAGE THRU 800-EXIT.
120-EXIT.
EXIT.
500-PROCESS-I-O.
MOVE 0 TO WS-INCRINUM.
PERFORM 510-SEND-RECORDS-HEADING THRU 510-EXIT.
IF NO-ERROR-YET
PERFORM 540-PROCESS-DATA-RECS THRU 540-EXIT
UNTIL NO-MORE-RECORDS-IN.
500-EXIT.
EXIT.
510-SEND-RECORDS-HEADING.
MOVE WS-OUT-DATA-MSG TO WS-INPUT-REC.
SET SPFROM TO ADDRESS OF WS-INPUT-REC.
*-------------------------------------------------------*
* PUTPIPE SENDS A RESULT ROW TO THE OUTPUT BUFFER, WHICH*
* WILL EVENTUALLY BE SENT DOWN TO THE CLIENT APPLICATION*
*-------------------------------------------------------*
CALL 'PUTPIPE' USING SPAREA.
IF SPRC NOT = '000'
SET ERROR-HAPPENED TO TRUE
MOVE 'PUTPIPE ' TO ERROR1-CALL
PERFORM 800-DO-MESSAGE THRU 800-EXIT.
510-EXIT.
EXIT.
540-PROCESS-DATA-RECS.
******************************************************************
* OBTAIN THE DATA RECORDS SENT WITH PROGRAM AND SEND BACK TO PIPE*
******************************************************************
IF NO-ERROR-YET
PERFORM 542-READ-RECORDS THRU 542-EXIT.
IF NO-ERROR-YET
AND MORE-RECORDS-IN
PERFORM 544-WRITE-RECORDS THRU 544-EXIT.
540-EXIT.
EXIT.
542-READ-RECORDS.
******************************************************************
* READ AN INPUT RECORD THROUGH THE INPUT PIPE *
* NOTE THAT THE SPRECLEN DOESN'T NEED TO BE SET BECAUSE THE *
* MAINFRAMECONNECT SETS THIS FIELD WHEN IT SENDS THE INPUT RECORD. *******************************************************************
ADD 1 TO INREC-CTR
SET SPINTO TO ADDRESS OF WS-INPUT-REC.
CALL 'GETPIPE' USING SPAREA.
EVALUATE SPRC
WHEN '000' CONTINUE
WHEN 'EOF' SET NO-MORE-RECORDS-IN TO TRUE
WHEN OTHER PERFORM
SET NO-MORE-RECORDS-IN TO TRUE
SET ERROR-HAPPENED TO TRUE
MOVE 'GETPIPE ' TO ERROR1-CALL
PERFORM 800-DO-MESSAGE THRU 800-EXIT
END-PERFORM
END-EVALUATE.
******************************************************************
* THIS IS JUST TO PREVENT ACCIDENTAL RUNAWAY. ******************************************************************
IF WS-INPUT-1ST-5 = SPACES
OR INREC-CTR > 500
SET NO-MORE-RECORDS-IN TO TRUE
SET ERROR-HAPPENED TO TRUE
MOVE 'RUNAWAY ' TO ERROR1-CALL
PERFORM 800-DO-MESSAGE THRU 800-EXIT
END-IF.
542-EXIT.
EXIT.
544-WRITE-RECORDS.
******************************************************************
* REFORMAT THE INPUT RECORD AND SEND BACK DOWN THE OUTPUT PIPE *
* NOTE THAT SPRECLEN IS RESET TO 55 EACH TIME BECAUSE THE VALUE *
* MIGHT BE CHANGED BY THE PREVIOUS GETPIPE. *
******************************************************************
ADD 1 TO WS-INCRINUM.
MOVE WS-INCRINUM TO WS-OUT-MSG-NUM.
* MOVE WS-INPUT-DATA TO WS-OUT-SOME-DATA.
MOVE SPACES TO WS-OUT-SOME-DATA.
MOVE WS-INPUT-DATA (1:SPRECLEN) TO WS-OUT-SOME-DATA.
MOVE WS-OUTPUT-REC TO WS-INPUT-REC.
MOVE 55 TO SPRECLEN.
SET SPFROM TO ADDRESS OF WS-INPUT-REC.
*-------------------------------------------------------*
* PUTPIPE SENDS A RESULT ROW TO THE OUTPUT BUFFER, WHICH*
* WILL EVENTUALLY BE SENT DOWN TO THE CLIENT APPLICATION*
*-------------------------------------------------------*
CALL 'PUTPIPE' USING SPAREA.
IF SPRC NOT = '000'
SET NO-MORE-RECORDS-IN TO TRUE
SET ERROR-HAPPENED TO TRUE
MOVE 'PUTPIPE ' TO ERROR1-CALL
PERFORM 800-DO-MESSAGE THRU 800-EXIT.
544-EXIT.
EXIT.
800-DO-MESSAGE.
******************************************************************
* SOMETHING FAILED, SO ISSUE AN ERROR MESSAGE AND GET OUT. *
******************************************************************
MOVE SPRC TO ERROR1-SPRC.
MOVE ERROR1-MSG TO SPMSG.
MOVE 'E' TO SPSTATUS.
*-------------------------------------------------------*
* MESSAGE WILL WRITE THE 100 BYTE SPMSG TO A MSG BUFFER,*
* WHICH WILL EVENTUALLY BE WRITTEN TO THE CLIENT *
* APPLICATION *
*-------------------------------------------------------*
CALL 'MESSAGE' USING SPAREA.
IF SPRC NOT = '000'
SET NO-MORE-RECORDS-IN TO TRUE
SET ERROR-HAPPENED TO TRUE.
800-EXIT.
EXIT.
900-WRAP-UP.
******************************************************************
* CLOSE PIPES - ISSUE STATUS. *
******************************************************************
*-------------------------------------------------------*
*CLOSEPIPE IS LIKE CLOSING A FILE, PLACES AN EOF MARKER*
*-------------------------------------------------------*
IF NO-ERROR-YET
MOVE 'INPUT' TO SPMODE
CALL 'CLOSPIPE' USING SPAREA
IF SPRC NOT = '000'
SET ERROR-HAPPENED TO TRUE
MOVE 'CLOSPIPE' TO ERROR1-CALL
PERFORM 800-DO-MESSAGE THRU 800-EXIT.
IF NO-ERROR-YET
MOVE 'OUTPUT' TO SPMODE
CALL 'CLOSPIPE' USING SPAREA
IF SPRC NOT = '000'
SET ERROR-HAPPENED TO TRUE
MOVE 'CLOSPIPE' TO ERROR1-CALL
PERFORM 800-DO-MESSAGE THRU 800-EXIT
END-IF
END-IF.
IF NO-ERROR-YET
MOVE 'OK' TO SPSTATUS
*-----------------------------------------------------------*
* CALLING STATUS WILL FLUSH ANY RESULTS AND/OR *
* MESSAGES FROM THE BUFFERS, TO THE CLIENT APPLICATION *
*-----------------------------------------------------------*
CALL 'STATUS' USING SPAREA
IF SPRC NOT = '000'
SET ERROR-HAPPENED TO TRUE
MOVE 'STATUS ' TO ERROR1-CALL
PERFORM 800-DO-MESSAGE THRU 800-EXIT
END-IF
ELSE
MOVE 'E' TO SPSTATUS
MOVE 'MYERCODE' TO SPCODE
CALL 'STATUS' USING SPAREA
END-IF.
********************************************************
* CLOSE OPEN SERVER
* IF THIS IS AN RPC CALL, PERFORM OPEN SERVER CLOSE
********************************************************
IF RPC-CALL
CALL 'RPDONE' USING SPAREA.
900-EXIT.
EXIT.
