| View previous topic :: View next topic |
| Author |
Message |
vijay
Beginner
Joined: 09 May 2003
Posts: 131
Topics: 64
|
 Posted: Wed May 05, 2004 11:33 am Post subject: Need Help with a small CICS/DB2 Program |
 |
|
Hi ,
I need help with a small program.I could not test bcos of Access problems.I need to write a CICS/DB2 program that would be used by many other programs using EXEC CICS LINK.
Basically I get client number and client client code and I've to lookup a table to validate it and pass back the result to the calling program.I did the coding and could not test it.
Can you please tell me if I've made any mistakes in my coding.(Particularly the mainline logic)
Here is the code:
| Code: |
000200 ID DIVISION. 00010000
000300 PROGRAM-ID. XC4OTBL. 00020000
000400 AUTHOR. KRYPTIX DN. 00030000
000500 DATE-WRITTEN. 05/04/2004. 00040000
000600 DATE-COMPILED. 00050000
000700***************************************************************** 00060000
000800* THIS IS A LINKED PROGRAM USED TO VALIDATE THE CLIENT * 00070000
000900* NUMBER. * 00080000
001500***************************************************************** 00090000
005200 ENVIRONMENT DIVISION. 00100000
005300* 00110000
005400 DATA DIVISION. 00120000
005500* 00130000
005600 WORKING-STORAGE SECTION. 00140000
005700* 00150000
007400*--------------------------------------------------------------* 00370000
008600*-- ERROR MESSAGE TO WRITE TO CICS LOG IN CASE OF DB2 ERRORS * 00380000
007400*--------------------------------------------------------------* 00390000
019100 00400000
01 WS-ERR-DATA. 00410000
03 WS-REQUEST-TYPE PIC X(01). 00420000
88 WS-WRITE-ERROR-TO-LOG VALUE 'Y'. 00430000
03 CALLING-TRAN-ID PIC X(04). 00440000
03 CALLING-PROGRAM-ID PIC X(08). 00450000
03 SQLCA-AREA PIC X(136). 00460000
019100 00470000
007400*--------------------------------------------------------------* 00480000
008600*-- COMMUNICATION AREA FROM THE LINKING PROGRAM (LEN 15) * 00490000
007400*--------------------------------------------------------------* 00500000
019100 00510000
022000 01 WS-COMMAREA. 00520000
022100 05 WS-CLIENT-NUM PIC 9(3). 00530000
022200 05 WS-CLIENT-CODE PIC X(5). 00540000
022200 05 WS-CLIENT-OK. 00550000
022503 88 WS-CLIENT-OK VALUE '0'. 00560000
022503 88 WS-CLIENT-NOT-OK VALUE '1'. 00570000
022503 05 WS-RETURN-CODE-DB2. 00630000
022503 10 WS-RC-DB2 PIC X(01). 00640000
022503 88 WS-RC-DB2-NORMAL VALUE '0'. 00650000
022503 88 WS-RC-DB2-ERROR VALUE '1'. 00660000
022503 10 WS-RC-DB2-SQLCODE PIC S9(6). 00670000
025800 00680000
007400*--------------------------------------------------------------* 00690000
008600*-- TABLE LAYOUT. * 00700000
007400*--------------------------------------------------------------* 00710000
EXEC SQL INCLUDE ZZCTABL END-EXEC. 00720000
00730000
007400*--------------------------------------------------------------* 00740000
008600*-- SQL COMMON AREA. * 00750000
007400*--------------------------------------------------------------* 00760000
EXEC SQL INCLUDE SQLCA END-EXEC. 00770000
00780000
025900 LINKAGE SECTION. 00790000
026000* 00800000
026100 01 DFHCOMMAREA PIC X(016). 00810000
026200 00820000
026300 EJECT 00830000
026400 00840000
026500 PROCEDURE DIVISION. 00850000
026600 00860000
026700 000-MAIN-LINE. 00870000
027200 00880000
INITIALIZE WS-COMMAREA. 00890000
027200 00910000
027300 MOVE DFHCOMMAREA TO WS-COMMAREA. 00920000
027400 00930000
027500 IF (WS-CLIENT-NUM NOT > SPACES) 00940000
SET WS-CLIENT-NOT-OK TO TRUE 00950001
027700 GO TO 000-EXIT 00990000
027701 END-IF 01000000
027702 01010000
027703 IF (WS-CLIENT-CODE NOT > SPACES) 01020000
SET WS-CLIENT-NOT-OK TO TRUE 01030001
027700 GO TO 000-EXIT 01060000
027705 END-IF 01070000
027706 01080000
MOVE WS-CLIENT-NUM TO ZZCTABL-CLIENT-NBR. 01220000
MOVE WS-CLIENT-CODE TO ZZCTABL-CLIENT-CD. 01250000
027706 01260001
028200 PERFORM 020-CHECK-TABLE THRU 020-EXIT. 01270000
028700 01290000
029102 01400000
162300 000-EXIT. 01410000
162400 01420000
162600 01430000
162700 MOVE WS-COMMAREA TO DFHCOMMAREA. 01440000
162800 01450000
162900 EXEC CICS 01460000
163000 RETURN 01470000
163100 END-EXEC. 01480000
163200 01490000
GOBACK. 01500000
163200 01510000
037900 01760000
038000 01770000
038100*----------------------------------------------------------------*01780000
038200* CHECK THE TABLE *01790000
038200* CLIENT NO. AND CLIENT CD WILL BE UNIQUE *01791000
038400*----------------------------------------------------------------*01800000
038500 01810000
038600 020-CHECK-TABLE. 01820000
039000 01830000
*-- SELECT THE RECORD BASED ON CLIENT_NBR AND CLIENT_CD 01840000
EXEC SQL 01850000
SELECT ZZPSS_TYPE_CD, 01860001
ZZPSS_KEY_NM 01870001
INTO :ZZCTABL-ZZPSS-TYPE-CD, 01880001
:ZZCTABL-ZZPSS-KEY-NM 01890001
FROM ZZCTABL 01900000
WHERE CLIENT_NBR = :ZZCTABL-CLIENT-NBR 01910000
AND ZZPSS_CLNT_CD = :ZZCTABL-CLIENT-CD 01920001
END-EXEC. 01930000
039000 01940000
IF SQLCODE = 0 01980000
SET CLIENT-OK TO TRUE 01981000
ELSE 01982000
IF SQLCODE = 100 01983000
SET CLIENT-NOT-OK TO TRUE 01984000
ELSE 01985000
IF SQLCODE NOT = 0 01990000
SET WS-RC-DB2-ERROR TO TRUE 02020000
MOVE SQLCODE TO WS-RC-DB2-SQLCODE 02030000
PERFORM 999-DB2-ERROR THRU 999-EXIT 02040000
END-IF 02050000
END-IF 02060000
END-IF. 02061000
051700 02070000
051800 020-EXIT. 02080000
051900 EXIT. 02090000
*--------------------------------------------------------------* 02404300
* WRITE DB2 ERROR LOG TO CSMT USING COMMON MODULE * 02404400
*--------------------------------------------------------------* 02404500
999-DB2-ERROR. 02404600
MOVE SPACE TO WS-ERR-DATA. 02404700
SET WS-WRITE-ERROR-TO-LOG TO TRUE. 02404800
MOVE EIBTRNID TO CALLING-TRAN-ID. 02404900
MOVE 'XC4OTBL' TO CALLING-PROGRAM-ID. 02405000
MOVE SQLCA TO SQLCA-AREA. 02406000
EXEC CICS LINK PROGRAM('WRDB2LOG') 02407000
COMMAREA(WS-ERR-DATA) 02408000
LENGTH(LENGTH OF WS-ERR-DATA) 02409000
NOHANDLE 02410000
END-EXEC. 02420000
EJECT 02430000
999-EXIT. 02440000
EXIT. 02450000
162200 02460000
|
Thanks,
Vijay |
|
| Back to top |
|
 |
