Version 2.4.1
 —  Adabas Native SQL Reference Manual  —

APPENDIX E - EXAMPLE OF ADA CODE GENERATED BY ADABAS NATIVE SQL

with TYPES, ADABAS_GENERIC_CALLS, TEXT_IO ;
use  TYPES, TEXT_IO ;
--
--  AN EXAMPLE OF SOFT COUPLING WITH A SEARCH CRITERION WHICH
--  CONTAINS FIELDS TAKEN FROM TWO FILES.  THE FIELDS PERSONNEL-ID
--  NAME, FIRST-NAME, BIRTH AND SEX (FROM THE MAIN FILE,
--  PERSONNEL-ID) ARE PRINTED FOR RECORDS THAT SATISFY THE
--  FOLLOWING CONDITION:
--     PERSONNEL-ID BETWEEN 10000001 AND 19999999
--     MODEL-VEAR-MAKE >
--     CLASS = 'C'

procedure AEX1 is
    START_MODEL : STRING (1..20) := "MERCEDES-BENZ     ";
    START_YEAR_MAKE : STRING (1..2) := "86" ;
    START_MODEL_YEAR_MAKE : STRING(1..22) := START_MODEL &
                             START_YEAR_MAKE ;

    FILLE1 : STRING(1..20) := " PERSONNEL-ID        " ;
    FILLE2 : STRING(1..17) := " NAME             " ;
    FILLE3 : STRING(1..18) := " FIRST-NAME        " ;
    FILLE4 : STRING(1..6) := "BIRTH   " ;
    FILLE5 : STRING(1..3) := "SEX" ;
    HEADER : STRING(1..64) := FILLE1 & FILLE2 & FILLE3 & FILLE4
                                       & FILLE5 ;
    HEADER2:  STRING(1..64) := (1..64 => '*');
    SPACE_LINE : STRING(1..80) := (1..80 => ' ');
