Transcript COBOLDay2

COBOL Programming
DAY 2
Agenda for Day2
 Data Movement verbs.
 Sequence Control verbs.
 Types of conditions.
 REDEFINES, RENAMES, USAGE clauses.
 Design and development of sample programs.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
MOVE VERB
•
The MOVE copies data from the source identifier or literal to one or more
destination identifiers.
•
The source and destination identifiers can be group or elementary data
items.
•
When the destination item is alphanumeric or alphabetic (PIC X or A) data
is copied into the destination area from left to right with space filling or
truncation on the right.
•
When data is MOVEd into an item the contents of the item are completely
replaced. If the source data is too small to fill the destination item entirely
the remaining area is zero or space filled.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
MOVE verb…
Identifier
MOVE 
 TO Identifier...
Literal 
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
DATA movement verbs…
(1) MOVE
(2) MOVE . . . CORRESPONDING ( CORR )
(3) MOVE . . . OF . . . TO . . . OF
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Before
Before
WS00-OUT1
‘BEST’
WS00-OUT1
‘
WS00-OUT2
1234
WS00-OUT2
0
’
Before
WS00-OUT3
0786
After
WS00-OUT3
Before
WS00-OUT4
2345
After
‘PAYAL PAREKH’
Copyright © 2005, Infosys
Technologies Ltd
‹#›
WS00-OUT4
‘SHUTI DEY’
ER/CORP/CRS/LA01/003
Version 1.0
MOVE to a numeric item
•
When the destination item is numeric, or edited numeric, then data is aligned
along the decimal point with zero filling or truncation as necessary.
•
When the decimal point is not explicitly specified in either the source or
destination items, the item is treated as if it had an assumed decimal point
immediately after its rightmost character.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Before
Before
WS00-OUT1
0000
WS00-OUT1
3456
WS00-OUT2
000000
WS00-OUT2
345678
Before
WS00-OUT3
000000
After
WS00-OUT3
Before
WS00-OUT4
After
00000000
Copyright © 2005, Infosys
Technologies Ltd
WS00-OUT4
‹#›
12345678
ER/CORP/CRS/LA01/003
Version 1.0
123456
MOVE .. example
****************************
Output SPOOL
WS00-OUT1 : HARAYANA
WS00-OUT2 : HARAYANA
****************************
Copyright © 2005, Infosys
‹#›
Version 1.0
Technologies Ltd
ER/CORP/CRS/LA01/003
JUSTIFIED RIGHT clause
Is used to change the default type movement of alphabetic and alphanumeric
data.
Example
01 NAME PIC X(10) JUSTIFIED RIGHT.
MOVE “KAJOL” TO NAME.
Contents of NAME field is
bbbbbKAJOL
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
JUSTIFIED RIGHT clause .. example
*********************************************
Output SPOOL
WS00-OUT1 : ABCDEFGHIJKLMNOPQRSTUVWXYZ
WS00-OUT2 :
ABCDEFGHIJKLMNOPQRSTUVWXYZ
*********************************************
ER/CORP/CRS/LA01/003
Copyright © 2005, Infosys
‹#›
Version 1.0
Technologies Ltd
MOVE CORRESPONDING
•
Facilitates movement of value of sub-item of a group item to a similar
named sub-item of another group item
Syntax
MOVE { CORRESPONDING, CORR } identifier-1
TO
identifier-2
where identifier-1 and identifier-2 are group items.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
MOVE CORRESPONDING .. example
****************************
Output SPOOL
WS00-GR2 : NISHANT
00000
****************************
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
MOVE . . . OF . . . TO . . . OF
Facilitates the movement of a particular field of a record to a particular field of
another record. (in other words it facilitates movement of value of a
individual/group item of one group item to an individual/group item of another
group item).
Example:
MOVE NAME OF STUD-REC TO
WS-NAME OF WS-STUD-REC.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
LEGAL MOVES
Certain combinations of sending and receiving data types are not permitted.
Receiving field
Sending field
Alphabetic
Alphanu
meric
Edited
Alphan
umeric
Numeric
Numeric
non
integer
Edited
numeric
Alphabetic
Y
Y
Y
N
N
N
Alphanumeric
Y
Y
Y
Y
Y
Y
Edited
Alphanumeric
Y
Y
Y
N
N
N
Numeric
N
Y
Y
Y
Y
Y
N
N
N
Y
Y
Y
N
Y
Y
Y
Y
Y
Numeric
integer
Edited
numeric
non
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
SEQUENCE CONTROL verbs
•
•
•
IF
.
.
.
GOTO
THEN
•
PERFORM
•
EVALUATE
.
.
STOP RUN
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
.
GO TO Verb
• Syntax-1
GO TO Paragraph Name.
• Example
GO TO 400-READ-PARA.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
IF statement
• Syntax-1
IF condition
[ THEN ] {statement-1, NEXT SENTENCE}
[ELSE {statement-2, NEXT SENTENCE}]
[
END-IF
].
• Examples
(1)
IF MARKS >= 80
ELSE
MOVE
‘A’
TO
THEN MOVE
‘B’
END-IF.
TO
GRADE
GRADE
(2) IF NOT OK-BALANCE THEN MOVE 2 TO BALANCE-CODE
ELSE
NEXT-SENTENCE
END-IF
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
IF statement
• Syntax-2 ( Nested IF )
IF condition-1 [ THEN ] statement-1
ELSE
IF condition-2 [ THEN ] statement-2
ELSE statement-3
END-IF
END-IF.
• Example
IF ( Var1 < 10 ) THEN DISPLAY “Zero”
ELSE
IF Var2 = 14 THEN DISPLAY “First”
ELSE DISPLAY “Second”
END-IF
END-IF.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
IF statement - Implied Operands
•
Example
IF TIME < 2 AND TIME > 1
THEN MOVE “SLOW” TO SPEED
END-IF.
Is equivalent to
IF TIME < 2 AND > 1 THEN MOVE “SLOW” TO SPEED.
•
Note: The following statement is invalid.
IF TOT-1 OR TOT-2 = 7 THEN DISPLAY “ The Sum is 7.”.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Classification of Conditions
•
Relational
condition
•
Sign
condition
•
Class
condition
•
Compound
condition
•
Condition-name
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Relational condition
 NOT GREATER THAN



 NOT >



