Version 2.4.1
 —  Adabas Native SQL Reference Manual  —

APPENDIX G - EXAMPLE OF COBOL CODE GENERATED BY ADABAS NATIVE SQL

 1
 0 000001                IDENTIFICATION DIVISION.                                         00000010
   000002                PROGRAM-ID. CEX1.                                                00000020
   000003               * WITH COBOL II SET THE NEXT LINE TO COMMENT
   000004               *REMARKS.
   000005               * AN EXAMPLE OF SOFT COUPLING WITH A SEARCH CRITERION WHICH     *
   000006               * CONTAINS FIELDS TAKEN FROM TWO FILES. THE FIELDS PERSONNEL-ID *
   000007               * NAME, FIRST-NAME, BIRTH AND SEX (FROM THE MAIN FILE,          *
   000008               * PERSONNEL-ID) ARE PRINTED FOR RECORDS THAT SATISFY THE        *
   000009               * FOLLOWING CONDITION:
   000010               *     PERSONNEL-ID BETWEEN 10000001 AND 19999999
   000011               *     MODEL-YEAR-MAKE >
   000012                ENVIRONMENT DIVISION.                                            00000030
   000013                DATA DIVISION.                                                   00000040
   000014                WORKING-STORAGE SECTION.                                         00000050
   000015                01  START-MODEL-YEAR-MAKE.                                       00000060
   000016                    02 START-MODEL            PIC X(20) VALUE 'MERCEDES-BENZ'.   00000070
   000017                    02 START-YEAR-MAKE        PIC 9(2)  VALUE 86.                00000080
   000018               *
   000019                01  HEADER.                                                      00000090
   000020                    02 FILLER          PIC X(12) VALUE 'PERSONNEL-ID'.           00000100
   000021                    02 FILLER          PIC X(8)  VALUE SPACE.                    00000110  IMP
   000022                    02 FILLER          PIC X(4)  VALUE 'NAME'.                   00000120
   000023                    02 FILLER          PIC X(13) VALUE SPACE.                    00000130  IMP
   000024                    02 FILLER          PIC X(10) VALUE 'FIRST NAME'.             00000140
   000025                    02 FILLER          PIC X(8)  VALUE SPACE.                    00000150  IMP
   000026                    02 FILLER          PIC X(3)  VALUE 'SEX'.                    00000160
   000027                01  HEADER2            PIC X(64) VALUE ALL '*'.                  00000170
   000028                01  SPACE-LINE         PIC X(80) VALUE SPACE.                    00000180  IMP
   000029                01  LINE1.                                                       00000190
   000030                    02 FILLER          PIC X(2)  VALUE SPACE.                    00000200  IMP
   000031                    02 PERSONNEL-NR    PIC X(8)  VALUE SPACE.                    00000210  IMP
   000032                    02 FILLER          PIC X(3)  VALUE SPACE.                    00000220  IMP
   000033                    02 LAST-NAME       PIC X(20) VALUE SPACE.                    00000230  IMP
   000034                    02 FILLER          PIC X(1)  VALUE SPACE.                    00000240  IMP
   000035                    02 F-NAME          PIC X(20) VALUE SPACE.                    00000250  IMP
   000036                    02 FILLER          PIC X(1)  VALUE SPACE.                    00000260  IMP
   000037                    02 KIND            PIC X(1)  VALUE SPACE.                    00000270  IMP
   000038               *
   000039               *
   000040               *         EXEC ADABAS
   000041               *    BEGIN DECLARE SECTION
   000042               *         END-EXEC
   000043               *
   000044                01  ADACODE PIC 9(4) COMP VALUE 0.                                ADABAS
   000045                01  CONTROL-BLOCKOPN.                                             ADABAS
   000046                    03 FILLER1OPN               PIC 9(4) COMP   VALUE 0.          ADABAS
   000047                    03 FILLER1-CHAROPN  REDEFINES FILLER1OPN  PIC XX.             ADABAS   46
   000048                    03 COMMAND-CODEOPN          PIC XX          VALUE SPACE.      ADABAS   IMP
   000049                    03 COMMAND-IDOPN            PIC X(4)        VALUE 'OPEN'.     ADABAS
   000050                    03 FILE-NUMBEROPN           PIC 9(4) COMP   VALUE     0.      ADABAS
   000051                    03 FILLER REDEFINES FILE-NUMBEROPN .                          ADABAS   50
   000052                       04 DBIDOPN  PIC X.                                         ADABAS
   000053                       04 FILLER PIC X.                                           ADABAS
   000054                    03 RESPONSE-CODEOPN         PIC 9(4) COMP   VALUE 0.          ADABAS
   000055                    03 ISNOPN                   PIC 9(9) COMP   VALUE 0.          ADABAS
   000056                    03 ISN-LOWER-LIMITOPN       PIC 9(9) COMP   VALUE 0.          ADABAS
   000057                    03 ISN-QUANTITYOPN          PIC 9(9) COMP   VALUE 0.          ADABAS