--
--        EXEC ADABAS
--  BEGIN DECLARE SECTION
--        END-EXEC
--
     ADACODE : SHORT_INTEGER := 0 ;
     CB_OPN : CONTROL_BLOCK :=
                            (FILLER1                   => "AS"      ,
                             COMMAND_CODE              => "  "      ,
                             COMMAND_ID                => "OPEN"    ,
                             FILE_NUMBER               =>          0,
                             RESPONSE_CODE             =>          0,
                             ISN                       =>          0,
                             ISN_LOWER_LIMIT           =>          0,
                             ISN_QUANTITY              =>          0,
                             FORMAT_BUFFER_LENGTH      =>          0,
                             RECORD_BUFFER_LENGTH      =>          0,
                             SEARCH_BUFFER_LENGTH      =>          0,
                             VALUE_BUFFER_LENGTH       =>          0,
                             ISN_BUFFER_LENGTH         =>          4,
                             COMMAND_OPTION_1          => " "       ,
                             COMMAND_OPTION_2          => " "       ,
                             ADDITIONS_1               => "        ",
                             ADDITIONS_2               => "    "    ,
                             ADDITIONS_3               => "        ",
                             ADDITIONS_4               => "        ",
                             ADDITIONS_5               => "        ",
                             COMMAND_TIME              =>          0,
                             USER_AREA                 => "AS  "    ) ;
       FORMAT_BUF_OPN                      :  FORMAT_BUFFER (1..0001)  ;
       SEARCH_BUF_OPN                      :  SEARCH_BUFFER (1..0001)  ;
       VB_OPN                              :  VALUE_BUFFER  (1..0001)  ;
       RB_OPN                              :  RECORD_BUFFER (1..1500)  ;
       ISN_BUF_OPN                         :  ISN_BUFFER    (1..0001)  ;
       package A_OPN is new ADABAS_GENERIC_CALLS
      (FORMAT_BUFFER,RECORD_BUFFER,SEARCH_BUFFER,VALUE_BUFFER) ;
       DDFILE   : STRING(1..3)  :=            "061"                    ;
       CSEQ     : STRING(1..8)                                         ;
       CLN1     : CLN_TYPE                                             ;
       CLN2     : CLN_TYPE                                             ;
       TRCE     : STRING(1..7)                                         ;
       CLNNUM   : SHORT_INTEGER                                        ;
       SQLRSP   : SHORT_INTEGER                                        ;
       SQLQTY   : INTEGER                                              ;
       SQLISN   : INTEGER                                              ;
     type FORMAT_BUFEMPL_1                 is
       record
          FILLE001 : STRING(1..32) :="AA,8,A,AE,20,A,AC,20,A,AH,6,U,AG";
          FILLE002 : STRING(1..05) :=",1,A.";
       end record                                                      ;
     FORMAT_BUFEMPL                        :  FORMAT_BUFEMPL_1         ;
     type SEARCH_BUFEMPL_1                 is
       record
          FILLE001 : STRING(1..32) :="(22,AA,24,AC)/22/AA,8,A,S,AA,8,A";
          FILLE002 : STRING(1..27) :=",D,/24/AO,22,A,GT,D,AH,1,A.";
       end record                                                      ;
     SEARCH_BUFEMPL                        :  SEARCH_BUFEMPL_1         ;
     type RECORD_BUFEMPL                   is
       record
          PERSONNEL_ID                     :  STRING (1..0008)         ;
          NAME                             :  STRING (1..0020)         ;
          FIRST_NAME                       :  STRING (1..0020)         ;
          BIRTH                            :  STRING (1..0006)         ;
          SEX                              :  STRING (1..0001)         ;
          ISN                              :  INTEGER                  ;
          QUANTITY                         :  INTEGER                  ;
          RESPONSE_CODE                    :  SHORT_INTEGER            ;
       end record                                                      ;
     EMPLOYEES                             :  RECORD_BUFEMPL           ;
     type VALUE_BUFEMPL                    is
       record
          V_PERSONNEL_ID_F                 :  STRING (1..0008)
                                           :=        (1..0008 => ' ' ) ;
          V_PERSONNEL_ID_T                 :  STRING (1..0008)
                                           :=        (1..0008 => ' ' ) ;
          V_MODEL_YEAR_MAKE                :  STRING (1..0022)
                                           :=        (1..0022 => ' ' ) ;
          V_CLASS                          :  STRING (1..0001)
                                           :=        (1..0001 => ' ' ) ;
       end record                                                      ;
     VBEMPL                                :  VALUE_BUFEMPL            ;
       ISN_BUFEMPL                         :  ISN_BUFFER    (1..0001)  ;
       package AEMPL is new ADABAS_GENERIC_CALLS
      (FORMAT_BUFEMPL_1,RECORD_BUFEMPL,SEARCH_BUFEMPL_1,VALUE_BUFEMPL) ;
     CBEMPL : CONTROL_BLOCK :=
                            (FILLER1                   => "AS"      ,
                             COMMAND_CODE              => "  "      ,
                             COMMAND_ID                => "EMPL"    ,
                             FILE_NUMBER               =>         22,
                             RESPONSE_CODE             =>          0,
                             ISN                       =>          0,
                             ISN_LOWER_LIMIT           =>          0,
                             ISN_QUANTITY              =>          0,
                             FORMAT_BUFFER_LENGTH      =>         37,
                             RECORD_BUFFER_LENGTH      =>         55,
                             SEARCH_BUFFER_LENGTH      =>         59,
                             VALUE_BUFFER_LENGTH       =>         39,
                             ISN_BUFFER_LENGTH         =>          4,
                             COMMAND_OPTION_1          => " "       ,
                             COMMAND_OPTION_2          => " "       ,
                             ADDITIONS_1               => "        ",
                             ADDITIONS_2               => "    "    ,
                             ADDITIONS_3               => "        ",
                             ADDITIONS_4               => "        ",
                             ADDITIONS_5               => "        ",
                             COMMAND_TIME              =>          0,
                             USER_AREA                 => "AS  "    ) ;
     ISNSIZEEMPL                           :  INTEGER                  ;
     ISNMOREEMPL                           :  INTEGER                  ;
     ISNINDEMPL                            :  INTEGER                  ;
     EOFEMPL                               :  BOOLEAN  := FALSE        ;

--
--        EXEC ADABAS
--  DECLARE EMPL CURSOR FOR
--  SELECT PERSONNEL-ID, NAME, FIRST-NAME, BIRTH, SEX
--  FROM EMPLOYEES, VEHICLES
--  WHERE EMPLOYEES.PERSONNEL-ID = VEHICLES.PERSONNEL-ID
--        AND PERSONNEL-ID BETWEEN "10000001" AND "19999999"
--        AND VEHICLES.MODEL-YEAR-MAKE > :START_MODEL_YEAR_MAKE
--        AND VEHICLES.CLASS = "C"
--        END-EXEC
--

begin

