22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 1 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0001 OPTIONS/EXTEND 0002 SUBROUTINE DBWRT$PUT_LIST( USRDB$REC, SEL_FIDS, SCNT, LUN ) 0003 C 0004 C *************************************************************************** 0005 C 0006 C ** PURPOSE: OUTPUT DATA TO FILE, IN INTERNAL FORMAT WITH FIELD DIVIDERS. 0007 C 0008 C OUTPUT FORMAT. 0009 C FIELD DIVIDER IS A E BETWEEN FIELDS. 0010 C LAST CHARACTER OF DATA RECORD IS ALWAYS A P. 0011 C LENGTH OF THE STRING BETWEEN FIELD DIVIDERS IS THE LENGTH OF THE USERDB FIELD. 0012 C 0013 C *************************************************************************** 0014 C 0015 C ** INCLUDE FILE FOR WHERE EVALUATIONS. 0016 C 0017 INCLUDE 'LIFE_DEV:DB_PARAMS.INC/NOLIST' 0162 INCLUDE 'LIFE_DEV:DB_INTERN.INC/NOLIST' 0200 INCLUDE 'LIFE_DEV:DB_FUNCS.INC/NOLIST' 0221 INCLUDE 'LIFE_DEV:DB_CROSS.INC/NOLIST' 0342 C 0343 C ** LOCAL VARIABLE DEFINITIONS. 0344 C 0345 INTEGER*4 LUN, SCNT, SEL_FIDS(USRDB$_NUM_FIELDS), LSLEN, FIELD_LEN, 0346 & SPNT, EPNT 0347 CHARACTER LOCSTR*80, DMPSTR*5, OUSTR*1062, COM*1, PER*1 0348 C 0349 C ** INITIALIZE LOCAL VARIABLES. 0350 C 0351 SPNT = 1 0352 COM = CHAR(5) 0353 PER = CHAR(16) 0354 C 0355 C ** RETRIEVE EACH DB FIELD FROM THE RECORD AND WRITE TO FILE. 0356 C 0357 DO JJ = 1,SCNT 0358 C 0359 C ** INITIALIZE LOCAL BUFFER STRING AND ITS LENGTH. 0360 C 0361 LOCSTR = ' ' 0362 LSLEN = 0 0363 C 0364 C ** GET THE FIELD SPECIFIED. 0365 C 0366 ISTAT = USRDB$GET_FIELD( USRDB$REC, SEL_FIDS(JJ), LOCSTR, LSLEN ) 0367 C 0368 C ** IF SUCCESS THEN PROCESS THE FIELD RETRIEVED. 0369 C 0370 IF (ISTAT .EQ. USRDB$_SUCCESS) THEN 0371 C 0372 C ** GET THE FIELD LOCATION IN DATABASE, AND ITS LENGTH FOR OUTPUT. 0373 C 0374 ISTAT2 = USRDB$LOCATE( SEL_FIDS(JJ), LPNTR ) 0375 C 0376 FIELD_LEN = USRDB$_CROSS_FLEN(LPNTR) 0377 C 0378 C ** CALCULATE THE END POINT OF THE STRING TO PROCESSED. DBWRT$PUT_LIST 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 2 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0379 C 0380 EPNT = SPNT + FIELD_LEN 0381 C 0382 C ** IF NOT LAST FIELD BEING PROCESSED, PUT BUFFER INTO OUTPUT STRING, AND A DIVIDER CHAR. 0383 C 0384 IF (JJ .NE. SCNT) THEN 0385 OUSTR(SPNT:EPNT) = LOCSTR(1:FIELD_LEN)//COM//' ' 0386 SPNT = EPNT + 1 0387 ELSE 0388 C 0389 C ** LAST FIELD BEING PROCESSED, PUT BUFFER INTO OUTPUT STRING AND AN END RECORD CHARACTER. 0390 C 0391 OUSTR(SPNT:EPNT) = LOCSTR(1:FIELD_LEN)//PER//' ' 0392 C 0393 C ** WRITE THE RECORD TO THE INTERNAL FORMAT FILE. 0394 C 0395 WRITE(LUN,1000) OUSTR 0396 C 0397 ENDIF 0398 C 0399 ENDIF 0400 C 0401 ENDDO 0402 C 0403 1000 FORMAT(A) 0404 C 0405 RETURN 0406 END DBWRT$PUT_LIST 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 3 01 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 284 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 7 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 3552 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 3843 ENTRY POINTS Address Type Name 0-00000000 DBWRT$PUT_LIST VARIABLES Address Type Name Address Type Name 2-00000D82 CHAR COM ** I*4 DBCPY$COPY ** I*4 DBCRS$FIELD_IDENT ** I*4 DBEVL$COMPOSE ** I*4 DBEVL$DEF_SORT ** I*4 DBEVL$LOGICAL ** I*4 DBEVL$PARSE ** I*4 DBEVL$SELECT ** I*4 DBEVL$SORT ** I*4 DBEVL$UPDATE ** I*4 DBEVL$WHERE ** CHAR DMPSTR 2-00000D88 I*4 EPNT ** I*4 FIELD_LEN ** I*4 ISTAT ** I*4 ISTAT2 ** I*4 JJ 2-0000090C CHAR LOCSTR 2-00000D90 I*4 LPNTR 2-00000D84 I*4 LSLEN AP-00000010@ I*4 LUN 2-0000095C CHAR OUSTR 2-00000D83 CHAR PER AP-0000000C@ I*4 SCNT ** I*4 SPNT ** I*4 USRDB$CLEAR_RECORD ** I*4 USRDB$DELETE_RECORD ** I*4 USRDB$GET_DUMP ** I*4 USRDB$GET_INIT ** I*4 USRDB$GET_RECORD ** I*4 USRDB$PUT_DUMP ** I*4 USRDB$PUT_FIELD ** I*4 USRDB$PUT_RECORD AP-00000004@ CHAR USRDB$REC ** I*4 USRDB$SQL ** I*4 USRDB$UPDATE_RECORD RECORDS Address Name Structure Bytes 2-00000130 DBINT USRDB$INTERNAL 1024 ARRAYS Address Type Name Bytes Dimensions AP-00000008@ I*4 SEL_FIDS 152 (38) 2-00000000 I*4 USRDB$_CROSS_FID 152 (38) 2-00000098 I*4 USRDB$_CROSS_FLEN 152 (38) 2-000002F8 CHAR USRDB$_DEFAULT 228 (38) DBWRT$PUT_LIST 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 4 01 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 2-0000023A CHAR USRDB$_DMPSTR 190 (38) 2-00000000 CHAR USRDB$_IDENTS 570 (38) LABELS Address Label 1-00000000 1000' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name I*4 USRDB$GET_FIELD I*4 USRDB$LOCATE OPTIONS QUALIFIERS /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /EXTEND_SOURCE /F77 /NOG_FLOATING /I4 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 5 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0002 OPTIONS/EXTEND 0003 SUBROUTINE DBWRT$DUMP_FIDS( USRDB$REC, SEL_FIDS, SCNT, LUN ) 0004 C 0005 C *************************************************************************** 0006 C 0007 C ** PURPOSE: OUTPUT DATA IN DUMP FORMAT TO FILE. 0008 C 0009 C *************************************************************************** 0010 C 0011 C ** INCLUDE FILE FOR WHERE EVALUATIONS. 0012 C 0013 INCLUDE 'LIFE_DEV:DB_PARAMS.INC/NOLIST' 0158 INCLUDE 'LIFE_DEV:DB_INTERN.INC/NOLIST' 0196 INCLUDE 'LIFE_DEV:DB_FUNCS.INC/NOLIST' 0217 INCLUDE 'LIFE_DEV:DB_CROSS.INC/NOLIST' 0338 C 0339 C ** DECLARE LOCAL VARIABLES. 0340 C 0341 INTEGER*4 LUN, SCNT, SEL_FIDS(USRDB$_NUM_FIELDS), LSLEN, FIELD_LEN 0342 CHARACTER LOCSTR*80, DMPSTR*5 0343 C 0344 C ** BEGIN THE LOOP TO WRITE THE DUMP FORMAT FILE. 0345 C 0346 DO JJ = 1,SCNT 0347 C 0348 C ** INITIALIZE LOCAL BUFFER AND ITS LENGTH. 0349 C 0350 LOCSTR = ' ' 0351 LSLEN = 0 0352 C 0353 C ** GET THE USERDB FIELD TO BE DUMPED. 0354 C 0355 ISTAT = USRDB$GET_FIELD( USRDB$REC, SEL_FIDS(JJ), LOCSTR, LSLEN ) 0356 C 0357 C ** SUCCESSFUL FIELD RETRIEVAL. 0358 C 0359 IF (ISTAT .EQ. USRDB$_SUCCESS) THEN 0360 C 0361 C ** LOCATE FIELD RETRIEVED. 0362 C 0363 ISTAT2 = USRDB$LOCATE( SEL_FIDS(JJ), LPNTR ) 0364 C 0365 C ** GET FIELD IDENTIFIER FOR DUMP FORMAT. 0366 C 0367 DMPSTR = USRDB$_DMPSTR(LPNTR) 0368 C 0369 C ** WRITE THE DUMP RECORD FOR THE FIELD RETRIEVED. 0370 C 0371 WRITE(LUN,1000) DMPSTR, LOCSTR(1:LSLEN) 0372 C 0373 ENDIF 0374 C 0375 ENDDO 0376 C 0377 C ** CLOSE THE DUMP FOR THIS USERDB RECORD. 0378 C DBWRT$DUMP_FIDS 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 6 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0379 WRITE(LUN,3000) 0380 C 0381 1000 FORMAT(A5,A) 0382 3000 FORMAT('%FIN') 0383 C 0384 RETURN 0385 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 199 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 16 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 2500 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 2715 ENTRY POINTS Address Type Name 0-00000000 DBWRT$DUMP_FIDS VARIABLES Address Type Name Address Type Name ** I*4 DBCPY$COPY ** I*4 DBCRS$FIELD_IDENT ** I*4 DBEVL$COMPOSE ** I*4 DBEVL$DEF_SORT ** I*4 DBEVL$LOGICAL ** I*4 DBEVL$PARSE ** I*4 DBEVL$SELECT ** I*4 DBEVL$SORT ** I*4 DBEVL$UPDATE ** I*4 DBEVL$WHERE 2-0000095C CHAR DMPSTR ** I*4 FIELD_LEN ** I*4 ISTAT ** I*4 ISTAT2 ** I*4 JJ 2-0000090C CHAR LOCSTR 2-0000096C I*4 LPNTR 2-00000964 I*4 LSLEN AP-00000010@ I*4 LUN AP-0000000C@ I*4 SCNT ** I*4 USRDB$CLEAR_RECORD ** I*4 USRDB$DELETE_RECORD ** I*4 USRDB$GET_DUMP ** I*4 USRDB$GET_INIT ** I*4 USRDB$GET_RECORD ** I*4 USRDB$PUT_DUMP ** I*4 USRDB$PUT_FIELD ** I*4 USRDB$PUT_RECORD AP-00000004@ CHAR USRDB$REC ** I*4 USRDB$SQL ** I*4 USRDB$UPDATE_RECORD DBWRT$DUMP_FIDS 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 7 01 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 RECORDS Address Name Structure Bytes 2-00000130 DBINT USRDB$INTERNAL 1024 ARRAYS Address Type Name Bytes Dimensions AP-00000008@ I*4 SEL_FIDS 152 (38) 2-00000000 I*4 USRDB$_CROSS_FID 152 (38) 2-00000098 I*4 USRDB$_CROSS_FLEN 152 (38) 2-000002F8 CHAR USRDB$_DEFAULT 228 (38) 2-0000076A CHAR USRDB$_DMPSTR 190 (38) 2-00000000 CHAR USRDB$_IDENTS 570 (38) LABELS Address Label Address Label 1-00000000 1000' 1-00000009 3000' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name I*4 USRDB$GET_FIELD I*4 USRDB$LOCATE OPTIONS QUALIFIERS /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /EXTEND_SOURCE /F77 /NOG_FLOATING /I4 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 8 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0002 OPTIONS/EXTEND 0003 SUBROUTINE DBWRT$PUT_OUTPUT( USRDB$REC, SEL_FIDS, SCNT, LUN ) 0004 C 0005 C *****************************************************(********************* 0006 C 0007 C ** PURPOSE: DISPLAY OUTPUT ONE FIELD PER LINE ON SCREEN, WITH DEFINITION. 0008 C 0009 C *************************************************************************** 0010 C 0011 C ** INCLUDE FILE FOR WHERE EVALUATIONS. 0012 C 0013 INCLUDE 'LIFE_DEV:DB_PARAMS.INC/NOLIST' 0158 INCLUDE 'LIFE_DEV:DB_INTERN.INC/NOLIST' 0196 INCLUDE 'LIFE_DEV:DB_FUNCS.INC/NOLIST' 0217 INCLUDE 'LIFE_DEV:DB_CROSS.INC/NOLIST' 0338 C 0339 C ** DECLARE LOCAL VARIABLES. 0340 C 0341 INTEGER*4 LUN, SCNT, SEL_FIDS(USRDB$_NUM_FIELDS), LSLEN, NMLEN 0342 CHARACTER LOCSTR*80, IDSTR*80 0343 C 0344 C ** BEGIN LOOP TO DISPLAY FIELDS SPECIFIED. 0345 C 0346 DO JJ = 1,SCNT 0347 C 0348 C ** INITIALIZE BUFFER AND LENGTH. 0349 C 0350 LOCSTR = ' ' 0351 LSLEN = 0 0352 C 0353 C ** GET FIELD SPECIFIED. 0354 C 0355 ISTAT = USRDB$GET_FIELD( USRDB$REC, SEL_FIDS(JJ), LOCSTR, LSLEN ) 0356 C 0357 C ** SUCCESSFUL GET OF FIELD. 0358 C 0359 IF (ISTAT .EQ. USRDB$_SUCCESS) THEN 0360 C 0361 C ** LOCATE FIELD. 0362 C 0363 ISTAT2 = USRDB$LOCATE( SEL_FIDS(JJ), LPNTR ) 0364 C 0365 C ** GET FIELD DISCRIPTION. 0366 C 0367 CALL STR$TRIM( IDSTR, USRDB$_IDENTS(LPNTR), NMLEN ) 0368 C 0369 C ** WRITE DISCRIPTION AND FIELD VALUE. 0370 C 0371 WRITE(LUN,1000) IDSTR, LOCSTR 0372 C 0373 ENDIF 0374 C 0375 ENDDO 0376 C 0377 C ** WRITE RECORD BREAK POINT. 0378 C DBWRT$PUT_OUTPUT 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 9 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0379 WRITE(LUN,2000) 0380 C 0381 1000 FORMAT(A,' = ',A) 0382 2000 FORMAT('.................. Record Break ..................') 0383 C 0384 RETURN 0385 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 208 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 71 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 2592 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 2871 ENTRY POINTS Address Type Name 0-00000000 DBWRT$PUT_OUTPUT VARIABLES Address Type Name Address Type Name ** I*4 DBCPY$COPY ** I*4 DBCRS$FIELD_IDENT ** I*4 DBEVL$COMPOSE ** I*4 DBEVL$DEF_SORT ** I*4 DBEVL$LOGICAL ** I*4 DBEVL$PARSE ** I*4 DBEVL$SELECT ** I*4 DBEVL$SORT ** I*4 DBEVL$UPDATE ** I*4 DBEVL$WHERE 2-0000095C CHAR IDSTR ** I*4 ISTAT ** I*4 ISTAT2 ** I*4 JJ 2-0000090C CHAR LOCSTR 2-000009B8 I*4 LPNTR 2-000009AC I*4 LSLEN AP-00000010@ I*4 LUN 2-000009B0 I*4 NMLEN AP-0000000C@ I*4 SCNT ** I*4 USRDB$CLEAR_RECORD ** I*4 USRDB$DELETE_RECORD ** I*4 USRDB$GET_DUMP ** I*4 USRDB$GET_INIT ** I*4 USRDB$GET_RECORD ** I*4 USRDB$PUT_DUMP ** I*4 USRDB$PUT_FIELD ** I*4 USRDB$PUT_RECORD AP-00000004@ CHAR USRDB$REC ** I*4 USRDB$SQL ** I*4 USRDB$UPDATE_RECORD DBWRT$PUT_OUTPUT 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 10 01 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 RECORDS Address Name Structure Bytes 2-00000130 DBINT USRDB$INTERNAL 1024 ARRAYS Address Type Name Bytes Dimensions AP-00000008@ I*4 SEL_FIDS 152 (38) 2-00000000 I*4 USRDB$_CROSS_FID 152 (38) 2-00000098 I*4 USRDB$_CROSS_FLEN 152 (38) 2-000002F8 CHAR USRDB$_DEFAULT 228 (38) 2-0000023A CHAR USRDB$_DMPSTR 190 (38) 2-00000530 CHAR USRDB$_IDENTS 570 (38) LABELS Address Label Address Label 1-00000000 1000' 1-00000012 2000' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name STR$TRIM I*4 USRDB$GET_FIELD I*4 USRDB$LOCATE OPTIONS QUALIFIERS /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /EXTEND_SOURCE /F77 /NOG_FLOATING /I4 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 11 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0002 OPTIONS/EXTEND 0003 SUBROUTINE DBWRT$PUT_SCREEN( USRDB$REC, SEL_FIDS, SCNT, LUN, DLUN ) 0004 C 0005 C *************************************************************************** 0006 C 0007 C ** PURPOSE: DISPLAY OUTPUT IN 'LLUD' FORMAT TO SCREEN. 0008 C 0009 C *************************************************************************** 0010 C 0011 C ** INCLUDE FILE FOR WHERE EVALUATIONS. 0012 C 0013 INCLUDE 'LIFE_DEV:DB_PARAMS.INC/NOLIST' 0158 INCLUDE 'LIFE_DEV:DB_INTERN.INC/NOLIST' 0196 INCLUDE 'LIFE_DEV:DB_FUNCS.INC/NOLIST' 0217 INCLUDE 'LIFE_DEV:DB_FIELDS.INC/NOLIST' 0239 C 0240 C ** DECLARE LOCAL VARIABLES. 0241 C 0242 INTEGER*4 LUN, DLUN, SCNT, SEL_FIDS(USRDB$_NUM_FIELDS), LSLEN 0243 CHARACTER LOCSTR*80, IDSTR*80 0244 C 0245 C ** INITIALIZE BUFFER AND LENGTH. 0246 C 0247 LOCSTR = ' ' 0248 LSLEN = 0 0249 C 0250 C ** GET FIELDS SPECEFIED FOR LLUD FORMAT OUTPUT. 0251 C 0252 ISTAT = USRDB$GET_FIELD( USRDB$REC, SEL_FIDS(1), LAST_NAME, LEN_LAST ) 0253 ISTAT = USRDB$GET_FIELD( USRDB$REC, SEL_FIDS(2), FRST_NAME, LEN_FRST ) 0254 ISTAT = USRDB$GET_FIELD( USRDB$REC, SEL_FIDS(3), MIDDLE_INIT, LSLEN ) 0255 ISTAT = USRDB$GET_FIELD( USRDB$REC, SEL_FIDS(4), INSTITUTION, LSLEN ) 0256 ISTAT = USRDB$GET_FIELD( USRDB$REC, SEL_FIDS(5), USER_IDENT, LEN_USER ) 0257 C 0258 C ** WRITE OUT RECORD ELEMENTS OBTAINED. 0259 C 0260 IF (MIDDLE_INIT .NE. ' ') THEN 0261 C 0262 C ** NO MIDDLE INITIAL OUTPUT. 0263 C 0264 WRITE(LUN,7000) LAST_NAME, FRST_NAME, MIDDLE_INIT, 0265 * INSTITUTION, USER_IDENT 0266 WRITE(DLUN,8000) USER_IDENT, LAST_NAME, FRST_NAME, MIDDLE_INIT, 0267 * INSTITUTION 0268 ELSE 0269 C 0270 C ** OUTPUT WITH MIDDLE INITIAL. 0271 C 0272 WRITE(LUN,7001) LAST_NAME, FRST_NAME, 0273 * INSTITUTION, USER_IDENT 0274 WRITE(DLUN,8001) USER_IDENT, LAST_NAME, FRST_NAME, 0275 * INSTITUTION 0276 C 0277 ENDIF 0278 C 0279 C ** RETURN TO CALLING PROGRAM. DBWRT$PUT_SCREEN 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 12 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0280 C 0281 RETURN 0282 C 0283 7000 FORMAT(' ',A,',',A,' ',A1,'.',T25, 0284 * A40,3X, 0285 * A) 0286 7001 FORMAT(' ',A,',',A,' ',2X,T25, 0287 * A40,3X, 0288 * A) 0289 8000 FORMAT(A,T15,'| ' 0290 * A,',',A,' ',A1,'.',T41,A33) 0291 0292 8001 FORMAT(A,T15,'| ' 0293 * A,',',A,T41,A33) 0294 C 0295 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 421 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 147 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 1344 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 1912 ENTRY POINTS Address Type Name 0-00000000 DBWRT$PUT_SCREEN VARIABLES Address Type Name Address Type Name ** CHAR ACCESS_CONTROL ** CHAR AREA_CODE ** CHAR AUTO_INFO ** CHAR CITY_NAME ** CHAR COMMENTS ** CHAR COUNTRY ** I*4 DBCPY$COPY ** I*4 DBCRS$FIELD_IDENT ** I*4 DBEVL$COMPOSE ** I*4 DBEVL$DEF_SORT ** I*4 DBEVL$LOGICAL ** I*4 DBEVL$PARSE ** I*4 DBEVL$SELECT ** I*4 DBEVL$SORT ** I*4 DBEVL$UPDATE ** I*4 DBEVL$WHERE ** CHAR DEPARTMENT AP-00000014@ I*4 DLUN ** CHAR DOMAIN_ID ** CHAR FAX_INFO 2-00000420 CHAR FRST_NAME ** CHAR IDSTR 2-00000435 CHAR INSTITUTION ** I*4 ISTAT 2-0000040C CHAR LAST_NAME 2-00000490 I*4 LEN_FRST 2-0000048C I*4 LEN_LAST 2-00000494 I*4 LEN_USER ** CHAR LIFE_USAGE ** CHAR LOCATION DBWRT$PUT_SCREEN 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 13 01 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 ** CHAR LOCSTR 2-00000488 I*4 LSLEN AP-00000010@ I*4 LUN ** CHAR MAIL_STOP 2-00000434 CHAR MIDDLE_INIT ** CHAR NAME_TITLE ** CHAR NETWORK_ID ** CHAR NODE_ID ** CHAR NOTIFY ** CHAR OTHER_DOMAIN ** CHAR OTHER_NET ** CHAR OTHER_NODE ** CHAR OTHER_USER ** CHAR PHONE_NMBR ** CHAR PRIM_ACTIVITY ** CHAR PRIM_WORK ** CHAR PRIN_EMPLOYER ** CHAR REMOTE_USER AP-0000000C@ I*4 SCNT ** CHAR SEC_ACTIVITY ** CHAR SEC_WORK ** CHAR SHORT_INSTITUTE ** CHAR STATE ** CHAR STREET_ADR_1 ** CHAR STREET_ADR_2 ** CHAR TIME_ZONE 2-00000400 CHAR USER_IDENT ** I*4 USRDB$CLEAR_RECORD ** I*4 USRDB$DELETE_RECORD ** I*4 USRDB$GET_DUMP ** I*4 USRDB$GET_INIT ** I*4 USRDB$GET_RECORD ** I*4 USRDB$LOCATE ** I*4 USRDB$PUT_DUMP ** I*4 USRDB$PUT_FIELD ** I*4 USRDB$PUT_RECORD AP-00000004@ CHAR USRDB$REC ** I*4 USRDB$SQL ** I*4 USRDB$UPDATE_RECORD ** CHAR ZIP_CODE RECORDS Address Name Structure Bytes 2-00000000 DBINT USRDB$INTERNAL 1024 ARRAYS Address Type Name Bytes Dimensions AP-00000008@ I*4 SEL_FIDS 152 (38) LABELS Address Label Address Label Address Label Address Label 1-00000000 7000' 1-00000027 7001' 1-0000004B 8000' 1-00000073 8001' FUNCTIONS AND SUBROUTINES REFERENCED Type Name I*4 USRDB$GET_FIELD OPTIONS QUALIFIERS /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /EXTEND_SOURCE /F77 /NOG_FLOATING /I4 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 14 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0002 OPTIONS/EXTEND 0003 FUNCTION DBEVL$SELECT( SELSTR, SEL_FIDS, SCNT, TLEN ) 0004 C 0005 C *************************************************************************** 0006 C 0007 C ** PURPOSE: EVALUATE STRINGS PROVIDED WITH SELECT COMMAND. 0008 C 0009 C *************************************************************************** 0010 C 0011 C ** INCLUDE FILE FOR WHERE EVALUATIONS. 0012 C 0013 INCLUDE 'LIFE_DEV:DB_PARAMS.INC/NOLIST' 0158 INCLUDE 'LIFE_DEV:DB_FUNCS.INC/NOLIST' 0179 INCLUDE 'LIFE_DEV:DB_CROSS.INC/NOLIST' 0300 C 0301 C ** DECLARE LOCAL VARIABLES. 0302 C 0303 CHARACTER SELSTR*(*), LOCSTR*15 0304 INTEGER*4 SEL_FIDS(USRDB$_NUM_FIELDS), SCNT, SLEN, TLEN, 0305 & FNDCOM, ENDSTR 0306 C 0307 C ** INITIALIZE RETURN VALUE OF FUNCTION. 0308 C 0309 DBEVL$SELECT = USRDB$_FAILURE 0310 C 0311 C ** TRIM DOWN THE PASSED STRING, AND GET ITS LENGTH. 0312 C 0313 CALL STR$TRIM( SELSTR, SELSTR, SLEN ) 0314 C 0315 C ** COMPRESS THE STRING PASSED. 0316 C 0317 CALL DBNET$COMP_STRING( SELSTR, SLEN ) 0318 C 0319 C ** CHECK THE LENGTH OF THE STRING, RETURN IF NO SELECT PROVIDED. 0320 C 0321 IF (SLEN .EQ. 0) THEN 0322 WRITE(6,1000) 0323 GOTO 9000 0324 ENDIF 0325 C 0326 C ** FIND THE COMMA IN THE STRING. 0327 C 0328 3000 FNDCOM = INDEX(SELSTR,',') 0329 C 0330 C ** IF NO COMMA, THEN WE ARE LOOKING AT LAST FIELD OF STRING. 0331 C 0332 IF (FNDCOM .EQ. 0) THEN 0333 NXTFND = 0 0334 ENDSTR = SLEN 0335 ELSE 0336 C 0337 C ** A COMMA FOUND, THEREFORE MORE FIELDS AFTER CURRENT FIELD TO BE PROCESSED. 0338 C 0339 NXTFND = FNDCOM + 1 0340 ENDSTR = FNDCOM - 1 0341 ENDIF DBEVL$SELECT 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 15 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0342 C 0343 C ** PULL CURRENT FIELD OUT OF STRING PASSED INTO A LOCAL BUFFER. 0344 C 0345 LOCSTR = SELSTR(1:ENDSTR)//' ' 0346 C 0347 C ** FIND THE POINTER TO THE FIELD IN THE LOCAL BUFFER. 0348 C 0349 IF (DBCRS$FIELD_IDENT( LOCSTR, IPNT ) .EQ. USRDB$_FAILURE) THEN 0350 C 0351 C ** NO POINTER FOUND, INVALID FIELD SPECIFIED. 0352 C 0353 WRITE(6,1250) LOCSTR 0354 GOTO 4000 0355 ENDIF 0356 C 0357 C ** GET THE FID OF THE FIELD SPECIFIED USING ITS POINTER. 0358 C 0359 LFID = USRDB$_CROSS_FID(IPNT) 0360 C 0361 C ** IF THE FIELD IS THE USER IDENTIFER (PRIMARY KEY) THEN BRANCH. 0362 C 0363 IF (LFID .EQ. USRDB$_FID_USER_IDENT) GOTO 4000 0364 C 0365 C ** CHECK THAT FIELD HAS NOT ALREAD BEEN SPECIFIED IN THE SELECTION. 0366 C 0367 DO MM = 1,SCNT 0368 IF (LFID .EQ. SEL_FIDS(MM)) GOTO 4000 0369 ENDDO 0370 C 0371 C ** GET THE FIELDS LENGTH AND ADD IT TO THE LENGTH OF ALL FIELDS FOUND SO FAR. 0372 C 0373 TLEN = TLEN + USRDB$_CROSS_FLEN(IPNT) 0374 C 0375 C ** INCREMENT THE COUND OF THE FIELDS FOUND. 0376 C 0377 SCNT = SCNT + 1 0378 C 0379 C ** ADD THE FID OF THE FIELD TO THE PROCESSING ARRAY. 0380 C 0381 SEL_FIDS(SCNT) = LFID 0382 C 0383 C ** CHECK IF ANY MORE FIELDS TO BE PROCESSED. 0384 C 0385 4000 IF (NXTFND .EQ. 0) THEN 0386 C 0387 C ** SET PROCEDURE VALUE TO SUCCESS, THEN BRANCH. 0388 C 0389 DBEVL$SELECT = USRDB$_SUCCESS 0390 GOTO 9000 0391 ENDIF 0392 C 0393 C ** SPECIFY THE REMAINDER OF THE STRING FOR PROCESSING. 0394 C 0395 SELSTR = SELSTR(NXTFND:SLEN)//' ' 0396 C 0397 C ** GET THE NEW LENGTH OF THE STRING FOR PROCESSING. 0398 C DBEVL$SELECT 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 16 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0399 CALL STR$TRIM(SELSTR, SELSTR, SLEN ) 0400 C 0401 C ** IF LENGTH IS NOT ZERO THEN BRANCH TO PROCCESS THE STRING. 0402 C 0403 IF (SLEN .GT. 0) GOTO 3000 0404 C 0405 C ** RETURN TO THE CALLING ROUTINE. 0406 C 0407 9000 RETURN 0408 C 0409 1000 FORMAT(' LQL%ERROR.SELECT: Invalid SELECT Syntax Provided, Cannot Interpret Command.') 0410 1250 FORMAT(' LQL%ERROR.SELECT: Invalid SELECT Syntax Provided, Field ID: ',A15) 0411 C 0412 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 321 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 149 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 1436 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 1906 ENTRY POINTS Address Type Name 0-00000000 I*4 DBEVL$SELECT VARIABLES Address Type Name Address Type Name ** I*4 DBCPY$COPY ** I*4 DBEVL$COMPOSE ** I*4 DBEVL$DEF_SORT ** I*4 DBEVL$LOGICAL ** I*4 DBEVL$PARSE ** I*4 DBEVL$SORT ** I*4 DBEVL$UPDATE ** I*4 DBEVL$WHERE ** I*4 ENDSTR ** I*4 FNDCOM 2-00000524 I*4 IPNT ** I*4 LFID 2-0000050C CHAR LOCSTR ** I*4 MM ** I*4 NXTFND AP-0000000C@ I*4 SCNT AP-00000004@ CHAR SELSTR 2-00000520 I*4 SLEN AP-00000010@ I*4 TLEN ** I*4 USRDB$CLEAR_RECORD ** I*4 USRDB$DELETE_RECORD ** I*4 USRDB$GET_DUMP ** I*4 USRDB$GET_FIELD ** I*4 USRDB$GET_INIT ** I*4 USRDB$GET_RECORD ** I*4 USRDB$LOCATE ** I*4 USRDB$PUT_DUMP ** I*4 USRDB$PUT_FIELD ** I*4 USRDB$PUT_RECORD ** I*4 USRDB$SQL ** I*4 USRDB$UPDATE_RECORD DBEVL$SELECT 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 17 01 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 ARRAYS Address Type Name Bytes Dimensions AP-00000008@ I*4 SEL_FIDS 152 (38) 2-00000000 I*4 USRDB$_CROSS_FID 152 (38) 2-00000098 I*4 USRDB$_CROSS_FLEN 152 (38) 2-000002F8 CHAR USRDB$_DEFAULT 228 (38) 2-0000023A CHAR USRDB$_DMPSTR 190 (38) 2-00000000 CHAR USRDB$_IDENTS 570 (38) LABELS Address Label Address Label Address Label Address Label Address Label 1-00000002 1000' 1-00000052 1250' 0-00000058 3000 0-000000FF 4000 0-0000013C 9000 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name I*4 DBCRS$FIELD_IDENT DBNET$COMP_STRING I*4 LIB$INDEX STR$TRIM OPTIONS QUALIFIERS /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /EXTEND_SOURCE /F77 /NOG_FLOATING /I4 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 18 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0002 OPTIONS/EXTEND 0003 SUBROUTINE DBNET$COMP_STRING( INSTR, LSTR ) 0004 C 0005 C ******************************************************************** 0006 C 0007 C ** COMPRESS STRING, REMOVE LEADING BLANKS. THIS SO COMMANDS WORK. 0008 C 0009 C ** INSTR = STRING TO BE COMPRESSED. PASSED IN/BACK 0010 C ** LSTR = LENGTH OF STRING, AND COMPRESSED LENGTH PASSED IN/BACK 0011 C 0012 C ******************************************************************** 0013 C 0014 C ** DEFINE LOCAL VARIABLES. 0015 C 0016 CHARACTER INSTR*(*), OUSTR*255 0017 INTEGER*4 LSTR, JSTR 0018 C 0019 C ** CHECK STRING LENGTH, RETURN IF ZERO 0020 C 0021 IF (LSTR .EQ. 0) RETURN 0022 C 0023 C ** CONVERT TO UPPERCASE. 0024 C 0025 CALL STR$UPCASE( INSTR, INSTR(1:LSTR) ) 0026 C 0027 C ** INITIALIZE NEW STRING LENGTH. 0028 C 0029 JSTR = 0 0030 C 0031 C ** LOOP ON STRING 0032 C 0033 DO II = 1,LSTR 0034 C 0035 C ** CHECK IF STRING IS A BLANK. 0036 C 0037 IF (INSTR(II:II) .NE. ' ') THEN 0038 JSTR = JSTR + 1 0039 OUSTR(JSTR:JSTR) = INSTR(II:II) 0040 ENDIF 0041 C 0042 C ** CHECK IF STRING IS A BACKSPACE 0043 C 0044 IF (INSTR(II:II) .EQ. CHAR(8)) THEN 0045 OUSTR(JSTR:JSTR) = ' ' 0046 JSTR = JSTR - 1 0047 ENDIF 0048 ENDDO 0049 C 0050 C ** SET STRING AND ITS LENGTH FOR CALLING ROUTINE USAGE. 0051 C 0052 LSTR = 0 0053 IF (JSTR .GT. 0) THEN 0054 INSTR = OUSTR(1:JSTR) 0055 LSTR = JSTR 0056 ENDIF 0057 C DBNET$COMP_STRING 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 19 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 0058 C ** RETURN TO CALLING ROUTINE 0059 C 0060 RETURN 0061 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 130 PIC CON REL LCL SHR EXE RD NOWRT QUAD 2 $LOCAL 284 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 414 ENTRY POINTS Address Type Name 0-00000000 DBNET$COMP_STRING VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name ** I*4 II AP-00000004@ CHAR INSTR ** I*4 JSTR AP-00000008@ I*4 LSTR 2-00000000 CHAR OUSTR FUNCTIONS AND SUBROUTINES REFERENCED Type Name STR$UPCASE OPTIONS QUALIFIERS /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /EXTEND_SOURCE /F77 /NOG_FLOATING /I4 DBNET$COMP_STRING 22-Mar-1991 18:19:01 VAX FORTRAN V5.5-98 Page 20 01 18-Mar-1991 20:57:31 LQL_DRVR1.FOR;1 COMMAND QUALIFIERS FOR/LIST/SHOW LQL_DRVR1 /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(DICTIONARY,INCLUDE,MAP,PREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=LIB4:[LIFENET.USERDB.CURRENT_SOURCE]LQL_DRVR1.LIS;3 /OBJECT=LIB4:[LIFENET.USERDB.CURRENT_SOURCE]LQL_DRVR1.OBJ;3 COMPILATION STATISTICS Run Time: 7.54 seconds Elapsed Time: 13.03 seconds Page Faults: 874 Dynamic Memory: 656 pages