Sybase.com

IDENTIFICATION DIVISION.
PROGRAM-ID. OSCICS8C.
DATE-WRITTEN. 09/17/96.
DATE-COMPILED.
******************************************************************
**
** (c) 1995 by Sybase, Inc. All Rights Reserved
**
******************************************************************

******************************************************************
** PROGRAM: OSCICS8C TRAN:SY8C....
**
** THIS PROGRAM IS A THE OPEN SERVER VERSION OF RSP8C. RECEIVES
** A TEXT INPUT STRING(10,000 BYTES) AND RETURNS IT IN A 50 BYTE
** COLUMN ONE ROW AT A TIME...
** Example: exec sy8c 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'
******************************************************************

ENVIRONMENT DIVISION.

DATA DIVISION.

WORKING-STORAGE SECTION.

******************************************************************
* COPY IN THE OS SERVER LIBRARYS
******************************************************************
COPY SYGWCOB.
******************************************************************
*OPEN SERVER WORK VARIBLES FOR OS CALL TO USE ...
******************************************************************
01 WS-GWL-WORK-VARIBLES.
05 GWL-PROC POINTER.
05 GWL-INIT-HANDLE POINTER.
05 GWL-RC PIC S9(9) COMP.
05 GWL-INFPRM-ID PIC S9(9) COMP.
05 GWL-INFPRM-TYPE PIC S9(9) COMP.
05 GWL-INFPRM-DATA-L PIC S9(9) COMP.
05 GWL-INFPRM-MAX-DATA-L PIC S9(9) COMP.
05 GWL-INFPRM-STATUS PIC S9(9) COMP.
05 GWL-INFPRM-NAME PIC X(30).
05 GWL-INFPRM-NAME-L PIC S9(9) COMP.
05 GWL-INFPRM-USER-DATA PIC S9(9) COMP.
05 GWL-INFUDT-USER-TYPE PIC S9(9) COMP.
05 GWL-STATUS-NR PIC S9(9) COMP.
05 GWL-STATUS-DONE PIC S9(9) COMP.
05 GWL-STATUS-COUNT PIC S9(9) COMP.
05 GWL-STATUS-COMM PIC S9(9) COMP.
05 GWL-COMM-STATE PIC S9(9) COMP.
05 GWL-STATUS-RETURN-CODE PIC S9(9) COMP.
05 GWL-STATUS-SUBCODE PIC S9(9) COMP.
05 GWL-NUMPRM-PARMS PIC S9(9) COMP.
05 GWL-RCVPRM-DATA-L PIC S9(9) COMP.
05 GWL-SETPRM-ID PIC S9(9) COMP.
05 GWL-SETPRM-TYPE PIC S9(9) COMP.
05 GWL-SETPRM-DATA-L PIC S9(9) COMP.
05 GWL-SETPRM-USER-DATA PIC S9(9) COMP.
05 GWL-CONVRT-SCALE PIC S9(9) COMP VALUE 2.
05 GWL-SETBCD-SCALE PIC S9(9) COMP VALUE 0.
05 GWL-INFBCD-LENGTH PIC S9(9) COMP.
05 GWL-INFBCD-SCALE PIC S9(9) COMP.
05 GWL-RETURN-ROWS PIC S9(9) COMP VALUE +0.
05 SNA-CONN-NAME PIC X(8) VALUE SPACES.
05 SNA-SUBC PIC S9(9) COMP.
05 WRK-DONE-STATUS PIC S9(9) COMP.
05 GWL-ACTUAL-LEN PIC S9(9) COMP.
05 GWL-TRAN-LEN PIC S9(9) COMP.
05 GWL-MSG-LEN PIC S9(9) COMP.
05 GWL-REQUEST-TYP PIC S9(9) COMP.
05 GWL-RPC-NAME PIC X(30) VALUE SPACES.
05 GWL-COMM-STATE PIC S9(9) COMP.
05 I PIC S9(9) COMP VALUE +0.
05 J PIC S9(4) COMP VALUE +0.

01 DESCRIPTION-FIELDS.
05 COLUMN-NUMBER PIC S9(09) COMP VALUE +0.
05 HOST-TYPE PIC S9(09) COMP VALUE +0.
05 HOST-LEN PIC S9(09) COMP VALUE +0.
05 COLUMN-LEN PIC S9(09) COMP VALUE +0.
05 COLUMN-NAME-LEN PIC S9(09) COMP VALUE +0.

01 WS-MSG-WORK-VARS.
05 MSG-NR PIC S9(9) COMP VALUE +9999.

01 WS-INPUT-LEN PIC s9(9) COMP VALUE +10000.
01 WS-INPUT-DATA-HDR.
03 WS-INPUT-DATA PIC X(10000) VALUE SPACES.
03 WS-INPUT-REDEFINE REDEFINES WS-INPUT-DATA.
05 WS-INPUT-TABLE OCCURS 10000 TIMES.
10 WS-INPUT-CHAR PIC X.

01 WS-OUTPUT-DATA-HDR.
03 WS-OUTPUT-DATA PIC X(50) VALUE SPACES.
03 WS-OUTPUT-REDEFINE REDEFINES WS-OUTPUT-DATA.
05 WS-OUTPUT-TABLE OCCURS 50 TIMES.
10 WS-OUTPUT-CHAR PIC X.

01 WS-OUTPUT-COL-NAME PIC X(13)
VALUE 'OUTPUT_COLUMN'.

******************************************************************
* MESSAGES *
******************************************************************