0  000058                    03 FORMAT-BUFFER-LENGTHOPN  PIC 9(4) COMP   VALUE     0.      ADABAS
   000059                    03 FBL-CHAROPN  REDEFINES FORMAT-BUFFER-LENGTHOPN  PIC XX.    ADABAS   58
   000060                    03 RECORD-BUFFER-LENGTHOPN  PIC 9(4) COMP   VALUE     0.      ADABAS
   000061                    03 RBL-CHAROPN  REDEFINES RECORD-BUFFER-LENGTHOPN  PIC XX.    ADABAS   60
   000062                    03 SEARCH-BUFFER-LENGTHOPN  PIC 9(4) COMP   VALUE     0.      ADABAS
   000063                    03 VALUE-BUFFER-LENGTHOPN   PIC 9(4) COMP   VALUE     0.      ADABAS
   000064                    03 ISN-BUFFER-LENGTHOPN     PIC 9(4) COMP   VALUE     4.      ADABAS
   000065                    03 COMMAND-OPTION-1OPN      PIC X           VALUE SPACE.      ADABAS   IMP
   000066                    03 COMMAND-OPTION-2OPN      PIC X           VALUE SPACE.      ADABAS   IMP
   000067                    03 ADDITIONS-1OPN                           VALUE SPACE.      ADABAS   IMP
   000068                      04 ADDITIONS-1-12OPN  PIC XX.                               ADABAS
   000069                      04 FILLER PIC XX.                                           ADABAS
   000070                      04 ADDITIONS-1-58OPN  PIC X(4).                             ADABAS
   000071                    03 FILLER REDEFINES ADDITIONS-1OPN .                          ADABAS   67
   000072                      04 ADDITIONS-1-BNOPN  PIC 9(4) COMP.                        ADABAS
   000073                      04 FILLER PIC X(6).                                         ADABAS
   000074                    03 ADDITIONS-2OPN           PIC X(4)        VALUE SPACE.      ADABAS   IMP
   000075                    03 ADDITIONS-3OPN           PIC X(8)        VALUE SPACE.      ADABAS   IMP
   000076                    03 ADDITIONS-4OPN           .                                 ADABAS
   000077                      04 ADDITIONS-4-12OPN PIC 9(4) COMP VALUE 0.                 ADABAS
   000078                      04 ADDITIONS-4-34OPN PIC 9(4) COMP VALUE 0.                 ADABAS
   000079                      04 ADDITIONS-4-56OPN PIC 9(4) COMP VALUE 0.                 ADABAS
   000080                      04 ADDITIONS-4-78OPN PIC 9(4) COMP VALUE 0.                 ADABAS
   000081                    03 ADDITIONS-5OPN           .                                 ADABAS
   000082                      04 ADDITIONS-5-BNOPN  PIC 9(9) COMP VALUE 0.                ADABAS
   000083                      04 ADDITIONS-5-58OPN  PIC X(4) VALUE SPACE.                 ADABAS   IMP
   000084                    03 FILLER REDEFINES ADDITIONS-5OPN .                          ADABAS   81
   000085                      04 ADDITIONS-5-1OPN  PIC X.                                 ADABAS
   000086                      04 ADDITIONS-5-28OPN  PIC X(7).                             ADABAS
   000087                    03 COMMAND-TIMEOPN          PIC 9(9) COMP.                    ADABAS
   000088                    03 USER-AREAOPN             PIC X(4)        VALUE '    '.     ADABAS
   000089                01  FORMAT-BUFOPN                        PIC X.                   ADABAS
   000090                01  SEARCH-BUFOPN                        PIC X.                   ADABAS
   000091                01  VALUE-BUFOPN                         PIC X.                   ADABAS
   000092                01  ISN-BUFOPN                           PIC X.                   ADABAS
   000093                01  OPENTYPE                             PIC X(00010).            ADABAS
   000094                01  RECORD-BUFOPN.                                                ADABAS
   000095                    02 RECORD-BUFOPN-01                  PIC X(00100).            ADABAS
   000096                    02 RECORD-BUFOPN-02                  PIC X(00100).            ADABAS
   000097                    02 RECORD-BUFOPN-03                  PIC X(00100).            ADABAS
   000098                    02 RECORD-BUFOPN-04                  PIC X(00100).            ADABAS
   000099                    02 RECORD-BUFOPN-05                  PIC X(00100).            ADABAS
   000100                    02 RECORD-BUFOPN-06                  PIC X(00100).            ADABAS
   000101                    02 RECORD-BUFOPN-07                  PIC X(00100).            ADABAS
   000102                    02 RECORD-BUFOPN-08                  PIC X(00100).            ADABAS
   000103                    02 RECORD-BUFOPN-09                  PIC X(00100).            ADABAS
   000104                    02 RECORD-BUFOPN-10                  PIC X(00100).            ADABAS
   000105                    02 RECORD-BUFOPN-11                  PIC X(00100).            ADABAS
   000106                    02 RECORD-BUFOPN-12                  PIC X(00100).            ADABAS
   000107                    02 RECORD-BUFOPN-13                  PIC X(00100).            ADABAS
   000108                    02 RECORD-BUFOPN-14                  PIC X(00100).            ADABAS
   000109                    02 RECORD-BUFOPN-15                  PIC X(00100).            ADABAS
   000110                01  DDFILE                      PIC 99999       VALUE     7.      ADABAS
   000111                01  DDDBID                      PIC 99999       VALUE 11177.      ADABAS
   000112                01  CSEQ                        PIC X(8).                         ADABAS
   000113                01  CLN1.                                                         ADABAS
   000114                    02 CLN1V PIC X(40) OCCURS 20.                                 ADABAS
