— 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
