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