This document describes examples of direct calls using the ACB interface.
The following file definitions are used in the examples that follow in this documentation. Two file structures (files 1 and 2) are used.
The following tables show the structures of files 1 and 2 where
SF | is standard format |
SL | is standard length |
File 1 is neither security-protected nor ciphered. Certain examples in the documentation assume that file 1 has been coupled to file 2 using the descriptor AA as the basis for coupling.
Adabas Definition | Explanation |
---|---|
01,GA | Group GA, consisting of fields AA and AB. |
02,AA,8,A,DE,NU | Elementary field AA; SL is 8 bytes, SF is alphanumeric, descriptor, null value suppression. |
02,AB,2,P,DE,NU | Elementary field AB; SL is 2, SF is packed, descriptor, null value suppression. |
01,AC,20,A,NU | Elementary field AC; SL is 20, SF is alphanumeric, null value suppression. |
01,MF,3,A,MU,DE,NU | Multiple value field MF; SL is 3, SF is alphanumeric, descriptor, null value suppression. |
01,GB,PE | Periodic group GB. |
02,BA,1,B,DE,NU | Elementary field BA (within periodic group GB); SL is 1, SF is binary, descriptor, null value suppression. |
02,BB,5,P,NU | Elementary field BB (within periodic group GB); SL is 5, SF is packed, null value suppression. |
02,BC,10,A,NU | Elementary field BC (within periodic group GB); SL is 10, SF is alphanumeric, null value suppression. |
01,GC,PE | Periodic group GC. |
02,CA,7,A,DE,NU | Elementary field CA (within periodic group GC); SL is 7, SF is alphanumeric, descriptor, null value suppression. |
02,CB,10,A,MU,NU SF | Multiple value field CB (within periodic group GC); SL is 10, is alphanumeric, null value suppression. |
File 2 is security-protected. It is not ciphered. Certain examples in this documentation assume that file 2 is coupled to file 1 using field RA as the basis for coupling.
Adabas Definition | Explanation |
---|---|
01,RG | Group RG, consisting of all the fields in the record. |
02,RA,8,A,DE,NU | Elementary field RA; SL is 8, SF is alphanumeric, descriptor, null value suppression. |
02,RB,10,A,DE | Elementary field RB; SL is 10, SF is alphanumeric, descriptor. |
02,GX | Group GX, consisting of the fields XA, XB, XC, XD, and XE. |
03,XA,10,A | Elementary field XA; SL is 10, SF is alphanumeric. |
03,XB,2,P,DE | Elementary field XB; SL is 2, SF is packed, descriptor. |
03,XC,6,U | Elementary field XC; SL is 6, SF is unpacked. |
03,XD,8,A,DE,NU | Elementary field XD; SL is 8, SF is alphanumeric, descriptor, null value suppression. |
03,XE,5,A,DE,NU | Elementary field XE; SL is 5, SF is alphanumeric, descriptor, null value suppression. |
SA=RA(1,4) | Subdescriptor SA; derived from bytes 1 through 4 of field RA, format is alphanumeric. |
SB=RA(1,8),RB(1,4) | Superdescriptor SB; derived from bytes 1 through 8 of field RA and bytes 1 through 4 of field RB, format is alphanumeric. |
SC=XB(1,2),XC(1,6) | Superdescriptor SC; derived from bytes 1 through 2 of field XB and bytes 1 through 6 of field XC, format is binary. |
This section contains examples of using direct Adabas calls in Assembler. The previously defined Adabas files defined are used in each example.
*** CONTROL BLOCK DS 0F CB DS 0CL80 USER CONTROL BLOCK DC CL2' ' RESERVED FOR ADABAS USE CCODE DC CL2' ' COMMAND CODE CID DC CL4' ' COMMAND ID FNR DC H'0' FILE NUMBER RC DC H'0' RESPONSE CODE ISN DC F'0' ISN ISNLL DC F'0' ISN LOWER LIMIT ISNQ DC F'0' ISN QUANTITY FBL DC H'100' FORMAT BUFFER LENGTH RBL DC H'250' RECORD BUFFER LENGTH SBL DC H'50' SEARCH BUFFER LENGTH VBL DC H'100' VALUE BUFFER LENGTH IBL DC H'20' ISN BUFFER LENGTH COPT1 DC CL1' ' COMMAND OPTION 1 COPT2 DC CL1' ' COMMAND OPTION 2 ADD1 DC CL8' ' ADDITIONS 1 ADD2 DC CL4' ' ADDITIONS 2 ADD3 DC CL8' ' ADDITIONS 3 ADD4 DC CL8' ' ADDITIONS 4 ADD5 DC CL8' ' ADDITIONS 5 CTIME DC F'0' COMMAND TIME UAREA DC CL4' ' USER AREA * * *** USER BUFFER AREAS FB DC CL100' ' FORMAT BUFFER RB DC CL250' ' RECORD BUFFER SB DC CL50' ' SEARCH BUFFER VB DC CL100' ' VALUE BUFFER IB DC CL20' ' ISN BUFFER * * *
This section provides the following examples:
Find the set of records in file 2 with XB = 99.
Read each record selected using the GET NEXT option.
EXMP1 MVC CCODE,=C'OP' OP COMMAND MVC RB(4),=C'ACC.' ACCESS ONLY REQUESTED CALL ADABAS,(CB,FB,RB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BNE EX1ERR BRANCH IF NOT 0
MVC CCODE,=C'S1' FIND COMMAND MVC CID,=C'S101' NONBLANK CID REQUIRED FOR * IDENTIFICATION OF THE LIST MVC FNR,=H'2' FILE 2 MVC ISNLL,=F'0' ALL QUALIFYING ISNS DESIRED MVC IBL,=H'0' ISN BUFFER NOT REQUIRED MVI FB,C'.' NO READ OF DATA STORAGE MVC SB(7),=C'XB,3,U.' SEARCH CRITERION MVC VB(3),=C'099' SEARCH VALUE CALL ADABAS,(CB,FB,RB,SB,VB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BNE EX1ERR BRANCH IF NOT 0 CLC ISNQ,=F'0' CHECK NUMBER OF ISNS FOUND BE EX1EXIT BRANCH TO EXIT IF NO ISNS FOUND
EX1B MVC CCODE,=C'L1' READ COMMAND MVC ISN,=F'0' BEGIN WITH 1ST ISN IN LIST MVI COPT2,C'N' GET NEXT OPTION TO BE USED MVC FB(3),=C'RG.' ALL FIELDS TO BE RETURNED EX1C CALL ADABAS,(CB,FB,RB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BE EX1D BRANCH IF RESPONSE CODE 0 CLC RC,=H'3' CHECK IF ALL RECORDS READ BE EX1EXIT BRANCH IF YES B EX1ERR BRANCH TO ERROR ROUTINE EX1D . . . PROCESS RECORD . . . B EX1C BRANCH TO READ NEXT RECORD
EX1ERR EQU * * DISPLAY ERROR MESSAGE * . TERMINATE USER PROGRAM
EX1EXIT MVC CCODE,=C'CL' CLOSE COMMAND CALL ADABAS,(CB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BNE EX1ERR BRANCH IF NOT 0
All records in file 1 are to be read in physical sequential order.
Each record read is to be updated with the following values:
Field AA = ABCDEFGH
Field AB = 500
User is to have exclusive control of file 1.
EXMP2 MVC CCODE,=C'OP' OPEN COMMAND MVC RB(6),=C'EXU=1.' EXCLUSIVE CONTROL REQUESTED CALL ADABAS,(CB,FB,RB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BE EX2A BRANCH IF RESPONSE CODE 0 B EX2ERR BRANCH IF NOT 0
EX2A MVC CID,=C'L201' NONBLANK CID REQUIRED MVC FNR,=H'1' FILE 1 TO BE READ MVC ISN,=F'0' ALL RECORDS TO BE READ MVC FB(3),=C'GA.' VALUES FOR FIELDS AA AND AB * (GROUP GA) TO BE RETURNED EX2B MVC CCODE,=C'L2' READ PHYS. SEQ. CALL ADABAS,(CB,FB,RB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BE EX2C BRANCH IF RESPONSE CODE 0 CLC RC,=H'3' CHECK FOR END-OF-FILE BE EX2EXIT BRANCH TO EXIT IF END-OF-FILE B EX2ERR BRANCH TO ERROR ROUTINE
The same fields are to be updated as were read.
The same CID and format buffer can be used for the update command.
The ISN of the record to be updated is already in the ISN field as a result of the L2 command.
EX2C MVC CCODE,=C'A1' UPDATE COMMAND MVC RB(8),=C'ABCDEFGH' VALUE FOR FIELD AA MVC RB+8(2),=PL2'500' VALUE FOR FIELD AB CALL ADABAS,(CB,FB,RB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BE EX2B BRANCH TO READ NEXT RECORD
EX2ERR EQU * * . DISPLAY ERROR MESSAGE * . TERMINATE USER PROGRAM
EX2EXIT MVC CCODE,=C'CL' CLOSE COMMAND CALL ADABAS,(CB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BNE EX2ERR BRANCH IF NOT 0 . . .
During user session initialization, the user program is to display information indicating the last successfully processed transaction of the previous user session.
For each user transaction, the user program is to
accept from a terminal 8 characters of input to be used as the key for updating files 1 and 2; and
issue the Find command for file 1 to determine if a record exists with field AA = input key.
If no record is found, the user program is to issue a message. If a record is found, the user program is to
delete the record from file 1; and
add a new record to file 2: Field RA = input key entered.
Other fields are to contain a null value.
If the record cannot be successfully added, the user program is to issue a BT command and display an error message.
If both updates are successful, the user program is to issue an ET command.
The section of the program illustrated is only executed during user session initialization:
The OP command is issued with ET data of the previous session being read:
EXMP3 EQU * MVC CCODE,=C'OP' OPEN COMMAND MVI COPT2,C'E' ET DATA TO BE READ MVC ADD1,=C'USER0001' USER IDENTIFICATION MVC ADD3,=C'PASSWORD' USER PASSWORD MVC RB(8),=C'UPD=1,2.' FILES 1 AND 2 TO BE UPDATED CALL ADABAS,(CB,FB,RB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BE EX3A BRANCH IF RESPONSE CODE 0 CLC RC,=H'9' CHECK FOR RESPONSE CODE 9 BE EXMP3 BRANCH TO REPEAT OPEN B EX3ERR BRANCH IF NOT 0 OR 9 EX3A EQU * CLC CID,=F'0' CHECK IF ET DATA FROM * PREVIOUS SESSION EXISTS BE EX3B BRANCH IF NO ET DATA * . . .
Display the ET data contained in the record buffer on the terminal screen to inform the user of the last successfully processed transaction of the previous user session:
B EX3C BRANCH TO BEGIN TRANS. PROCESS. EX3B EQU *
If no ET data was received, a message is displayed indicating that no transactions were successfully processed during the previous user session.
This section is executed for each user transaction:
EX3C EQU * * . . . ACCEPT INPUT FROM TERMINAL . . .
Issue the Find command for file 1 to determine if a record exists with the field AA equal to the input key entered:
EX3D EQU * MVC CCODE,=C'S4' FIND WITH HOLD COMMAND MVC CID,=C' ' ISN LIST NOT TO BE SAVED MVC FNR,=H'1' FILE 1 MVC ISNLL,=F'0' ALL QUALIFY. ISNS TO BE RETURNED MVI FB,C'.' NO READ OF DATA STORAGE MVC SB(3),=C'AA.' SEARCH CRITERION MVC VB(8),INPUT SEARCH VALUE CALL ADABAS,(CB,FB,RB,SB,VB,IB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BE EX3E BRANCH IF RESPONSE CODE 0 B EX3ERR BRANCH TO ERROR ROUTINE EX3E EQU * CLC ISNQ,=F'0' CHECK NUMBER OF RECORDS FOUND BNE EX3F BRANCH IF RECORD FOUND
If no record is found, the user program issues a message requesting a correction:
B EX3C RETURN TO ACCEPT USER INPUT
The ISN of the record to be deleted is already in the ISN field and in hold status as a result of the S4 command.
EX3F EQU * MVC CCODE,=C'E4' DELETE COMMAND CALL ADABAS,(CB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BE EX3G BRANCH IF RESPONSE CODE 0 CLC RC,=H'9' CHECK IF CURRENT TRANS. HAS BEEN * BACKED OUT BY ADABAS BE EX3D IF YES, BRANCH TO REPEAT S4 B EX3ERR BRANCH TO ERROR ROUTINE
EX3G EQU * MVC CCODE,=C'N1' ADD NEW RECORD MVC FNR,=H'2' FILE 2 MVC FB(6),=C'RA.' VALUE BEING PROVIDED FOR RA MVC RB(8),INPUT VALUE FOR FIELD RA CALL ADABAS,(CB,FB,RB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BE EX3I BRANCH IF RESPONSE CODE 0 CLC RC,=H'9' WAS TRANSACTION BACKED OUT? BE EX3D IF YES, RETURN TO REISSUE TRANS.
If the attempt to add a new record is not successful, the transaction is backed out and the user is notified that an error condition exists.
MVC CCODE,=C'BT' BACKOUT TRANSACTION CALL ADABAS,(CB) CALL ADABAS CLC RC,=H'0' CHECK IF RESPONSE CODE 0 BE EX3H BRANCH IF 0
When the backout is not successful, a message is issued indicating that result.
B EX3ERR BRANCH TO ERROR ROUTINE EX3H EQU *
When the backout is successful, a message is issued indicating that after an error was detected, the transaction was backed out.
B EX3ERR BRANCH TO ERROR ROUTINE
When the updates have been successfully executed, an ET command with ET data is issued.
EX3I EQU * MVC CCODE,=C'ET' END OF TRANSACTION COMMAND MVI COPT2,C'E' ET DATA TO BE WRITTEN MVC RB(8),INPUT ET DATA CONSISTS OF INPUT KEY OF THIS TRANSACTION CALL ADABAS,(CB,FB,RB) CALL ADABAS CLC RC,=H'0' CHECK RESPONSE CODE BE EX3C IF RESPONSE CODE 0, RETURN TO RECEIVE INPUT FOR * THE NEXT TRANSACTION CLC RC,=H'9' CHECK IF CURRENT TRANSACTION HAS BEEN BACKED OUT * BY ADABAS BE EX3D IF CURRENT TRANSACTION HAS BEEN BACKED OUT, * RETURN TO REISSUE TRANSACTION
EX3ERR EQU * * . NONZERO RESPONSE CODE RECEIVED * . DISPLAY ERROR MESSAGE * . TERMINATE USER PROGRAM . . . INPUT DS CL8 KEY ENTERED FROM TERMINAL
This section contains examples of using direct Adabas calls in COBOL. The previously defined Adabas files are used in each example.
* *** CONTROL BLOCK 01 CONTROL-BLOCK. 02 FILLER PIC X(2) VALUE SPACES. 02 COMMAND-CODE PIC X(2) VALUE SPACES. 02 COMMAND-ID PIC X(4) VALUE SPACES. 02 FILE-NUMBER PIC S9(4) COMP VALUE +0. 02 RESPONSE-CODE PIC S9(4) COMP VALUE +0. 02 ISN PIC S9(8) COMP VALUE +0. 02 ISN-LOWER-LIMIT PIC S9(8) COMP VALUE +0. 02 ISN-QUANTITY PIC S9(8) COMP VALUE +0. 02 FORMAT-BUFFER-LENGTH PIC S9(4) COMP VALUE +100. 02 RECORD-BUFFER-LENGTH PIC S9(4) COMP VALUE +250. 02 SEARCH-BUFFER-LENGTH PIC S9(4) COMP VALUE +50. 02 VALUE-BUFFER-LENGTH PIC S9(4) COMP VALUE +100. 02 ISN-BUFFER-LENGTH PIC S9(4) COMP VALUE +20. 02 COMMAND-OPTION-1 PIC X VALUE SPACE. 02 COMMAND-OPTION-2 PIC X VALUE SPACE. 02 ADDITIONS-1 PIC X(8) VALUE SPACES. 02 ADDITIONS-2 PIC X(4) VALUE SPACES. 02 ADDITIONS-3 PIC X(8) VALUE SPACES. 02 ADDITIONS-4 PIC X(8) VALUE SPACES. 02 ADDITIONS-5 PIC X(8) VALUE SPACES. 02 COMMAND-TIME PIC S9(8) COMP VALUE +0. 02 USER-AREA PIC X(4) VALUE SPACES. * *** USER BUFFER AREAS 01 FORMAT-BUFFER PIC X(100) VALUE SPACES. 01 RECORD-BUFFER PIC X(250) VALUE SPACES. 01 SEARCH-BUFFER PIC X(50) VALUE SPACES. 01 VALUE-BUFFER PIC X(100) VALUE SPACES. 01 ISN-BUFFER PIC X(20) VALUE SPACES. *
*** ADDITIONAL FIELDS USED IN THE EXAMPLES 01 PROGRAM-WORK-AREA. 05 COMM-ID PIC X(4). 05 COMM-ID-X REDEFINES COMM-ID PIC S9(8) COMP. 05 INPUT-KEY PIC X(8). 05 RECORD-BUFFER-EX2. 10 RECORD-BUFFER-A PIC X(8). 10 RECORD-BUFFER-B PIC S9(3) COMP-3. 05 RECORD-BUFFER-EX3. 10 OPEN-RECORD-BUFFER. 15 OPEN-RECORD-BUFFER-X PIC X(8). 15 FILLER PIC S9(8) COMP. 10 FILLER PIC X(18). 10 UPDATED-XC PIC X(6). 10 LAST-XD PIC X(8). 10 FILLER PIC X(5). 05 USER-DATA. 10 RESTART-XD PIC X(8). 10 RESTART-ISN PIC S9(8) COMP. 05 SYNC-CHECK-SWITCH PIC 9 VALUE 0. 05 AB-VALUE PIC S9(4) COMP-3 VALUE +500. *
This section provides the following examples:
Find the set of records in file 2 with XB = 99.
Read each record selected using the GET NEXT option.
EXMP1. MOVE 'OP' TO COMMAND-CODE. MOVE 'ACC.' TO RECORD-BUFFER. CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER. IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX1ERR.
MOVE 'S1' TO COMMAND-CODE. MOVE 'S101' TO COMMAND-ID. MOVE 2 TO FILE-NUMBER. MOVE 0 TO ISN-LOWER-LIMIT. MOVE 0 TO ISN-BUFFER-LENGTH. MOVE '.' TO FORMAT-BUFFER. MOVE 'XB,3,U.' TO SEARCH-BUFFER. MOVE '099' TO VALUE-BUFFER. CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER, SEARCH-BUFFER, VALUE-BUFFER. IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX1ERR. EX1A. IF ISN-QUANTITY = 0 GO TO EX1EXIT.
EX1B. MOVE 'L1' TO COMMAND-CODE. MOVE 0 TO ISN. MOVE 'N' TO COMMAND-OPTION-2. MOVE 'RG.' TO FORMAT-BUFFER. EX1C. CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER. IF RESPONSE-CODE = 0 GO TO EX1D. IF RESPONSE-CODE = 3 GO TO EX1EXIT. EX1D. . . . PROCESS RECORD . . . GO TO EX1C.
EX1ERR. * .DISPLAY ERROR MESSAGE * .TERMINATE USER PROGRAM
EX1EXIT. MOVE 'CL' TO COMMAND-CODE. CALL 'ADABAS' USING CONTROL-BLOCK. IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX1ERR.
All records in file 1 are to be read in physical sequential order.
Each record read is to be updated with the following values:
Field AA = ABCDEFGH
Field AB = 500
User is to have exclusive control of file 1.
EXMP2. MOVE 'OP' TO COMMAND-CODE. MOVE 'EXU=1.' TO RECORD-BUFFER. CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER. IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX2ERR.
EX2A. MOVE 'L201' TO COMMAND-ID. MOVE 1 TO FILE-NUMBER. MOVE 0 TO ISN. MOVE 'GA.' TO FORMAT-BUFFER. EX2B. MOVE 'L2' TO COMMAND-CODE. CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER. IF RESPONSE-CODE = 0 GO TO EX2C. IF RESPONSE-CODE = 3 GO TO EX2EXIT. GO TO EX2ERR.
The same fields are to be updated as were read.
The same CID and format buffer can be used for the update command.
The ISN of the record to be updated is already in the ISN field as a result of the L2 command.
EX2C. MOVE 'A1' TO COMMAND-CODE. MOVE 'ABCDEFGH' TO RECORD-BUFFER-A. MOVE AB-VALUE TO RECORD-BUFFER-B. CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER-EX2. IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX2ERR. GO TO EX2B.
EX2ERR. . DISPLAY ERROR MESSAGE . TERMINATE USER PROGRAM
EX2EXIT. MOVE 'CL' TO COMMAND-CODE. CALL 'ADABAS' USING CONTROL-BLOCK. IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX2ERR.
During user session initialization, the user program is to display information indicating the last successfully processed transaction of the previous user session.
For each user transaction, the user program is to
accept from a terminal 8 characters of input to be used as the key for updating files 1 and 2; and
issue the Find command for file 1 to determine if a record exists with field AA = input key.
If no record is found, the user program is to issue a message. If a record is found, the user program is to
delete the record from file 1; and
add a new record to file 2: Field RA = input key entered.
Other fields are to contain a null value.
If the record cannot be successfully added, the user program is to issue a BT command and display an error message.
If both updates are successful, the user program is to issue an ET command.
This section of the program is only executed during user session initialization.
The OP command is issued with ET data of the previous session being read.
A message is displayed on the terminal screen identifying the last successfully processed transaction of the user's previous session.
EX3. MOVE 'OP' TO COMMAND-CODE. MOVE 'E' TO COMMAND-OPTION-2. MOVE 'USER0002' TO ADDITIONS-1. MOVE 'PASSWORD' TO ADDITIONS-3. MOVE 'UPD=1,2.' TO RECORD-BUFFER. CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER. IF RESPONSE-CODE = 9 GO TO EX3. IF RESPONSE-CODE NOT EQUAL TO 0 GO TO EX3ERR. EX3A. MOVE COMMAND-ID TO COMM-ID. IF COMM-ID-X = +0 GO TO EX3B. * Display ET data (contained in RECORD BUFFER) on screen to inform user of * last successfully processed transaction of previous user session. . . .DISPLAY ET DATA. . . GO TO EX3C. EX3B. *** No ET data received. * Display message that no transactions were successfully processed during * the previous user session . . .DISPLAY MESSAGE . . . *** Transaction processing. * This section is executed for each user transaction. EX3C. * . . .ACCEPT INPUT FROM TERMINAL. . . * Issue Find command for file 1 to determine if record exists with field AA * equal to input key entered. EX3D. MOVE 'S4' TO COMMAND-CODE. MOVE SPACES TO COMMAND-ID. MOVE 1 TO FILE-NUMBER. MOVE 0 TO ISN-LOWER-LIMIT. MOVE '.' TO FORMAT-BUFFER. MOVE 'AA.' TO SEARCH-BUFFER. MOVE INPUT-KEY TO VALUE-BUFFER. CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER, SEARCH-BUFFER, VALUE-BUFFER, ISN-BUFFER. IF RESPONSE-CODE = 0 GO TO EX3E. GO TO EX3ERR. EX3E. IF ISN-QUANTITY NOT EQUAL TO ZEROS GO TO EX3F. ***No records found, issue message requesting correction. . . .ISSUE MESSAGE . . . GO TO EX3C. *** Delete record from file 1. * ISN of record to be deleted is already in ISN field and in hold status * as a result of the S4 command. EX3F. MOVE E3' TO COMMAND-CODE. CALL 'ADABAS' USING CONTROL-BLOCK. IF RESPONSE-CODE = 0 GO TO EX3G. IF RESPONSE-CODE = 9 GO TO EX3D. GO TO EX3ERR. *** Add new record to file 2. EX3G. MOVE 'N1' TO COMMAND-CODE. MOVE 2 TO FILE-NUMBER. MOVE 'RA.' TO FORMAT-BUFFER. MOVE INPUT-KEY TO RECORD-BUFFER. CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER. IF RESPONSE-CODE = 0 GO TO EX3I. IF RESPONSE-CODE = 9 GO TO EX3D. *** Attempt to add new record not successful. * Backout transaction. * Notify user that error condition exists. MOVE 'BT' TO COMMAND-CODE. CALL 'ADABAS' USING control-block. IF RESPONSE-CODE = 0 GO TO EX3H. *** Backout not successful. * Issue message indicating that the backout was not successful GO TO EX3ERR. EX3H. *** Backout successful. * Issue message indicating the error condition detected while while adding a * new record GO TO EX3ERR. *** Updates successfully executed. * Issue ET command with ET data. EX3I. MOVE 'ET' TO COMMAND-CODE. MOVE 'E' TO COMMAND-OPTION-2. MOVE INPUT-KEY TO RECORD-BUFFER. CALL 'ADABAS' USING CONTROL-BLOCK, FORMAT-BUFFER, RECORD-BUFFER. IF RESPONSE-CODE = 0 GO TO EX3C. IF RESPONSE-CODE = 9 GO TO EX3D. *** Error Routine EX3ERR. * . DISPLAY ERROR MESSAGE * . TERMINATE USER PROGRAM . . .
This section contains examples of using direct Adabas calls in PL/ I . The previously defined Adabas files are used in each example.
/*** CONTROL BLOCK ***/ DCL 1 CONTROL_BLOCK, 02 FILLER1 CHAR (2) INIT (' '), 02 COMMAND_CODE CHAR (2) INIT (' '), 02 COMMAND_ID CHAR (4) INIT (' '), 02 FILE_NUMBER BIN FIXED (15) INIT (0), 02 RESPONSE_CODE BIN FIXED (15) INIT (0), 02 ISN BIN FIXED (31) INIT (0), 02 ISN_LOWER_LIMIT BIN FIXED (31) INIT (0), 02 ISN_QUANTITY BIN FIXED (31) INIT (0), 02 FORMAT_BUFFER_LENGTH BIN FIXED (15) INIT (100), 02 RECORD_BUFFER_LENGTH BIN FIXED (15) INIT (250), 02 SEARCH_BUFFER_LENGTH BIN FIXED (15) INIT (50), 02 VALUE_BUFFER_LENGTH BIN FIXED (15) INIT (100), 02 ISN_BUFFER_LENGTH BIN FIXED (15) INIT (20), 02 COMMAND_OPTION_1 CHAR(1) INIT (' '), 02 COMMAND_OPTION_2 CHAR(1) INIT (' '), 02 ADDITIONS_1 CHAR(8) INIT (' '), 02 ADDITIONS_2 CHAR(4) INIT (' '), 02 ADDITIONS_3 CHAR(8) INIT (' '), 02 ADDITIONS_4 CHAR(8) INIT (' '), 02 ADDITIONS_5 CHAR(8) INIT (' '), 02 COMMAND_TIME BIN FIXED (31) INIT (0), 02 USER_AREA CHAR(4) INIT (' '); /*** USER BUFFER AREAS ***/ DCL FORMAT_BUFFER CHAR(100), RECORD_BUFFER CHAR(250), SEARCH_BUFFER CHAR(50), VALUE_BUFFER CHAR(100), ISN_BUFFER CHAR(20); * * /*** ADDITIONAL FIELDS USED IN THE EXAMPLES ***/ DCL COMM_ID_X BIN FIXED(31); COMM_ID CHAR(4) BASED (ADDR(COMM_ID_X)); DCL INPUT_KEY CHAR(8); DCL SYNC_CHECK_SWITCH CHAR(1) INIT('0'); DCL 1 RECORD_BUFFER_EX2, 2 RECORD_BUFFER_A CHAR(8), 2 RECORD_BUFFER_B DEC FIXED(3,0), 2 FILLER3 CHAR(240); DCL 1 RECORD_BUFFER_EX3, 2 OPEN_RECORD_BUFFER, 3 OPEN_RECORD_BUFFER_X CHAR(8), 3 FILLER4 BIN FIXED(31), 2 FILLER5 CHAR(18), 2 UPDATED_XC CHAR(6), 2 LAST_XD CHAR(8), 2 FILLER6 CHAR(5), 1 USER_DATA, 2 RESTART_XD CHAR(8), 2 RESTART_ISN BIN FIXED(31); DCL ADABAS ENTRY OPTIONS(ASM);
This section provides the following examples:
Find the set of records in file 2 with XB = 99.
Read each record selected using the GET NEXT option.
*** Issue Open Command **/ EXMP1: COMMAND_CODE = 'OP'; RECORD_BUFFER = 'ACC.'; CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER); IF RESPONSE_CODE > 0 THEN GOTO EX1ERR;
/*** Issue Find Command ***/ COMMAND_CODE = 'S1'; COMMAND_ID = 'S101'; FILE_NUMBER = 2; ISN_LOWER_LIMIT = 0; ISN_BUFFER_LENGTH = 0; FORMAT_BUFFER = '.'; SEARCH_BUFFER = 'XB,3,U.'; VALUE_BUFFER = '099'; CALL ADABAS (CONTROL_BLOCK, FORMAT_BUFFER, RECORD_BUFFER, SEARCH_BUFFER, VALUE_BUFFER); IF RESPONSE_CODE > 0 THEN GOTO EX1ERR; EX1A: IF ISN_QUANTITY = 0 THEN GOTO EX1EXIT; EX1B: COMMAND_CODE = 'L1'; ISN = 0; COMMAND_OPTION_1 = 'N'; FORMAT_BUFFER = 'RG.'; EX1C: CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER); IF RESPONSE_CODE = 0 THEN GOTO EX1D; IF RESPONSE_CODE = 3 THEN GOTO EX1EXIT; EX1D: . . .PROCESS RECORD . . . GOTO EX1C;
/*** Error Routine ***/ EX1ERR: /* . DISPLAY ERROR MESSAGE */ /* . TERMINATE USER PROGRAM */
/** Issue Close Command **/ EX1EXIT: COMMAND_CODE = 'CL'; CALL ADABAS (CONTROL_BLOCK); IF RESPONSE_CODE > 0 THEN GOTO EX1ERR;
All records in file 1 are to be read in physical sequential order.
Each record read is to be updated with the following values:
Field AA = ABCDEFGH
Field AB = 500
User is to have exclusive control of file 1.
/*** Issue Open Command ***/ EXMP2: COMMAND_CODE = 'OP'; RECORD_BUFFER = 'EXU=1.'; CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER); IF RESPONSE_CODE > 0 THEN GOTO EX2ERR;
/*** Issue Read Physical Seq. Command ***/ EX2A: COMMAND_ID = 'L201'; FILE_NUMBER = 1; ISN = 0; FORMAT_BUFFER = 'GA.'; EX2B: COMMAND_CODE = 'L2'; CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER); IF RESPONSE_CODE = 0 THEN GOTO EX2C; IF RESPONSE_CODE = 3 THEN GOTO EX2EXIT; GOTO EX2ERR;
/*** Update record. ***/ /* Same fields are to be updated as were read. */ /* Same CID and FORMAT BUFFER can be used for update. */ /* ISN of record to be updated is already in ISN field as a result of */ /* the L2 command. */ EX2C: COMMAND_CODE = 'A1'; RECORD_BUFFER_A = 'ABCDEFGH'; RECORD_BUFFER_B = 500; CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER, RECORD_BUFFER_EX2); IF RESPONSE_CODE > 0 THEN GOTO EX2ERR; GOTO EX2B;
/*** Error Routine ***/ EX2ERR: /* . DISPLAY ERROR MESSAGE */ /* . TERMINATE USER PROGRAM */
/* Close User Session */ EX2EXIT: COMMAND_CODE = 'CL'; CALL ADABAS (CONTROL_BLOCK); IF RESPONSE_CODE > 0 THEN GOTO EX2ERR;
This example illustrates a user session with ET logic. The user program is to perform the following functions:
During user session initialization, display information indicating the last successfully processed transaction of the previous user session.
For each user transaction:
Accept from a terminal 8 characters of input that is used as the key for updating files 1 and 2.
Issue a Find command for file 1 to determine if a record exists with field AA = input key.
If no record is found, issue a message.
If a record is found:
Delete the record from file 1;
Add a new record to file 2: Field RA = input key entered. Other fields to contain null value.
If the record cannot be successfully added, issue a BT command, display error message.
If both updates are successful, issue an ET command.
This section of the program is only executed during user session initialization.
The OP command is issued with ET data of the previous session being read.
A message is displayed on the terminal screen identifying the last successfully processed transaction of the user's previous session.
EX3: COMMAND_CODE = 'OP'; COMMAND_OPTION_2 = 'E'; ADDITIONS_1 = 'USER0003'; ADDITIONS_3 = 'PASSWORD'; RECORD_BUFFER = 'UPD=1,2.'; CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER); IF RESPONSE_CODE = 9 THEN GOTO EX3; IF RESPONSE_CODE > 0 THEN GOTO EX3ERR; EX3A: COMM_ID = COMMAND_ID; IF COMM_ID_X = 0 THEN GOTO EX3B; /* Display ET data (contained in RECORD BUFFER) on screen to inform user of last successfully processed transaction of previous user session. */ . . .DISPLAY ET DATA. . . GOTO EX3C; EX3B: /* */ /*** No ET data received. */ /* Display message that no transactions were successfully processed during the previous user session. */ . . .DISPLAY MESSAGE . . . /* */ /*** Transaction processing. ***/ /* This section is executed for each user transaction. */ EX3C: . . .ACCEPT INPUT FROM TERMINAL. . . /* */ /* Issue Find command for file 1 to determine if rec exists with field AA equal to input key entered. */ EX3D: COMMAND_CODE = 'S4'; COMMAND_ID = ' '; FILE_NUMBER = 1; ISN_LOWER_LIMIT = 0; FORMAT_BUFFER = '.'; SEARCH_BUFFER = 'AA.'; VALUE_BUFFER = INPUT_KEY; CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER, SEARCH_BUFFER,VALUE_BUFFER,ISN_BUFFER); IF RESPONSE_CODE = 0 THEN GOTO EX3E; GOTO EX3ERR; EX3E: IF ISN_QUANTITY > 0 THEN GOTO EX3F; /* */ /* No record found, issue message requesting correction. */ . . .ISSUE MESSAGE . . . GOTO EX3C; /* */ /* Delete record from file 1. */ /* ISN of record to be deleted is already in ISN field and in hold status as a result of the S4 command. */ EX3F: COMMAND_CODE = 'E4'; CALL ADABAS (CONTROL_BLOCK); IF RESPONSE_CODE = 0 THEN GOTO EX3G; IF RESPONSE_CODE = 9 THEN GOTO EX3D; GOTO EX3ERR; /***Add new record to file 2. */ EX3G: COMMAND_CODE = 'N1'; FILE_NUMBER = 2; FORMAT_BUFFER = 'RA.'; RECORD_BUFFER = INPUT_KEY; CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER); IF RESPONSE_CODE = 0 THEN GOTO EX3I; IF RESPONSE_CODE = 9 THEN GOTO EX3D; /* */ /* Attempt to add new record not successful. Backout transaction and notify user that error condition exists. */ COMMAND_CODE = 'BT'; CALL ADABAS (CONTROL_BLOCK); IF RESPONSE_CODE = 0 THEN GOTO EX3H; /* */ /* Backout not successful. */ . . .ISSUE MESSAGE INDICATING BACKOUT NOT SUCCESSFUL . . GO TO EX3ERR. /* */ EX3H: /*** Backout successful. ***/ /* Issue message indicating error condition detected while adding new record.*/ . . .ISSUE MESSAGE. . . GOTO EX3ERR; /* */ /*** Updates successfully executed. ***/ /* Issue ET command with ET data. */ EX3I: COMMAND_CODE = 'ET'; COMMAND_OPTION_2 = 'E'; RECORD_BUFFER = INPUT_KEY; CALL ADABAS (CONTROL_BLOCK,FORMAT_BUFFER,RECORD_BUFFER); IF RESPONSE_CODE = 0 THEN GOTO EX3C; IF RESPONSE_CODE = 9 THEN GOTO EX3D; /* */ /*** Error Routine ***/ EX3ERR: /* . DISPLAY ERROR MESSAGE */ /* . TERMINATE USER PROGRAM */ . . .
This section contains an example of using direct Adabas calls in FORTRAN. The previously defined Adabas files are used in each example.
C *** CONTROL BLOCK *** INTEGER*4 CB(20),CID,ISN,ISNL,ISNQ INTEGER*4 ADD1(2),ADD2,ADD3(2),ADD4(2),ADD5(2) INTEGER*4 CTIME,UAREA INTEGER*2 CBI(40),CCODE,FNR,RC,FBL,RBL,SBL,VBL,IBL LOGICAL*1 CBL(80),COPT1,COPT2 EQUIVALENCE (CB(1),CBI(1),CBL(1)) EQUIVALENCE (CID,CB(2)),(ISN,CB(4)) EQUIVALENCE (ISNL,CB(5)),(ISNQ,CB(6)) EQUIVALENCE (ADD1(1),CB(10)),(ADD2,CB(12)),(ADD3(1),CB(13)) EQUIVALENCE (ADD4(1),CB(15),(ADD5(1),CB(17)) EQUIVALENCE (CTIME,CB(19)),(UAREA,CB(20)) EQUIVALENCE (CCODE,CBI(2)),(FNR,CBI(5)),(RC,CBI(6)) EQUIVALENCE (FBL,CBI(13)),(RBL,CBI(14)),(SBL,CBI(15)) EQUIVALENCE (VBL,CBI(16)),(IBL,CBI(17)) EQUIVALENCE (COPT1,CBL(35)),(COPT2,CBL(36)) C *** USER BUFFER AREAS *** INTEGER*4 FB(25),RB(50),SB(10),VB(10),IB(50) * * C *** ADDITIONAL FIELDS USED IN THIS EXAMPLE *** LOGICAL*1 BLANK/1H /,COPH/1HH/,PERIOD/1H./,COPN/1HN/ INTEGER*2 S1/2HS1/,L1/2HL1/,CL/2HCL/ INTEGER*4 CID1/4HS101/,FB1/4H. /,FB2/4HRG. /,SB1/4HXB,3/ INTEGER*4 SB2/4H,U. /,VB1/4H099 /
This section provides the following example:
Find the set of records in file 2 with XB = 99.
Read each record selected using the GET NEXT option.
c*** Initialize Control Block DO 5 I=1,80 CBL(I)=BLANK 5 CONTINUE DO 10 I=3,6 CB(I)=0 10 CONTINUE CBI(13)=100 CBI(14)=200 CBI(15)=40 CBI(16)=40 CBI(17)=200 CBI(19)=0
c***Issue FIND Command CCODE=S1 CID=CID1 FNR=2 ISNL=0 COPT1=COPH FB(1)=FB1 SB(1)=SB1 SB(2)=SB2 VB(1)=VB1 CALL ADABAS(CB,FB,RB,SB,VB,IB) IF(RC.NE.0) GO TO 50 IF(ISNQ.EQ.0) GO TO 100
c***Read Each Record Selected 15 CONTINUE CCODE=L1 ISN=0 COPT1=COPN FB(1)=FB2 CALL ADABAS(CB,FB,RB) IF(RC.EQ.0) GO TO 30 IF(RC.EQ.3) GO TO 100 PRINT 60,RC,CCODE 60 FORMAT(1H0,'ADABAS ERROR CODE',I4,' FROM '.A2,' COMMAND') GO TO 50 30 CONTINUE C ...PROCESS RECORD... GO TO 15 50 CONTINUE STOP 100 CONTINUE ...