user1046630
user1046630

Reputation: 1

COBOL issue - issue from a beginner , please guide

I want to acheive the below

a string of pic X(5) contains A1992 and is incremented to A9999 , after it reaches A9999 , the A should be replaced by B and the other characters should be reinitialized to 0000 ie B0000 , this should happen until Z9999 , is it possible somehow ?

or if you could show me how to increment A till Z that would be suffice

Upvotes: 0

Views: 1175

Answers (4)

Dave Smith
Dave Smith

Reputation: 756

For lovers of obfuscated COBOL, here's the shortest (portable) version I can think of (assuming a compiler with Intrinsic Functions):

IDENTIFICATION DIVISION.
PROGRAM-ID. so.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ws-counter value "A00".
   03 ws-alpha   pic x.
   03 ws-number  pic 99.
PROCEDURE DIVISION.
1.
     Perform with test after until ws-counter > "Z99"
       Display ws-counter, " " with no advancing
       Add 1 To ws-number
          On size error
             Move zero to ws-number
             perform with test after until ws-alpha is alphabetic-upper or > "Z"
                 Move Function Char (Function Ord( ws-alpha ) + 1) to ws-alpha
             end-perform 
       End-add
    End-perform.
END PROGRAM so.

Tested on OpenVMS/COBOL. I shorten the value to X(3) since it's boring to watch run. A non-portable version (if you are aware of the Endianness of your platform) is to redefined the prefix as a S9(4) COMP and increment the low-order bits directly. But that solution wouldn't be any shorter...

Upvotes: 0

NealB
NealB

Reputation: 16928

Just can't help myself... How about this...

   IDENTIFICATION DIVISION.                                         
   PROGRAM-ID. EXAMPLE.                                             
   DATA DIVISION.                                                   
   WORKING-STORAGE SECTION.                                         
   01.                                                              
       02 ALL-LETTERS  PIC X(26) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
       02 LETTERS REDEFINES ALL-LETTERS.                            
          03 LETTER    PIC X OCCURS 26 INDEXED BY I. 
   01  START-NUMBER    PIC 9(4).              
   01  COUNTER.                                                     
       02 COUNTER-LETTER    PIC X.                                  
       02 COUNTER-NUMBER    PIC 9(4).                                
   PROCEDURE DIVISION.
       MOVE 1992 TO START-NUMBER                                              
       PERFORM VARYING I FROM 1 BY 1 UNTIL I > LENGTH OF ALL-LETTERS                   
           MOVE LETTER (I) TO COUNTER-LETTER                        
           PERFORM TEST AFTER VARYING COUNTER-NUMBER FROM START-NUMBER BY 1 
                                UNTIL COUNTER-NUMBER = 9999         
              DISPLAY COUNTER - or whatever else you need to do with the counter...             
           END-PERFORM
           MOVE ZERO TO START-NUMBER                                              
       END-PERFORM                                                  
       GOBACK                  
       .                       

This will print all the "numbers" beginning with A1992 through to Z9999.

Basically stole Marcus_33's code and twiked it a tiny bit more. If you feel so inclined please upvote his answer, not mine

Upvotes: 1

Marcus_33
Marcus_33

Reputation: 464

I'd probably do this with a nested perform loop.

Storage:

01  ws-counter-def
    03  ws-counter-def-alpha-list      pic x(27) value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
    03  ws-counter-def-num             pic 9(4) comp-3.

01  ws-counter redefines ws-counter-def
    03  ws-counter-alpha occurs 27 times indexed by counter-idx   pic x.
    03  ws-counter-num                 pic 9(4) comp-3.      

01  ws-variable                        
    03  ws-variable-alpha              pic X
    03  ws-variable-num                pic X(4).                     

Procedure:

Initialize counter-idx.
Move 1992 to ws-counter-num.

Perform varying counter-idx from 1 by 1 until counter-idx > 26
  move ws-counter-alpha(counter-idx) to ws-variable-alpha
  perform until ws-counter-num = 9999
        add 1 to ws-counter-
        move ws-counter-num to ws-variable-num.
        *do whatever it is you need to do to the pic X(5) value in ws-variable*
  end-perform
  move zeros to ws-counter-num
end-perform.

Upvotes: 2

Joe Zitzelberger
Joe Zitzelberger

Reputation: 4263

You will need to do some manual character manipulation on this one. There are several parts, first, you need to handle the simple addition of the numeric portion, then you need to handle the rollover of that to increment the alpha portion.

Data structures similar to this might be helpful:

01 Some-Work-Area.
  02 Odometer-Char-Vals      pic x(27) value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
  02 Odometer-Char occurs 27 pic x.
  02 Odo-Char-Ndx            pic s9(8) binary.

01 My-Odometer.
    88 End-Odometer-Value    value 'Z9999'.
  02 My-Odometer-X           pic X.
  02 My-Odometer-9           pic 9999.
    88 Carry-Is-True         value 9999.

This would be used with a simple perform loop like so:

Move 0 to My-Odometer-9
Move 1 to Odo-Char-Ndx
Move Odometer-Char-Vals (Odo-Char-Ndx) to My-Odometer-X

Perform until End-Odometer-Value
   Add 1 to My-Odometer-9
   Display My-Odometer
   If Carry-Is-True
      Move 0 to My-Odometer-9
      Add 1 to Odo-Char-Ndx
      Move Odometer-Char-Vals (Odo-Char-Ndx) to My-Odometer-X
   End-If
End-Perform

That is one way you could do it.

Please note, the code above took some shortcuts (aka skanky hacks) -- like putting a pad cell in the Odometer-Char array so I don't have to range check it. You wouldn't want to use this for anything but examples and ideas.

Upvotes: 2

Related Questions