NOT LESS THAN



 NOT <

 Identifier
 


  NOT EQUAL TO

 Literal
 IS 

 ArithmeticExpression   NOT =


 

GREATER
THAN
OR
EQUAL
TO


 >=



LESS
THAN
OR
EQUAL
TO


 <=

Copyright © 2005, Infosys
Technologies Ltd
‹#›
 Identifier



 Literal

 ArithmeticExpression 


ER/CORP/CRS/LA01/003
Version 1.0
Sign condition
• Syntax
POSITIVE 


Arithmetic Expression IS [ NOT]  NEGATIVE 
ZERO



• Example
IF
DISCRIMINANT
IS
NEGATIVE
THEN
DISPLAY “The roots are imaginary”.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Class condition
• Syntax
 NUMERIC

 ALPHABETIC



Identifier IS [NOT]  ALPHABETIC - LOWER 
 ALPHABETIC - UPPER 


 UserDefinedClassName 
• Example
IF REGNO IS NOT NUMERIC
THEN DISPLAY “Records will not be sorted”.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Compound Condition
• Syntax
Condition-1 { AND, OR } Condition-2
• Examples
(1) IF PERCENT > 80 AND TOTAL > 480
THEN MOVE ‘A’ TO GRADE.
(2) IF ROW-NUMBER > 24 OR COLUMN > 80
THEN DISPLAY “Page Error ! “.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Condition Names
•
Are essentially boolean variables.
•
Are always associated with data names called
condition variables.
•
Is defined in the DATA DIVISION with level
number 88.
•
Syntax
88 condition-name {VALUE IS, VALUES ARE } literal-1 [ { THRU,
THROUGH } literal-2 ].
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Condition-Names .. example
Condition Variable
01 MARITAL STATUS PIC 9.
Condition
Names
88
88
88
88
88
88
SINGLE
VALUE IS ZERO.
MARRIED
VALUE IS 1.
WIDOWED
VALUE IS 2.
DIVORCED
VALUE IS 3.
ONCE-MARRIED VALUES ARE 1, 2, 3.
VALID-STATUS VALUES ARE 0 THRU 3.
PROCEDURE DIVISION Statements.
IF SINGLE SUBTRACT 125 FROM DEDUCTIONS.
IF ONCE-MARRIED ADD 300 TO SPECIAL-PAY.
IF MARRIED PERFORM B000-MARRIAGE-GIFT.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Defining Condition Names.
 VALUE 

