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

Unable to display comp variable
IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic Quick References
View previous topic :: View next topic  
Author Message
shub2204

New User


Joined: 13 May 2020
Posts: 19
Location: India
PostPosted: Fri Oct 02, 2020 7:05 pm
 Reply with quote
hi,

My requirement goes like this: We have a table VPF040 with a two column varchar x(193) which contains data from all columns combined together of a table VPF230. The column name in VPF040 are audit_before and audit_after. Now when data of table vpf230 is added over to 040. It contains unreadable data as VPF230 contains many columns with picture clause S9(*) usage comp. So when copy of data is added to the vpf040 , the comp values are added as unreadable. I am trying to decode these values using a cobol program below:

Code:


       IDENTIFICATION DIVISION.                                         00010001
       PROGRAM-ID.    PFVPF40.                                          00020002
                                                                        00030001
      ******************************************************************00040001
      *                                                                 00050001
      *   SYSTEM   -  P.A.F.                                            00060001
      *                                                                 00070001
      *   PROGRAM  -  PFVPF40.                                          00080007
      *                                                                 00090001
      *   FUNCTION -  THIS PROGRAM WILL CONVERT UNREADABLE DATA IN VPF4000100002
      *               TO READABLE FORMAT.                               00110002
      *-----------------------------------------------------------------00120001
      ******************************************************************00130001
                                                                        00140001
       ENVIRONMENT DIVISION.                                            00150001
                                                                        00160001
       INPUT-OUTPUT SECTION.                                            00170001
                                                                        00180001
       FILE-CONTROL.                                                    00190001
                                                                        00200001
           SELECT INFILE    ASSIGN TO UT-S-INFILE                       00210001
                           FILE STATUS IS WV-FILE-STATUS.               00220001
                                                                        00330001
       DATA DIVISION.                                                   00340001
                                                                        00350001
       FILE SECTION.                                                    00360001
                                                                        00370001
       FD INFILE                                                        00380001
            BLOCK CONTAINS 0                                            00390001
            RECORDING MODE IS F.                                        00400001
                                                                        00410001
       01 INFILE-RECORD.                                                00420001
                                                                        00430001
           15  INFILE-TIME               PIC  X(14).                    00440008
           15  INFILE-TABLE              PIC  9(03).                    00450002
           15  INFILE-UPC                PIC  X(08).                    00460002
           15  FILLER                    PIC  X(55).                    00480008
                                                                        00490001
                                                                        00800001
       WORKING-STORAGE SECTION.                                         00810001
                                                                        00820001
       01  WC-CONSTANTS.                                                00830001
                                                                        00840001
           05  WV-ABCODE                    PIC  9(04).                 00850001
           05  WC-SQL-NOTFND                PIC S9(09) COMP VALUE +0100.00860001
           05  WC-SQL-DUPLIC                PIC S9(09) COMP VALUE -0811.00870001
                                                                        00880001
           05  WC-PFCR001                   PIC  X(07) VALUE 'PFVPF40'. 00890010
                                                                        00900001
           05  WV-FILE-STATUS               PIC  9(02).                 00910001
                                                                        00970001
       01  DCLVPF230B.                                                  00980002
           10 VPF230-MR-UDPRN      PIC 9(9) USAGE DISPLAY.              00990010
           10 VPF230-MR-TIME-ADDED  PIC X(14).                          01000002
           10 VPF230-MR-TIME-DELETED  PIC X(14).                        01010002
           10 VPF230-MR-TIME-AMENDED  PIC X(14).                        01020002
           10 VPF230-MR-ORGID      PIC 9(9) USAGE DISPLAY.              01030010
           10 VPF230-MR-DEPTID     PIC 9(9).                            01040002
           10 VPF230-MR-BNR        PIC 9(4).                            01050002
           10 VPF230-MR-BNM        PIC 9(9).                            01060002
           10 VPF230-MR-DP         PIC 9(9).                            01070002
           10 VPF230-MR-DTH        PIC 9(9).                            01080002
           10 VPF230-MR-DTHDE      PIC 9(4).                            01090002
           10 VPF230-MR-TH         PIC 9(9).                            01100002
           10 VPF230-MR-THDE       PIC 9(4).                            01110002
           10 VPF230-MR-LOC        PIC 9(9).                            01120002
           10 VPF230-MR-CONCAT     PIC X(1).                            01130002
           10 VPF230-MR-UPC        PIC 9(9).                            01140002
                                                                        01290001
       01  DCLVPF230A.                                                  01291002
           10 VPF230-MR-UDPRN         PIC 9(9).                         01292005
           10 VPF230-MR-TIME-ADDED    PIC X(14).                        01293005
           10 VPF230-MR-TIME-DELETED  PIC X(14).                        01294002
           10 VPF230-MR-TIME-AMENDED  PIC X(14).                        01295002
           10 VPF230-MR-ORGID         PIC 9(9).                         01296005
           10 VPF230-MR-DEPTID        PIC 9(9).                         01297005
           10 VPF230-MR-BNR           PIC 9(4).                         01298005
           10 VPF230-MR-BNM           PIC 9(9).                         01299005
           10 VPF230-MR-DP            PIC 9(9).                         01299105
           10 VPF230-MR-DTH           PIC 9(9).                         01299205
           10 VPF230-MR-DTHDE         PIC 9(4).                         01299305
           10 VPF230-MR-TH            PIC 9(9).                         01299405
           10 VPF230-MR-THDE          PIC 9(4).                         01299505
           10 VPF230-MR-LOC           PIC 9(9).                         01299605
           10 VPF230-MR-CONCAT        PIC X(1).                         01299705
           10 VPF230-MR-UPC           PIC 9(9).                         01299805
                                                                        01299902
           EXEC SQL INCLUDE SQLCA    END-EXEC.                          01300001
                                                                        01310001
           EXEC SQL INCLUDE VPF040   END-EXEC.                          01320001
           EXEC SQL INCLUDE VPF230   END-EXEC.                          01321011
                                                                        01330001
                                                                        01350001
           EXEC SQL INCLUDE SSWSQLE  END-EXEC.                          01360001
                                                                        01370001
                                                                        01380001
   *** LINKAGE SECTION.                                                 01390001
                                                                        01400001
       01 WV-BUFFER.                                                    01410001
                                                                        01420001
           05  WS-LEN     PIC S9(4) COMP.                               01430001
           05  VAR        PIC X(1).                                     01440001
                                                                        01450001
       PROCEDURE DIVISION USING WV-BUFFER.                              01460001
                                                                        01470001
                                                                        01480001
       A01-CONTROL SECTION.                                             01490001
                                                                        01500001
       A01010-ENTRY.                                                    01510001
                                                                        01520001
             DISPLAY 'VALUE FROM JCL'VAR                                01530001
                                                                        01540001
           EVALUATE VAR                                                 01550001
                                                                        01560001
           WHEN '1'                                                     01570001
                                                                        01580001
           PERFORM B01-INIT-STAGE                                       01590001
                                                                        01600001
           PERFORM B03-MAIN-PROCESS                                     01610001
                                                                        01620001
           PERFORM B06-TERMINATE                                        01630001
                                                                        01640001
           WHEN '0'                                                     01650001
                                                                        01660001
           PERFORM B01-INIT-STAGE                                       01670002
                                                                        01680001
           PERFORM B03-MAIN-PROCESS                                     01690002
                                                                        01700001
           PERFORM B06-TERMINATE                                        01710002
                                                                        01720001
           WHEN OTHER                                                   01730001
                                                                        01740001
              DISPLAY 'INVALID PARMS PASSED SHOULD BE EITHER 1 OR 0'    01750001
                                                                        01760001
           END-EVALUATE                                                 01770001
                                                                        01780001
                                                                        01790001
           GOBACK                                                       01800001
           .                                                            01810001
       A01999-EXIT.                                                     01820001
                                                                        01830001
           EXIT.                                                        01840001
                                                                        01850001
       B01-INIT-STAGE SECTION.                                          01860001
                                                                        01870001
       B01010-ENTRY.                                                    01880001
                                                                        01890001
           OPEN INPUT INFILE                                            01900001
                                                                        01910001
           EVALUATE WV-FILE-STATUS                                      01920001
           WHEN ZERO                                                    01930001
                CONTINUE                                                01940001
           WHEN OTHER                                                   01950001
               DISPLAY '** PFCR001 - INVALID INFILE OPEN **'            01960001
               MOVE 0003 TO WV-ABCODE                                   01970001
               PERFORM Z09-ABEND                                        01980001
           END-EVALUATE                                                 01990001
                                                                        02000001
                                                                        02330001
           .                                                            02340001
       B01999-EXIT.                                                     02350001
                                                                        02360001
           EXIT.                                                        02370001
                                                                        02380001
       B03-MAIN-PROCESS SECTION.                                        02390001
                                                                        02400001
       B03010-ENTRY.                                                    02410001
                                                                        02420001
            PERFORM UNTIL WV-FILE-STATUS = 10                           02430001
              READ INFILE                                               02440006
                                                                        02450001
              INITIALIZE DCLVPF040                                      02460002
              INITIALIZE DCLVPF230                                      02470011
              INITIALIZE DCLVPF230A                                     02470111
              INITIALIZE DCLVPF230B                                     02471002
                                                                        02472009
              MOVE INFILE-TIME    TO VPF040-AUDIT-TIME                  02473009
              MOVE INFILE-UPC     TO VPF040-AUDIT-UPC                   02474009
              MOVE INFILE-TABLE   TO VPF040-AUDIT-TABLE                 02475009
                                                                        02480001
                                                                        02530001
              PERFORM X27-OPEN-VPF040                                   02540002
              PERFORM X27-FETCH-VPF040 UNTIL SQLCODE = WC-SQL-NOTFND    02541002
                   DISPLAY 'STARTTING DISPLAY'                          02541105
                                                                        02542102
              PERFORM X27-CLOSE-VPF040                                  02542202
                                                                        02550001
           END-PERFORM                                                  02870001
                 .                                                      02880001
       B03010-EXIT.                                                     02890001
                                                                        02900001
           EXIT.                                                        02910001
                                                                        02920001
                                                                        03780001
       X27-OPEN-VPF040 SECTION.                                         03790002
                                                                        03800001
       X27010-ENTRY.                                                    03810001
                                                                        03820001
           EXEC SQL                                                     03830001
                DECLARE VPF040-CSR CURSOR FOR                           03831002
                SELECT AUDIT_TIME                                       03840001
                      ,AUDIT_TABLE                                      03850001
                      ,AUDIT_REF                                        03860001
                      ,AUDIT_BEFORE1                                    03871002
                      ,AUDIT_AFTER1                                     03872002
                      ,AUDIT_UPC                                        03880001
                FROM   VPF040                                           03960002
                WHERE  AUDIT_TIME   > :VPF040-AUDIT-TIME                03970009
                AND    AUDIT_TABLE  = :VPF040-AUDIT-TABLE               03980009
                AND    AUDIT_UPC    = :VPF040-AUDIT-UPC                 03990009
           END-EXEC                                                     04010001
                                                                        04020001
           EXEC SQL                                                     04021003
           OPEN VPF040-CSR                                              04022002
           END-EXEC                                                     04023003
                                                                        04023102
           EVALUATE SQLCODE                                             04024002
           WHEN ZERO                                                    04025002
              CONTINUE                                                  04026002
                                                                        04027002
           WHEN OTHER                                                   04028002
               DISPLAY 'SQLCODE IS:' SQLCODE                            04028102
               MOVE 0100 TO WV-ABCODE                                   04029002
               PERFORM Z09-ABEND                                        04029102
           END-EVALUATE                                                 04029205
           .                                                            04030001
       X27999-EXIT.                                                     04040001
                                                                        04050001
           EXIT.                                                        04060001
                                                                        04060102
                                                                        04060202
       X27-FETCH-VPF040 SECTION.                                        04061002
                                                                        04062002
       X27011-ENTRY.                                                    04063002
                                                                        04064002
           EXEC SQL                                                     04065002
                FETCH VPF040-CSR                                        04066002
                INTO  :VPF040-AUDIT-TIME                                04069402
                     ,:VPF040-AUDIT-TABLE                               04069502
                     ,:VPF040-AUDIT-REF                                 04069602
                     ,:VPF040-AUDIT-BEFORE1                             04069702
                     ,:VPF040-AUDIT-AFTER1                              04069802
           END-EXEC                                                     04070704
                                                                        04070802
           EVALUATE SQLCODE                                             04070902
           WHEN ZERO                                                    04071002
                                                                        04071102
              MOVE VPF040-AUDIT-BEFORE1 TO DCLVPF230                    04071211
              MOVE DCLVPF230            TO DCLVPF230B                   04071311
              INITIALIZE DCLVPF230                                      04071411
              MOVE VPF040-AUDIT-AFTER1  TO DCLVPF230                    04071511
              MOVE DCLVPF230            TO DCLVPF230A                   04071611
              DISPLAY 'BEFORE IMAGE:' DCLVPF230B                        04071711
              DISPLAY 'AFTER  IMAGE:' DCLVPF230A                        04071811
                                                                        04071911
           WHEN +100                                                    04072011
                                                                        04072111
              CONTINUE                                                  04072211
                                                                        04072310
           WHEN OTHER                                                   04072410
               DISPLAY 'SQLCODE IS:' SQLCODE                            04072510
               MOVE 0102 TO WV-ABCODE                                   04072610
               PERFORM Z09-ABEND                                        04072710
           END-EVALUATE                                                 04072810
           .                                                            04072910
       X27011-EXIT.                                                     04073010
                                                                        04073110
           EXIT.                                                        04073210
                                                                        04073310
                                                                        04073410
                                                                        04073510
       X27-CLOSE-VPF040 SECTION.                                        04073610
                                                                        04073710
       X27011-ENTRY.                                                    04073810
                                                                        04073910
           EXEC SQL                                                     04074010
                CLOSE VPF040-CSR                                        04074110
           END-EXEC                                                     04074210
                                                                        04074310
           EVALUATE SQLCODE                                             04074410
           WHEN ZERO                                                    04074510
                                                                        04074610
              CONTINUE                                                  04074710
                                                                        04074902
           WHEN OTHER                                                   04075002
               DISPLAY 'SQLCODE IS:' SQLCODE                            04075102
               MOVE 0103 TO WV-ABCODE                                   04075202
               PERFORM Z09-ABEND                                        04075302
           END-EVALUATE                                                 04075405
           .                                                            04075502
       X27011-EXIT.                                                     04075602
                                                                        04075702
           EXIT.                                                        04075802
                                                                        04076002
                                                                        04080001
                                                                        04380001
       B06-TERMINATE SECTION.                                           04390001
                                                                        04400001
       B06010-ENTRY.                                                    04410001
                                                                        04420001
           CLOSE INFILE                                                 04430001
                                                                        04440001
           EVALUATE WV-FILE-STATUS                                      04450001
           WHEN ZERO                                                    04460001
               CONTINUE                                                 04470001
                                                                        04480001
           WHEN OTHER                                                   04490001
               DISPLAY '** PFCR001 - INVALID FILE CLOSE ON INFILE *'    04500001
               MOVE 0009 TO WV-ABCODE                                   04510001
               PERFORM Z09-ABEND                                        04520001
           END-EVALUATE                                                 04530001
                                                                        04540001
              .                                                         04880001
       B06010-EXIT.                                                     04890001
                                                                        04900001
           EXIT.                                                        04910001
                                                                        04920001
                                                                        05250001
                                                                        05260001
                                                                        05270001
       Z09-ABEND SECTION.                                               05280001
                                                                        05290001
       Z09010-ENTRY.                                                    05300001
                                                                        05310001
           MOVE WC-PFCR001 TO WZ-FORMATTED-SQLCODE                      05320001
                                                                        05330001
           DISPLAY ' ********************************'                  05340001
           DISPLAY ' *       ABEND CODE ' WV-ABCODE '        *'.        05350001
                                                                        05360001
           PERFORM Z9-SQL-ERROR.                                        05370001
                                                                        05380001
       Z09999-EXIT.                                                     05390001
                                                                        05400001
           EXIT.                                                        05410001
                                                                        05420001
           EXEC SQL INCLUDE SSPSQLE  END-EXEC.                          05430001
                                                                        05440001