0  000115                01  CLN2.                                                         ADABAS
   000116                    02 CLN2V PIC X(40) OCCURS 20.                                 ADABAS
   000117                01  CLNNUM                      PIC 9(4) COMP.                    ADABAS
   000118                01  TRCE                        PIC X(7).                         ADABAS
   000119                01  SQLRSP                      PIC 9(4) COMP.                    ADABAS
   000120                01  SQLQTY                      PIC 9(9) COMP.                    ADABAS
   000121                01  SQLISN                      PIC 9(9) COMP.                    ADABAS
   000122                01  ADA-FULL-INTOPN PIC 9(9) COMP VALUE 12288.                    ADABAS
   000123                01  FILLER REDEFINES ADA-FULL-INTOPN.                             ADABAS   122
   000124                    02 FILLER PIC XX.                                             ADABAS
   000125                    02 ADA-HALF-INTOPN PIC XX.                                    ADABAS
   000126                01  SAVE-DBID-1OPN              PIC 9(9) COMP   VALUE 0.          ADABAS
   000127                01  SAVE-DBID-DEFOPN  REDEFINES SAVE-DBID-1OPN .                  ADABAS   126
   000128                    02 FILLER PIC X(2).                                           ADABAS
   000129                    02 SAVE-DBIDOPN  PIC 9(4) COMP.                               ADABAS
   000130                01  FORMAT-BUFEMPL.                                               ADABAS
   000131                    02 FILLER PIC X(30) VALUE                                     ADABAS
   000132                    'AA,8,A,AE,20,A,AC,20,A,AG,1,A.'.                             ADABAS
   000133                01  SEARCH-BUFEMPL.                                               ADABAS
   000134                    02 FILLER PIC X(46) VALUE                                     ADABAS
   000135                    '(1,AA,2,AC)/1/AA,8,A,S,AA,8,A,D,/2/AO,24,A,GT.'.             ADABAS
   000136                01  EMPLOYEES.                                                    ADADATA
   000137                    02 RECORD-BUFEMPL.                                            ADADATA
   000138                     03 PERSONNEL-ID                     PIC X(00008).            ADADATA
   000139                     03 NAME                             PIC X(00020).            ADADATA
   000140                     03 FIRST-NAME                       PIC X(00020).            ADADATA
   000141                     03 SEX                              PIC X(00001).            ADADATA
   000142                    02 ISN                               PIC 9(9) COMP VALUE 0.   ADADATA
   000143                    02 QUANTITY                          PIC 9(9) COMP VALUE 0.   ADADATA
   000144                    02 RESPONSE-CODE                     PIC 9(4) COMP VALUE 0.   ADADATA
   000145                01  VALUE-BUFEMPL.                                                ADABAS
   000146                    02 V-PERSONNEL-ID-F                  PIC X(00008)             ADABAS
   000147                                                             VALUE LOW-VALUE.     ADABAS   IMP
   000148                    02 V-PERSONNEL-ID-T                  PIC X(00008)             ADABAS
   000149                                                             VALUE LOW-VALUE.     ADABAS   IMP
   000150                    02 V-MODEL-YEAR-MAKE.                                         ADABAS
   000151                     03 S-YEAR                           PIC  9(0004)             ADABAS
   000152                                                                    VALUE    0.   ADABAS
   000153                     03 S-MAKE                           PIC X(00020)             ADABAS
   000154                                                             VALUE LOW-VALUE.     ADABAS   IMP
   000155                01  ISN-BUFEMPL.                                                  ADABAS
   000156                    03 ISN-BUFVECEMPL OCCURS     1  PIC 9(9) COMP.                ADABAS
   000157                01  CONTROL-BLOCKEMPL.                                            ADABAS
   000158                    03 FILLER1EMPL              PIC 9(4) COMP   VALUE 0.          ADABAS
   000159                    03 FILLER1-CHAREMPL REDEFINES FILLER1EMPL PIC XX.             ADABAS   158
   000160                    03 COMMAND-CODEEMPL         PIC XX          VALUE SPACE.      ADABAS   IMP
   000161                    03 COMMAND-IDEMPL           PIC X(4)        VALUE 'EMPL'.     ADABAS
   000162                    03 FILE-NUMBEREMPL          PIC 9(4) COMP   VALUE     1.      ADABAS
   000163                    03 FILLER REDEFINES FILE-NUMBEREMPL.                          ADABAS   162
   000164                       04 DBIDEMPL PIC X.                                         ADABAS
   000165                       04 FILLER PIC X.                                           ADABAS
   000166                    03 RESPONSE-CODEEMPL        PIC 9(4) COMP   VALUE 0.          ADABAS
   000167                    03 ISNEMPL                  PIC 9(9) COMP   VALUE 0.          ADABAS
   000168                    03 ISN-LOWER-LIMITEMPL      PIC 9(9) COMP   VALUE 0.          ADABAS
   000169                    03 ISN-QUANTITYEMPL         PIC 9(9) COMP   VALUE 0.          ADABAS
   000170                    03 FORMAT-BUFFER-LENGTHEMPL PIC 9(4) COMP   VALUE    30.      ADABAS
   000171                    03 FBL-CHAREMPL REDEFINES FORMAT-BUFFER-LENGTHEMPL PIC XX.    ADABAS   170
