| Previous | Contents | Index |
MOVE 0 TO LINE-COUNT.
MOVE 1 TO PTR.
GET-WORD.
IF LINE-COUNT NOT < 4
DISPLAY " " TEXT-STRING
GO TO GOT-WORDS.
ACCEPT INPUT-MESSAGE.
DISPLAY INPUT-MESSAGE.
SAME-WORD.
MOVE PTR TO HOLD-PTR.
STRING INPUT-MESSAGE DELIMITED BY SPACE
", " DELIMITED BY SIZE
INTO TEXT-STRING
WITH POINTER PTR
ON OVERFLOW
STRING " " DELIMITED BY SIZE
INTO TEXT-STRING
WITH POINTER HOLD-PTR
DISPLAY " " TEXT-STRING
MOVE SPACES TO TEXT-STRING
ADD 1 TO LINE-COUNT
MOVE 1 TO PTR
GO TO SAME-WORD.
GO TO GET-WORD.
GOT-WORDS.
EXIT.
|
This example demonstrates how This, example, demonstrates, the STRING statement can how, the, STRING, statement, construct text strings can, construct, text, using the POINTER phrase strings, using, the, POINTER, phrase, |
The SUBTRACT statement subtracts one, or the sum of two or more, numeric items from one or more items. It stores the difference in one or more items.
num
is a numeric literal or the identifier of an elementary numeric item.rsult
is the identifier of an elementary numeric item. However, in Format 2, rsult can be an elementary numeric edited item. It is the resultant identifier.stment
is an imperative statement executed when a size error condition has occurred.stment2
is an imperative statement executed when no size error condition has occurred.grp-1
is the identifier of a group item.grp-2
is the identifier of a group item.
CORR is an abbreviation for CORRESPONDING.
Each of the examples assume these data descriptions and initial values.
INITIAL VALUES
03 ITEMA PIC S99 VALUE -85. -85
03 ITEMB PIC 99 VALUE 2. 2
03 ITEMC VALUE "123".
05 ITEMD OCCURS 3 TIMES 1 2 3
PIC 9.
03 ITEME PIC S99 VALUE -95. -95
|
SUBTRACT 2 ITEMB FROM ITEMA. ITEMA = -89 |
SUBTRACT 14 FROM ITEMA, ITEME ITEMA = -99
ON SIZE ERROR ITEME = -95
MOVE 0 TO ITEMB. ITEMB = 0
|
SUBTRACT 14 FROM ITEMA ITEMA = -99
ON SIZE ERROR
MOVE 9 TO ITEMB.
NOT ON SIZE ERROR
MOVE 1 TO ITEMB. ITEMB = 1
|
SUBTRACT 1 FROM ITEMB ITEMD (ITEMB). ITEMB = 1
ITEMD (1) = 0
|
SUBTRACT ITEME ITEMD (ITEMB) FROM ITEMA ITEMB = 8
GIVING ITEMB.
|
SUBTRACT 10 ITEMB FROM ITEMD (ITEMB) ITEMD (2) = 2
ON SIZE ERROR ITEMA = 0
MOVE 0 TO ITEMA
END-SUBTRACT.
SUBTRACT 1 FROM ITEMA. ITEMA = -1
|
IF ITEMB < 3 AND > 1
SUBTRACT 1 FROM ITEMD(ITEMB)
ON SIZE ERROR
MOVE 0 TO ITEMA
END-SUBTRACT
DISPLAY 'yes'
ELSE
DISPLAY 'no'.
|
The SUPPRESS statement causes the Report Writer Control System (RWCS) to inhibit the presentation of a report group.
The SUPPRESS statement can appear only in a USE BEFORE REPORTING Declarative procedure.
PROCEDURE DIVISION.
DECLARATIVES.
DET SECTION.
USE BEFORE REPORTING DETAIL-LINE.
DETA-1.
IF SORTED-NAME = NAME
ADD A TO B
SUPPRESS PRINTING.
IF NAME = SPACES SUPPRESS PRINTING.
END DECLARATIVES.
MAIN SECTION.
.
.
.
|
The TERMINATE statement causes the Report Writer Control System (RWCS) to complete the processing of the specified report.
report-name
names a report defined by a Report Description entry in the Report Section of the Data Division.
Section 6.8.42, USE statement.
6.8.40 UNLOCK
The UNLOCK statement removes a record lock from the current record or from all locked records in the file. On Alpha, the X/Open standard UNLOCK statement always removes the record lock from all locked records in the file.
file-name
is the name of a sequential, relative, or indexed file described in the Data Division.
| File Status |
File Organization |
Access Method |
Meaning |
|---|---|---|---|
| 00 | All | All | Unlock is successful |
| 93 | All | All | No current record |
| 94 | All | All | File not open, or incompatible open mode |
| 30 | All | All | All other permanent errors |
These examples assume only one access stream for the image. The following examples refer to this partial program:
CONFIGURATION SECTION.
FILE-CONTROL.
SELECT MASTER-FILE ASSIGN TO "CLIENT.DAT"
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS MASTER-KEY
FILE STATUS IS FILE-STAT.
I-O-CONTROL.
*
* This APPLY clause is required syntax for manual record locking
*
APPLY LOCK-HOLDING ON MASTER-FILE.
DATA DIVISION.
FD MASTER-FILE
LABEL RECORDS STANDARD.
01 MASTER-RECORD.
.
.
.
PROCEDURE DIVISION.
A100-BEGIN.
*
* The ALLOWING phrase enables file sharing
*
OPEN I-O MASTER-FILE ALLOWING ALL.
.
.
.
A900-END-OF-JOB.
|
READ MASTER-FILE KEY IS MASTER-KEY
ALLOWING NO OTHERS.
REWRITE MASTER-RECORD ALLOWING NO OTHERS.
UNLOCK MASTER-FILE.
|
READ MASTER-FILE KEY IS MASTER-KEY
ALLOWING NO OTHERS.
.
.
.
UNLOCK MASTER-FILE RECORD.
|
PERFORM A100-READ-MASTER UNTIL
MASTER-KEY = ID-KEY
OR
MASTER-KEY > ID-KEY.
.
.
.
UNLOCK MASTER-FILE ALL RECORDS.
.
.
.
A100-READ-MASTER.
READ MASTER-FILE ALLOWING NO OTHERS.
|
X/Open Standard Example (Alpha)
The following example shows the use of X/Open standard syntax:
SELECT employee-file ASSIGN TO "EMPFIL"
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS employee-id
LOCK MANUAL LOCK ON MULTIPLE RECORDS
FILE STATUS IS emp-stat.
.
.
.
* The file is implicitly shareable via the SELECT specification.
OPEN I-O employee-file.
PERFORM UNTIL emp-stat = end-of-file
READ employee-file NEXT RECORD
WITH LOCK
IF employee-job-code = peon-code
PERFORM find-boss-record
ENDIF
.
.
.
REWRITE employee-record
* This will unlock this record and the boss's
* record found earlier.
UNLOCK employee-file RECORDS
END-PERFORM.
FIND-BOSS-RECORD.
START employee-file
KEY > employee-job-code.
READ employee-file NEXT WITH LOCK.
|
The UNSTRING statement separates contiguous data in a sending field and stores it in one or more receiving fields.
src-string
is the identifier of an alphanumeric class data item. It cannot be reference modified. Src-string is the sending field.delim
is a nonnumeric literal or the identifier of an alphanumeric data item. It is the delimiter for the UNSTRING operation.dest-string
is the identifier of an alphanumeric, alphabetic, or numeric DISPLAY data item. It is the receiving field for the data from src-string.delim-dest
is the identifier of an alphanumeric data item. It is the receiving field for delimiters.countr
is the identifier of an elementary numeric data item described as an integer. It contains the count of characters moved.pointr
is the identifier of an elementary numeric data item described as an integer. It points to the current character position in src-string.tally-ctr
is the identifier of an elementary numeric data item described as an integer. It counts the number of dest-string fields accessed during the UNSTRING operation.stment
is an imperative statement executed for an on overflow condition.stment2
is an imperative statement executed for a not on overflow condition.
The examples assume these data descriptions:
WORKING-STORAGE SECTION.
01 INMESSAGE PIC X(20).
01 THEDATE.
03 THEYEAR PIC XX JUST RIGHT.
03 THEMONTH PIC XX JUST RIGHT.
03 THEDAY PIC XX JUST RIGHT.
01 HOLD-DELIM PIC XX.
01 PTR PIC 99.
01 FIELD-COUNT PIC 99.
01 MONTH-COUNT PIC 99.
01 DAY-COUNT PIC 99.
01 YEAR-COUNT PIC 99.
|
DISPLAY "Enter a date: " NO ADVANCING.
ACCEPT INMESSAGE.
UNSTRING INMESSAGE
DELIMITED BY "-" OR "/" OR ALL " "
INTO THEMONTH DELIMITER IN HOLD-DELIM
THEDAY DELIMITER IN HOLD-DELIM
THEYEAR DELIMITER IN HOLD-DELIM
ON OVERFLOW MOVE ALL "0" TO THEDATE.
INSPECT THEDATE REPLACING ALL " " BY "0".
DISPLAY THEDATE.
|
Enter a date: 6/13/87 870613 Enter a date: 6-13-87 870613 Enter a date: 6-13 87 870613 Enter a date: 6/13/87/2 000000 Enter a date: 1-2-3 030102 |
DISPLAY "Enter two dates in a row: " NO ADVANCING.
ACCEPT INMESSAGE.
MOVE 1 TO PTR.
PERFORM DISPLAY-TWO 2 TIMES.
GO TO DISPLAYED-TWO.
DISPLAY-TWO.
MOVE SPACES TO THEDATE.
MOVE 0 TO FIELD-COUNT.
UNSTRING INMESSAGE
DELIMITED BY "-" OR "/" OR ALL " "
INTO THEMONTH DELIMITER IN HOLD-DELIM
THEDAY DELIMITER IN HOLD-DELIM
THEYEAR DELIMITER IN HOLD-DELIM
WITH POINTER PTR
TALLYING IN FIELD-COUNT.
INSPECT THEDATE REPLACING ALL " " BY "0".
DISPLAY THEDATE " " PTR " " FIELD-COUNT.
DISPLAYED-TWO.
EXIT.
|
Enter two dates in a row: 6/13/87 8/15/87 870613 09 03 870815 21 03 Enter two dates in a row: 10 15 87-1 1 88 871015 10 03 880101 21 03 Enter two dates in a row: 6/13/87-12/31/87 870613 09 03 871231 21 03 Enter two dates in a row: 6/13/87-12/31 870613 09 03 001231 21 02 Enter two dates in a row: 6/13/87/12/31/87 870613 09 03 871231 21 03 |
| Previous | Next | Contents | Index |