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

MOVE full string into a receiving field in loop


IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
babu_hi

New User


Joined: 11 Apr 2006
Posts: 93

PostPosted: Thu Jul 31, 2008 3:33 pm
Reply with quote

i am facing problem with string concept in cobol.
my requirement is like this,THIS CONCEPT I AM USING FOR DYNEMEIC SQL PROCESSING.

Code:
05  WS-VAR1                  PIC X(02) VALUE 1.
05   WS-UNION                PIC X(05) VALUE 'UNION'.
05  WS-SELECT                PIC X(20) VALUE SPACES.
05  WS-SELECT                PIC X(20) VALUE SPACES.         
05  WS-DYN-SELECT.                                           
      49  WS-DS-LENGTH       PIC S9(04)   VALUE +4000  COMP. 
      49  WS-DS-COMMAND      PIC  X(4000) VALUE SPACES.       
05  WS-DYN-WHERE.                                             
      49  WS-WHERE-LEN       PIC S9(04)   VALUE +4000  COMP. 
      49  WS-WHERE-COMMAND   PIC  X(4000) VALUE SPACES.       
05  WS-DYN-OPEN.                                             
      49  WS-OPEN-LEN        PIC S9(04)   VALUE +4000  COMP. 
      49  WS-DYNCURSOR-OPEN  PIC  X(4000) VALUE SPACES.       


STRING ' WHERE SEND_RT_NO = ? ',               
       ' AND   RECV_RT_NO = ? ',               
       ' AND   RESEND_IND = ? ',               
       ' AND   FILE_RECV_CNT = ? ',           
       ' AND   CREA_DTE = ? ',                 
       ' AND   CREA_TME = ? ',                 
       ' AND   CASH_LET_BUS_DTE = ? ',         
       ' AND   CASH_LET_ID = ? ',             
       ' AND   BUNDLE_ID = ? ',               
       ' AND   CNTL_REC_IND = ?> '             
       DELIMITED BY SIZE                       
       INTO WS-WHERE-COMMAND                   
END-STRING

STRING  LK-DBL-SEND-ABA1,         
        LK-DBL-RECV-ABA1,         
        LK-DBL-RESEND-IND,       
        LK-DBL-FILE-RECV-IND1,   
        LK-DBL-CREATE-DATE,       
        LK-DBL-CREATE-TIME,       
        LK-DBL-BUSINESS-DATE,     
        LK-DBL-CASH-LET-ID,       
        LK-DBL-BUNDLE-ID,         
        LK-DBL-HEADER             
        DELIMITED BY SIZE         
        INTO WS-DYNCURSOR-OPEN   
END-STRING                       
                                   
STRING '<SELECT * FROM ARW0.' 
DELIMITED BY SIZE             
INTO WS-SELECT.               

PERFORM UNTIL WS-VAR1 = WS-SUB1                             
        ADD 1 TO LK-SUB1                                     
        MOVE LK-CNTL-TBNAME1(LK-SUB1)   TO                   
                                  WS-CNTL-TBNAME1(WS-VAR1)   
        MOVE WS-CNTL-TBNAME1(WS-VAR1) TO WS-TBNAME1         
        MOVE WS-TBNAME1(1:11)         TO WS-TBNAME           
        IF WS-VAR1 = 1                                       
            STRING WS-SELECT DELIMITED BY SIZE               
                   WS-TBNAME                                 
                   WS-WHERE-COMMAND DELIMITED BY SIZE       
                   INTO WS-DS-COMMAND                       
        END-IF
   IF WS-VAR1 > 1                               
       STRING WS-DS-COMMAND DELIMITED BY SIZE   
           WS-SELECT DELIMITED BY SIZE       
           WS-TBNAME                         
           WS-WHERE-COMMAND DELIMITED BY SIZE
           INTO WS-DS-COMMAND                 
   END-IF
******************************************************************     
**** HERE THE UNION KEYWORD IS ADD END OF EACH SELECTMENT.IF THE       
**** BELOW CONDITION SATISFIES THEN IT WON'T BE ADD IN THE SELECT.     
******************************************************************     
       IF WS-VAR1 NOT = WS-SUB1                                         
          STRING WS-DS-COMMAND DELIMITED BY SIZE                       
                 WS-UNION      DELIMITED BY SIZE                       
                 INTO WS-DS-COMMAND                                     
       END-IF                                                           
       ADD 1 TO WS-VAR1                                                 
       END-PERFORM.                                                     
          DISPLAY WS-DS-COMMAND.                                       


I WANT OUT PUT LIKE THIS.

Code:
<SELECT * FROM ARW0.ARWX9-T008 WHERE ACNO = ? AND NAME = ?> UNION <SELECT * FROM ARW0.ARWX9-T009 WHERE ACNO = ? AND NAME = ?> UNION <SELECT * FROM ARW0.ARWX9-T010 WHERE ACNO = ? AND NAME = ?>

BUT I AM GETTING THE STRING EVEN PUT IN A LOOP LIKE THIS(I DISPLAYED WS-DS-COMMAND),

Code:
<SELECT * FROM ARW0.ARWX9-T008 WHERE ACNO = ? AND NAME = ?>
Back to top
View user's profile Send private message
babu_hi

New User


Joined: 11 Apr 2006
Posts: 93

PostPosted: Thu Jul 31, 2008 7:40 pm
Reply with quote

please give any idea for my problem in string?
Back to top
View user's profile Send private message
dick scherrer

Moderator Emeritus


Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix

PostPosted: Thu Jul 31, 2008 7:52 pm
Reply with quote

Hello,

Add some DISPLAY statements after the various STRINGs to see what is happening. You would want to identify each different DISPLAY so you know which part of the code you are in and i'd suggest displaying the subscripts as well.

Code:
05  WS-VAR1                  PIC X(02) VALUE 1.
Why is this field defined as X(2)?
Back to top
View user's profile Send private message
dbzTHEdinosauer

Global Moderator


Joined: 20 Oct 2006
Posts: 6966
Location: porcelain throne

PostPosted: Thu Jul 31, 2008 7:52 pm
Reply with quote

you delimit each ws-xx-command with size. each is in a 4000 char area, yet you string to only 4000. you have a 4000 bag with 8000 lbs of ....
Back to top
View user's profile Send private message
dbzTHEdinosauer

Global Moderator


Joined: 20 Oct 2006
Posts: 6966
Location: porcelain throne

PostPosted: Thu Jul 31, 2008 7:54 pm
Reply with quote

i would initialize the ws-nn-commands with high values. then when the ws-nn.command field is moved delimit based on high-values not size. that will get you thru a couple.

you need to keep track of your lengths (actual area populated).
Back to top
View user's profile Send private message
UmeySan

Active Member


Joined: 22 Aug 2006
Posts: 771
Location: Germany

PostPosted: Thu Jul 31, 2008 9:54 pm
Reply with quote

I would use several dedicated areas. Also i would follow the advice of dbzTHEdinosauer, initialize this areas initialized by high values.

Then I would build a logic, using STRING and UNSTRING with the POINTER options.
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 Replace each space in cobol string wi... COBOL Programming 3
No new posts PARSE Syntax for not fix length word ... JCL & VSAM 7
No new posts Sortjoin and Search for a String and ... DFSORT/ICETOOL 1
No new posts Replace Multiple Field values to Othe... DFSORT/ICETOOL 12
No new posts VB to VB copy - Full length reached SYNCSORT 8
Search our Forums:

Back to Top