IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

COBOL DB2 Program


IBM Mainframe Forums -> HomeWorks & Requests
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
anil.Liyan

New User


Joined: 14 Dec 2023
Posts: 3
Location: India

PostPosted: Wed Dec 27, 2023 9:05 pm
Reply with quote

Hi All,

correct the below code if any mistakes are there, and
main objective of the code is to update the port status code to 9999.
when the record met the condition.

in file has records code should take those and check one by one in database and if condition met then only need to update to the 9999


000001 ID DIVISION.
000002 PROGRAM-ID. CSLSRUPD.
000003 AUTHOR. S ANIL.
000004 DATE-WRITTEN. 2023 11 27.
000005 DATE-COMPILED.
000006 ******************************************************************
000007 * *
000008 * PROGRAM NAME - CSLSRUPD *
000009 * PROGRAM TYPE - WPTLSR TABLE UPDATE *
000010 * UPDATE LSR STATUS ON WPTLSR *
000011 * FREQUENCY - WEEKLY *
000012 * *
000013 ******************************************************************
000014 * D E S C R I P T I O N O F T H E P R O G R A M *
000015 ******************************************************************
000016 * *
000017 * THIS SUBROUTINE IS USED TO UPDATE STATUS_CD TO 9999 *
000018 * LOCAL SERVICE REQUEST TABLE. (WPTLSR) *
000019 * *
000020 ******************************************************************
000021 *
000022 ENVIRONMENT DIVISION.
000023 CONFIGURATION SECTION.
000024 SOURCE-COMPUTER. IBM-370.
000025 OBJECT-COMPUTER. IBM-370.
000026 INPUT-OUTPUT SECTION.
000027 FILE-CONTROL.
000028 SELECT WPTFILE ASSIGN TO UT-S-WPTFILE
000029 FILE STATUS IS WS-FILE-STATUS.
000030 SELECT OUTFILE ASSIGN TO UT-S-OUTFILE
000031 FILE STATUS IS WS-OUTFILE-STATUS.
000032 DATA DIVISION.
000033 FILE SECTION.
000034 FD WPTFILE
000035 LABEL RECORDS ARE STANDARD
000036 DATA RECORD IS WPTLSR-RECORD.
000037 01 WPTLSR-RECORD PIC X(80).
000038
000039 FD OUTFILE
000040 LABEL RECORDS ARE STANDARD
000041 DATA RECORD IS OUTFILE-RECORD.
000042 01 OUTFILE-RECORD.
000043 05 OT-NNSP PIC X(4).
000044 05 OT-PON-NO PIC X(16).
000045 05 OT-LSR-VER-NO PIC X(1).
000046
000047 WORKING-STORAGE SECTION.
000048 01 WS-FILE-STATUS PIC X(02).
000049 01 WS-OUTFILE-STATUS PIC X(02).
000050 01 WS-SQLCODE PIC S9(9) COMP.
000051 01 WS-SQLSTATE PIC X(05).
000052 01 WS-EOF PIC X(01) VALUE 'N'.
000053 01 WS-UPDATE-COUNT PIC 9(3) VALUE 0.
000054 01 WS-F2-PON-NO PIC X(16).
000055 01 WS-F2-NNSP PIC X(4).
000056 01 WS-NNSP PIC X(4).
000057 01 WS-PON-NO PIC X(16).
000058 01 WS-LSR-VER-NO PIC X(1).
000059 01 WPTLSR-IN-RECORD.
000060 05 WS-F1-NNSP PIC X(4).
000061 05 WS-F1-PON-NO PIC X(16).
000062 05 FILLER PIC X(62).
000063
000064 ***----------------------------------------------------
000065 *** DB2 DATABASES ***
000066 ***-----------------------------------------------------------***
000067
000068 EXEC SQL
000069 INCLUDE SQLCA
000070 END-EXEC.
000071
000072 EXEC SQL
000073 INCLUDE WPTLSR
000074 END-EXEC.
000075
000076 PROCEDURE DIVISION.
000077 MAINLINE-PROCESS SECTION.
000078 PERFORM A-INITIALIZE.
000079 PERFORM B-MAIN-PROCESS UNTIL WS-EOF.
000080 PERFORM C-TERMINATE.
000081 STOP RUN.
000082 /
000083 A-INITIALIZE.
000084
000085 OPEN INPUT WPTFILE
000086 OUTPUT OUTFILE.
000087 PERFORM A10-READ-INPUT-FILE.
000088 /
000089 A10-READ-INPUT-FILE.
000090
000091 READ WPTFILE
000092 AT END MOVE 'Y' TO WS-EOF
000093 NOT AT END
000094 MOVE WPTLSR-RECORD TO WPTLSR-IN-RECORD
000095 END-READ.
000096 /
000097 B-MAIN-PROCESS.
000098
000099 PERFORM B10-PROCESS-RECORD.
000100 PERFORM A10-READ-INPUT-FILE.
000101 /
000102 B10-PROCESS-RECORD.
000103
000104 MOVE WS-F1-NNSP TO NNSP.
000105 MOVE WS-F1-PON-NO TO PON-NO.
000106
000107 EXEC SQL
000108 SELECT DISTINCT NNSP, PON_NO, LSR_VER_NO
000109 INTO
000110 :WS-NNSP, :WS-PON-NO, :WS-LSR-VER-NO
000111 FROM WPTLSR A
000112 WHERE
000113 NNSP = :NNSP AND PON_NO = :PON-NO
000114 AND A.LSR_VER_NO =
000115 (SELECT MAX(B.LSR_VER_NO)
000116 FROM WPTLSR B
000117 WHERE
000118 A.NNSP = B.NNSP AND A.PON_NO = B.PON_NO)
000119 END-EXEC.
000120
000121 IF SQLCODE = 0
000122 MOVE WS-NNSP TO WS-F2-NNSP.
000123 MOVE WS-PON-NO TO WS-F2-PON-NO.
000124 MOVE WS-NNSP TO OT-NNSP.
000125 MOVE WS-PON-NO TO OT-PON-NO.
000126 MOVE WS-LSR-VER-NO TO OT-LSR-VER-NO.
000127 WRITE OUTFILE-RECORD.
000128 PERFORM B20-UPDATE-WPTLSR.
000129 END-IF.
000130 /
000131 B20-UPDATE-WPTLSR.
000132
000133 EXEC SQL
000134 UPDATE
000135 WPTLSR
000136 SET
000137 PORT_STATUS_CD = 9999
000138 WHERE NNSP = :WS-F2-NNSP
000139 AND PON_NO = :WS-F2-PON-NO
000140 END-EXEC.
000141 EVALUATE SQLCODE
000142 WHEN 0
000143 ADD +1 TO WS-UPDATE-COUNT
000144 WHEN OTHER
000145 DISPLAY 'ERROR UPDATING RECORD: ' WS-NNSP WS-PON-NO
000146 'SQLCODE: ' SQLCODE ' SQLSTATE: ' SQLSTATE
000147 END-EVALUATE.
000148 /
000149 C-TERMINATE.
000150 CLOSE WPTFILE.
000151 CLOSE OUTFILE.
000152 DISPLAY 'NUMBER OF RECORDS UPDATED: ' WS-UPDATE-COUNT.
****** **************************** Bottom of Data **************************** 
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10888
Location: italy