88 ConditionName 
VALUES


 Literal

 THROUGH 

 HighValue
 LowValue  THRU








•
Condition Names are defined using the special level number 88 in the DATA
DIVISION of a COBOL program.
•
They are defined immediately after the definition of the data item with which
they are associated with.
•
We can use Condition Names for a group as well as an elementary item.
•
A condition name takes the value TRUE or FALSE depending on the value
of the data item with which it is associated. The VALUE clause of the
associated data item is used to identify the values which make the Condition
Name TRUE.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
JCL
000100 //ER4857C JOB ,,NOTIFY=&SYSUID,CLASS=B
000500 //STEP1 EXEC PGM=COND88
000700 //STEPLIB DD DSN=OPERN.CICS3.LOADLIB,DISP=SHR
000800 //SYSIN DD *
000900 050
Before
001000 081
001100 /*
WS00-MARKS
000
WS00-DISP
After
Before
WS00-MARKS
WS00-MARKS
050
WS00-DISP
NOT CLEARED COMPRE
After
000
WS00-MARKS
WS00-DISP
Copyright © 2005, Infosys
Technologies Ltd
‹#›
081
WS00-DISP
PASSED COMPRE
ER/CORP/CRS/LA01/003
Version 1.0
Break
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
The PERFORM Verb
•
Iteration constructs are used when we need to repeat the same instructions
over and over again in our programs.
•
Other programming languages have a variety of iteration / looping
constructs (e.g. WHILE, FOR, REPEAT). Each of these in turn facilitate the
creation of different ‘types’ of iteration structure.
•
In COBOL we have ‘PERFORM’ verb which is used to create these looping
constructs. The PERFORM has several variations each of which simulates
different looping constructs of other programming languages.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Paragraphs - Revisited
•
A PARAGRAPH comprises of one or more sentences.
•
The paragraph-name indicates the start of a paragraph. The next
paragraph or section name or the end of the program text terminates the
paragraph.
•
Paragraph names are either user defined or language enforced. They are
followed by a full stop.
– B0000-PERF-PARA.
– PROGRAM-ID.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Paragraph Example
P0000-PROCESS-RECORD.
DISPLAY StudentRecord
READ StudentFile
AT END MOVE HIGH-VALUES TO StudentRecord
END-READ.
D0000-PRODUCE-OUTPUT.
DISPLAY “Here is a message”.
NOTE
Scope of P0000-PROCESS-RECORD is delimited by the
occurrence the paragraph name D0000-PRODUCE-OUTPUT.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM Verb - variations
•
Simple PERFORM
•
In-line PERFORM
•
Nested PERFORM
•
PERFORM . . . THRU
•
PERFORM . . . UNTIL
•
PERFORM . . . TIMES
•
PERFORM . . . VARYING
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM Verb - Simple PERFORM
•
Syntax
PERFORM Paragraph-Name.
•
Example
PERFORM 500-PROCESS-PARA.
•
This is not iterative but instructs the computer to execute the chunk of code
inside the mentioned paragraph before reverting back to the sentence
following the PERFORM coded.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM Verb – Simple PERFORM example
****************************************
WE ARE INSIDE B000-LAST-PARA
Output SPOOL
WE ARE INSIDE B001-FIRST-PARA
WE ARE INSIDE B002-MIDDLE-PARA
ER/CORP/CRS/LA01/003
Copyright © 2005, Infosys
‹#›
Version 1.0
Technologies
Ltd
****************************************
PERFORM Verb - In-line PERFORM
•
Syntax
PERFORM imperative-statements.
•
Example
PERFORM
MOVE NUM-1 TO MAX
IF NUM-2 > MAX THEN MOVE NUM-2 TO MAX
DISPLAY “Maximum is ” MAX.
END-PERFORM
Lets see an example ..
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
INLINE PERFORM PROGRAM
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
JCL FOR THE INLINE
PERFORM PROGRAM
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
When SYSIN data satisfies
the condition WS-STRING =
‘KARINA’ the scope of the
INLINE PERFORM gets
terminated
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM Verb – Nested PERFORM
•
Syntax
Paragraph-Name-1.
PERFORM Paragraph-Name-2.
.
.
.
.
.
.
.
.
Paragraph-Name-2.
PERFORM Paragraph-Name-3.
.
.
.
.
.
.
.
.
Paragraph-Name-3.
MOVE A TO B.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM Verb – Nested PERFORM
****************************************
WE ARE INSIDE B000-LAST-PARA
Output SPOOL
WE ARE INSIDE B001-FIRST-PARA
WE ARE INSIDE B002-MIDDLE-PARA
ER/CORP/CRS/LA01/003
Copyright © 2005, Infosys
‹#›
Version 1.0
Technologies
Ltd
****************************************
PERFORM Verb – PERFORM … THRU …
• Syntax
PERFORM Paragraph-Name-1 [ { THRU, THROUGH }
Paragraph-Name-2 ].
• Example
PERFORM 300-READ-PARA THRU 600-UPDATE-PARA.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM … THRU …
- example
****************************
WE ARE INSIDE B000-DISP-PARA
Output SPOOL
WE ARE INSIDE B001-DISP-PARA
WE ARE INSIDE B002-DISP-PARA
ER/CORP/CRS/LA01/003
Copyright © 2005, Infosys
‹#›
****************************
Version 1.0
Technologies Ltd
PERFORM Verb – PERFORM .. UNTIL ..
• Syntax
PERFORM
Paragraph-Name-1 [ { THRU, THROUGH }
Paragraph-Name-2 ] UNTIL condition.
• Example
PERFORM 300-READ-PARA UNTIL EOF = ‘N’.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM Verb –
PERFORM . . UNTIL .. WITH TEST AFTER OPTION
• Syntax
PERFORM
Paragraph-Name-1 [ { THRU, THROUGH }
Paragraph-Name-2 ]
[WITH TEST {BEFORE, AFTER}]
UNTIL condition.
• Example
PERFORM 300-PROCESS-PARA WITH TEST AFTER
UNTIL VALUE NOT = 0.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM . . UNTIL .. WITH TEST AFTER OPTION
•
This format is used where the WHILE or REPEAT constructs are used in
other languages.
•
If the WITH TEST BEFORE phrase is used the PERFORM behaves like a
WHILE loop and the condition is tested before the loop body is entered.
•
If the WITH TEST AFTER phrase is used the PERFORM behaves like a
REPEAT loop and the condition is tested after the loop body is entered.
•
The WITH TEST BEFORE phrase is the default and so is rarely explicitly
stated.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM Verb –
PERFORM . . UNTIL .. WITH TEST BEFORE
Output SPOOL
****************************
****************************
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM Verb –
PERFORM . . UNTIL .. WITH TEST AFTER
10 Times!! Why?
****************************
WE ARE INSIDE B000-PERF-PARA
WE ARE INSIDE B000-PERF-PARA
WE ARE INSIDE B000-PERF-PARA
WE ARE INSIDE B000-PERF-PARA
WE ARE INSIDE B000-PERF-PARA
WE ARE INSIDE B000-PERF-PARA
Output SPOOL
WE ARE INSIDE B000-PERF-PARA
WE ARE INSIDE B000-PERF-PARA
WE ARE INSIDE B000-PERF-PARA
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
WE ARE
INSIDE B000-PERF-PARA
Version 1.0
****************************
PERFORM Verb – PERFORM .. TIMES
• Syntax
PERFORM
Paragraph-Name-1 [ { THRU, THROUGH }
Paragraph-Name-2 ] { integer, identifier } TIMES.
• Example
PERFORM 500-PROCESS-PARA THRU 800-END-PARA 8 TIMES.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM Verb – PERFORM .. TIMES …… Example
****************************
HELLO GUEST. WELCOME TO E&R TRAINING
HELLO GUEST. WELCOME TO E&R TRAINING
HELLO GUEST. WELCOME TO E&R TRAINING
Output SPOOL
HELLO GUEST. WELCOME TO E&R TRAINING
HELLO GUEST. WELCOME TO E&R TRAINING
Copyright © 2005, Infosys
Technologies Ltd
****************************
ER/CORP/CRS/LA01/003
‹#›
Version 1.0
PERFORM Verb - PERFORM . . . VARYING
• Syntax
PERFORM
Paragraph-Name-1
[
{
THRU,
THROUGH
}
Paragraph-Name-2 ]
VARYING
identifier-1
FROM
{identifier-2,
integer-1}
BY { identifier-3, integer-2 }
UNTIL condition.
• Example
PERFORM 500-WRITE-PARA
VARYING I FROM 1 BY 1
UNTIL I > 5.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
PERFORM Verb - PERFORM . . . VARYING
****************************
HELLO GUEST. WISH YOU ALL THE BEST
HELLO GUEST. WISH YOU ALL THE BEST
Output SPOOL
HELLO GUEST. WISH YOU ALL THE BEST
HELLO GUEST. WISH YOU ALL THE BEST
****************************
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
EXIT statement
•
Is used to transfer the control back to the statement following the
“PERFORM statement” from within a paragraph invoked by the
PERFORM statement.
Syntax
EXIT.
Note:
It is recommended to avoid using EXIT similar to GO TO since it is against the
idea of structured programming.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
The Evaluate
 Identifier



Literal


 CondExpression 

EVALUATE 
 ArithExpression 
 TRUE



 FALSE










  ANY

  Condition


 WHEN   TRUE

  FALSE




 Identifier


   THRU








NOT
Literal
  THROUGH 





 
 ArithExpression  










 Identifier
 

 
 Literal
 
 ArithExpression   

 







 StatementBlock






 WHEN OTHER StatementBlock
END - EVALUATE
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0














EVALUATE Verb .. example
There are two valid ranges
which the logic checks for –
1) Marks > 79
2) Marks > 64 & <= 79
*************************************
YOU HAVE CLEARED EXAM WITH A GRADE
Output SPOOL
*************************************
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
STOP RUN statement
•
Syntax
•
Instructs the computer to terminate the program.
•
Closes all the files that were opened for file operations.
•
The STOP RUN is usually the last statement in the main paragraph.
:
STOP RUN.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
REDEFINES Clause
• Facilitates two or more data-names to point to the same memory location
Syntax
data-name-1 REDEFINES data-name-2.
Example
01 STUD-DETAILS.
05 STUD-NAME.
10 FIRST-NAME
PIC A(15).
10 MIDDLE-NAME PIC A(10).
10 LAST-NAME
PIC A(10).
05 NAME REDEFINES STUD-NAME.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
REDEFINES Clause
Rules governing REDEFINES clause
 Multiple REDEFINES is allowed for a data-item.
 REDEFINES clause must not be used for 01 level in FILE SECTION.
 Must not be used for data-items defined in level numbers 66 and 88.
 The REDEFINING item should not have an OCCURS clause.
 Any change in REDEFINED item reflects on the value of the REDEFINING
item and vice-versa.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
REDEFINES CLAUSE … example
WS00-YEAR2 redefines WS00-YEAR1.
It is the same 8 bytes of
information which WS00-YEAR2
provides in the Year, Month & Day
format in it’s sub-items.
Any change in WS00-YEAR1 changes
value of WS00-YEAR2 and vice-versa.
************************************
YEAR FOR ENTERED DATE IS
: 2005
MONTH FOR ENTERED DATE IS : 01
Output SPOOL
DAY FOR ENTERED DATE IS
Copyright © 2005, Infosys
Technologies Ltd
: 01
************************************
ER/CORP/CRS/LA01/003
‹#›
Version 1.0
RENAMES Clause
•
Facilitates re-grouping of elementary data items in a record. After the
renames enforcement the elementary items would belong to the original
(renamed) group item as well as the new (renaming) group item.
Syntax
66 data-name-1 RENAMES data-name-2 THRU data-name-3.
Rules to be followed while using RENAMES
 RENAMES must be used after the description of the fields required.
 Must be coded only with level number 66.
 Data-names 2 and 3 should not have level numbers 01 and
Clause.
OCCURS
 The elementary items getting renamed should be contiguous.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
RENAMES Clause
Example
01 STUD-DETAILS.
05 REG-NO
05 S-F-NAME
05 S-M-NAME
05 S-L-NAME
PIC 9(5).
PIC X(15).
PIC X(12).
PIC X(8).
66 STUD-NAME RENAMES S-F-NAME THRU S-L-NAME.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
RENAMES clause .. example
WS-REN would be picking up
the value of the sub-items
from WS-IN12 to WS-22
(spreading across WS-IN1 &
WS-IN2 values).
Note that WS-IN11 is left
out.
*********************************
WS-REN VALUE IS : 341234
Output SPOOL
*********************************
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
USAGE Clause
•
•
Is used to specify the internal form in which the data is to be stored.
Every variable will have an attached usage clause (even if not declared by
the programmer).
• Syntax
USAGE IS {DISPLAY, COMPUTATIONAL, COMP} [ - {1, 2, 3}].
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
USAGE Clause
•
USAGE is DISPLAY
– Each character of the data is represented in one byte
•
USAGE IS COMPUTATIONAL
– The data item is represented as pure binary
•
USAGE IS COMP-1
– The data item is represented as a single precision floating point number
(similar to real or float).
•
USAGE IS COMP-2
– The data item is represented internally as Double precision floating
number (similar to Long or Double).
•
USAGE IS COMP-3
– In decimal form but 1 digit takes half a byte (nibble). The sign is stored as
right most half a byte character.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
USAGE Clause
Rules to followed while using USAGE clause
 Usage clause cannot be used with data items declared with 66 or 88
levels.
 Usage clause when declared for a group item, ensures that all the
sub-items of the group item default to the same USAGE clause as the
group item’s.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
USAGE Clause .. example
B0001-POPULATE-FIELDS.
MOVE 99999
TO WS00-COMP-FORM
MOVE 99999
TO WS00-COMP1-FORM
MOVE 99999
TO WS00-COMP2-FORM
MOVE 99999
TO WS00-COMP3-FORM
B0002-DISPLAY-FIELDS.
DISPLAY '******************************************'
DISPLAY '* COMP
DISPLAY IS
: ' WS00-COMP-FORM
DISPLAY '* COMP1 DISPLAY IS
: ' WS00-COMP1-FORM
DISPLAY '* COMP2 DISPLAY IS
: ' WS00-COMP2-FORM
DISPLAY '* COMP3 DISPLAY IS
: ' WS00-COMP3-FORM
DISPLAY '******************************************'
******************************************
* COMP
Output SPOOL
DISPLAY IS
: 99999
* COMP1 DISPLAY IS
:
.99999000E 05
* COMP2 DISPLAY IS
:
.99999000000000000E 05
* COMP3 DISPLAY IS
: 99999
ER/CORP/CRS/LA01/003
Copyright © 2005,
Infosys
‹#›
******************************************
Version 1.0
Technologies Ltd
Review
 Data Movement verbs. (MOVE)
 Sequence Control verbs (IF,PERFORM,EVALUATE)
 Types of conditions.
 REDEFINES, RENAMES, USAGE clauses
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Review questions
•
What is wrong with the following code
(1) IF A EQUALS B
MOVE 1 TO A
END –IF
This should be ; IF A IS EQUAL TO B
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Review questions ..
•
How many times will the paragraph named
100-PARA be executed by the following PERFORM STATEMENT
PERFORM 100-PARA VARYING X
FROM 1 BY 1 UNTIL X=10
9 TIMES
PERFORM 100-PARA VARYING X
FROM 1 BY 1 UNTIL X > 10
10 TIMES
PERFORM 100-PARA VARYING X
FROM 0 BY 1 UNTIL X=10
10 TIMES
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Review questions
•
State true or false
– The justified clause can be used for any data type
False
– The redefines clause can be used to redefine only
False
elementary items
True
– The data item at the level 49 will always have a picture
clause
True
– In a move statement, though the sending field is one, the
receiving fields may be more than one.
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Summary
•
Data Movement verbs.
•
Sequence Control verbs.
•
Types of conditions.
•
REDEFINES, RENAMES, USAGE clauses.
•
Design and development of sample programs
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0
Thank You!
Copyright © 2005, Infosys
Technologies Ltd
‹#›
ER/CORP/CRS/LA01/003
Version 1.0