[USflag] The American Programmer [USflag]


Home
Books on Mainframe Programming
Mainframe Manuals and Tutorials
System Abend codes, Sqlcodes, VSAM/QSAM codes
Everything about the IBM AS/400 Midrange Computer - iSeries
Everything about CICS
Everything about COBOL
Everything about DB2 and SQL
Everything about IMS
  Books on IMS
  Manuals on IMS - Hierarchical Database Management System
  IMS/DLI and other type Abend Codes
  IMS/DLI skeleton COBOL Example program
  IMS/DLI DBD PSB Example
  IMS/DLI COBOL Example program to delete segments
  IMS/DLI COBOL program delete all root segments
  IMS/DLI COBOL Example program to insert segments
  IMS/DLI COBOL Example program to update segments
Everything about Java and JavaScript
Everything about JCL and JES
Everything about REXX
Everything about zOS, VSAM, Tivoli, Assembler
Everything about TSO, ISPF, Spufi
Site Map and Site Search

           Home   > IMS   > Program to Replace Segments in IMS Database

COBOL/IMS/DLI Program. Uses REPL to change segments on a database

Updating an IMS database with COBOL/DLI.
Do GHU first, then the REPL.
A portion of a program that will do file maintenance in an IMS database.
...
000100* EXAMPLE OF REPLACE. Program segment.
008500* 
008600 01  W200-FUNCTION.
008700     03  GN-FUNC          PIC X(4) VALUE 'GN'.
008800     03  GU-FUNC          PIC X(4) VALUE 'GU'.
008810     03  GHU-FUNC         PIC X(4) VALUE 'GHU'.
008900     03  GNP-FUNC         PIC X(4) VALUE 'GNP'.
008910     03  DLET-FUNC        PIC X(4) VALUE 'DLET'.
008920     03  ROLB-FUNC        PIC X(4) VALUE 'ROLB'.
008930     03  REPL-FUNC        PIC X(4) VALUE 'REPL'.
010100
010110 01  SSA-ROOT-QUAL.
010120     05  FILLER PIC X(8) VALUE 'TSROOT'.
010130     05  FILLER PIC X    VALUE '('.
010140     05  FILLER PIC X(8) VALUE 'TSRSTAFF'.
010141     05  FILLER PIC X(2) VALUE '= '.
010150     05  SSA-ROOT-VALUE  PIC X(4) VALUE '0000'.
010160     05  FILLER PIC X    VALUE ')'.
012510
012520*    GET THE SEGMENT YOU WANT TO CHANGE
012530*    WITH A HOLD
012561     MOVE  '9678' TO SSA-ROOT-VALUE
012570
012600     CALL 'CBLTDLI' USING
012700           GHU-FUNC
012800           DB-PCBMASK
012900           TSROOT
012910           SSA-ROOT-QUAL
012911
012912     PERFORM  CHECK-STATUS-CODE.
012913
012990     IF DB-STATUS-CODE = '  '
012991     THEN PERFORM CHANGE-IT
012992     ELSE DISPLAY 'CAN NOT CHANGE'
012993     END-IF
012994
013000     GOBACK.
013100
013110 CHANGE-IT.
013213*    CHANGE THE DATA IN THE IO AREA
013214     MOVE 'MICKEY MOUSE ' TO TSRSNAME
013217
013218*    DO THE CHANGE WITH
013219*       REPL   FUNCTION
013220*       DATABASE PCB
013221*       IO AREA FOR THE SEGMENT YOU ARE DELETING
013222*       (NO SSA'S)
013223
013230     CALL 'CBLTDLI' USING
013300           REPL-FUNC
013400           DB-PCBMASK
013500           TSROOT
013600
013700     PERFORM  CHECK-STATUS-CODE.
...
Learn how to use all the features of IMS: IMS/DLI Programming Books

[Books Computer]

Home Books for Computer Professionals Privacy Terms |
Site Map and Site Search Programming Manuals and Tutorials The REXX Files Top of Page |