PostPosted: Wed Dec 27, 2023 9:48 pm
Reply with quote

Quote:
correct the below code if any mistakes are there, [...]


what does prevent You from doing it ...

*compile* the program to produce the executable
*run* the executable to check if it produces the proper results
Back to top
View user's profile Send private message
Joerg.Findeisen

Senior Member


Joined: 15 Aug 2015
Posts: 1335
Location: Bamberg, Germany

PostPosted: Wed Dec 27, 2023 10:15 pm
Reply with quote

This is supposed to be a help forum, and NOT a *do-my-job-for-me* site free of charge.

See formatting aids when posting code or data. It has been explained over and over how to do it.
Back to top
View user's profile Send private message
anil.Liyan

New User


Joined: 14 Dec 2023
Posts: 3
Location: India

PostPosted: Wed Dec 27, 2023 10:27 pm
Reply with quote

Sorry Joerg.Findeisen.

its my bad i have compiled and executed the code in test as well still im getting S0c4 abend SqlError =-805 when we reached out to DBA team to check the bind again they are telling it is not realed to bind issue like.

now i dont understand why im getting error so only posted my code and asked

sorry for that
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10888
Location: italy

PostPosted: Wed Dec 27, 2023 10:51 pm
Reply with quote

see here for the meaning of the -805 SQL error code

