Sample area sweep cobol program using AUTOSTATUS and IF SET MEMBER
Article ID: 57057
Updated On:
Products
IDMS
IDMS - Database
IDMS - ADS
Issue/Introduction
Here is the source of a sample CA-IDMS batch cobol program.
The key features are:-
* it uses AUTOSTATUS
* it performs an area sweep
* and it also exhibits usage of an IF SET MEMBER test.
See comments in the source listing for further information.
Environment
IDMS - All Supported Releases
Resolution
*DMLIST
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMPLE01.
*****************************************************************
*
* SAMPLE IDMS BATCH PROGRAM SHOWING USAGE OF ...
* - AUTOSTATUS
* - AREA SWEEP
* - IF SET MEMBER TEST
*
* THE PROGRAM READS ALL OF THE EMPLOYEE RECORDS, DISPLAYING
* THEIR IDS AND DBKEYS, AND THOSE OF THE OWNING DEPARTMENT
* RECORD IF THERE IS ONE.
*
*****************************************************************
ENVIRONMENT DIVISION.
IDMS-CONTROL SECTION.
PROTOCOL. MODE IS BATCH-AUTOSTATUS DEBUG.
IDMS-RECORDS WITHIN WORKING-STORAGE SECTION.
DATA DIVISION.
SCHEMA SECTION.
DB EMPSS01 WITHIN EMPSCHM VERSION 100.
WORKING-STORAGE SECTION.
01 WS.
05 WS-PROGRAM-NAME PIC X(8) VALUE 'SAMPLE01'.
05 WS-OWNER-ID PIC X(4).
05 WS-OWNER-DBKEY PIC X(12).
05 WS-MEMBER-DBKEY PIC X(12).
05 WS-DBKEY-GRP.
10 WS-DBKEY PIC S9(8) USAGE COMP.
10 WS-RADIX-FACTOR PIC S9(8) USAGE COMP VALUE 256.
10 WS-DBKEY-DISPLAY-GRP.
15 WS-PAGE-NUMBER PIC 9(8).
15 WS-SEPARATOR PIC X(1) VALUE '-'.
15 WS-LINE-INDEX PIC 9(3).
*
PROCEDURE DIVISION.
MAIN-LINE.
DISPLAY 'SAMPLE01> STARTING.'.
PERFORM BIND-AND-READY.
DISPLAY 'SAMPLE01> DATABASE PREPARED.'.
*
* USE "ON DB-END-OF-SET CONTINUE" TO ALLOW THAT CONDITION
* THROUGH. AUTOSTATUS WILL CATCH AND ABORT ON ANY OTHER
* NON-ZERO ERROR-STATUS.
*
OBTAIN FIRST EMPLOYEE WITHIN EMP-DEMO-REGION
ON DB-END-OF-SET CONTINUE.
PERFORM PROCESS-ONE-MEMBER UNTIL DB-END-OF-SET.
FINISH.
DISPLAY 'SAMPLE01> FINISHED.'.
GOBACK.
*
* THE PROCESS-ONE-MEMBER ROUTINE IS CALLED ONCE FOR EACH
* EMPLOYEE RECORD IN THE DATABASE.
*
PROCESS-ONE-MEMBER.
ACCEPT WS-DBKEY FROM EMPLOYEE CURRENCY.
PERFORM FORMAT-DBKEY.
MOVE WS-DBKEY-DISPLAY-GRP TO WS-MEMBER-DBKEY.
*
* WHEN TESTING FOR SET MEMBERSHIP, IT IS BEST TO TEST FOR
* "IF NOT SET-NAME MEMBER", BECAUSE IT COMPILES AS
* "IF ERROR-STATUS = '1601'", AND THIS ALLOWS THE
* PERFORM IDMS-STATUS AS THE FIRST STATEMENT IN THE ELSE
* CLAUSE TO TRAP ANY OTHER NON-ZERO ERROR-STATUS.
*
IF NOT DEPT-EMPLOYEE MEMBER
MOVE 'NONE' TO WS-OWNER-ID
MOVE '************' TO WS-OWNER-DBKEY
ELSE
PERFORM IDMS-STATUS
OBTAIN OWNER WITHIN DEPT-EMPLOYEE
MOVE DEPT-ID-0410 TO WS-OWNER-ID
ACCEPT WS-DBKEY FROM DEPARTMENT CURRENCY
PERFORM FORMAT-DBKEY
MOVE WS-DBKEY-DISPLAY-GRP TO WS-OWNER-DBKEY
END-IF.
DISPLAY 'SAMPLE01> EMP: ' EMP-ID-0415 ', '
'DBKEY: ' WS-MEMBER-DBKEY '; '
'DEPT: ' WS-OWNER-ID ', '
'DBKEY: ' WS-OWNER-DBKEY '.'.
*
* IN AN AREA SWEEP, BEFORE ISSUING THE OBTAIN NEXT, YOU
* MUST ALWAYS RE-ESTABLISH CURRENCY ON THE CURRENT RECORD
* IN CASE THE AREA CURRENCY HAS BEEN ALTERED BY ANY DML
* IN THE PROCESSING LOOP.
*
FIND CURRENT EMPLOYEE.
*
* SEE COMMENTS FOR THE OBTAIN FIRST - THE SAME LOGIC
* APPLIES HERE FOR THE OBTAIN NEXT.
*
OBTAIN NEXT EMPLOYEE WITHIN EMP-DEMO-REGION
ON DB-END-OF-SET CONTINUE.
*
FORMAT-DBKEY.
DIVIDE WS-DBKEY BY WS-RADIX-FACTOR
GIVING WS-PAGE-NUMBER
REMAINDER WS-LINE-INDEX.
*
BIND-AND-READY.
MOVE WS-PROGRAM-NAME TO PROGRAM-NAME.
COPY IDMS SUBSCHEMA-BINDS.
READY USAGE-MODE IS RETRIEVAL.
*
COPY IDMS IDMS-STATUS.
*IDMS-ABORT SECTION.
IDMS-ABORT.
EXIT.
Feedback
Yes
No
Powered by