01 WS-MSG.
05 FILLER PIC X(17)
VALUE 'ERROR IN OS CALL '.
05 WS-MSG-FUNC PIC X(10).
05 FILLER PIC X(04)
VALUE 'RC='.
05 WS-MSG-RC PIC 9(9).
05 FILLER PIC X(18)
VALUE ' SUBCODE ERROR = '.
05 MSG-SUBC PIC 9(9) VALUE 0.
05 WS-MSG-TEXT PIC X(50) VALUE SPACES.

01 WORK-SRVIN-INFO.
05 WK-INFO-TBL-ID PIC S9(8) COMP.
05 WK-INFO-TBL-NAME PIC X(30).
05 WK-INFO-TBL-VALUE PIC X(10).

LINKAGE SECTION.
**************************************************************
* THE LINKAGE SECTION DEFINES MASKS FOR DATA AREAS THAT ARE
* PASSED BETWEEN THIS PROGRAM.
**************************************************************

01 DFHCOMMAREA PIC X(1).

PROCEDURE DIVISION.

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 RECEIVE THE
* RPC PARM........
******************************************************

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

*---> Find out how many parms are being passed <---*

CALL 'TDNUMPRM' USING GWL-PROC, GWL-NUMPRM-PARMS.

*---> More than one pump back a message <---*

IF GWL-NUMPRM-PARMS not = +1 THEN
MOVE 'Invalid Number of Parameters'
TO WS-MSG-TEXT
MOVE GWL-RC TO WS-MSG-RC
MOVE 'TDNUMPRM' TO WS-MSG-FUNC
PERFORM 920-SEND-MESSAGE THRU 920-EXIT
PERFORM 910-ERR-PROCESS THRU 910-EXIT
END-IF

*---> Get that parm into into the host varible <---*

IF GWL-NUMPRM-PARMS = +1 THEN
CALL 'TDRCVPRM' USING GWL-PROC, GWL-RC,
GWL-NUMPRM-PARMS,
WS-INPUT-DATA,
TDSLONGVARCHAR,
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
PERFORM 920-SEND-MESSAGE THRU 920-EXIT
PERFORM 910-ERR-PROCESS THRU 910-EXIT
END-IF
END-IF.
200-EXIT.
EXIT.
300-PROCESS-OUTPUT.
****************************************************************
* BREAK UP THE 10K INPUT FIELDS INTO A 50 BYTE COLUMN AND SEND
****************************************************************

MOVE +1 TO COLUMN-NUMBER.
MOVE LENGTH OF WS-OUTPUT-DATA TO HOST-LEN
COLUMN-LEN.
MOVE LENGTH OF 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
PERFORM 920-SEND-MESSAGE THRU 920-EXIT
PERFORM 910-ERR-PROCESS THRU 910-EXIT
END-IF.

PERFORM VARYING I FROM 1 BY 1 UNTIL I > GWL-ACTUAL-LEN
COMPUTE J = J + 1
MOVE WS-INPUT-CHAR(I) TO WS-OUTPUT-CHAR(J)
IF J = 50
THEN
PERFORM 310-SEND-ROW THRU 310-EXIT
MOVE ZERO TO J
MOVE SPACES TO WS-OUTPUT-DATA
END-IF
END-PERFORM.
IF J > ZERO
THEN PERFORM 310-SEND-ROW THRU 310-EXIT.

300-EXIT.
EXIT.
310-SEND-ROW.
****************************************************************
* SEND ROW OF DATA TO CLIENT....
*****************************************************************

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
PERFORM 920-SEND-MESSAGE THRU 920-EXIT
PERFORM 910-ERR-PROCESS THRU 910-EXIT
END-IF.

310-EXIT.
EXIT.
EJECT
900-ALL-DONE.
******************************************************************
* CLOSE CONNECTION TO CLIENT AND RETURN TO CICS... *
******************************************************************

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.
PERFORM 990-CICS-RETURN THRU 990-EXIT.

900-EXIT.
EXIT.

910-ERR-PROCESS.
******************************************************************
* PERFORM ALL-DONE IN A ERROR STATE *
******************************************************************

MOVE ZERO TO GWL-RETURN-ROWS.
MOVE TDS-DONE-ERROR TO WRK-DONE-STATUS.
PERFORM 900-ALL-DONE THRU 900-EXIT.

910-EXIT.
EXIT.

920-SEND-MESSAGE.
******************************************************************
* SEND ERROR MESSAGE DOWN TO CLIENT *
******************************************************************
CALL 'TDSTATUS' USING GWL-PROC, GWL-RC, GWL-STATUS-NR,
GWL-STATUS-DONE, GWL-STATUS-COUNT,
GWL-STATUS-COMM,
GWL-STATUS-RETURN-CODE,
GWL-STATUS-SUBCODE.

*==> ENSURE THAT WE ARE IN 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.

MOVE LENGTH OF EIBTRNID TO GWL-TRAN-LEN.
MOVE LENGTH OF WS-MSG TO GWL-MSG-LEN.
CALL 'TDSNDMSG' USING GWL-PROC, GWL-RC, TDS-ERROR-MSG,
MSG-NR, TDS-ERROR-SEV, TDS-ZERO,
TDS-ZERO, EIBTRNID, GWL-TRAN-LEN,
WS-MSG, GWL-MSG-LEN.

920-EXIT.
EXIT.

980-CICS-DUMP.
******************************************************************
* CAUSE A CICS TRANSACTION DUMP USUALLY BECAUSE SOMETHING IS BAD *
******************************************************************
EXEC CICS
DUMP DUMPCODE('SY8C') NOHANDLE
END-EXEC.

980-EXIT.
EXIT.

990-CICS-RETURN.
******************************************************************
* RETURN TO CICS... *
******************************************************************

EXEC CICS
RETURN
END-EXEC.

990-EXIT.
EXIT.