--
--      EXEC ADABAS
--   OPEN EMPL
--      END-EXEC
--
           VBEMPL.V_PERSONNEL_ID_F  := "10000001"  ;
           VBEMPL.V_PERSONNEL_ID_T  := "19999999"  ;
           VBEMPL.V_MODEL_YEAR_MAKE  := START_MODEL_YEAR_MAKE  ;
           VBEMPL.V_CLASS  := "C"  ;
     ISNSIZEEMPL := INTEGER(CBEMPL.ISN_BUFFER_LENGTH / 4) ;
     ISNINDEMPL := 1 ;
     CBEMPL.ISN_LOWER_LIMIT := 0 ;
     CBEMPL.COMMAND_OPTION_1 := " " ;
     CBEMPL.COMMAND_OPTION_2 := " " ;
     CBEMPL.ISN_QUANTITY := 0                                ;
     CBEMPL.ISN_BUFFER_LENGTH := 0 ;
     CBEMPL.COMMAND_CODE := "S1" ;
     AEMPL.ADABAS    (
        CBEMPL,FORMAT_BUFEMPL,
            EMPLOYEES                       ,SEARCH_BUFEMPL,VBEMPL,
        ISN_BUFEMPL                                 ) ;
     EMPLOYEES.RESPONSE_CODE                       :=
                                CBEMPL.RESPONSE_CODE ;
     EMPLOYEES.QUANTITY                            :=
                                CBEMPL.ISN_QUANTITY ;
     EMPLOYEES.ISN                                 :=
                                CBEMPL.ISN ;
     if CBEMPL.RESPONSE_CODE /= 0
        then
     CSEQ := "00000000" ;
     CLN1(01) := "        EXEC ADABAS                     " ;
     CLN2(01) := "                                        " ;
     CLN1(02) := "     OPEN EMPL                          " ;
     CLN2(02) := "                                        " ;
     CLN1(03) := "        END-EXEC                        " ;
     CLN2(03) := "                                        " ;
     CLNNUM := 03 ;
         AEMPL.RESPF
           (CBEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL,
            EMPLOYEES                       ,SEARCH_BUFEMPL,VBEMPL,
            CLN1,CLN2,TRCE,CLNNUM) ;
          end if ;
     ISNMOREEMPL := CBEMPL.ISN_QUANTITY ;
     if ISNMOREEMPL > 0 then
       EOFEMPL := FALSE ;
     else
       EOFEMPL := TRUE ;
     end if ;
     if ISNMOREEMPL < ISNSIZEEMPL then
        ISNSIZEEMPL := ISNMOREEMPL ;
     end if ;
     ISNINDEMPL :=0 ;

     PUT_LINE (HEADER) ;
     PUT_LINE (HEADER2) ;
     PUT_LINE (SPACE_LINE) ;
--
--       EXEC ADABAS
--   FETCH EMPL
--       END-EXEC
--
     if ISNINDEMPL = ISNMOREEMPL then
         EOFEMPL := TRUE ;
     end if ;
     if not(EOFEMPL) then
     EOFEMPL := FALSE ;
     CBEMPL.COMMAND_OPTION_2 := "N" ;
     CBEMPL.COMMAND_OPTION_1 := " " ;
     CBEMPL.COMMAND_CODE := "L1" ;
     AEMPL.ADABAS    (
        CBEMPL,FORMAT_BUFEMPL,
            EMPLOYEES                       ,SEARCH_BUFEMPL,VBEMPL,
        ISN_BUFEMPL                                 ) ;
     EMPLOYEES.RESPONSE_CODE                       :=
                                CBEMPL.RESPONSE_CODE ;
     EMPLOYEES.QUANTITY                            :=
                                CBEMPL.ISN_QUANTITY ;
     EMPLOYEES.ISN                                 :=
                                CBEMPL.ISN ;
     if CBEMPL.RESPONSE_CODE = 3 then
       EOFEMPL := TRUE ;
     else
     if CBEMPL.RESPONSE_CODE /= 0
        then
     CSEQ := "00000000" ;
     CLN1(01) := "         EXEC ADABAS                    " ;
     CLN2(01) := "                                        " ;
     CLN1(02) := "     FETCH EMPL                         " ;
     CLN2(02) := "                                        " ;
     CLN1(03) := "         END-EXEC                       " ;
     CLN2(03) := "                                        " ;
     CLNNUM := 03 ;
         AEMPL.RESPF
           (CBEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL,
            EMPLOYEES                       ,SEARCH_BUFEMPL,VBEMPL,
            CLN1,CLN2,TRCE,CLNNUM) ;
          end if ;
     end if ;
     end if ;
     if EOFEMPL then
        ADACODE := 003 ;
     else
        ADACODE := 0 ;
     end if ;

   while ADACODE /= 3 loop
     PUT_LINE (" " & EMPLOYEES.PERSONNEL_ID & "   " & EMPLOYEES.NAME &
               " " & EMPLOYEES.FIRST_NAME & " " & EMPLOYEES.BIRTH & " "
                   & EMPLOYEES.SEX ) ;
