Demonstration

Additional CA IDMS/DB Facilities › Retrieving All Record Occurrences › Demonstration

Demonstration

Objective

This example uses the DB-EXIT facility to retrieve all employees working in each office.

Procedure

The DB-EXIT facility is used to walk the OFFICE-EMPLOYEE set until the end of the set is reached:

CALL DB-EXIT ('FIRST-AREA' 'OFFICE ' 'ORG-DEMO-REGION ') retrieves the first OFFICE record in the ORG-DEMO-REGION area.
CALL DB-EXIT ('FIRST' 'EMPLOYEE ' 'OFFICE-EMPLOYEE ') retrieves the first EMPLOYEE record in the OFFICE-EMPLOYEE set if the first office retrieval was successful.
CALL DB-EXIT ('NEXT' 'EMPLOYEE ' 'OFFICE-EMPLOYEE ') retrieves the next EMPLOYEE record until the end of the set is reached.
CALL DB-EXIT ('NEXT-AREA' 'OFFICE ' 'ORG-DEMO-REGION ') retrieves the next OFFICE record and, if successful, returns to retrieve the first EMPLOYEE record for that office.

Complete Code

col. 2
▼
DATABASE DICTNAME=DOCUDICT
IN DB SS=EMPSS01
PATH-- OFFICE EMPLOYEE
010 MSG  'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQ'
010 JUNK
0151*005 IDMS-STATUS             HH 'IDMS-STATUS' 'FIELD'
0151*010 OFFICE-CODE-0450        HH 'OFFICE CODE'
0151*020 EMP-NAME-0415           HH 'EMPLOYEE' 'NAME'
0152*005 IDMS-STATUS
0152*010 MSG
01OUT D
01SORT OFFICE-CODE-0450 0 EMP-NAME-0415
017      CALL DB-EXIT ('FIRST-AREA' 'OFFICE ' 'ORG-DEMO-REGION ')
017      IF IDMS-STATUS EQ '0000' 050
017      MOVE 'ERROR IN RETRIEVAL OF FIRST OFFICE' MSG
017      RELS 2
017      PERFORM 800
017050   CALL DB-EXIT ('FIRST' 'EMPLOYEE ' 'OFFICE-EMPLOYEE ')
017      B 150
017100   CALL DB-EXIT ('NEXT' 'EMPLOYEE ' 'OFFICE-EMPLOYEE ')
017150   IF IDMS-STATUS EQ '0000' 200                   $Test for record found
017      IF IDMS-STATUS EQ '0307' 300                   $Test for end of set
017      MOVE 'ERROR IN RETRIEVAL OF EMPLOYEE' MSG
017      RELS 2
017      PERFORM 800
017200   RELS 1
017      B 100
017300   CALL DB-EXIT ('NEXT-AREA' 'OFFICE ' 'ORG-DEMO-REGION ')
017      IF IDMS-STATUS EQ '0000' 050
017      IF IDMS-STATUS EQ '0307' STOP
017      MOVE 'ERROR IN RETRIEVAL OF NEXT OFFICE' MSG
017      RELS 2
017      PERFORM 800
017800   JUNK / 0  JUNK                              $Forces a buffer dump
017      STOP

Result

IDMS-STATUS EMPLOYEE FIELD OFFICE CODE NAME 0000 001 BETSY ZEDI 0000 001 HERBERT CRANE 0000 001 HERBERT LIPSICH 0000 001 JAMES GALLWAY 0000 001 JAMES JACOBI 0000 002 DOUGLAS KAHALLY 0000 002 SANDY KRAAMER 0000 002 TOM FITZHUGH 0000 005 ALAN DONOVAN 0000 005 BETH CLOUD 0000 005 BURT LANCHESTER 0000 005 CAROLYN CROW 0000 005 DANIEL MOON 0000 005 RENE MAKER 0000 005 TERRY CLOTH 0000 008 C. BREEZE 0000 008 HARRY ARM 0000 008 JOE KASPAR 0000 008 MARK TIME 0000 008 RICHARD MUNYON 0000 008 RICHARD WAGNER 0000 008 ROGER WILCO 0000 008 ROY ANDALE 0000 008 THEMIS PAPAZEUS