0  000172                    03 RECORD-BUFFER-LENGTHEMPL PIC 9(4) COMP   VALUE    49.      ADABAS
   000173                    03 RBL-CHAREMPL REDEFINES RECORD-BUFFER-LENGTHEMPL PIC XX.    ADABAS   172
   000174                    03 SEARCH-BUFFER-LENGTHEMPL PIC 9(4) COMP   VALUE    46.      ADABAS
   000175                    03 VALUE-BUFFER-LENGTHEMPL  PIC 9(4) COMP   VALUE    40.      ADABAS
   000176                    03 ISN-BUFFER-LENGTHEMPL    PIC 9(4) COMP   VALUE     4.      ADABAS
   000177                    03 COMMAND-OPTION-1EMPL     PIC X           VALUE SPACE.      ADABAS   IMP
   000178                    03 COMMAND-OPTION-2EMPL     PIC X           VALUE SPACE.      ADABAS   IMP
   000179                    03 ADDITIONS-1EMPL                          VALUE SPACE.      ADABAS   IMP
   000180                      04 ADDITIONS-1-12EMPL PIC XX.                               ADABAS
   000181                      04 FILLER PIC XX.                                           ADABAS
   000182                      04 ADDITIONS-1-58EMPL PIC X(4).                             ADABAS
   000183                    03 FILLER REDEFINES ADDITIONS-1EMPL.                          ADABAS   179
   000184                      04 ADDITIONS-1-BNEMPL PIC 9(4) COMP.                        ADABAS
   000185                      04 FILLER PIC X(6).                                         ADABAS
   000186                    03 ADDITIONS-2EMPL          PIC X(4)        VALUE SPACE.      ADABAS   IMP
   000187                    03 ADDITIONS-3EMPL          PIC X(8)        VALUE SPACE.      ADABAS   IMP
   000188                    03 ADDITIONS-4EMPL          PIC X(8)        VALUE SPACE.      ADABAS   IMP
   000189                    03 ADDITIONS-5EMPL          .                                 ADABAS
   000190                      04 ADDITIONS-5-BNEMPL PIC 9(9) COMP VALUE 0.                ADABAS
   000191                      04 ADDITIONS-5-58EMPL PIC X(4) VALUE SPACE.                 ADABAS   IMP
   000192                    03 FILLER REDEFINES ADDITIONS-5EMPL.                          ADABAS   189
   000193                      04 ADDITIONS-5-1EMPL PIC X.                                 ADABAS
   000194                      04 ADDITIONS-5-28EMPL PIC X(7).                             ADABAS
   000195                    03 COMMAND-TIMEEMPL         PIC 9(9) COMP.                    ADABAS
   000196                    03 USER-AREAEMPL            PIC X(4)        VALUE '    '.     ADABAS
   000197                01  ISNSIZEEMPL  PIC 9(9) COMP.                                   ADABAS
   000198                01  ISNMOREEMPL  PIC 9(9) COMP.                                   ADABAS
   000199                01  ISNINDEMPL PIC 9(4) COMP.                                     ADABAS
   000200                01  EOF-COBEMPL PIC 9 VALUE 0.                                    ADABAS
   000201                    88 EOFEMPL VALUE 1.                                           ADABAS
   000202                    88 NOT-EOFEMPL VALUE 0.                                       ADABAS
   000203                01  SAVE-DBID-1EMPL             PIC 9(9) COMP   VALUE     0.      ADABAS
   000204                01  SAVE-DBID-DEFEMPL REDEFINES SAVE-DBID-1EMPL.                  ADABAS   203
   000205                    02 FILLER PIC X(2).                                           ADABAS
   000206                    02 SAVE-DBIDEMPL PIC 9(4) COMP.                               ADABAS
   000207               *
   000208               *
   000209               *         EXEC ADABAS
   000210               *    DECLARE EMPL CURSOR FOR
   000211               *    SELECT PERSONNEL-ID, NAME, FIRST-NAME,  SEX
   000212               *    FROM EMPLOYEES, VEHICLES
   000213               *    WHERE EMPLOYEES.PERSONNEL-ID = VEHICLES.PERSONNEL-ID
   000214               *          AND PERSONNEL-ID BETWEEN '10000001' AND '19999999'
   000215               *          AND VEHICLES.MODEL-YEAR-MAKE > :START-MODEL-YEAR-MAKE
   000216               *         END-EXEC
   000217               *
   000218                                                                                 00000280
   000219                PROCEDURE DIVISION.                                              00000290
   000220               *
   000221               *
   000222               *         EXEC ADABAS
   000223               *    TRACE ON
   000224               *         END-EXEC
   000225               *
   000226                    DISPLAY HEADER.                                              00000300  19
   000227                    DISPLAY HEADER2.                                             00000310  27
   000228                    DISPLAY SPACE-LINE.                                          00000320  28