--
--       EXEC ADABAS
--   FETCH EMPL
--       END-EXEC
--
     if ISNINDEMPL = ISNMOREEMPL then
         EOFEMPL := TRUE ;
     end if ;
     if not(EOFEMPL) then
     EOFEMPL := FALSE ;
     CBEMPL.COMMAND_OPTION_2 := "N" ;
     CBEMPL.COMMAND_OPTION_1 := " " ;
     CBEMPL.COMMAND_CODE := "L1" ;
     AEMPL.ADABAS    (
        CBEMPL,FORMAT_BUFEMPL,
            EMPLOYEES                       ,SEARCH_BUFEMPL,VBEMPL,
        ISN_BUFEMPL                                 ) ;
     EMPLOYEES.RESPONSE_CODE                       :=
                                CBEMPL.RESPONSE_CODE ;
     EMPLOYEES.QUANTITY                            :=
                                CBEMPL.ISN_QUANTITY ;
     EMPLOYEES.ISN                                 :=
                                CBEMPL.ISN ;
     if CBEMPL.RESPONSE_CODE = 3 then
       EOFEMPL := TRUE ;
     else
     if CBEMPL.RESPONSE_CODE /= 0
        then
     CSEQ := "00000000" ;
     CLN1(01) := "         EXEC ADABAS                    " ;
     CLN2(01) := "                                        " ;
     CLN1(02) := "     FETCH EMPL                         " ;
     CLN2(02) := "                                        " ;
     CLN1(03) := "         END-EXEC                       " ;
     CLN2(03) := "                                        " ;
     CLNNUM := 03 ;
         AEMPL.RESPF
           (CBEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL,
            EMPLOYEES                       ,SEARCH_BUFEMPL,VBEMPL,
            CLN1,CLN2,TRCE,CLNNUM) ;
          end if ;
     end if ;
     end if ;
     if EOFEMPL then
        ADACODE := 003 ;
     else
        ADACODE := 0 ;
     end if ;

   end loop ;
--
--       EXEC ADABAS
--   CLOSE EMPL
--       END-EXEC
--
     CBEMPL.COMMAND_OPTION_1 := "I" ;
     CBEMPL.COMMAND_OPTION_2 := "S" ;
     CBEMPL.COMMAND_CODE := "RC" ;
     AEMPL.ADABAS    (
        CBEMPL,FORMAT_BUFEMPL,
            EMPLOYEES                       ,SEARCH_BUFEMPL,VBEMPL,
        ISN_BUFEMPL                                 ) ;
     EMPLOYEES.RESPONSE_CODE                       :=
                                CBEMPL.RESPONSE_CODE ;
     EMPLOYEES.QUANTITY                            :=
                                CBEMPL.ISN_QUANTITY ;
     EMPLOYEES.ISN                                 :=
                                CBEMPL.ISN ;
     if CBEMPL.RESPONSE_CODE /= 0
        then
     CSEQ := "00000000" ;
     CLN1(01) := "         EXEC ADABAS                    " ;
     CLN2(01) := "                                        " ;
     CLN1(02) := "     CLOSE EMPL                         " ;
     CLN2(02) := "                                        " ;
     CLN1(03) := "         END-EXEC                       " ;
     CLN2(03) := "                                        " ;
     CLNNUM := 03 ;
         AEMPL.RESPF
           (CBEMPL,DDFILE,CSEQ,FORMAT_BUFEMPL,
            EMPLOYEES                       ,SEARCH_BUFEMPL,VBEMPL,
            CLN1,CLN2,TRCE,CLNNUM) ;
          end if ;

--
--       EXEC ADABAS
--   DBCLOSE
--       END-EXEC
--
     CB_OPN.RECORD_BUFFER_LENGTH := 1500 ;
     CB_OPN.COMMAND_OPTION_2 := " " ;
     CB_OPN.COMMAND_CODE := "CL" ;
     A_OPN.ADABAS    (
        CB_OPN,FORMAT_BUF_OPN,
            RB_OPN                          ,SEARCH_BUF_OPN,VB_OPN,
        ISN_BUF_OPN                                 ) ;
     if CB_OPN.RESPONSE_CODE /= 0
        then
     CSEQ := "00000000" ;
     CLN1(01) := "         EXEC ADABAS                    " ;
     CLN2(01) := "                                        " ;
     CLN1(02) := "     DBCLOSE                            " ;
     CLN2(02) := "                                        " ;
     CLN1(03) := "         END-EXEC                       " ;
     CLN2(03) := "                                        " ;
     CLNNUM := 03 ;
         A_OPN.RESPF
           (CB_OPN,DDFILE,CSEQ,FORMAT_BUF_OPN,
            RB_OPN                          ,SEARCH_BUF_OPN,VB_OPN,
            CLN1,CLN2,TRCE,CLNNUM) ;
          end if ;
end AEX1 ;

Top of page