PEX1 : PROC OPTIONS(MAIN); 00000010
/* AN EXAMPLE OF SOFT COUPLING WITH A SEARCH CRITERION WHICH 00000020
CONTAINS FIELDS TAKEN FROM TWO FILES. THE FIELDS PERSONNEL-ID 00000030
NAME, FIRST-NAME, BIRTH AND SEX (FROM THE MAIN FILE, 00000040
PERSONNEL-ID) ARE PRINTED FOR RECORDS THAT SATISFY THE 00000050
FOLLOWING CONDITION: 00000060
PERSONNEL-ID BETWEEN 10000001 AND 19999999 00000070
MODEL-YEAR-MAKE > 00000080
CLASS = 'C' */00000090
/* */00000100
DCL 1 START_STRUC, 00000110
2 START_MODEL CHAR(20) INIT('MERCEDES-BENZ'), 00000120
2 START_YEAR_MAKE PIC '(2)9' INIT(86); 00000130
DCL START_MODEL_YEAR_MAKE CHAR(22) BASED(ADDR(START_STRUC));00000140
/* */00000150
DCL 1 HEADER, 00000160
2 FILLER1 CHAR(12) INIT('PERSONNEL-ID'), 00000170
2 FILLER2 CHAR(8) INIT(' '), 00000180
2 FILLER3 CHAR(4) INIT('NAME'), 00000190
2 FILLER4 CHAR(13) INIT(' '), 00000200
2 FILLER5 CHAR(10) INIT('FIRST-NAME'), 00000210
2 FILLER6 CHAR(8) INIT(' '), 00000220
2 FILLER7 CHAR(5) INIT('BIRTH'), 00000230
2 FILLER8 CHAR(1) INIT(' '), 00000240
2 FILLER9 CHAR(3) INIT('SEX'); 00000250
DCL 1 HEADER2 CHAR(64) INIT((64)'*'); 00000260
DCL 1 LINE1, 00000270
2 FILLER1 CHAR(2) INIT(' '), 00000280
2 PERSONNEL_NR CHAR(8) INIT(' '), 00000290
2 FILLER2 CHAR(3) INIT(' '), 00000300
2 LAST_NAME CHAR(20) INIT(' '), 00000310
2 FILLER3 CHAR(1) INIT(' '), 00000320
2 F_NAME CHAR(20) INIT(' '), 00000330
2 FILLER4 CHAR(1) INIT(' '), 00000340
2 BIRTHDAY CHAR(6) INIT(' '), 00000350
2 FILLER5 CHAR(1) INIT(' '), 00000360
2 KIND CHAR(1) INIT(' '); 00000370
/* */00000380
-/* ** 00000390
EXEC ADABAS 00000400
BEGIN DECLARE SECTION 00000410
END-EXEC 00000420
** */ 00000430
DCL ADACODE FIXED BIN(15) INIT (0); ADABAS
DCL ADABAS ENTRY OPTIONS(ASM,INTER); ADABAS
DCL RESPINT ENTRY OPTIONS(ASM,INTER); ADABAS
DCL 1 CONTROL_BLOCKOPN UNAL, ADABAS
3 FILLER1OPN CHAR(2) INIT ('AS') , ADABAS
3 COMMAND_CODEOPN CHAR(2) , ADABAS
3 COMMAND_IDOPN CHAR(4) INIT ('OPEN') , ADABAS
3 FILE_NUMBEROPN FIXED BIN(15) INIT ( 0) , ADABAS
3 RESPONSE_CODEOPN FIXED BIN(15) INIT (0) , ADABAS
3 ISNOPN FIXED BIN(31) INIT (0) , ADABAS
3 ISN_LOWER_LIMITOPN FIXED BIN(31) INIT (0) , ADABAS
3 ISN_QUANTITYOPN FIXED BIN(31) , ADABAS
3 FORMAT_BUFFER_LENGTHOPN FIXED BIN(15) INIT ( 0) , ADABAS
3 RECORD_BUFFER_LENGTHOPN FIXED BIN(15) INIT ( 0) , ADABAS
3 SEARCH_BUFFER_LENGTHOPN FIXED BIN(15) INIT ( 0) , ADABAS
3 VALUE_BUFFER_LENGTHOPN FIXED BIN(15) INIT ( 0) , ADABAS
3 ISN_BUFFER_LENGTHOPN FIXED BIN(15) INIT ( 4) , ADABAS
3 COMMAND_OPTION_1OPN CHAR(1) INIT (' ') , ADABAS
3 COMMAND_OPTION_2OPN CHAR(1) INIT (' ') , ADABAS
3 ADDITIONS_1OPN CHAR(8) INIT (' ') , ADABAS
3 ADDITIONS_2OPN CHAR(4) INIT (' ') , ADABAS
3 ADDITIONS_3OPN CHAR(8) INIT (' ') , ADABAS
3 ADDITIONS_4OPN CHAR(8) INIT (' ') , ADABAS
3 ADDITIONS_5OPN , ADABAS
4 ADDITIONS_5_BNOPN FIXED BIN(31) INIT (0) , ADABAS
4 ADDITIONS_5_58OPN CHAR(4) , ADABAS
3 COMMAND_TIMEOPN FIXED BIN(31) , ADABAS
3 USER_AREAOPN CHAR(4) INIT ('AS') ; ADABAS
DCL CONTROL_BLOCK_1OPN CHAR(80) ADABAS
BASED(ADDR(CONTROL_BLOCKOPN )); ADABAS
DCL ADDITIONS_1_12OPN CHAR(2) DEF ADDITIONS_1OPN ; ADABAS
DCL ADDITIONS_1_BNOPN FIXED BIN(15) UNAL ADABAS
BASED (ADDR(ADDITIONS_1OPN )); ADABAS
DCL ADDITIONS_1_58OPN CHAR(4) DEF ADDITIONS_1OPN POS(5); ADABAS
DCL 1 ADDITIONS_5_DEFOPN BASED (ADDR(ADDITIONS_5OPN )), ADABAS
2 ADDITIONS_5_1OPN CHAR(1), ADABAS
2 ADDITIONS_5_28OPN CHAR(7); ADABAS
DCL 1 ADDITIONS_4_DEFOPN BASED (ADDR(ADDITIONS_4OPN)), ADABAS
2 ADDITIONS_4_12OPN FIXED BIN(15), ADABAS
2 ADDITIONS_4_34OPN FIXED BIN(15), ADABAS
2 ADDITIONS_4_56OPN FIXED BIN(15), ADABAS
2 ADDITIONS_4_78OPN FIXED BIN(15); ADABAS
DCL DBIDOPN CHAR(1) BASED (ADDR(FILE_NUMBEROPN )); ADABAS
DCL FORMAT_BUFOPN CHAR (0001) ; ADABAS
DCL SEARCH_BUFOPN CHAR (0001) ; ADABAS
DCL VALUE_BUFOPN CHAR (0001) ; ADABAS
DCL ISN_BUFOPN CHAR (0001) ; ADABAS
DCL RECORD_BUFOPN CHAR (1500) ; ADABAS
DCL OPENTYPE CHAR (0010) ; ADABAS
DCL DDFILE PIC'999' INIT ( 30) ; ADABAS
DCL CSEQ CHAR(8) ; ADABAS
DCL CLN1(20) CHAR(40) ; ADABAS
DCL CLN2(20) CHAR(40) ; ADABAS
DCL TRCE CHAR(7) ; ADABAS
DCL CLNNUM FIXED BIN(15) ; ADABAS
DCL SQLRSP FIXED BIN(15) ; ADABAS
DCL SQLQTY FIXED BIN(31) ; ADABAS
DCL SQLISN FIXED BIN(31) ; ADABAS
DCL SAVE_DBID_1OPN FIXED BIN(15) ; ADABAS
DCL 1 SAVE_DBID_DEFOPN BASED(ADDR(SAVE_DBID_1OPN )), ADABAS
2 FILLEROPN CHAR(1), ADABAS
2 SAVE_DBIDOPN CHAR(1); ADABAS
DCL 1 FORMAT_BUFEMPL_1 , ADABAS
2 FILLE001 CHAR(34) INIT('AA,8,A,AE,20,A,AC,20,A,AH,6,U,AG,1'), ADABAS
2 FILLE002 CHAR(03) INIT(',A.'), ADABAS
FORMAT_BUFEMPL CHAR(00037) ADABAS
BASED (ADDR( FORMAT_BUFEMPL_1 )); ADABAS
DCL 1 SEARCH_BUFEMPL_1 , ADABAS
2 FILLE001 CHAR(34) INIT('(22,AA,24,AC)/22/AA,8,A,S,AA,8,A,D'), ADABAS
2 FILLE002 CHAR(25) INIT(',/24/AO,22,A,GT,D,AH,1,A.'), ADABAS
SEARCH_BUFEMPL CHAR(00059) ADABAS
BASED (ADDR( SEARCH_BUFEMPL_1 )); ADABAS
DCL 1 EMPLOYEES UNAL, ADADATA
2 RECORD_BUFEMPL_1 , ADADATA
3 PERSONNEL_ID CHAR (0008) , ADADATA
3 NAME CHAR (0020) , ADADATA
3 FIRST_NAME CHAR (0020) , ADADATA
3 BIRTH PIC '(0005)99' , ADADATA
3 SEX CHAR (0001) , ADADATA
2 ISN FIXED BIN(31), ADADATA
2 QUANTITY FIXED BIN(31), ADADATA
2 RESPONSE_CODE FIXED BIN(15), ADADATA
RECORD_BUFEMPL CHAR(00055) ADADATA
BASED (ADDR( RECORD_BUFEMPL_1 )); ADADATA
DCL 1 VALUE_BUFEMPL_1 UNAL, ADABAS
2 V_PERSONNEL_ID_F CHAR (0008) ADABAS
INIT(' '), ADABAS
2 V_PERSONNEL_ID_T CHAR (0008) ADABAS
INIT(' '), ADABAS
2 V_MODEL_YEAR_MAKE, ADABAS
3 S_YEAR PIC '(0001)99' ADABAS
INIT(0), ADABAS
3 S_MAKE CHAR (0020) ADABAS
INIT(' '), ADABAS
2 V_CLASS CHAR (0001) ADABAS
INIT(' '), ADABAS
VALUE_BUFEMPL CHAR(00039) ADABAS
BASED (ADDR(VALUE_BUFEMPL_1 )); ADABAS
DCL V_MODEL_YEAR_MAKE_EMPL CHAR (0022) ADABAS
BASED (ADDR( ADABAS
VALUE_BUFEMPL_1.V_MODEL_YEAR_MAKE )); ADABAS
DCL ISN_BUFEMPL ( 1) FIXED BIN(31); ADABAS
DCL 1 CONTROL_BLOCKEMPL UNAL, ADABAS
3 FILLER1EMPL CHAR(2) INIT ('AS') , ADABAS
3 COMMAND_CODEEMPL CHAR(2) , ADABAS
3 COMMAND_IDEMPL CHAR(4) INIT ('EMPL') , ADABAS
3 FILE_NUMBEREMPL FIXED BIN(15) INIT ( 22) , ADABAS
3 RESPONSE_CODEEMPL FIXED BIN(15) INIT (0) , ADABAS
3 ISNEMPL FIXED BIN(31) INIT (0) , ADABAS
3 ISN_LOWER_LIMITEMPL FIXED BIN(31) INIT (0) , ADABAS
3 ISN_QUANTITYEMPL FIXED BIN(31) , ADABAS
3 FORMAT_BUFFER_LENGTHEMPL FIXED BIN(15) INIT ( 37) , ADABAS
3 RECORD_BUFFER_LENGTHEMPL FIXED BIN(15) INIT ( 55) , ADABAS
3 SEARCH_BUFFER_LENGTHEMPL FIXED BIN(15) INIT ( 59) , ADABAS
3 VALUE_BUFFER_LENGTHEMPL FIXED BIN(15) INIT ( 39) , ADABAS
3 ISN_BUFFER_LENGTHEMPL FIXED BIN(15) INIT ( 4) , ADABAS
3 COMMAND_OPTION_1EMPL CHAR(1) INIT (' ') , ADABAS
3 COMMAND_OPTION_2EMPL CHAR(1) INIT (' ') , ADABAS
3 ADDITIONS_1EMPL CHAR(8) INIT (' ') , ADABAS
3 ADDITIONS_2EMPL CHAR(4) INIT (' ') , ADABAS
3 ADDITIONS_3EMPL CHAR(8) INIT (' ') , ADABAS
3 ADDITIONS_4EMPL CHAR(8) INIT (' ') , ADABAS
3 ADDITIONS_5EMPL , ADABAS
4 ADDITIONS_5_BNEMPL FIXED BIN(31) INIT (0) , ADABAS
4 ADDITIONS_5_58EMPL CHAR(4) , ADABAS
3 COMMAND_TIMEEMPL FIXED BIN(31) , ADABAS
3 USER_AREAEMPL CHAR(4) INIT ('AS') ; ADABAS
DCL CONTROL_BLOCK_1EMPL CHAR(80) ADABAS
BASED(ADDR(CONTROL_BLOCKEMPL)); ADABAS
DCL ADDITIONS_1_12EMPL CHAR(2) DEF ADDITIONS_1EMPL; ADABAS
DCL ADDITIONS_1_BNEMPL FIXED BIN(15) UNAL ADABAS
BASED (ADDR(ADDITIONS_1EMPL)); ADABAS
DCL ADDITIONS_1_58EMPL CHAR(4) DEF ADDITIONS_1EMPL POS(5); ADABAS
DCL 1 ADDITIONS_5_DEFEMPL BASED (ADDR(ADDITIONS_5EMPL)), ADABAS
2 ADDITIONS_5_1EMPL CHAR(1), ADABAS
2 ADDITIONS_5_28EMPL CHAR(7); ADABAS
DCL DBIDEMPL CHAR(1) BASED (ADDR(FILE_NUMBEREMPL)); ADABAS
DCL ISNSIZEEMPL FIXED BIN(31) ; ADABAS
DCL ISNMOREEMPL FIXED BIN(31) ; ADABAS
DCL ISNINDEMPL FIXED BIN(15) ; ADABAS
DCL SAVE_DBID_1EMPL FIXED BIN(15) ; ADABAS
DCL 1 SAVE_DBID_DEFEMPL BASED(ADDR(SAVE_DBID_1EMPL)), ADABAS
2 FILLEREMPL CHAR(1), ADABAS
2 SAVE_DBIDEMPL CHAR(1); ADABAS
DCL EOFEMPL BIT(1) INIT ('0'B); ADABAS
/* */00000440
-/* ** 00000450
EXEC ADABAS 00000460
DECLARE EMPL CURSOR FOR 00000470
SELECT PERSONNEL-ID, NAME, FIRST-NAME, BIRTH, SEX 00000480
FROM EMPLOYEES, VEHICLES 00000490
WHERE EMPLOYEES.PERSONNEL-ID = VEHICLES.PERSONNEL-ID 00000500
AND PERSONNEL-ID BETWEEN '10000001' AND '19999999' 00000510
AND VEHICLES.MODEL-YEAR-MAKE > :START_MODEL_YEAR_MAKE 00000520
AND VEHICLES.CLASS = 'C' 00000530
END-EXEC 00000540
** */ 00000550
/* */00000560
PUT SKIP EDIT (HEADER) (A); 00000570
PUT SKIP EDIT (HEADER2) (A); 00000580
PUT SKIP; 00000590
/* */00000600
-/* ** 00000610
EXEC ADABAS 00000620
OPEN EMPL 00000630
END-EXEC 00000640
** */ 00000650
VALUE_BUFEMPL_1.V_PERSONNEL_ID_F = '10000001'; ADABAS
VALUE_BUFEMPL_1.V_PERSONNEL_ID_T = '19999999'; ADABAS
V_MODEL_YEAR_MAKE_EMPL = START_MODEL_YEAR_MAKE; ADABAS
VALUE_BUFEMPL_1.V_CLASS = 'C'; ADABAS
DO; ADABAS
ISNSIZEEMPL=ISN_BUFFER_LENGTHEMPL/4; ADABAS
ISNINDEMPL=1; ADABAS
ISN_LOWER_LIMITEMPL=0; ADABAS
COMMAND_OPTION_1EMPL=' '; ADABAS
COMMAND_OPTION_2EMPL=' '; ADABAS
ISN_BUFFER_LENGTHEMPL=0; ADABAS
ISN_QUANTITYEMPL=0 ; ADABAS
COMMAND_CODEEMPL='S1'; ADABAS
CALL ADABAS ( ADABAS
CONTROL_BLOCKEMPL,FORMAT_BUFEMPL,RECORD_BUFEMPL, ADABAS
SEARCH_BUFEMPL,VALUE_BUFEMPL, ADABAS
ISN_BUFEMPL ); ADABAS
EMPLOYEES.RESPONSE_CODE =RESPONSE_CODEEMPL; ADABAS
EMPLOYEES.QUANTITY =ISN_QUANTITYEMPL; ADABAS
EMPLOYEES.ISN =ISNEMPL; ADABAS
IF RESPONSE_CODEEMPL*=0 ADABAS
THEN DO; ADABAS
CSEQ='00000650'; ADABAS
CLN1(01)=' EXEC ADABAS '; ADABAS
CLN2(01)=' '; ADABAS
CLN1(02)=' OPEN EMPL '; ADABAS
CLN2(02)=' '; ADABAS
CLN1(03)=' END-EXEC '; ADABAS
CLN2(03)=' '; ADABAS
CLNNUM=03; ADABAS
CALL RESPINT ADABAS
(CONTROL_BLOCKEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL, ADABAS
RECORD_BUFEMPL,SEARCH_BUFEMPL,VALUE_BUFEMPL, ADABAS
CLN1,CLN2,TRCE,CLNNUM); ADABAS
END; ADABAS
ISNMOREEMPL=ISN_QUANTITYEMPL; ADABAS
IF ISNMOREEMPL > 0 THEN EOFEMPL= '0'B; ADABAS
ELSE EOFEMPL= '1'B; ADABAS
IF ISNMOREEMPL<ISNSIZEEMPL THEN ISNSIZEEMPL=ISNMOREEMPL; ADABAS
ISNINDEMPL=0; ADABAS
END; ADABAS
/* */00000660
-/* ** 00000670
EXEC ADABAS 00000680
FETCH EMPL 00000690
END-EXEC 00000700
** */ 00000710
DO; ADABAS
IF ISNINDEMPL=ISNMOREEMPL THEN EOFEMPL='1'B; ADABAS
IF *EOFEMPL THEN DO; ADABAS
EOFEMPL='0'B; ADABAS
COMMAND_OPTION_2EMPL='N'; ADABAS
COMMAND_OPTION_1EMPL=' '; ADABAS
COMMAND_CODEEMPL='L1'; ADABAS
CALL ADABAS ( ADABAS
CONTROL_BLOCKEMPL,FORMAT_BUFEMPL,RECORD_BUFEMPL, ADABAS
SEARCH_BUFEMPL,VALUE_BUFEMPL, ADABAS
ISN_BUFEMPL ); ADABAS
EMPLOYEES.RESPONSE_CODE =RESPONSE_CODEEMPL; ADABAS
EMPLOYEES.QUANTITY =ISN_QUANTITYEMPL; ADABAS
EMPLOYEES.ISN =ISNEMPL; ADABAS
IF RESPONSE_CODEEMPL=3 ADABAS
THEN EOFEMPL='1'B; ADABAS
ELSE ADABAS
IF RESPONSE_CODEEMPL*=0 ADABAS
THEN DO; ADABAS
CSEQ='00000710'; ADABAS
CLN1(01)=' EXEC ADABAS '; ADABAS
CLN2(01)=' '; ADABAS
CLN1(02)=' FETCH EMPL '; ADABAS
CLN2(02)=' '; ADABAS
CLN1(03)=' END-EXEC '; ADABAS
CLN2(03)=' '; ADABAS
CLNNUM=03; ADABAS
CALL RESPINT ADABAS
(CONTROL_BLOCKEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL, ADABAS
RECORD_BUFEMPL,SEARCH_BUFEMPL,VALUE_BUFEMPL, ADABAS
CLN1,CLN2,TRCE,CLNNUM); ADABAS
END; ADABAS
END; ADABAS
END; ADABAS
IF EOFEMPL THEN ADACODE = 003; ADABAS
ELSE ADACODE = 0; ADABAS
/* */00000720
DO WHILE (ADACODE *= 3); 00000730
PERSONNEL_NR = PERSONNEL_ID; 00000740
LAST_NAME = NAME; 00000750
F_NAME = FIRST_NAME; 00000760
BIRTHDAY = BIRTH; 00000770
KIND = SEX; 00000780
PUT SKIP EDIT (LINE1) (A); 00000790
-/* ** 00000800
EXEC ADABAS 00000810
FETCH EMPL 00000820
END-EXEC 00000830
** */ 00000840
DO; ADABAS
IF ISNINDEMPL=ISNMOREEMPL THEN EOFEMPL='1'B; ADABAS
IF *EOFEMPL THEN DO; ADABAS
EOFEMPL='0'B; ADABAS
COMMAND_OPTION_2EMPL='N'; ADABAS
COMMAND_OPTION_1EMPL=' '; ADABAS
COMMAND_CODEEMPL='L1'; ADABAS
CALL ADABAS ( ADABAS
CONTROL_BLOCKEMPL,FORMAT_BUFEMPL,RECORD_BUFEMPL, ADABAS
SEARCH_BUFEMPL,VALUE_BUFEMPL, ADABAS
ISN_BUFEMPL ); ADABAS
EMPLOYEES.RESPONSE_CODE =RESPONSE_CODEEMPL; ADABAS
EMPLOYEES.QUANTITY =ISN_QUANTITYEMPL; ADABAS
EMPLOYEES.ISN =ISNEMPL; ADABAS
IF RESPONSE_CODEEMPL=3 ADABAS
THEN EOFEMPL='1'B; ADABAS
ELSE ADABAS
IF RESPONSE_CODEEMPL*=0 ADABAS
THEN DO; ADABAS
CSEQ='00000840'; ADABAS
CLN1(01)=' EXEC ADABAS '; ADABAS
CLN2(01)=' '; ADABAS
CLN1(02)=' FETCH EMPL '; ADABAS
CLN2(02)=' '; ADABAS
CLN1(03)=' END-EXEC '; ADABAS
CLN2(03)=' '; ADABAS
CLNNUM=03; ADABAS
CALL RESPINT ADABAS
(CONTROL_BLOCKEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL, ADABAS
RECORD_BUFEMPL,SEARCH_BUFEMPL,VALUE_BUFEMPL, ADABAS
CLN1,CLN2,TRCE,CLNNUM); ADABAS
END; ADABAS
END; ADABAS
END; ADABAS
IF EOFEMPL THEN ADACODE = 003; ADABAS
ELSE ADACODE = 0; ADABAS
END; 00000850
/* */00000860
-/* ** 00000870
EXEC ADABAS 00000880
CLOSE EMPL 00000890
END-EXEC 00000900
** */ 00000910
DO; ADABAS
COMMAND_OPTION_1EMPL='I'; ADABAS
COMMAND_OPTION_2EMPL='S'; ADABAS
COMMAND_CODEEMPL='RC'; ADABAS
CALL ADABAS ( ADABAS
CONTROL_BLOCKEMPL,FORMAT_BUFEMPL,RECORD_BUFEMPL, ADABAS
SEARCH_BUFEMPL,VALUE_BUFEMPL, ADABAS
ISN_BUFEMPL ); ADABAS
EMPLOYEES.RESPONSE_CODE =RESPONSE_CODEEMPL; ADABAS
EMPLOYEES.QUANTITY =ISN_QUANTITYEMPL; ADABAS
EMPLOYEES.ISN =ISNEMPL; ADABAS
IF RESPONSE_CODEEMPL*=0 ADABAS
THEN DO; ADABAS
CSEQ='00000910'; ADABAS
CLN1(01)=' EXEC ADABAS '; ADABAS
CLN2(01)=' '; ADABAS
CLN1(02)=' CLOSE EMPL '; ADABAS
CLN2(02)=' '; ADABAS
CLN1(03)=' END-EXEC '; ADABAS
CLN2(03)=' '; ADABAS
CLNNUM=03; ADABAS
CALL RESPINT ADABAS
(CONTROL_BLOCKEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL, ADABAS
RECORD_BUFEMPL,SEARCH_BUFEMPL,VALUE_BUFEMPL, ADABAS
CLN1,CLN2,TRCE,CLNNUM); ADABAS
END; ADABAS
END; ADABAS
/* */00000920
-/* ** 00000930
EXEC ADABAS 00000940
DBCLOSE 00000950
END-EXEC 00000960
** */ 00000970
DO; ADABAS
RECORD_BUFFER_LENGTHOPN=1500; ADABAS
COMMAND_OPTION_2OPN =' '; ADABAS
COMMAND_CODEOPN ='CL'; ADABAS
CALL ADABAS ( ADABAS
CONTROL_BLOCKOPN ,FORMAT_BUFOPN ,RECORD_BUFOPN , ADABAS
SEARCH_BUFOPN ,VALUE_BUFOPN , ADABAS
ISN_BUFOPN ); ADABAS
IF RESPONSE_CODEOPN *=0 ADABAS
THEN DO; ADABAS
CSEQ='00000970'; ADABAS
CLN1(01)=' EXEC ADABAS '; ADABAS
CLN2(01)=' '; ADABAS
CLN1(02)=' DBCLOSE '; ADABAS
CLN2(02)=' '; ADABAS
CLN1(03)=' END-EXEC '; ADABAS
CLN2(03)=' '; ADABAS
CLNNUM=03; ADABAS
CALL RESPINT ADABAS
(CONTROL_BLOCKOPN ,DDFILE,CSEQ,FORMAT_BUFOPN , ADABAS
RECORD_BUFOPN ,SEARCH_BUFOPN ,VALUE_BUFOPN , ADABAS
CLN1,CLN2,TRCE,CLNNUM); ADABAS
END; ADABAS
END; ADABAS
/* */00000980