0  000229               *
   000230               *
   000231               *         EXEC ADABAS
   000232               *    OPEN EMPL
   000233               *         END-EXEC
   000234               *
   000235                    MOVE '10000001' TO V-PERSONNEL-ID-F OF VALUE-BUFEMPL          ADABAS   146 145
   000236                    MOVE '19999999' TO V-PERSONNEL-ID-T OF VALUE-BUFEMPL          ADABAS   148 145
   000237                    MOVE START-MODEL-YEAR-MAKE TO V-MODEL-YEAR-MAKE OF            ADABAS   15 150
   000238                    VALUE-BUFEMPL                                                 ADABAS   145
   000239                    MOVE ADA-HALF-INTOPN TO FILLER1-CHAREMPL                      ADABAS   125 159
   000240                    COMPUTE ISNSIZEEMPL = ISN-BUFFER-LENGTHEMPL / 4               ADABAS   197 176
   000241                    MOVE 1 TO ISNINDEMPL                                          ADABAS   199
   000242                    MOVE 0 TO ISN-LOWER-LIMITEMPL                                 ADABAS   168
   000243                    MOVE 0                               TO ISN-QUANTITYEMPL      ADABAS   169
   000244                    MOVE ' ' TO COMMAND-OPTION-2EMPL                              ADABAS   178
   000245                    MOVE ' ' TO COMMAND-OPTION-1EMPL                              ADABAS   177
   000246                    MOVE 0 TO ISN-BUFFER-LENGTHEMPL                               ADABAS   176
   000247                    MOVE SAVE-DBIDEMPL TO RESPONSE-CODEEMPL                       ADABAS   206 166
   000248                    MOVE 'S1' TO COMMAND-CODEEMPL                                 ADABAS   160
   000249                    CALL 'ADABAS'   USING                                         ADABAS   EXT
   000250                            CONTROL-BLOCKEMPL FORMAT-BUFEMPL RECORD-BUFEMPL       ADABAS   157 130 137
   000251                            SEARCH-BUFEMPL VALUE-BUFEMPL                          ADABAS   133 145
   000252                            ISN-BUFEMPL                                           ADABAS   155
   000253                    MOVE ISNEMPL TO ISN OF                                        ADABAS   167 142
   000254                                             EMPLOYEES                            ADABAS   136
   000255                    MOVE RESPONSE-CODEEMPL TO RESPONSE-CODE OF                    ADABAS   166 144
   000256                                             EMPLOYEES                            ADABAS   136
   000257                    MOVE ISN-QUANTITYEMPL TO QUANTITY OF                          ADABAS   169 143
   000258                                             EMPLOYEES                            ADABAS   136
   000259                     MOVE 0 TO ISNINDEMPL                                         ADABAS   199
   000260                    IF RESPONSE-CODEEMPL NOT = 0                                  ADABAS   166
   000261      1             MOVE '        ' TO CSEQ                                       ADABAS   112
   000262      1             MOVE '                EXEC ADABAS             ' TO CLN1V (01) ADABAS   114
   000263      1             MOVE '                                        ' TO CLN2V (01) ADABAS   116
   000264      1             MOVE '           OPEN EMPL                    ' TO CLN1V (02) ADABAS   114
   000265      1             MOVE '                                        ' TO CLN2V (02) ADABAS   116
   000266      1             MOVE '                END-EXEC                ' TO CLN1V (03) ADABAS   114
   000267      1             MOVE '                                        ' TO CLN2V (03) ADABAS   116
   000268      1             MOVE 03 TO CLNNUM                                             ADABAS   117
   000269      1                 CALL 'RESPINT'                                            ADABAS   EXT
   000270      1                   USING CONTROL-BLOCKEMPL DDFILE CSEQ FORMAT-BUFEMPL      ADABAS   157 110 112 130
   000271      1                    RECORD-BUFEMPL SEARCH-BUFEMPL VALUE-BUFEMPL            ADABAS   137 133 145
   000272      1                    CLN1 CLN2 TRCE CLNNUM DDDBID.                          ADABAS   113 115 118 117 111
   000273                    MOVE ISN-QUANTITYEMPL TO ISNMOREEMPL                          ADABAS   169 198
   000274                    IF ISNMOREEMPL > 0 MOVE 0 TO EOF-COBEMPL                      ADABAS   198 200
   000275      1                           ELSE MOVE 1 TO EOF-COBEMPL.                     ADABAS   200
   000276                    IF ISNMOREEMPL < ISNSIZEEMPL                                  ADABAS   198 197
   000277      1                          MOVE ISNMOREEMPL TO ISNSIZEEMPL.                 ADABAS   198 197
   000278               *
   000279               *
   000280               *         EXEC ADABAS
   000281               *    FETCH EMPL
   000282               *         END-EXEC
   000283               *
   000284                    MOVE ADA-HALF-INTOPN TO FILLER1-CHAREMPL                      ADABAS   125 159
   000285                    IF ISNINDEMPL = ISNMOREEMPL MOVE 1 TO EOF-COBEMPL.            ADABAS   199 198 200
