COBOL DB2 Program

anil.Liyan · New User Joined: 14 Dec 2023 Posts: 3 Location: India

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

enrico-sorichetti · Posted: Wed Dec 27, 2023 9:48 pm

Joerg.Findeisen · Posted: Wed Dec 27, 2023 10:15 pm

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.

anil.Liyan · New User Joined: 14 Dec 2023 Posts: 3 Location: India

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

enrico-sorichetti · Posted: Wed Dec 27, 2023 10:51 pm

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

www.ibm.com/docs/en/db2-for-zos/11?topic=codes-805

sergeyken · Posted: Thu Dec 28, 2023 1:05 am

Rohit Umarjikar · Posted: Fri Dec 29, 2023 5:14 pm

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.

sergeyken · Posted: Fri Dec 29, 2023 5:52 pm

Rohit Umarjikar · Posted: Fri Dec 29, 2023 5:53 pm

TS already confirmed from DBA THAT bind is good so it’s not because of that for sure

anil.Liyan · New User Joined: 14 Dec 2023 Posts: 3 Location: India

i have resolved the issue and code is working fine now

sergeyken · Posted: Thu Jan 04, 2024 8:24 pm

Rohit Umarjikar · Posted: Thu Jan 04, 2024 8:37 pm