This repository has been archived by the owner on Jun 2, 2023. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 5
/
OLACB04.jclsamp
188 lines (171 loc) · 14.7 KB
/
OLACB04.jclsamp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
//OLACB04 JOB (),'ME',
// MSGCLASS=H,NOTIFY=&SYSUID
//*
//* Compile Cobol CICS test program for OLA - Host Service
//*
//* Test invoking a CICS program and returning a response to
//* WAS usinf a COMMAREA. This a an OLA Sample.
//*
//MYPROCS JCLLIB ORDER=MVSBUILD.CICSTS32.CICS.SDFHPROC
//CMP EXEC DFHYITVL,INDEX='MVSBUILD.CICSTS32.CICS',
// PROGLIB='BOSS.OLA.SAMPLES.LOAD',
// DSCTLIB='BOSS.OLA.SAMPLES.COPYBOOK',
// AD370HLQ='MVSBUILD.COB340',
// LE370HLQ='CEE'
//TRN.SYSIN DD *
* ------------------------------------------------------------
*
* olacb04.cob - Sample Cobol program that can be used under
* CICS, batch, or USS and demonstrates use
* of the Connection Get, Receive Request,
* Get Data, Send Response APIs.
*
* Copyright IBM Corporation 2008,2014
*
* LICENSE: Apache License
* Version 2.0, January 2004
* http://www.apache.org/licenses/
*
* This sample program returns the message that was passed.
*
* OLACB04 is a basic Cobol sample program which is used
* to demonstrate using the primitive APIs that allow a
* CICS/batch program to become an OLA server.
*
* The following code is sample code created by IBM Corporation.
* This sample code is not part of any standard IBM product and
* is provided to you solely for the purpose of assisting you in
* the development of your applications. The code is provided
* 'as is', without warranty or condition of any kind. IBM shall
* not be liable for any damages arising out of your use of the
* sample code, even if IBM has been advised of the possibility
* of such damages.
*
* -------------------------------------------------------------
*
* Module Name OLACB04
*
IDENTIFICATION DIVISION.
PROGRAM-ID. OLACB04.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*
01 FILLER PIC X(32) VALUE
'** Working storage starts here**'.
01 registername PIC X(12) VALUE SPACES.
01 servicename PIC X(255).
01 servicenamel PIC 9(8) COMP.
01 rcs-rqst-area PIC X(100) VALUE SPACES.
01 rcs-rqst-area-addr USAGE POINTER.
01 rcs-rqst-len PIC 9(8) COMP VALUE 100.
01 get-rqst-area PIC X(100) VALUE SPACES.
01 get-rqst-area-addr USAGE POINTER.
01 srp-resp-area PIC X(2048) VALUE SPACES.
01 srp-resp-area-addr USAGE POINTER.
01 srp-resp-len PIC 9(8) COMP VALUE 100.
01 waittime PIC 9(8) USAGE BINARY.
01 async PIC 9(8) USAGE BINARY.
01 con-handle-addr PIC X(12) VALUE LOW-VALUES.
01 rc PIC 9(8) COMP VALUE 0.
01 rsn PIC 9(8) COMP VALUE 0.
01 rv PIC 9(8) COMP VALUE 0.
*
LINKAGE SECTION.
*
PROCEDURE DIVISION.
*
* Setup the parameters for Connection Get API
*
MOVE 0 TO async.
MOVE 'OLACB04REG ' TO registername.
MOVE 0 To waittime.
CALL 'BBOA1CNG' USING registername,
con-handle-addr,
waittime,
rc, rsn.
* DISPLAY "OLACB04: Back from BBOA1CNG!: " rc "/" rsn
IF rc > 0 THEN
DISPLAY "OLACB04: Bad RC/RSN from BBOA1CNG: " rc "/" rsn
EXIT PROGRAM
END-IF.
*
* Setup the parameters for Receive Request API
*
SET rcs-rqst-area-addr TO ADDRESS OF rcs-rqst-area.
MOVE LENGTH OF rcs-rqst-area TO rcs-rqst-len.
*
MOVE 'OLACB04' TO servicename.
MOVE 5 TO servicenamel.
*
PERFORM BBOA1RCS-LOOP THRU BBOA1RCS-LOOP-END UNTIL rc GREATE
- R THAN 0.
EXEC CICS RETURN
END-EXEC.
BBOA1RCS-LOOP.
*
* CALL RECEIVE REQUEST SPECIFIC API
*
CALL 'BBOA1RCS' USING con-handle-addr,
servicename,
servicenamel,
rcs-rqst-len,
async,
rc, rsn.
* DISPLAY "OLACB04: Back from BBOA1RCS!: " rc "/" rsn
IF rc > 0 THEN
DISPLAY "OLACB04: Bad RC/RSN from BBOA1RCS: " rc "/" rsn
GO TO BBOA1CNR-EXIT
END-IF.
*
BBOA1GET.
*
* Get data API call
*
SET get-rqst-area-addr TO ADDRESS OF get-rqst-area.
CALL 'BBOA1GET' USING con-handle-addr,
get-rqst-area-addr, rcs-rqst-len,
rc, rsn, rv.
IF rc > 0 THEN
DISPLAY "OLACB04: Bad RC/RSN from BBOA1GET: " rc "/" rsn
GO TO BBOA1CNR-EXIT
END-IF.
BBOA1SRP-SETUP.
*
* Setup the parameters to SEND RESPONSE
*
MOVE get-rqst-area TO srp-resp-area.
SET srp-resp-area-addr TO ADDRESS OF srp-resp-area.
BBOA1SRP.
*
* CALL SEND RESPONSE API
*
CALL 'BBOA1SRP' USING con-handle-addr,
srp-resp-area-addr, srp-resp-len,
rc, rsn.
* DISPLAY "OLACB04: Back from BBOA1SRP!: " rc "/" rsn
IF rc > 0 THEN
DISPLAY "OLACB04: Bad RC/RSN from BBOA1SRP: " rc "/" rsn
GO TO BBOA1CNR-EXIT
END-IF.
*
BBOA1RCS-LOOP-END.
*
BBOA1CNR-EXIT.
*
* Connection Release
*
CALL 'BBOA1CNR' USING
con-handle-addr,
rc, rsn.
If rc > 0 Then
DISPLAY "OLACB04: Bad RC/RSN from BBOA1CNR: " rc "/" rsn
End-IF.
*
EXEC CICS RETURN
END-EXEC.
//LKED.SYSLIB DD DSN=BOSS.OLA90907.PERF.SBBOLOAD,DISP=SHR
// DD DSN=MVSBUILD.CICSTS32.CICS.SDFHLOAD,DISP=SHR
// DD DSN=CEE.SCEELKED,DISP=SHR
//LKED.SYSIN DD *
NAME OLACB04(R)