kolusu
Site Admin
Joined: 26 Nov 2002
Posts: 12376
Topics: 75
Location: San Jose
|
| Posted: Wed May 05, 2004 12:03 pm Post subject: |
|
|
Vijay,
A quick look at the code, I see a couple of errors.
1. you defined WS-CLIENT-OK at the group level as well as at the 88 level. It should be changed to
| Code: |
05 WS-CLIENT-STATUS PIC X(01).
88 WS-CLIENT-OK VALUE '0'.
88 WS-CLIENT-NOT-OK VALUE '1'.
|
2. It is just my opinion but I hate GO TO. You can replace it with a PERFORM 000-END-PROGRAM. And 000-end-program will have the following code.
| Code: |
PERFORM 000-END-PROGRAM
000-END-PROGRAM.
MOVE WS-COMMAREA TO DFHCOMMAREA
EXEC CICS
RETURN
END-EXEC
.
|
3. You never need a goback in CICS program as it never gets execueted. so you can remove it.
4.I would also modify the sql code checking to a evaluate statement
| Code: |
EVALUATE SQLCODE
WHEN 0
SET CLIENT-OK TO TRUE
WHEN +100
SET CLIENT-NOT-OK TO TRUE
WHEN OTHER
SET WS-RC-DB2-ERROR TO TRUE
MOVE SQLCODE TO WS-RC-DB2-SQLCODE
PERFORM 999-DB2-ERROR THRU 999-EXIT
END-EVALUATE
|
Other than these little corrections your code looks good.
Kolusu
_________________
Kolusu
www.linkedin.com/in/kolusu |
|
| Back to top |
|
|
vijay
Beginner
Joined: 09 May 2003
Posts: 131
Topics: 64
|
| Posted: Wed May 05, 2004 12:08 pm Post subject: |
|
|
Thanks a lot Kolusu.You're of great Help and this site is helpful as always.
Vijay |
|
| Back to top |
|
|
|
|
|
FAQ
Search
Quick Manuals
Register
Profile
Log in to check your private messages
Log in
