IDENTIFICATIONDIVISION. PROGRAM-ID. OSCICS4C. DATE-WRITTEN. 12/17/96. DATE-COMPILED. ****************************************************************** ** ** (c) 1995 by Sybase, Inc. All Rights Reserved ** ******************************************************************
****************************************************************** ** PROGRAM: OSCICS4C ** ** THIS PROGRAM IS A THE OPEN SERVER VERSION OF RSP4C. ** It will receive one of 2 Keywords @ERRORMSG or @WARNMSG and ** Other Keywords. Will reply with the keywords and data. ** If @ERRORMSG AND/OR @WARNMSG are 'Y' that type of message ** will be returned... ** exec SY4C @WARNMSG=Y,@ERRORMSG=Y......... ******************************************************************
01 WS-HOLD-MSG PIC X(107) VALUESPACES.
01 WS-WARN-MSG PIC X(107) VALUE 'THIS IS A WARNING MESSAGE........'.
01 WS-ERR-MSG PIC X(107) VALUE 'THIS IS A ERROR MESSAGE........'.
LINKAGESECTION. **************************************************************
* THE LINKAGESECTION DEFINES MASKS FORDATA AREAS THAT ARE
* PASSED BETWEEN THIS PROGRAM. **************************************************************
01 DFHCOMMAREA PIC X(1).
PROCEDUREDIVISION.
000-MAIN-PROCESSING.
PERFORM 100-INITIALIZE THRU 100-EXIT.
PERFORM 200-PROCESS-INPUT THRU 200-EXIT.
PERFORM 300-PROCESS-OUTPUT THRU 300-EXIT.
PERFORM 900-ALL-DONE THRU 900-EXIT.
GOBACK.
000-EXIT. EXIT.
100-INITIALIZE.
******************************************************
* INTIALIZED THE TDS CONNECTION AND CONFIRM THAT IS
* WAS AN RPC CALL, ........ ******************************************************
*==> INITIAL QUEUE NAME <===* MOVE EIBTRMID TO WS-TRMID.
*==> ESTABLISH GATEWAY ENVIRONMENT <===*
CALL'TDINIT'USING DFHEIBLK, GWL-RC, GWL-INIT-HANDLE. IF GWL-RC NOT = TDS-OK THEN PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF.
*==> ACCEPT CLIENT REQUEST <===*
CALL'TDACCEPT'USING GWL-PROC, GWL-RC, GWL-INIT-HANDLE,
SNA-CONN-NAME, SNA-SUBC. IF GWL-RC NOT = TDS-OK THEN PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF.
*==> TO MAKE SURE WE WERE STARTED BY RPC REQUEST... <===*
CALL'TDINFRPC'USING GWL-PROC, GWL-RC,
GWL-REQUEST-TYP, GWL-RPC-NAME,
GWL-COMM-STATE. IF GWL-RC NOT = TDS-OK OR
GWL-REQUEST-TYP NOT = TDS-RPC-EVENT THEN MOVE GWL-RC TO WS-MSG-RC MOVE'TDINFRPC'TO WS-MSG-FUNC PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF.
100-EXIT. EXIT.
200-PROCESS-INPUT. ****************************************************************
* RECEIVE THE INPUT PARAMETER INTO HOST VARIBLE, SEND ROW DATA *
* BACK DOWNTO CLIENT * ****************************************************************
*---> Find out how many parms are being passed <---*
CALL'TDNUMPRM'USING GWL-PROC, GWL-NUMPRM-PARMS.
*---> NO PARMS, pump back a message <---*
IF GWL-NUMPRM-PARMS < +1 THEN MOVE'At least one parm is needed' TO WS-MSG-TEXT MOVE GWL-RC TO WS-MSG-RC MOVE'TDNUMPRM'TO WS-MSG-FUNC MOVE WS-MSG TO WS-HOLD-MSG MOVE TDS-ERROR-MSG TO WS-ERROR-MSG MOVE TDS-ERROR-SEV TO WS-ERROR-SEV PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF.
*---> TESTTO SEE IF THE KEYWORDS "WARNMSG"AND <---*
*---> OR ERRORMSG WHERE SENT.... <---* MOVELENGTHOF WS-WARNMSG TO WS-LENGTH. CALL'TDLOCPRM'USING GWL-PROC, WS-WARNMSG-ID,
WS-WARNMSG, WS-LENGTH.
MOVELENGTHOF WS-ERRORMSG TO WS-LENGTH. CALL'TDLOCPRM'USING GWL-PROC, WS-ERRORMSG-ID,
WS-ERRORMSG, WS-LENGTH.
*---> SAVE THE NUMBER OF PARMS FOR THE LOOP <---* MOVE GWL-NUMPRM-PARMS TO WS-NUMPRM-PARMS.
*---> LOOP THRU THE PARMS ANDWRITETO TEMP STORAGE <----* PERFORMVARYING GWL-NUMPRM-PARMS FROM 1 BY 1 UNTIL GWL-NUMPRM-PARMS > WS-NUMPRM-PARMS PERFORM 210-GET-PARM THRU 210-EXIT PERFORM 220-WRITE-TS THRU 220-EXIT
END-PERFORM.
200-EXIT. EXIT.
210-GET-PARM. ****************************************************************
* *---> Get that parm intointo the host varible <---* * ****************************************************************
CALL'TDRCVPRM'USING GWL-PROC, GWL-RC,
GWL-NUMPRM-PARMS,
WS-INPUT-DATA,
TDSCHAR,
WS-INPUT-LEN,
GWL-ACTUAL-LEN IF GWL-RC NOT = TDS-OK THEN MOVE GWL-RC TO WS-MSG-RC MOVE'TDRCVPRM'TO WS-MSG-FUNC MOVE WS-MSG TO WS-HOLD-MSG MOVE TDS-ERROR-MSG TO WS-ERROR-MSG MOVE TDS-ERROR-SEV TO WS-ERROR-SEV PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF.
210-EXIT. EXIT.
220-WRITE-TS. ****************************************************************
* *---> WRITE PARMS TO TEMP STORAGE, LATER RETURN PARMS <---* *
* *---> BACK DOWNTO CLIENT AS OUTPUT <---* * ****************************************************************
EXECCICS
WRITEQ TS QUEUE(WS-QUEUE-NAME) FROM (WS-INPUT-DATA) LENGTH(LENGTHOF WS-INPUT-DATA)
RESP (CICSRC) END-EXEC. IF CICSRC NOT = DFHRESP(NORMAL) MOVE CICSRC TO CICSRC-DIS MOVE CICSRC-DIS TO WS-MSG-RC MOVE'WRITEQ'TO WS-MSG-FUNC MOVE WS-MSG TO WS-HOLD-MSG MOVE TDS-ERROR-MSG TO WS-ERROR-MSG MOVE TDS-ERROR-SEV TO WS-ERROR-SEV PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF.
220-EXIT. EXIT.
300-PROCESS-OUTPUT. ****************************************************************
* READ TEMP STORAGE QUEUE AND SEND ROWS TO CLIENT * ****************************************************************
PERFORM 310-DEFINE-OUTPUT THRU 310-EXIT.
PERFORMVARYING I FROM 1 BY 1 UNTIL I > WS-NUMPRM-PARMS PERFORM 320-READQ-TS THRU 320-EXIT PERFORM 330-SEND-ROW THRU 330-EXIT END-PERFORM.
*---> PROCESS WARNMSG AND/OR ERRORMSG AFTER SENDING ROWS. <---* IF WARNING-MSG THEN MOVE TDS-INFO-MSG TO WS-ERROR-MSG MOVE TDS-INFO-SEV TO WS-ERROR-SEV MOVE WS-WARN-MSG TO WS-HOLD-MSG PERFORM 920-SEND-MESSAGE THRU 920-EXIT END-IF. IF ERROR-MSG THEN MOVE TDS-ERROR-MSG TO WS-ERROR-MSG MOVE TDS-ERROR-SEV TO WS-ERROR-SEV MOVE WS-ERR-MSG TO WS-HOLD-MSG PERFORM 920-SEND-MESSAGE THRU 920-EXIT END-IF.
300-EXIT. EXIT.
310-DEFINE-OUTPUT. ****************************************************************
* DEFINE THE OUTPUT COLUM AS CHAR OF 55 BYTES * ****************************************************************
MOVE +1 TO COLUMN-NUMBER. MOVELENGTHOF WS-OUTPUT-DATA TO HOST-LEN
COLUMN-LEN. MOVELENGTHOF WS-OUTPUT-COL-NAME TO COLUMN-NAME-LEN. CALL'TDESCRIB'USING GWL-PROC,
GWL-RC,
COLUMN-NUMBER,
TDSCHAR,
HOST-LEN,
WS-OUTPUT-DATA,
TDS-ZERO,
TDS-FALSE,
TDSCHAR,
COLUMN-LEN,
WS-OUTPUT-COL-NAME,
COLUMN-NAME-LEN.
IF GWL-RC NOT = TDS-OK THEN MOVE GWL-RC TO WS-MSG-RC MOVE'TDESCRIB'TO WS-MSG-FUNC MOVE WS-MSG TO WS-HOLD-MSG MOVE TDS-ERROR-MSG TO WS-ERROR-MSG MOVE TDS-ERROR-SEV TO WS-ERROR-SEV PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF.
310-EXIT. EXIT.
320-READQ-TS. ****************************************************************
* READ THE INPUT TEMP STORAGE QUEUE **************************************************************** EXECCICS
READQ TS QUEUE(WS-QUEUE-NAME) INTO (WS-OUTPUT-DATA) LENGTH(LENGTHOF WS-OUTPUT-DATA) NEXT
RESP (CICSRC) END-EXEC. IF CICSRC NOT = DFHRESP(NORMAL) MOVE CICSRC TO CICSRC-DIS MOVE CICSRC-DIS TO WS-MSG-RC MOVE'READQ'TO WS-MSG-FUNC MOVE WS-MSG TO WS-HOLD-MSG MOVE TDS-ERROR-MSG TO WS-ERROR-MSG MOVE TDS-ERROR-SEV TO WS-ERROR-SEV PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF.
*---> PROCESS WARNMSG AND/OR ERRORMSG PARMS IF YES... <---* IF WS-WARNMSG-ID = I AND WS-OUTPUT-DATA = 'Y' MOVE'Y'TO WS-WARNMSG-88. IF WS-ERRORMSG-ID = I AND WS-OUTPUT-DATA = 'Y' MOVE'Y'TO WS-ERRORMSG-88.
320-EXIT. EXIT.
CALL'TDSNDROW'USING GWL-PROC, GWL-RC IF GWL-RC NOT = TDS-OK THEN MOVE GWL-RC TO WS-MSG-RC MOVE'TDSNDROW'TO WS-MSG-FUNC MOVE WS-MSG TO WS-HOLD-MSG MOVE TDS-ERROR-MSG TO WS-ERROR-MSG MOVE TDS-ERROR-SEV TO WS-ERROR-SEV PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF.
330-EXIT. EXIT.
EJECT
900-ALL-DONE. ******************************************************************
* CLOSE CONNECTION TO CLIENT ANDRETURNTOCICS... * ******************************************************************
CALL'TDSNDDON'USING GWL-PROC, GWL-RC, WRK-DONE-STATUS,
GWL-RETURN-ROWS, TDS-ZERO, TDS-ENDRPC. IF GWL-RC NOT = TDS-OK THEN PERFORM 980-CICS-DUMP THRU 980-EXIT PERFORM 990-CICS-RETURN THRU 990-EXIT END-IF.
CALL'TDFREE'USING GWL-PROC, GWL-RC.
EXECCICS
DELETEQ TS QUEUE(WS-QUEUE-NAME)
RESP (CICSRC) END-EXEC. IF CICSRC NOT = DFHRESP(NORMAL) MOVE CICSRC TO CICSRC-DIS MOVE CICSRC-DIS TO WS-MSG-RC MOVE'DELETEQ'TO WS-MSG-FUNC MOVE WS-MSG TO WS-HOLD-MSG MOVE TDS-ERROR-MSG TO WS-ERROR-MSG MOVE TDS-ERROR-SEV TO WS-ERROR-SEV PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF.
PERFORM 990-CICS-RETURN THRU 990-EXIT.
900-EXIT. EXIT.
910-ERR-PROCESS. ******************************************************************
* PERFORM ALL-DONE IN A ERROR STATE * ******************************************************************
MOVEZEROTO GWL-RETURN-ROWS. MOVE TDS-DONE-ERROR TO WRK-DONE-STATUS. PERFORM 900-ALL-DONE THRU 900-EXIT.
*==> ENSURE THAT WE AREIN THE CORRECT STATE TO SEND A MESSAGE <=* IF GWL-RC NOT = TDS-OK THEN PERFORM 980-CICS-DUMP THRU 980-EXIT PERFORM 990-CICS-RETURN THRU 990-EXIT END-IF.
IF GWL-STATUS-COMM = TDS-RECEIVE THEN CALL'TDCANCEL'USING GWL-PROC, GWL-RC.
MOVELENGTHOF EIBTRNID TO GWL-TRAN-LEN. MOVELENGTHOF WS-HOLD-MSG TO GWL-MSG-LEN. CALL'TDSNDMSG'USING GWL-PROC, GWL-RC, WS-ERROR-MSG,
MSG-NR, WS-ERROR-SEV, TDS-ZERO,
TDS-ZERO, EIBTRNID, GWL-TRAN-LEN,
WS-HOLD-MSG, GWL-MSG-LEN.
920-EXIT. EXIT.
980-CICS-DUMP. ******************************************************************
* CAUSE A CICS TRANSACTION DUMP USUALLY BECAUSE SOMETHING IS BAD * ****************************************************************** EXECCICS
DUMP DUMPCODE('SY3C') NOHANDLE END-EXEC.
¤ Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.0.62Bemerkung:
(vorverarbeitet)
¤
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.