Version 2.4.1
 —  Adabas Native SQL Reference Manual  —

APPENDIX - EXAMPLE OF PL/I CODE GENERATED BY ADABAS NATIVE SQL

  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

Top of page