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