www.ibm.com/docs/en/db2-for-zos/11?topic=codes-805
Back to top
View user's profile Send private message
sergeyken

Senior Member


Joined: 29 Apr 2008
Posts: 2141
Location: USA

PostPosted: Thu Dec 28, 2023 1:05 am
Reply with quote

anil.Liyan wrote:
Hi All,

correct the below code if any mistakes are there,  

The newcomers are getting more and more rude and insolent...
Back to top
View user's profile Send private message
Rohit Umarjikar

Global Moderator


Joined: 21 Sep 2010
Posts: 3076
Location: NYC,USA

PostPosted: Fri Dec 29, 2023 5:14 pm
Reply with quote

This has nothing to do with bind , please use correct loadlib in joblib of the JCL to point to your compiled code..

Moved to beginners forum.
Back to top
View user's profile Send private message
sergeyken

Senior Member


Joined: 29 Apr 2008
Posts: 2141
Location: USA

PostPosted: Fri Dec 29, 2023 5:52 pm
Reply with quote

Rohit Umarjikar wrote:
This has nothing to do with bind , please use correct loadlib in joblib of the JCL to point to your compiled code..

For instance, if no BIND at all has been done, it results in the same error -805.
Etc, etc, etc...

I recommend to start from learning about: pre-compile, compile, link-edit, bind, joblib, steplib, + 1000 other things, before writing ANY CODE.

Next question at this forum may be: "My screen is completely dark, and empty, as well there is no light in my room. Hi, all, find the bug in my code!"
Back to top
View user's profile Send private message
Rohit Umarjikar

Global Moderator


Joined: 21 Sep 2010
Posts: 3076
Location: NYC,USA

PostPosted: Fri Dec 29, 2023 5:53 pm
Reply with quote

TS already confirmed from DBA THAT bind is good so it’s not because of that for sure
Back to top
View user's profile Send private message
anil.Liyan

New User


Joined: 14 Dec 2023
Posts: 3
Location: India

PostPosted: Thu Jan 04, 2024 3:13 pm
Reply with quote

i have resolved the issue and code is working fine now
Back to top
View user's profile Send private message
sergeyken

Senior Member


Joined: 29 Apr 2008
Posts: 2141
Location: USA

PostPosted: Thu Jan 04, 2024 8:24 pm
Reply with quote

anil.Liyan wrote:
i have resolved the issue and code is working fine now

more and more rude and insolent...
Back to top
View user's profile Send private message
Rohit Umarjikar

Global Moderator


Joined: 21 Sep 2010
Posts: 3076
Location: NYC,USA

PostPosted: Thu Jan 04, 2024 8:37 pm
Reply with quote

anil.Liyan wrote:
i have resolved the issue and code is working fine now

Please post what was done to resolve the issue to benefit others and follow the same practice going forward.. thank you
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> HomeWorks & Requests

 


Similar Topics
Topic Forum Replies
No new posts COBOL sorting, with input GDG base COBOL Programming 7
No new posts Need help with ADABAS query (COBOL-AD... All Other Mainframe Topics 0
No new posts Replacing FILLER with FILLER<SeqNu... DFSORT/ICETOOL 2
No new posts Error to invoke MPP program through B... IMS DB/DC 3
No new posts Compile Sp Cobol base COBOL Programming 1
Search our Forums:

Back to Top