IMS DB
IM-CHKP pcbname checkpointID ... [length1 dataarea1 [... length7 dataarea7 IM-XRST pcbname ... [length1 area1 [... length7 area7]] ... [checkpointID maxiolength] IM-CHKP-OSVS pcbname checkpointID IM-DEQ pcbname deqcharacter IM-GSCD pcbname IM-LOG pcbname logcode loglength message IM-ROLB pcbname [msgarea] IM-ROLL IM-STAT-DBAS-FULL pcbname IM-STAT-DBAS-UNFORMATED pcbname IM-STAT-DBAS-SUMMARY pcbname IM-STAT-VBAS-FULL pcbname IM-STAT-VBAS-UNFORMATED pcbname IM-STAT-VBAS-SUMMARY pcbname
| checkpoint | An 8-character COBOL data name or a literal that specifies the ID for this checkpoint | 
| dataarea | Name of the data area designated in Working-Storage | 
| deqchara | A COBOL data name or single character literal string | 
| length | Length of data area as defined in Working-Storage | 
| logcode | A COBOL data name or literal character string containing a code that must be greater than or equal to X'A0' and less than or equal to X'E0' | 
| loglength | Length of record, excluding the 5-byte header | 
| maxiolength | Length of the largest program I/O area; can be variable or literal; default is the longest path call I/O area, or 0 if no path call exists | 
| message | A COBOL data name or literal string | 
| msgarea | Name of area in program where IMS returns the message segment being processed | 
| pcbname | Data view; can be up to 20 characters; default is IO-PCB | 
WS     CHKPT-WORKAREAS
            CHKPT-ID
                FILLERX4 V'CID1'
                CHKPT-ID-CTR    9(4) V 0
            CHKPT-LIMIT  S9(5) V 0 COMP-3
                88 CHKPT-LIMIT-REACHED    V+50
 WS     CHECKPOINT-AREA-1
            PREV-PART-NO X8  V LOW-VALUES
 NTRY
        IM-XRST IO 8 CHECKPOINT-AREA-1
        IF NOT IM-OK
            PERFORM ERROR-PARA
 /*     IF IM-XRST-AREA IS NOT BLANK,
 /*         PROGRAM IS BEING RESTARTED
        IF IM-XRST-AREA NOT = SPACES
            MOVE IM-XRST-CHECKPOINT TO CHKPT-ID
            TRUE RESTART
        ELSE
 /*         PERFORM FIRST CHECK POINT
            PERFORM SYMB-CHKPT-RTN
        REPEAT
            PERFORM READ-DB
        UNTIL END-ON-REC
            PERFORM PROCESS-DB-REC
 /*         INCREMENT COUNTER FOR EACH RECORD READ
            CHKPT-LIMIT = CHKPT-LIMIT + 1
            IF CHKPT-LIMIT-REACHED
                PERFORM SYMB-CHKPT-RTN
 PARA   SYMB-CHKPT-RTN
 /*     INCREMENT CHKPT-ID CNTR
        CHKPT-ID-CTR = CHKPT-ID-CTR + 1
        IM-CHKP IO CHKPT-ID
        ... 8 CHECKPOINT-AREA-1
        IF NOT IM-OK
            PERFORM ERROR-PARA
        CHKPT-LIMIT = 0 
                  		$IM-CHKP ("IO", "'MYCHKP'", 25, "AREA-1",
% ... 37, "AREA-2")
$IM-CHKP ("IO", "MY-BASIC-CHKP-NAME")
$IM-XRST ("IO", 25, "AREA-1")
 
                  		01  IM-CBLTDLI-ARGUMENTS.
    05  IM-CHKP             PIC X(4) VALUE 'CHKP'.
    05  IM-DEQ              PIC X(4) VALUE 'DEQ '.
    05  IM-LOG              PIC X(4) VALUE 'LOG '.
    05  IM-STAT             PIC X(4) VALUE 'STAT'.
    05  IM-XRST             PIC X(4) VALUE 'XRST'.
    05  OSVSCHKP            PIC X(8) VALUE'OSVSCHKP'.
    05  IM-CALL-FUNCTION    PIC X(4).
    05  IM-IO-AREA-LEN      PIC S9(9) COMP VALUE +0.
    05  IM-IO-MAXAREA-LEN   PIC S9(9) COMP VALUE +0.
    05  IM-LEN-25           PIC S9(9) COMP VALUE +25.
    05  IM-LEN-37           PIC S9(9) COMP VALUE +37.
01  IM-LOG-AREA.
    05  IM-LOG-LEN          PIC S9(4) COMP.
    05  FILLER              PIC S9(4) COMP VALUE +0.
    05  IM-LOG-CODE         PIC X.
    05  IM-LOG-RECORD       PIC X(55).
01  IM-DEQ-CHR   PIC X.
01  IM-XRST-AREA.
    05  IM-XRST-CHECKPOINT  PIC X(8).
    05  FILLER              PIC X(4) VALUE SPACES.
01  IM-CHECKPOINT-ID        PIC X(8).
01  IM-STAT-FUNCTION.
    05  FILLER              PIC X(4).
    05  IM-STAT-FORMAT      PIC X.
    05  FILLER              PIC X(4).
01  IM-STATISTICS  PIC X(120). 
                  		MOVE 'MYCHKP' TO IM-CHECKPOINT-ID
IF IM-IO-MAXAREA-LEN < IM-IO-AREA-LEN
    MOVE IM-IO-AREA-LEN
... TO IM-IO-MAXAREA-LEN
CALL 'CBLTDLI' USING
... IM-CHKP IO-PCB
... IM-IO-MAXAREA-LEN
... IM-CHECKPOINT-ID
... IM-LEN-25 AREA-1
... IM-LEN-37 AREA-2
MOVE IO-PCB-STATUS
... TO IM-STATUS
...    TP-STATUS
MOVE MY-BASIC-CHKP-NAME
... TO IM-CHECKPOINT-ID
CALL 'CBLTDLI' USING
... IM-CHKP IO-PCB
... IM-CHECKPOINT-ID
MOVE IO-PCB-STATUS
... TO IM-STATUS
...    TP-STATUS
MOVE 'MYOSVSCP'
... TO IM-CHECKPOINT-ID
CALL 'CBLTDLI' USING
... IM-CHKP IO-PCB
... IM-CHECKPOINT-ID
... IM-OSVSCHKP
MOVE IO-PCB-STATUS
... TO IM-STATUS
...    TP-STATUS
MOVE 'A' TO IM-DEQ-CHR
CALL 'CBLTDLI' USING
... IM-DEQ IO-PCB
...IM-DEQ-CHR
MOVE IO-PCB-STATUS
... TO IM-STATUS
...    TP-STATUS
COMPUTE IM-LOG-LEN = 38 + 5
MOVE LOG-CODE-1 TO IM-LOG-CODE
MOVE LOG-MESSAGE-1
... TO IM-LOG-RECORD
CALL 'CBLTDLI' USING
... IM-LOG IO-PCB
... IO-LOG-AREA
MOVE IO-PCB-STATUS
... TO IM-STATUS
...    TP-STATUS
COMPUTE IM-LOG-LEN = 55 + 5
MOVE LOG-CODE-2 TO IM-LOG-CODE
MOVE LOG-MESSAGE-2
... TO IM-LOG-RECORD
CALL 'CBLTDLI' USING
... IM-LOG IO-PCB
... IO-LOG-AREA
MOVE IO-PCB-STATUS
... TO IM-STATUS
...    TP-STATUS
MOVE 'VBAS'
... TO IM-STAT-FUNCTION /* CLR TAIL
MOVE 'S' TO IM-STAT-FORMAT
CALL 'CBLTDLI' USING
... IM-STAT BE1PARTS-PCB
... IM-STATISTICS
... IM-STAT-FUNCTION
MOVE BE1PARTS-PCB-STATUS
... TO IM-STATUS
MOVE BE1PARTS-PCB
... TO IM-DB-PCB
MOVE SPACES
... TO IM-XRST-AREA
IF IM-IO-AREA-LEN > IM-IO-MAXAREA-LEN
    MOVE IM-IO-AREA-LEN
... TO IM-IO-MAXAREA-LEN
CALL 'CBLTDLI' USING
... IM-XRST IO-PCB
... IM-IO-AREA-LEN
... IM-XRST-AREA
... IM-LEN-25 AREA-1
MOVE IO-PCB-STATUS
... TO IM-STATUS
...    TP-STATUS