Now data in the table looks like this:

Code:

€©201704240945460             0                          p            µ   Ö1
ßžCPFP290      s
Ux201704240947440             0                                     µ   Ö1
ßžCPFP290      s
Uy201704240947480             0                          …            µ   Ö1
ßžCPFP290      s
Xi201001221110320             0                                     ž   ˆc1 , CPFP992      ~
X–201001221110320             0                                     ž   ˆc1 , CPFP992      ~
÷z200610081016330             0                            ¾        Z   œ1 ¼CPFP191      þ
÷z200610081016330             0                            ð        Z   œ1 ¼CPFP191      þ
÷z200610081016330             0                            ¿        Z   œ1 ¼CPFP191      þ
 

when i run this program i still got values in unreadable format.

the dclgen of tables looks like this:
Back to top
View user's profile Send private message
shub2204

New User


Joined: 13 May 2020
Posts: 19
Location: India
PostPosted: Fri Oct 02, 2020 7:06 pm
 Reply with quote
01 DCLVPF230.
10 VPF230-MR-UDPRN PIC S9(9) USAGE COMP.
10 VPF230-MR-TIME-ADDED PIC X(14).
10 VPF230-MR-TIME-DELETED PIC X(14).
10 VPF230-MR-TIME-AMENDED PIC X(14).
10 VPF230-MR-ORGID PIC S9(9) USAGE COMP.
10 VPF230-MR-DEPTID PIC S9(9) USAGE COMP.
10 VPF230-MR-BNR PIC S9(4) USAGE COMP.
10 VPF230-MR-BNM PIC S9(9) USAGE COMP.
10 VPF230-MR-DP PIC S9(9) USAGE COMP.
10 VPF230-MR-DTH PIC S9(9) USAGE COMP.
10 VPF230-MR-DTHDE PIC S9(4) USAGE COMP.
10 VPF230-MR-TH PIC S9(9) USAGE COMP.
10 VPF230-MR-THDE PIC S9(4) USAGE COMP.
10 VPF230-MR-LOC PIC S9(9) USAGE COMP.
10 VPF230-MR-CONCAT PIC X(1).
10 VPF230-MR-UPC PIC S9(9) USAGE COMP.
Back to top
View user's profile Send private message
shub2204