0  000286                    IF NOT-EOFEMPL                                                ADABAS   202
   000287      1             MOVE 0 TO EOF-COBEMPL                                         ADABAS   200
   000288      1             MOVE 'N' TO COMMAND-OPTION-2EMPL                              ADABAS   178
   000289      1             MOVE ' ' TO COMMAND-OPTION-1EMPL                              ADABAS   177
   000290      1             MOVE SAVE-DBIDEMPL TO RESPONSE-CODEEMPL                       ADABAS   206 166
   000291      1             MOVE 'L1' TO COMMAND-CODEEMPL                                 ADABAS   160
   000292      1             CALL 'ADABAS'   USING                                         ADABAS   EXT
   000293      1                     CONTROL-BLOCKEMPL FORMAT-BUFEMPL RECORD-BUFEMPL       ADABAS   157 130 137
   000294      1                     SEARCH-BUFEMPL VALUE-BUFEMPL                          ADABAS   133 145
   000295      1                     ISN-BUFEMPL                                           ADABAS   155
   000296      1             MOVE ISNEMPL TO ISN OF                                        ADABAS   167 142
   000297      1                                      EMPLOYEES                            ADABAS   136
   000298      1             MOVE RESPONSE-CODEEMPL TO RESPONSE-CODE OF                    ADABAS   166 144
   000299      1                                      EMPLOYEES                            ADABAS   136
   000300      1             IF RESPONSE-CODEEMPL = 3                                      ADABAS   166
   000301      2                MOVE 1 TO EOF-COBEMPL                                      ADABAS   200
   000302      2             ELSE IF RESPONSE-CODEEMPL NOT = 0                             ADABAS   166
   000303      3             MOVE '        ' TO CSEQ                                       ADABAS   112
   000304      3             MOVE '                EXEC ADABAS             ' TO CLN1V (01) ADABAS   114
   000305      3             MOVE '                                        ' TO CLN2V (01) ADABAS   116
   000306      3             MOVE '           FETCH EMPL                   ' TO CLN1V (02) ADABAS   114
   000307      3             MOVE '                                        ' TO CLN2V (02) ADABAS   116
   000308      3             MOVE '                END-EXEC                ' TO CLN1V (03) ADABAS   114
   000309      3             MOVE '                                        ' TO CLN2V (03) ADABAS   116
   000310      3             MOVE 03 TO CLNNUM                                             ADABAS   117
   000311      3                 CALL 'RESPINT'                                            ADABAS   EXT
   000312      3                   USING CONTROL-BLOCKEMPL DDFILE CSEQ FORMAT-BUFEMPL      ADABAS   157 110 112 130
   000313      3                    RECORD-BUFEMPL SEARCH-BUFEMPL VALUE-BUFEMPL            ADABAS   137 133 145
   000314      3                    CLN1 CLN2 TRCE CLNNUM DDDBID.                          ADABAS   113 115 118 117 111
   000315                    IF EOFEMPL MOVE 003 TO ADACODE                                ADABAS   201 44
   000316      1                   ELSE MOVE 0 TO ADACODE.                                 ADABAS   44
   000317               *
   000318                    PERFORM READ-EMPLOYEES UNTIL ADACODE = 3.                    00000330  383 44
   000319               *
   000320               *
   000321               *         EXEC ADABAS
   000322               *    CLOSE EMPL
   000323               *         END-EXEC
   000324               *
   000325                    MOVE ADA-HALF-INTOPN TO FILLER1-CHAREMPL                      ADABAS   125 159
   000326                    MOVE 'I' TO COMMAND-OPTION-1EMPL                              ADABAS   177
   000327                    MOVE 'S' TO COMMAND-OPTION-2EMPL                              ADABAS   178
   000328                    MOVE SAVE-DBIDEMPL TO RESPONSE-CODEEMPL                       ADABAS   206 166
   000329                    MOVE 'RC' TO COMMAND-CODEEMPL                                 ADABAS   160
   000330                    CALL 'ADABAS'   USING                                         ADABAS   EXT
   000331                            CONTROL-BLOCKEMPL FORMAT-BUFEMPL RECORD-BUFEMPL       ADABAS   157 130 137
   000332                            SEARCH-BUFEMPL VALUE-BUFEMPL                          ADABAS   133 145
   000333                            ISN-BUFEMPL                                           ADABAS   155
   000334                    MOVE ISNEMPL TO ISN OF                                        ADABAS   167 142
   000335                                             EMPLOYEES                            ADABAS   136
   000336                    MOVE RESPONSE-CODEEMPL TO RESPONSE-CODE OF                    ADABAS   166 144
   000337                                             EMPLOYEES                            ADABAS   136
   000338                    IF RESPONSE-CODEEMPL NOT = 0                                  ADABAS   166
   000339      1             MOVE '        ' TO CSEQ                                       ADABAS   112
   000340      1             MOVE '                EXEC ADABAS             ' TO CLN1V (01) ADABAS   114
   000341      1             MOVE '                                        ' TO CLN2V (01) ADABAS   116
   000342      1             MOVE '           CLOSE EMPL                   ' TO CLN1V (02) ADABAS   114
0  000343      1             MOVE '                                        ' TO CLN2V (02) ADABAS   116
   000344      1             MOVE '                END-EXEC                ' TO CLN1V (03) ADABAS   114
   000345      1             MOVE '                                        ' TO CLN2V (03) ADABAS   116
   000346      1             MOVE 03 TO CLNNUM                                             ADABAS   117
   000347      1                 CALL 'RESPINT'                                            ADABAS   EXT
   000348      1                   USING CONTROL-BLOCKEMPL DDFILE CSEQ FORMAT-BUFEMPL      ADABAS   157 110 112 130
   000349      1                    RECORD-BUFEMPL SEARCH-BUFEMPL VALUE-BUFEMPL            ADABAS   137 133 145
   000350      1                    CLN1 CLN2 TRCE CLNNUM DDDBID.                          ADABAS   113 115 118 117 111
   000351               *
   000352               *
   000353               *         EXEC ADABAS
   000354               *    DBCLOSE
   000355               *         END-EXEC
   000356               *
   000357                    MOVE ADA-HALF-INTOPN TO FILLER1-CHAROPN                       ADABAS   125 47
   000358                    MOVE  1500 TO RECORD-BUFFER-LENGTHOPN                         ADABAS   60
   000359                    MOVE ' ' TO COMMAND-OPTION-2OPN                               ADABAS   66
   000360                    MOVE ' ' TO COMMAND-OPTION-1OPN                               ADABAS   65
   000361                    MOVE SAVE-DBIDOPN  TO RESPONSE-CODEOPN                        ADABAS   129 54
   000362                    MOVE 'CL' TO COMMAND-CODEOPN                                  ADABAS   48
   000363                    CALL 'ADABAS'   USING                                         ADABAS   EXT
   000364                            CONTROL-BLOCKOPN  FORMAT-BUFOPN  RECORD-BUFOPN        ADABAS   45 89 94
   000365                            SEARCH-BUFOPN  VALUE-BUFOPN                           ADABAS   90 91
   000366                            ISN-BUFOPN                                            ADABAS   92
   000367                    IF RESPONSE-CODEOPN  NOT = 0                                  ADABAS   54
   000368      1             MOVE '        ' TO CSEQ                                       ADABAS   112
   000369      1             MOVE '                EXEC ADABAS             ' TO CLN1V (01) ADABAS   114
   000370      1             MOVE '                                        ' TO CLN2V (01) ADABAS   116
   000371      1             MOVE '           DBCLOSE                      ' TO CLN1V (02) ADABAS   114
   000372      1             MOVE '                                        ' TO CLN2V (02) ADABAS   116
   000373      1             MOVE '                END-EXEC                ' TO CLN1V (03) ADABAS   114
   000374      1             MOVE '                                        ' TO CLN2V (03) ADABAS   116
   000375      1             MOVE 03 TO CLNNUM                                             ADABAS   117
   000376      1                 CALL 'RESPINT'                                            ADABAS   EXT
   000377      1                   USING CONTROL-BLOCKOPN  DDFILE CSEQ FORMAT-BUFOPN       ADABAS   45 110 112 89
   000378      1                    RECORD-BUFOPN  SEARCH-BUFOPN  VALUE-BUFOPN             ADABAS   94 90 91
   000379      1                    CLN1 CLN2 TRCE CLNNUM DDDBID.                          ADABAS   113 115 118 117 111
   000380               *
   000381                    STOP RUN.                                                    00000340
   000382               *
   000383                READ-EMPLOYEES.                                                  00000350
   000384                    MOVE PERSONNEL-ID TO PERSONNEL-NR.                           00000360  138 31
   000385                    MOVE NAME TO LAST-NAME.                                      00000370  139 33
   000386                    MOVE FIRST-NAME TO F-NAME.                                   00000380  140 35
   000387                    MOVE SEX TO KIND.                                            00000390  141 37
   000388                    DISPLAY LINE1.                                               00000400  29
   000389                    MOVE SPACE TO LINE1.                                         00000410  IMP 29
   000390               *
   000391               *                                                                 00000420
   000392               *         EXEC ADABAS                                             00000430
   000393               *    FETCH EMPL                                                   00000440
   000394               *         END-EXEC                                                00000450
   000395               *                                                                 00000460
   000396                    MOVE ADA-HALF-INTOPN TO FILLER1-CHAREMPL                      ADABAS   125 159
   000397                    IF ISNINDEMPL = ISNMOREEMPL MOVE 1 TO EOF-COBEMPL.            ADABAS   199 198 200
   000398                    IF NOT-EOFEMPL                                                ADABAS   202
   000399      1             MOVE 0 TO EOF-COBEMPL                                         ADABAS   200