New User


Joined: 13 May 2020
Posts: 19
Location: India
PostPosted: Fri Oct 02, 2020 7:07 pm
 Reply with quote
Here is a screenshot of output:

Code:
CL0
: Ä (q\201809281451580             0                                       <

:

: Ä (q\20180928145158202009291114310                                       <

: í (q\201809281451580             20200930085957                 Â         <

: Ä (q\201809281451580             20200930085957                 Â         <

:   (q\201809281451580             20200930085957                 Â         <

:   (q\201809281451580             20200930085957                 Â         <

: Ä 0 4202009300929140             0                         ã×             <

: Ä 0 4202009300929140             0                         ã×             <
Back to top
View user's profile Send private message
Robert Sample

Global Moderator


Joined: 06 Jun 2008
Posts: 8696
Location: Dubuque, Iowa, USA
PostPosted: Fri Oct 02, 2020 7:50 pm
 Reply with quote
Your topic title is "Unable to display comp variable" -- yet you do not ever DISPLAY a COMP variable. All of your DISPLAY statements are for group variables, which are alphanumeric (not COMP). Try putting
Code:
 DISPLAY VPF230-MR-UDPRN
after your fetch. You seem to be wanting to handle all the data as a single field such as
Code:
MOVE DCLVPF230            TO DCLVPF230B
This will not do anything to your data as group variables are alphanumeric, period. Any COMP variables under a group variable name would have to be moved individually to allow the numeric conversion to take place.
Back to top
View user's profile Send private message
shub2204

New User


Joined: 13 May 2020
Posts: 19
Location: India
PostPosted: Tue Oct 06, 2020 6:01 pm
 Reply with quote
Thanks Robert for the tip..i figured it out..just made simple things worse when comp variable are easily displayable.here is my modified code:
Code:


       IDENTIFICATION DIVISION.                                         00010001
       PROGRAM-ID.    PFVPF40.                                          00020002
                                                                        00030001
      ******************************************************************00040001
      *                                                                 00050001
      *   SYSTEM   -  P.A.F.                                            00060001
      *                                                                 00070001
      *   PROGRAM  -  PFVPF40.                                          00080007
      *                                                                 00090001
      *   FUNCTION -  THIS PROGRAM WILL CONVERT UNREADABLE DATA IN VPF4000100002
      *               TO READABLE FORMAT FOR TABLE 230. ADD DATE,TABLE, 00110032
      *               UPC IN THE FORMAT 'YYYYMMDDHHMMSS230AADDDSUU'     00111032
      *               AA=AREA,DDD=DISTRICT,S=SECTOR,UU-UNIT             00112032
      *-----------------------------------------------------------------00120001
      ******************************************************************00130001
                                                                        00140001
       ENVIRONMENT DIVISION.                                            00150001
                                                                        00160001
       INPUT-OUTPUT SECTION.                                            00170001
                                                                        00180001
       FILE-CONTROL.                                                    00190001
                                                                        00200001
           SELECT INFILE    ASSIGN TO UT-S-INFILE                       00210001
                           FILE STATUS IS WV-FILE-STATUS.               00220001
                                                                        00330001
       DATA DIVISION.                                                   00340001
                                                                        00350001
       FILE SECTION.                                                    00360001
                                                                        00370001
       FD INFILE                                                        00380001
            BLOCK CONTAINS 0                                            00390001
            RECORDING MODE IS F.                                        00400001
                                                                        00410001
       01 INFILE-RECORD.                                                00420001
                                                                        00430001
           15  INFILE-TIME               PIC  X(14).                    00440008
           15  INFILE-TABLE              PIC  9(03).                    00450002
           15  INFILE-UPC                PIC  X(08).                    00460002
           15  FILLER                    PIC  X(55).                    00480008
                                                                        00490001
                                                                        00800001
       WORKING-STORAGE SECTION.                                         00810001
                                                                        00820001
       01  WC-CONSTANTS.                                                00830001
                                                                        00840001
           05  WV-ABCODE                    PIC  9(04).                 00850001
           05  WC-SQL-NOTFND                PIC S9(09) COMP VALUE +0100.00860001
           05  WC-SQL-DUPLIC                PIC S9(09) COMP VALUE -0811.00870001
                                                                        00880001
           05  WC-PFCR001                   PIC  X(07) VALUE 'PFVPF40'. 00890010
                                                                        00900001
           05  WV-FILE-STATUS               PIC  9(02).                 00910001
                                                                        00970001
       01  DCLVPF230B.                                                  00980002
            10 VPF230-MR-UDPRN      PIC S9(9) USAGE COMP.               00990014
            10 VPF230-MR-TIME-ADDED  PIC X(14).                         01000013
            10 VPF230-MR-TIME-DELETED  PIC X(14).                       01010013
            10 VPF230-MR-TIME-AMENDED  PIC X(14).                       01020013
            10 VPF230-MR-ORGID      PIC S9(9) USAGE COMP.               01030014
            10 VPF230-MR-DEPTID     PIC S9(9) USAGE COMP.               01040013
            10 VPF230-MR-BNR        PIC S9(4) USAGE COMP.               01050013
            10 VPF230-MR-BNM        PIC S9(9) USAGE COMP.               01060013
            10 VPF230-MR-DP         PIC S9(9) USAGE COMP.               01070013
            10 VPF230-MR-DTH        PIC S9(9) USAGE COMP.               01080013
            10 VPF230-MR-DTHDE      PIC S9(4) USAGE COMP.               01090013
            10 VPF230-MR-TH         PIC S9(9) USAGE COMP.               01100013
            10 VPF230-MR-THDE       PIC S9(4) USAGE COMP.               01110013
            10 VPF230-MR-LOC        PIC S9(9) USAGE COMP.               01120013
            10 VPF230-MR-CONCAT     PIC X(1).                           01130013
            10 VPF230-MR-UPC        PIC S9(9) USAGE COMP.               01140013
                                                                        01141017
                                                                        01142017
       01  DCLVPF230A.                                                  01150017
            10 VPF230-MR-UDPRN      PIC S9(9) USAGE COMP.               01160017
            10 VPF230-MR-TIME-ADDED  PIC X(14).                         01170017
            10 VPF230-MR-TIME-DELETED  PIC X(14).                       01180017
            10 VPF230-MR-TIME-AMENDED  PIC X(14).                       01190017
            10 VPF230-MR-ORGID      PIC S9(9) USAGE COMP.               01200017
            10 VPF230-MR-DEPTID     PIC S9(9) USAGE COMP.               01210017
            10 VPF230-MR-BNR        PIC S9(4) USAGE COMP.               01220017
            10 VPF230-MR-BNM        PIC S9(9) USAGE COMP.               01230017
            10 VPF230-MR-DP         PIC S9(9) USAGE COMP.               01240017
            10 VPF230-MR-DTH        PIC S9(9) USAGE COMP.               01250017
            10 VPF230-MR-DTHDE      PIC S9(4) USAGE COMP.               01260017
            10 VPF230-MR-TH         PIC S9(9) USAGE COMP.               01270017
            10 VPF230-MR-THDE       PIC S9(4) USAGE COMP.               01280017
            10 VPF230-MR-LOC        PIC S9(9) USAGE COMP.               01281017
            10 VPF230-MR-CONCAT     PIC X(1).                           01282017
            10 VPF230-MR-UPC        PIC S9(9) USAGE COMP.               01283017
                                                                        01290001
                                                                        01299902
           EXEC SQL INCLUDE SQLCA    END-EXEC.                          01300001
                                                                        01310001
           EXEC SQL INCLUDE VPF040   END-EXEC.                          01320001
           EXEC SQL INCLUDE VPF230   END-EXEC.                          01327011
                                                                        01343001
                                                                        01350001
           EXEC SQL INCLUDE SSWSQLE  END-EXEC.                          01360001
                                                                        01372001
                                                                        01380001
   *** LINKAGE SECTION.                                                 01390001
                                                                        01400001
       01 WV-BUFFER.                                                    01410001
                                                                        01420001
           05  WS-LEN     PIC S9(4) COMP.                               01430001
           05  VAR        PIC X(1).                                     01440001
                                                                        01450001
       PROCEDURE DIVISION USING WV-BUFFER.                              01460001
                                                                        01470001
                                                                        01480001
       A01-CONTROL SECTION.                                             01490001
                                                                        01500001
       A01010-ENTRY.                                                    01510001
                                                                        01520001
             DISPLAY 'VALUE FROM JCL'  VAR                              01530022
                                                                        01540001
           EVALUATE VAR                                                 01550001
                                                                        01560001
           WHEN '1'                                                     01570001
                                                                        01580001
           PERFORM B01-INIT-STAGE                                       01590001
                                                                        01600001
           PERFORM B03-MAIN-PROCESS                                     01610001
                                                                        01620001
           PERFORM B06-TERMINATE                                        01630001
                                                                        01640001
           WHEN '0'                                                     01650001
                                                                        01660001
           PERFORM B01-INIT-STAGE                                       01670002
                                                                        01680001
           PERFORM B03-MAIN-PROCESS                                     01690002
                                                                        01700001
           PERFORM B06-TERMINATE                                        01710002
                                                                        01720001
           WHEN OTHER                                                   01730001
                                                                        01740001
              DISPLAY 'INVALID PARMS PASSED SHOULD BE EITHER 1 OR 0'    01750001
                                                                        01760001
           END-EVALUATE                                                 01770001
                                                                        01780001
                                                                        01790001
           GOBACK                                                       01800001
           .                                                            01810001
       A01999-EXIT.                                                     01820001
                                                                        01830001
           EXIT.                                                        01840001
                                                                        01850001
       B01-INIT-STAGE SECTION.                                          01860001
                                                                        01870001
       B01010-ENTRY.                                                    01880001
                                                                        01890001
           OPEN INPUT INFILE                                            01900001
                                                                        01910001
           EVALUATE WV-FILE-STATUS                                      01920001
           WHEN ZERO                                                    01930001
                CONTINUE                                                01940001
           WHEN OTHER                                                   01950001
               DISPLAY '** PFCR001 - INVALID INFILE OPEN **'            01960001
               MOVE 0003 TO WV-ABCODE                                   01970001
               PERFORM Z09-ABEND                                        01980001
           END-EVALUATE                                                 01990001
                                                                        02000001
                                                                        02330001
           .                                                            02340001
       B01999-EXIT.                                                     02350001
                                                                        02360001
           EXIT.                                                        02370001
                                                                        02380001
       B03-MAIN-PROCESS SECTION.                                        02390001
                                                                        02400001
       B03010-ENTRY.                                                    02410001
                                                                        02420001
            PERFORM UNTIL WV-FILE-STATUS = 10                           02430001
              READ INFILE                                               02440006
                                                                        02450001
              INITIALIZE DCLVPF040                                      02460002
              INITIALIZE DCLVPF230                                      02470011
              INITIALIZE DCLVPF230A                                     02470111
              INITIALIZE DCLVPF230B                                     02471002
                                                                        02472009
              MOVE INFILE-TIME    TO VPF040-AUDIT-TIME                  02473009
              MOVE INFILE-UPC     TO VPF040-AUDIT-UPC                   02474009
              MOVE INFILE-TABLE   TO VPF040-AUDIT-TABLE                 02475009
                                                                        02480001
                                                                        02530001
              PERFORM X27-OPEN-VPF040                                   02540002
              PERFORM X27-FETCH-VPF040 UNTIL SQLCODE = WC-SQL-NOTFND    02541002
                                                                        02542102
              PERFORM X27-CLOSE-VPF040                                  02542202
                                                                        02550001
           END-PERFORM                                                  02870001
                 .                                                      02880001
       B03010-EXIT.                                                     02890001
                                                                        02900001
           EXIT.                                                        02910001
                                                                        02920001
                                                                        03780001
       X27-OPEN-VPF040 SECTION.                                         03790002
                                                                        03800001
       X27010-ENTRY.                                                    03810001
                                                                        03820001
           EXEC SQL                                                     03830001
                DECLARE VPF040-CSR CURSOR FOR                           03831002
                SELECT AUDIT_TIME                                       03840001
                      ,AUDIT_TABLE                                      03850001
                      ,AUDIT_REF                                        03860001
                      ,AUDIT_BEFORE1                                    03871002
                      ,AUDIT_AFTER1                                     03872002
                      ,AUDIT_UPC                                        03880001
                FROM   VPF040                                           03960002
                WHERE  AUDIT_TIME   > :VPF040-AUDIT-TIME                03970009
                AND    AUDIT_TABLE  = :VPF040-AUDIT-TABLE               03980009
                AND    AUDIT_UPC    = :VPF040-AUDIT-UPC                 03990009
           END-EXEC                                                     04010001
                                                                        04020001
           EXEC SQL                                                     04021003
           OPEN VPF040-CSR                                              04022002
           END-EXEC                                                     04023003
                                                                        04023102
           EVALUATE SQLCODE                                             04024002
           WHEN ZERO                                                    04025002
              CONTINUE                                                  04026002
                                                                        04027002
           WHEN OTHER                                                   04028002
               DISPLAY 'SQLCODE IS:' SQLCODE                            04028102
               MOVE 0100 TO WV-ABCODE                                   04029002
               PERFORM Z09-ABEND                                        04029102
           END-EVALUATE                                                 04029205
           .                                                            04030001
       X27999-EXIT.                                                     04040001
                                                                        04050001
           EXIT.                                                        04060001
                                                                        04060102
                                                                        04060202
       X27-FETCH-VPF040 SECTION.                                        04061002
                                                                        04062002
       X27011-ENTRY.                                                    04063002
                                                                        04064002
           EXEC SQL                                                     04065002
                FETCH VPF040-CSR                                        04066002
                INTO  :VPF040-AUDIT-TIME                                04069402
                     ,:VPF040-AUDIT-TABLE                               04069502
                     ,:VPF040-AUDIT-REF                                 04069602
                     ,:VPF040-AUDIT-BEFORE1                             04069702
                     ,:VPF040-AUDIT-AFTER1                              04069802
           END-EXEC                                                     04070704
                                                                        04070802
           EVALUATE SQLCODE                                             04070902
           WHEN ZERO                                                    04071002
                                                                        04071102
              MOVE VPF040-AUDIT-BEFORE1 TO DCLVPF230                    04071211
              MOVE DCLVPF230            TO DCLVPF230B                   04071311
              INITIALIZE DCLVPF230                                      04071411
              MOVE VPF040-AUDIT-AFTER1  TO DCLVPF230                    04071511
              MOVE DCLVPF230            TO DCLVPF230A                   04071611
      *       DISPLAY 'BEFORE IMAGE:' VPF230-MR-UDPRN OF DCLVPF230B' '  04071931
      *               VPF230-MR-TIME-ADDED OF DCLVPF230B ' '            04073031
      *               VPF230-MR-TIME-DELETED OF DCLVPF230B ' '          04074031
      *               VPF230-MR-TIME-AMENDED OF DCLVPF230B ' '          04074131
      *               VPF230-MR-ORGID  OF DCLVPF230B ' '                04074231
      *               VPF230-MR-DEPTID OF DCLVPF230B ' '                04074331
      *               VPF230-MR-BNR    OF DCLVPF230B ' '                04074431
      *               VPF230-MR-BNM    OF DCLVPF230B ' '                04074531
      *               VPF230-MR-DP     OF DCLVPF230B ' '                04074631
      *               VPF230-MR-DTH    OF DCLVPF230B ' '                04074731
      *               VPF230-MR-DTHDE  OF DCLVPF230B ' '                04074831
      *               VPF230-MR-TH     OF DCLVPF230B ' '                04074931
      *               VPF230-MR-THDE   OF DCLVPF230B ' '                04075031
      *               VPF230-MR-LOC    OF DCLVPF230B ' '                04075131
      *               VPF230-MR-CONCAT OF DCLVPF230B ' '                04075231
      *               VPF230-MR-UPC    OF DCLVPF230B                    04075331
      *                                                                 04075431
      *       DISPLAY 'AFTER IMAGE:' VPF230-MR-UDPRN OF DCLVPF230A ' '  04075531
      *               VPF230-MR-TIME-ADDED OF DCLVPF230A ' '            04075631
      *               VPF230-MR-TIME-DELETED OF DCLVPF230A  ' '         04075731
      *               VPF230-MR-TIME-AMENDED OF DCLVPF230A ' '          04075831
      *               VPF230-MR-ORGID  OF DCLVPF230A ' '                04075931
      *               VPF230-MR-DEPTID OF DCLVPF230A ' '                04076031
      *               VPF230-MR-BNR    OF DCLVPF230A ' '                04076131
      *               VPF230-MR-BNM    OF DCLVPF230A ' '                04076231
      *               VPF230-MR-DP     OF DCLVPF230A ' '                04076331
      *               VPF230-MR-DTH    OF DCLVPF230A ' '                04076431
      *               VPF230-MR-DTHDE  OF DCLVPF230A ' '                04076531
      *               VPF230-MR-TH     OF DCLVPF230A ' '                04076631
      *               VPF230-MR-THDE   OF DCLVPF230A ' '                04076731
      *               VPF230-MR-LOC    OF DCLVPF230A ' '                04076831
      *               VPF230-MR-CONCAT OF DCLVPF230A ' '                04076931
      *               VPF230-MR-UPC    OF DCLVPF230A                    04077031
      *                                                                 04077131
              DISPLAY 'UDPRN:' VPF230-MR-UDPRN OF DCLVPF230B ' '        04077222
      -               VPF230-MR-UDPRN OF DCLVPF230A                     04077321
              DISPLAY 'TIME ADDED:' VPF230-MR-TIME-ADDED OF DCLVPF230B  04077425
      -               ' '   VPF230-MR-TIME-ADDED OF DCLVPF230A          04077522
              DISPLAY 'TIME DELETED:'                                   04077627
      -               VPF230-MR-TIME-DELETED   OF DCLVPF230B            04077727
      -               ' ' VPF230-MR-TIME-DELETED                        04077830
                                               OF DCLVPF230A            04077930
              DISPLAY 'TIME AMENDED:'                                   04078027
      -                 VPF230-MR-TIME-AMENDED OF DCLVPF230B ' '        04078127
      -                 VPF230-MR-TIME-AMENDED OF DCLVPF230A            04078227
              DISPLAY 'ORG ID:' VPF230-MR-ORGID  OF DCLVPF230B ' '      04078426
      -               VPF230-MR-ORGID  OF DCLVPF230A                    04078526
              DISPLAY 'DEPT ID:' VPF230-MR-DEPTID OF DCLVPF230B ' '     04078626
      -               VPF230-MR-DEPTID OF DCLVPF230A                    04078726
              DISPLAY 'BNR:' VPF230-MR-BNR    OF DCLVPF230B ' '         04078826
      -               VPF230-MR-BNR    OF DCLVPF230A                    04078926
              DISPLAY 'BNM:' VPF230-MR-BNM    OF DCLVPF230B ' '         04079026
      -               VPF230-MR-BNM    OF DCLVPF230A                    04079126
              DISPLAY 'DELIVERY POINT:' VPF230-MR-DP OF DCLVPF230B ' '  04079226
      -               VPF230-MR-DP OF DCLVPF230A                        04079326
              DISPLAY 'DTH:' VPF230-MR-DTH    OF DCLVPF230B ' '         04079426
      -               VPF230-MR-DTH    OF DCLVPF230A                    04079526
              DISPLAY 'DTHDE:' VPF230-MR-DTHDE  OF DCLVPF230B ' '       04079626
      -               VPF230-MR-DTHDE    OF DCLVPF230A                  04079726
              DISPLAY 'THOROUGHFARE:' VPF230-MR-TH     OF DCLVPF230B    04079826
      -                ' ' VPF230-MR-TH     OF DCLVPF230A               04079926
              DISPLAY 'THOROUGHFARE DE:' VPF230-MR-THDE OF DCLVPF230B   04080027
      -                 ' ' VPF230-MR-THDE   OF DCLVPF230A              04080127
              DISPLAY 'LOCALITY:' VPF230-MR-LOC    OF DCLVPF230B ' '    04080226
      -               VPF230-MR-LOC    OF DCLVPF230A                    04080326
              DISPLAY 'CONCAT  :' VPF230-MR-CONCAT OF DCLVPF230B ' '    04080426
      -               VPF230-MR-CONCAT OF DCLVPF230A' '                 04080526
              DISPLAY 'POSTCODE:'  VPF230-MR-UPC    OF DCLVPF230B ' '   04080626
      -                VPF230-MR-UPC    OF DCLVPF230A                   04080726
                                                                        04080826
           WHEN +100                                                    04080926
                                                                        04081026
              CONTINUE                                                  04081126
                                                                        04081226
           WHEN OTHER                                                   04081326
               DISPLAY 'SQLCODE IS:' SQLCODE                            04081426
               MOVE 0102 TO WV-ABCODE                                   04081526
               PERFORM Z09-ABEND                                        04081626
           END-EVALUATE                                                 04081726
           .                                                            04081826
       X27011-EXIT.                                                     04081926
                                                                        04082026
           EXIT.                                                        04082126
                                                                        04082226
                                                                        04082326
                                                                        04082426
       X27-CLOSE-VPF040 SECTION.                                        04082526
                                                                        04082626
       X27011-ENTRY.                                                    04082726
                                                                        04082826
           EXEC SQL                                                     04082926
                CLOSE VPF040-CSR                                        04083026
           END-EXEC                                                     04083126
                                                                        04083226
           EVALUATE SQLCODE                                             04083326
           WHEN ZERO                                                    04083426
                                                                        04083526
              CONTINUE                                                  04083626
                                                                        04083726
           WHEN OTHER                                                   04083826
               DISPLAY 'SQLCODE IS:' SQLCODE                            04083926
               MOVE 0103 TO WV-ABCODE                                   04084026
               PERFORM Z09-ABEND                                        04084126
           END-EVALUATE                                                 04084226
           .                                                            04084326
       X27011-EXIT.                                                     04084426
                                                                        04084526
           EXIT.                                                        04084626
                                                                        04085021
                                                                        04090001
                                                                        04380001
       B06-TERMINATE SECTION.                                           04390001
                                                                        04400001
       B06010-ENTRY.                                                    04410001
                                                                        04420001
           CLOSE INFILE                                                 04430001
                                                                        04440001
           EVALUATE WV-FILE-STATUS                                      04450001
           WHEN ZERO                                                    04460001
               CONTINUE                                                 04470001
                                                                        04480001
           WHEN OTHER                                                   04490001
               DISPLAY '** PFCR001 - INVALID FILE CLOSE ON INFILE *'    04500001
               MOVE 0009 TO WV-ABCODE                                   04510001
               PERFORM Z09-ABEND                                        04520001
           END-EVALUATE                                                 04530001
                                                                        04540001
              .                                                         04880001
       B06010-EXIT.                                                     04890001
                                                                        04900001
           EXIT.                                                        04910001
                                                                        04920001
                                                                        05250001
                                                                        05260001
                                                                        05270001
       Z09-ABEND SECTION.                                               05280001
                                                                        05290001
       Z09010-ENTRY.                                                    05300001
                                                                        05310001
           MOVE WC-PFCR001 TO WZ-FORMATTED-SQLCODE                      05320001
                                                                        05330001
           DISPLAY ' ********************************'                  05340001
           DISPLAY ' *       ABEND CODE ' WV-ABCODE '        *'.        05350001
                                                                        05360001
           PERFORM Z9-SQL-ERROR.                                        05370001
                                                                        05380001
       Z09999-EXIT.                                                     05390001
                                                                        05400001
           EXIT.                                                        05410001
                                                                        05420001
           EXEC SQL INCLUDE SSPSQLE  END-EXEC.                          05430001
                                                                        05440001

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 -> COBOL Programming

 

Similar Topics
Topic Forum Replies
No new posts Extracting Variable decimal numbers f... DFSORT/ICETOOL 17
No new posts Variable Output file name DFSORT/ICETOOL 8
No new posts COBOL - Move S9(11)v9(7) COMP-3 to -(... COBOL Programming 5
No new posts Moving Or setting POINTER to another ... COBOL Programming 2
No new posts parsing variable length/position data... DFSORT/ICETOOL 5
Search our Forums:

Back to Top
IBMMainframes.com is not an official and/or affiliated with IBM® in anyway
Board Rules | FAQ | Downloads | Wiki | SiteMap | Contact Us