0  000400      1             MOVE 'N' TO COMMAND-OPTION-2EMPL                              ADABAS   178
   000401      1             MOVE ' ' TO COMMAND-OPTION-1EMPL                              ADABAS   177
   000402      1             MOVE SAVE-DBIDEMPL TO RESPONSE-CODEEMPL                       ADABAS   206 166
   000403      1             MOVE 'L1' TO COMMAND-CODEEMPL                                 ADABAS   160
   000404      1             CALL 'ADABAS'   USING                                         ADABAS   EXT
   000405      1                     CONTROL-BLOCKEMPL FORMAT-BUFEMPL RECORD-BUFEMPL       ADABAS   157 130 137
   000406      1                     SEARCH-BUFEMPL VALUE-BUFEMPL                          ADABAS   133 145
   000407      1                     ISN-BUFEMPL                                           ADABAS   155
   000408      1             MOVE ISNEMPL TO ISN OF                                        ADABAS   167 142
   000409      1                                      EMPLOYEES                            ADABAS   136
   000410      1             MOVE RESPONSE-CODEEMPL TO RESPONSE-CODE OF                    ADABAS   166 144
   000411      1                                      EMPLOYEES                            ADABAS   136
   000412      1             IF RESPONSE-CODEEMPL = 3                                      ADABAS   166
   000413      2                MOVE 1 TO EOF-COBEMPL                                      ADABAS   200
   000414      2             ELSE IF RESPONSE-CODEEMPL NOT = 0                             ADABAS   166
   000415      3             MOVE '        ' TO CSEQ                                       ADABAS   112
   000416      3             MOVE '                EXEC ADABAS             ' TO CLN1V (01) ADABAS   114
   000417      3             MOVE '                                        ' TO CLN2V (01) ADABAS   116
   000418      3             MOVE '           FETCH EMPL                   ' TO CLN1V (02) ADABAS   114
   000419      3             MOVE '                                        ' TO CLN2V (02) ADABAS   116
   000420      3             MOVE '                END-EXEC                ' TO CLN1V (03) ADABAS   114
   000421      3             MOVE '                                        ' TO CLN2V (03) ADABAS   116
   000422      3             MOVE 03 TO CLNNUM                                             ADABAS   117
   000423      3                 CALL 'RESPINT'                                            ADABAS   EXT
   000424      3                   USING CONTROL-BLOCKEMPL DDFILE CSEQ FORMAT-BUFEMPL      ADABAS   157 110 112 130
   000425      3                    RECORD-BUFEMPL SEARCH-BUFEMPL VALUE-BUFEMPL            ADABAS   137 133 145
   000426      3                    CLN1 CLN2 TRCE CLNNUM DDDBID.                          ADABAS   113 115 118 117 111
   000427                    IF EOFEMPL MOVE 003 TO ADACODE                                ADABAS   201 44
   000428      1                   ELSE MOVE 0 TO ADACODE.                                 ADABAS   44

Top of page