22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 1 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0001 OPTIONS/EXTEND 0002 FUNCTION USRDB$SQL( LUN, TFILE ) 0003 C 0004 C *************************************************************************** 0005 C 0006 C ** PURPOSE: GENERATE A SQL ENVIRONMENT FOR THE LIFENET USER DB. 0007 C 0008 C *************************************************************************** 0009 C 0010 C ** INCLUDE FILE FOR WHERE EVALUATIONS. 0011 C 0012 INCLUDE 'LIFE_DEV:DB_PARAMS.INC/NOLIST' 0157 INCLUDE 'LIFE_DEV:DB_INTERN.INC/NOLIST' 0195 INCLUDE 'LIFE_DEV:DB_FUNCS.INC/NOLIST' 0216 INCLUDE 'LIFE_DEV:DB_CROSS.INC/NOLIST' 0337 INCLUDE 'LIFE_DEV:DB_INDEX.INC/NOLIST' 0396 INCLUDE 'LIFE_DEV:DB_WHERE.INC/NOLIST' 0420 C 0421 C ** DECLARE LOCAL VARIABLES. 0422 C 0423 CHARACTER TFILE*64, OU_FILE*64, SRT_STRING*80, DMPSTR*5, WSTR*6, 0424 & LINEIN*255, CMDSTR*10, SC_FILE*64, FID_STR*15, CLSTR*6, 0425 & PRET*64, UPDVAL(SQL$_MAX_UPDATE)*80, CHKSRT*80, FID_SEL(4)*15, 0426 & MAKNAME*20, GETNAME*20, NEWNAME*12 0427 INTEGER*4 LUN, WSCN, NLUN, FSPC, BQL, SEL_FIDS(USRDB$_NUM_FIELDS), SLUN, 0428 & SRT_KEY, SRT_MATCH, TLEN, SLEN, UPD_FID(SQL$_MAX_UPDATE), SCNT, 0429 & LAST_WRITE, TOT_REC, TOT_FND, PCNT, UPDLEN(SQL$_MAX_UPDATE), 0430 & SFID, SCLEN, DLUN, SLN, SRT_PNTR, UCNT, ULEN, CLUN 0431 LOGICAL DUMP_FILE, LIST_FILE, DO_UPDATE, WHOK, DO_WHERE, SCRN_OUT, 0432 & NEED_SORT, DO_SELECT, PAGE_FILE, SORT_CHECK, GET_FILE, MAXCPY, 0433 & SECURITY, DUMP_ALL, DISP_DATA, TF_EXIST 0434 C 0435 C ** ABORT ENVIRONMENT FOR PROGRAMS. 0436 C COMMON /FLAGS/ DUMP_ALL 0437 C 0438 C ** INITIALIZE LOGICAL VARIABLES FOR EXTERNAL ENVIRONMENT. 0439 C 0440 GET_FILE = .FALSE. 0441 DUMP_ALL = .TRUE. 0442 C 0443 C ** CHECK SECURITY OF ENVIRONMENT, SET LOGICAL VARIABLE TRUE OR FALSE. 0444 C 0445 SECURITY = DBUPD$SECURITY 0446 C 0447 C ** INITIALIZE FUNCTION VARIABLE. 0448 C 0449 1000 USRDB$SQL = USRDB$_FAILURE 0450 C 0451 C ** CHECK IF USING INPUT FROM TERMINAL OR A SCRIPT FILE. 0452 C 0453 IF (LUN .NE. 5) THEN 0454 C 0455 C ** OPEN THE SCRIPT FILE. 0456 C 0457 OPEN( UNIT = LUN, FILE=TFILE, CARRIAGECONTROL='LIST', 0458 & TYPE='UNKNOWN', READONLY, SHARED ) 0459 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 2 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0460 C ** READ SOURCE FOR TERMINAL INPUT. 0461 C 0462 ELSE 0463 C 0464 LUN = 5 0465 C 0466 ENDIF 0467 C 0468 C ** INITIALIZE FUNCTIONS 0469 C 0470 1125 IERR = 0 0471 IQ = 9 0472 LINEIN = 'CLEAR ALL'//' ' 0473 C 0474 C ** BEGIN PROCESSING OF DATA READ IN. 0475 C 0476 1250 DO WHILE (IERR .EQ. 0) 0477 C 0478 C ** FIND SPACE BETWEEN VERB AND ACTION. 0479 C 0480 FSPC = INDEX(LINEIN,' ') - 1 0481 C 0482 C ** IF SPACE EXISTED THEN PROCESS THE LINE, ELSE CONTINUE LOOP. 0483 C 0484 IF (FSPC .NE. 0) THEN 0485 C 0486 C ** GET AND UPCASE THE COMMAND STRING INTO A BUFFER. 0487 C 0488 CALL STR$UPCASE( CMDSTR, LINEIN(1:FSPC) ) 0489 C 0490 C ** CALCULATE POSITION OF BEGINNING OF ACTION. 0491 C 0492 BQL = FSPC + 2 0493 C 0494 C ** CHECK FOR EACH VERB, THEN SETUP ITS ACTIONS. 0495 C ** CHECK FOR FIELDS BEING SELECTED FOR OUTPUT. 0496 C 0497 IF ((CMDSTR(1:FSPC) .EQ. 'SELECT') .AND. (.NOT. DO_UPDATE)) THEN 0498 C 0499 C ** CHECK IF NUMBER OF SELECTS HAS REACHED LIMIT. 0500 C 0501 IF (SCNT .EQ. USRDB$_NUM_FIELDS) THEN 0502 C 0503 C ** WARN USER THAT NUMBER OF SELECTS HAVE REACHED LIMIT. 0504 C 0505 WRITE(6,6750) 0506 C 0507 C ** BRANCH TO NEXT READ 0508 C 0509 GOTO 4500 0510 C 0511 C ** GET THE FIDS OF THE FIELDS SELECTED. CAN HAVE MULTIPLE SELECT STATEMENTS. 0512 C 0513 ELSE IF (LINEIN(BQL:BQL) .EQ. '*') THEN 0514 C 0515 C ** LOOP THRU ALL KNOWN FIELDS, SINCE USER ASKED FOR GLOBAL RETREIVAL. 0516 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 3 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0517 SLEN = 0 0518 DO MM = 1,USRDB$_NUM_FIELDS 0519 SEL_FIDS(MM) = USRDB$_CROSS_FID(MM) 0520 SLEN = SLEN + USRDB$_CROSS_FLEN(MM) 0521 ENDDO 0522 C 0523 C ** SET TOTAL COUNT TO NUMBER OF FIELDS. 0524 C 0525 SCNT = USRDB$_NUM_FIELDS 0526 C 0527 C ** SET TOTAL LENGTH TO TOTAL LENGTH OF RECORDS TO BE READ. 0528 C 0529 SLEN = SLEN - USRDB$_FLEN_USER_IDENT 0530 C 0531 C ** CHECK FOR SPECIFIC SELECT ITEMS. 0532 C 0533 ELSE IF (DBEVL$SELECT( LINEIN(BQL:IQ), SEL_FIDS, SCNT, SLEN ) .EQ. USRDB$_FAILURE) THEN 0534 C 0535 C ** WARN USER THAT SELECTED ITEMS NOT KNOWN 0536 C 0537 WRITE(6,2500) 0538 C 0539 C ** IF NOT USING INTERACTIVE PROMPTING, THEN ABORT PROGRAM 0540 C 0541 IF (LUN .NE. 5) GOTO 9000 0542 C 0543 C ** INSTRUCTIONAL STATMENT. 0544 C 0545 WRITE(6,2550) 0546 C 0547 C ** BRANCH TO NEXT READ 0548 C 0549 GOTO 4500 0550 C 0551 ENDIF 0552 C 0553 C ** NOT AN UPDATE COMMAND BEING PERFORMED. 0554 C 0555 DO_UPDATE = .FALSE. 0556 DO_SELECT = .TRUE. 0557 C 0558 C ** INCREMENT THE TOTAL LENGTH OF OUTPUT FOR THE LIST FILE. 0559 C 0560 TLEN = TLEN + SLEN 0561 C 0562 C ** SELECT WITH UPDATE FLAG ALREADY SET. ISSUE ERROR MESSAGE. 0563 C 0564 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'SELECT') .AND. (DO_UPDATE)) THEN 0565 C 0566 WRITE(6,6600) 0567 C 0568 C ** CHECK FOR UPDATE SITUATION. 0569 C 0570 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'UPDATE') 0571 & .AND. (SECURITY) 0572 & .AND. (.NOT. DO_SELECT)) THEN 0573 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 4 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0574 C ** CHECK IF NUMBER OF UPDATES EXCEEDS THE TOTAL NUMBER OF UPDATES ALLOWED. 0575 C 0576 IF (UCNT .EQ. SQL$_MAX_UPDATE) THEN 0577 C 0578 C ** TELL USER THAT NO MORE UPDATES ARE ALLOWED. 0579 C 0580 WRITE(6,3020) 0581 C 0582 C ** BRANCH TO NEXT READ 0583 C 0584 GOTO 4500 0585 C 0586 C 0587 C ** GET FIELD TO BE UPDATED, AND ITS VALUE TO REPLACED WITH 0588 C 0589 ELSE IF (DBEVL$UPDATE( LINEIN(BQL:IQ), UPD_FID, UCNT, UPDVAL, UPDLEN ) .EQ. USRDB$_FAILURE) THEN 0590 C 0591 C ** INFORM USER OF SYNTAX FAILURE OF UPDATE SPECIFICATION. 0592 C 0593 WRITE(6,3000) 0594 C 0595 C ** IF NOT INTERACTIVE, THEN ABORT PROGRAM. 0596 C 0597 IF (LUN .NE. 5) GOTO 9000 0598 C 0599 C ** INSTRUCTIONAL TEXT. 0600 C 0601 WRITE(6,3050) 0602 C 0603 C ** BRANCH TO NEXT READ 0604 C 0605 GOTO 4500 0606 C 0607 ENDIF 0608 C 0609 C ** AN UPDATE COMMAND BEING PERFORMED. 0610 C 0611 DO_UPDATE = .TRUE. 0612 DO_SELECT = .FALSE. 0613 C 0614 C ** TURN ON THE DUMP FUNCTION BY DEFAULT DURING AN UPDATE. 0615 C 0616 IF (LIST_FILE) DUMP_FILE = .TRUE. 0617 C 0618 C ** PUSH THE FIELDS BEING UPDATED INTO THE SELECT STACK. 0619 C 0620 SCNT = SCNT + 1 0621 SEL_FIDS(SCNT) = UPD_FID(UCNT) 0622 C 0623 C ** UPDATE WITH SELECT FLAG ALREADY SET. ISSUE ERROR MESSAGE. 0624 C 0625 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'UPDATE') .AND. (DO_SELECT)) THEN 0626 C 0627 C ** SELECT OPTIONS ALREADY INITIATED, MUST INITIALIZE FIRST. 0628 C 0629 WRITE(6,6650) 0630 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 5 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0631 C ** UPDATE WITH NO SECURITY PRIVILEGE TO UPDATE. 0632 C 0633 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'UPDATE') .AND. (.NOT. SECURITY)) THEN 0634 C 0635 C ** ISSUE COMMAND TO UPDATE WITH NO PRIVILEGE!!!!! 0636 C 0637 WRITE(6,6875) 0638 C 0639 C ** MAKE A COPY OF AN EXISTING DATABASE RECORD. 0640 C 0641 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'COPY') .AND. (SECURITY)) THEN 0642 C 0643 C ** GET NEWNAME FOR USERID FIELD. 0644 C 0645 CALL STR$TRIM( NEWNAME, LINEIN(BQL:IQ), NWN ) 0646 C 0647 C ** IF VALID USERNAME, THEN VALIDATE COPY FUNCTION. 0648 C 0649 IF (NWN .GT. 2) THEN 0650 C 0651 C ** SET FLAG FOR MAKING COPY OF DATABASE RECORD. 0652 C 0653 MAKCPY = .TRUE. 0654 DO_WHERE = .FALSE. 0655 C 0656 ENDIF 0657 C 0658 C ** TRIED TO MAKE COPY WITHOUT PRIVILEGE 0659 C 0660 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'COPY') .AND. (.NOT. SECURITY)) THEN 0661 C 0662 C ** ISSUE SLAP OF HAND, NO PRIV FOR OPERATION REQUESTED. 0663 C 0664 WRITE(6,6875) 0665 C 0666 C ** CHECK FOR OUTPUT WHILE WRITING TO A FILE. 0667 C 0668 ELSE IF (CMDSTR(1:FSPC) .EQ. 'DISPLAY') THEN 0669 C 0670 C ** TOGGLE THE DISPLAY FUNCTION ON OR OFF. 0671 C 0672 IF (DISP_DATA) THEN 0673 DISP_DATA = .FALSE. 0674 ELSE 0675 DISP_DATA = .TRUE. 0676 ENDIF 0677 C 0678 C ** CHECK FOR SPECIAL OUTPUT TO SCREEN, LLUD FUNCTION. 0679 C 0680 ELSE IF (CMDSTR(1:FSPC) .EQ. 'SCREEN') THEN 0681 C 0682 C ** SETUP FOR SCREEN OUTPUT FOR LLUD FUNCTIONS. 0683 C 0684 SEL_FIDS(1) = USRDB$_FID_LAST_NAME 0685 SEL_FIDS(2) = USRDB$_FID_FRST_NAME 0686 SEL_FIDS(3) = USRDB$_FID_MIDDLE_INIT 0687 SEL_FIDS(4) = USRDB$_FID_INSTITUTION USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 6 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0688 SEL_FIDS(5) = USRDB$_FID_USER_IDENT 0689 C 0690 C ** GET LENGTHS OF FIELDS BEING OUTPUT TO SCREEN. 0691 C 0692 SLEN = USRDB$_FLEN_USER_IDENT + USRDB$_FLEN_INSTITUTION + USRDB$_FLEN_FRST_NAME 0693 SLEN = SLEN + USRDB$_FLEN_LAST_NAME + USRDB$_FLEN_MIDDLE_INIT 0694 C 0695 C ** DEFINE LOGICALS NEEDED FOR SCREEN OUTPUT FORMAT. 0696 C 0697 SCRN_OUT = .TRUE. 0698 DO_SELECT = .TRUE. 0699 C 0700 C ** DEFINE NUMBER OF FIELDS BEING SELECTED FOR SCREEN OUTPUT FORMAT. 0701 C 0702 SCNT = 5 0703 C 0704 C ** CHECK FOR OUTPUT TO A INTERIM FILE. 0705 C 0706 ELSE IF (CMDSTR(1:FSPC) .EQ. 'FILE') THEN 0707 C 0708 C ** DETERMINE NAME OF FILE FOR OUTPUT. 0709 C 0710 CALL STR$TRIM( OU_FILE, LINEIN(BQL:IQ), IOU ) 0711 C 0712 C ** CHECK FILENAME PROVIDED FOR ILLEGAL CHARACTERS, AND COMPRESS IT. 0713 C 0714 CALL DBNET$COMP_STRING( OU_FILE, IOU ) 0715 C 0716 C ** CHECK THAT A FILENAME STRING STILL EXIST. 0717 C 0718 IF (IOU .GT. 0) THEN 0719 C 0720 C ** SET LOGICALS INDISATING OUTPUT TYPE TO BE PERFORMED. 0721 C 0722 LIST_FILE = .TRUE. 0723 SCRN_OUT = .FALSE. 0724 IF (DO_UPDATE) DUMP_FILE = .TRUE. 0725 C 0726 ELSE 0727 C 0728 C ** WRITE ERROR MESSAGE TO USER. 0729 C 0730 WRITE(6,3150) 0731 C 0732 ENDIF 0733 C 0734 C ** OUTPUT COMMANDS IN BUFFER TO SCREEN OR TO FILE. 0735 C 0736 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'SHOW') .OR. (CMDSTR(1:FSPC) .EQ. 'LIST')) THEN 0737 C 0738 C ** IF A LIST IS BEING PERFORMED, THEN SETUP THE SCRIPT FILE. 0739 C 0740 IF (CMDSTR(1:FSPC) .EQ. 'LIST') THEN 0741 C 0742 C ** DETERMINE OUTPUT FILE FOR SCRIPT OF CURRENT ENTRIES. 0743 C 0744 CALL STR$TRIM( SC_FILE, LINEIN(BQL:IQ), ISC ) USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 7 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0745 C 0746 C ** CHECK THAT FILENAME PROVIDED IS LEGAL. 0747 C 0748 CALL DBNET$COMP_STRING( SC_FILE, ISC ) 0749 C 0750 C ** IF NO FILE NAME PROVIDED, OR FILENAME ILLEGAL, THEN PROVIDE DEFAULT. 0751 C 0752 IF (ISC .EQ. 0) SC_FILE = 'LOC_SCR:SCRIPTS.FILE' 0753 C 0754 C ** LOGICAL UNIT NUMBER OF THE OUTPUT SCRIPT FILE. 0755 C 0756 SLUN = 18 0757 C 0758 C ** OPEN THE NEW SCRIPT FILE. 0759 C 0760 OPEN( UNIT = SLUN, FILE=SC_FILE, CARRIAGECONTROL='LIST', TYPE='NEW' ) 0761 C 0762 ELSE 0763 C 0764 C ** OPEN LIST FILE TO SCREEN. 0765 C 0766 SLUN = 17 0767 OPEN( UNIT = SLUN, FILE='SYS$OUTPUT', CARRIAGECONTROL='LIST', TYPE='UNKNOWN' ) 0768 C 0769 ENDIF 0770 C 0771 C ** SHOW THE SETTINGS THAT HAVE BEEN MADE TO DATE. 0772 C 0773 IF ((SLUN .EQ. 17) .AND. (.NOT. SCRN_OUT)) WRITE(SLUN,7900) 0774 C 0775 C ** SHOW OUTPUT FILE NAME FOR OUTPUT OF DATA TO A FILE. 0776 C 0777 IF (LIST_FILE) WRITE(SLUN,7000) OU_FILE 0778 C 0779 C ** INDICATE IF FILE IS TO BE IN DUMP FORMAT. 0780 C 0781 IF ((DUMP_FILE) .AND. (LIST_FILE)) WRITE(SLUN,7100) 0782 C 0783 C ** INDICATE IF OUTPUT IS TO BE PLACED ON SCREEN AT SAME TIME. 0784 C 0785 IF (DISP_DATA) WRITE(SLUN,7130) 0786 C 0787 C ** INDICATE IF OUTPUT IS TO BE PAGED ON SCREEN. 0788 C 0789 IF ((.NOT. LIST_FILE) .AND. (PAGE_FILE)) WRITE(SLUN,7150) 0790 C 0791 C ** SHOW WHAT ITEMS ARE TO BE UPDATED, IF DEFINED. 0792 C 0793 IF (DO_UPDATE) THEN 0794 C 0795 C ** GET FID OF STRINGS TO BE UPDATED, AND DISPLAY INFORMATION. 0796 C 0797 DO MM = 1,UCNT 0798 ISTAT4 = USRDB$LOCATE( UPD_FID(MM), IPNT ) 0799 FID_STR = USRDB$_IDENTS( IPNT ) 0800 CALL STR$TRIM( FID_STR, FID_STR, IX ) 0801 ULEN = UPDLEN(MM) USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 8 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0802 WRITE(SLUN,7200) FID_STR, UPDVAL(MM) 0803 ENDDO 0804 C 0805 C ** SHOW WHAT ITEMS ARE TO BE SELECTED, IF DEFINED. 0806 C 0807 ELSE IF (DO_SELECT) THEN 0808 C 0809 C ** GET FID OF STRINGS TO BE SELECTED, AND DISPLAY INFORMATION. 0810 C 0811 DO MM = 1,SCNT,4 0812 KK = MM + 3 0813 IF ((MM+3) .GT. SCNT) KK = SCNT 0814 DO LL = MM,KK 0815 ISTAT4 = USRDB$LOCATE( SEL_FIDS(LL), IPNT ) 0816 FID_SEL(LL-MM+1) = USRDB$_IDENTS( IPNT ) 0817 ENDDO 0818 JJ = KK - MM + 1 0819 WRITE(SLUN,7300) (FID_SEL(LL),LL=1,JJ) 0820 ENDDO 0821 C 0822 C ** SHOW NEW RECORD IS TO BE CREATED VIA A COPY COMMAND. 0823 C 0824 ELSE IF (MAKCPY) THEN 0825 WRITE(SLUN,7250) NEWNAME 0826 ENDIF 0827 C 0828 C ** SHOW THE WHERE CLAUSES GENERATED. 0829 C 0830 IF (DO_WHERE) THEN 0831 DO MM = 1,WSCN 0832 C 0833 ISTAT4 = USRDB$LOCATE( EVAL$REC(MM).FID, IPNT ) 0834 CALL STR$TRIM( FID_STR, USRDB$_IDENTS( IPNT ), IX ) 0835 IFL = EVAL$REC(MM).FSLEN 0836 C 0837 C ** DEFINE THE TYPE OF EVALUATION. 0838 C 0839 IF (EVAL$REC(MM).FUNC .EQ. 'S') THEN 0840 WSTR = 'WHERE' 0841 ELSE IF (EVAL$REC(MM).FUNC .EQ. 'A') THEN 0842 WSTR = 'AND' 0843 ELSE IF (EVAL$REC(MM).FUNC .EQ. 'O') THEN 0844 WSTR = 'OR' 0845 ELSE IF (EVAL$REC(MM).FUNC .EQ. 'V') THEN 0846 WSTR = 'EQV' 0847 ELSE IF (EVAL$REC(MM).FUNC .EQ. 'N') THEN 0848 WSTR = 'NEQV' 0849 ELSE IF (EVAL$REC(MM).FUNC .EQ. 'R') THEN 0850 WSTR = 'EOR' 0851 ELSE IF (EVAL$REC(MM).FUNC .EQ. 'E') THEN 0852 WSTR = 'EEQV' 0853 ELSE IF (EVAL$REC(MM).FUNC .EQ. 'Q') THEN 0854 WSTR = 'ENEQ' 0855 ELSE IF (EVAL$REC(MM).FUNC .EQ. 'F') THEN 0856 WSTR = 'FINISH' 0857 ENDIF 0858 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 9 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0859 C ** DISPLAY THE WHERE CLAUSE. 0860 C 0861 IF (EVAL$REC(MM).QUAL .EQ. 'E') THEN 0862 WRITE(SLUN,7400) WSTR, FID_STR, EVAL$REC(MM).FIND 0863 ELSE IF (EVAL$REC(MM).QUAL .EQ. 'N') THEN 0864 WRITE(SLUN,7450) WSTR, FID_STR, EVAL$REC(MM).FIND 0865 ELSE IF (EVAL$REC(MM).QUAL .EQ. ' ') THEN 0866 WRITE(SLUN,7500) WSTR 0867 ENDIF 0868 C 0869 ENDDO 0870 ENDIF 0871 C 0872 C ** SHOW THE SORT FUNCTION SELECTED. 0873 C 0874 IF (.NOT. NEED_SORT) THEN 0875 C 0876 C ** GET THE FIELD NAME TO BE SORTED. 0877 C 0878 FID_STR = IDX$_NAME( SRT_KEY+1 ) 0879 CALL STR$TRIM( FID_STR, FID_STR, IX ) 0880 CALL STR$TRIM( SRT_STRING, SRT_STRING, SLN ) 0881 IF (SLN .EQ. 0) SLN = 1 0882 C 0883 C ** INDICATE SORT IS BY FIELD, NO SPECIFIC VALUE. 0884 C 0885 IF (SRT_MATCH .EQ. USRDB$_MATCH_NA) THEN 0886 WRITE(SLUN,7650) FID_STR 0887 ELSE 0888 C 0889 C ** INDICATE SORT IS BY FIELD, WITH SPECIFIC VALUES. 0890 C 0891 IF (SRT_MATCH .EQ. USRDB$_MATCH_EQ) THEN 0892 WSTR = '.EQ.' 0893 ELSE IF (SRT_MATCH .EQ. USRDB$_MATCH_GT) THEN 0894 WSTR = '.GT.' 0895 ELSE IF (SRT_MATCH .EQ. USRDB$_MATCH_LT) THEN 0896 WSTR = '.LT.' 0897 ELSE IF (SRT_MATCH .EQ. USRDB$_MATCH_GE) THEN 0898 WSTR = '.GE.' 0899 ELSE IF (SRT_MATCH .EQ. USRDB$_MATCH_LE) THEN 0900 WSTR = '.LE.' 0901 ENDIF 0902 WRITE(SLUN,7600) FID_STR, WSTR, SRT_STRING 0903 ENDIF 0904 ENDIF 0905 C 0906 C ** LINEGIDES FOR SCREEN DISPLAY. 0907 C 0908 IF (SLUN .EQ. 17) WRITE(SLUN,7950) 0909 C 0910 C ** CLOSE OUTPUT FILE, SCREEN AS NEEDED. 0911 C 0912 CLOSE(SLUN) 0913 C 0914 C ** EXIT THE PROGRAM 0915 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 10 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0916 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'EXIT') .AND. (LUN .EQ. 5)) THEN 0917 C 0918 C ** DECLARE SUCCESS CONDITION. 0919 C 0920 USRDB$SQL = USRDB$_SUCCESS 0921 C 0922 C ** BRANCH TO NORMAL EXIT OF SUBROUTINE. 0923 C 0924 GOTO 9000 0925 C 0926 C ** REINITIALIZE THE PROGRAM 0927 C 0928 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'INIT') .AND. (LUN .EQ. 5)) THEN 0929 C 0930 C ** BRANCH TO NORMAL INITIALIZATION OF SUBROUTINE. 0931 C 0932 GOTO 1000 0933 C 0934 C ** CLEAR COMMAND TYPES. 0935 C 0936 ELSE IF (CMDSTR(1:FSPC) .EQ. 'CLEAR') THEN 0937 C 0938 C ** GET TYPE OF CLEAR TO BE PERFORMED. 0939 C 0940 CALL STR$TRIM( CLSTR, LINEIN(BQL:IQ), ICL ) 0941 CALL DBNET$COMP_STRING( CLSTR, ICL ) 0942 C 0943 C ** CHECK IF A CLEAR TYPE WAS DEFINED. 0944 C 0945 IF (ICL .EQ. 0) THEN 0946 WRITE(6,6900) 0947 C 0948 C ** BRANCH TO NEXT READ 0949 C 0950 GOTO 4500 0951 ENDIF 0952 C 0953 C ** SELEC^ OR UPDATE CLEAR HAS BEEN DEFINED. 0954 C 0955 IF ((CLSTR(1:ICL) .EQ. 'ALL') .OR. 0956 & (CLSTR(1:ICL) .EQ. 'SELECT') .OR. 0957 & (CLSTR(1:ICL) .EQ. 'SCREEN') .OR. 0958 & (CLSTR(1:ICL) .EQ. 'UPDATE')) THEN 0959 SCNT = 1 0960 UCNT = 0 0961 C 0962 C ** INITIALIZE THE SELECTION VARIABLES. 0963 C 0964 SEL_FIDS(1) = USRDB$_FID_USER_IDENT 0965 DO MM = 2,USRDB$_NUM_FIELDS 0966 SEL_FIDS(MM) = 0 0967 ENDDO 0968 SLEN = 0 0969 TLEN = USRDB$_FLEN_USER_IDENT 0970 DO_SELECT = .FALSE. 0971 C 0972 C ** INITIALIZE THE UPDATE VARIABLES. USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 11 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 0973 C 0974 DO MM = 1,SQL$_MAX_UPDATE 0975 UPD_FID(MM) = 0 0976 ENDDO 0977 DO_UPDATE = .FALSE. 0978 MAKCPY = .FALSE. 0979 SCRN_OUT = .FALSE. 0980 ENDIF 0981 C 0982 C ** INITIALIZE THE FILE FUNCTION. 0983 C 0984 IF ((CLSTR(1:ICL) .EQ. 'ALL') .OR. (CLSTR(1:ICL) .EQ. 'FILE')) LIST_FILE = .FALSE. 0985 C 0986 C ** INITIALIZE THE DUMP FUNCTION. 0987 C 0988 IF ((CLSTR(1:ICL) .EQ. 'ALL') .OR. (CLSTR(1:ICL) .EQ. 'DUMP')) DUMP_FILE = .FALSE. 0989 C 0990 C ** INITIALIZE THE WHERE FUNCTIONS. 0991 C 0992 IF ((CLSTR(1:ICL) .EQ. 'ALL') .OR. (CLSTR(1:ICL) .EQ. 'WHERE')) THEN 0993 WSCN = 0 0994 DO MM = 1,USRDB$_NUM_FIELDS 0995 EVAL$REC(MM).BUFFER = ' ' 0996 ENDDO 0997 WHOK = .TRUE. 0998 DO_WHERE = .FALSE. 0999 ENDIF 1000 C 1001 C ** INITIALIZE THE SORT FUNCTION. 1002 C 1003 IF ((CLSTR(1:ICL) .EQ. 'ALL') .OR. (CLSTR(1:ICL) .EQ. 'SORT')) THEN 1004 NEED_SORT = .TRUE. 1005 SRT_KEY = 0 1006 SRT_MATCH = 0 1007 SRT_STRING = ' ' 1008 ENDIF 1009 C 1010 C ** INITIALIZE THE DISPLAY FUNCTIONS. 1011 C 1012 IF (CLSTR(1:ICL) .EQ. 'ALL') THEN 1013 IF (LUN .EQ. 5) WRITE(6,6700) 1014 C 1015 DISP_DATA = .FALSE. 1016 PAGE_FILE = .FALSE. 1017 ENDIF 1018 C 1019 C ** INDICATE OUTPUT FILE IS TO BE IN DUMP FILE FORMAT. 1020 C 1021 ELSE IF (CMDSTR(1:FSPC) .EQ. 'DUMP') THEN 1022 C 1023 C ** INDICATE THE FILE TO BE WRITTEN IN DUMP/UPDATE STYLE FORMAT. 1024 C 1025 IF (.NOT. DUMP_FILE) THEN 1026 DUMP_FILE = .TRUE. 1027 ELSE 1028 DUMP_FILE = .FALSE. 1029 ENDIF USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 12 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1030 C 1031 C ** INDICATE OUTPUT FILE IS TO BE IN DUMP FILE FORMAT. 1032 C 1033 ELSE IF (CMDSTR(1:FSPC) .EQ. 'PAGE') THEN 1034 C 1035 C ** INDICATE THE FILE TO BE WRITTEN IN DUMP/UPDATE STYLE FORMAT. 1036 C 1037 IF (.NOT. PAGE_FILE) THEN 1038 PAGE_FILE = .TRUE. 1039 ELSE 1040 PAGE_FILE = .FALSE. 1041 ENDIF 1042 C 1043 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'START') .OR. 1044 & (CMDSTR(1:FSPC) .EQ. 'RUN')) THEN 1045 C 1046 C ** DETERMINE NAME OF FILE FOR INPUT. 1047 C 1048 CALL STR$TRIM( TFILE, LINEIN(BQL:IQ), IIN ) 1049 CALL DBNET$COMP_STRING( TFILE, IIN ) 1050 C 1051 IF (IIN .GT. 0) THEN 1052 C 1053 C ** CHECK EXISTANCE OF FILE. 1054 C 1055 INQUIRE(FILE=TFILE, EXIST=TF_EXIST ) 1056 C 1057 C ** THE FILE EXIST. 1058 C 1059 IF (TF_EXIST) THEN 1060 C 1061 C ** DEFINE FILE VARIABLES, BRANCH TO STARTING LOCATION. 1062 C 1063 GET_FILE = .TRUE. 1064 C 1065 LUN = 25 1066 C 1067 GOTO 1000 1068 C 1069 ELSE 1070 C 1071 C ** NO FILE EXIST, INFORM USER. 1072 C 1073 WRITE(6,4750) TFILE 1074 C 1075 IF (LUN .NE. 5) GOTO 1125 1076 C 1077 ENDIF 1078 C 1079 ENDIF 1080 C 1081 C ** CHECK FOR COPY OR UPDATE CONDITION, ISSUE WARNING. 1082 C 1083 IF ((MAKCPY .OR. DO_UPDATE) .AND. (.NOT. DO_WHERE)) THEN 1084 C 1085 C ** IF NOT INTERACTIVE, THEN ABORT PROGRAM. 1086 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 13 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1087 IF (LUN .NE. 5) GOTO 9000 1088 C 1089 C ** INSTRUCTIONAL TEXT. 1090 C 1091 WRITE(6675) 1092 C 1093 C ** BRANCH TO NEXT READ 1094 C 1095 GOTO 4500 1096 C 1097 ENDIF 1098 C 1099 C ** START PROCESSING THE COMMANDS GIVEN SO FAR. 1100 C 1101 GOTO 4000 1102 C 1103 C ** CHECK IF COMMAND WAS A 'WHERE' CLAUSE. 1104 C 1105 ELSE IF (CMDSTR(1:FSPC) .EQ. 'WHERE') THEN 1106 C 1107 C ** INCREMENT THE WHERE CLAUSE COUNTER, AND SPECIFY LOGICAL AS TRUE. 1108 C 1109 WSCN = WSCN + 1 1110 DO_WHERE = .TRUE. 1111 C 1112 C ** SET THE FUNCTIONAL SPECIFIER IN THE RECORD STRUCTURE. 1113 C 1114 EVAL$REC(WSCN).FUNC = 'S' 1115 C 1116 C ** CHECK RETURN STATUS OF THE FUNCTION CALLED. 1117 C 1118 IF (DBEVL$PARSE( EVAL$REC(WSCN), LINEIN(BQL:IQ) ) .EQ. USRDB$_FAILURE) THEN 1119 C 1120 C ** IF THE ROUTINE CALLED FROM ANOTHER PROGRAM, THEN BRANCH TO RETURN. 1121 C ** ELSE CLEAR THE BUFFER VARIABLE, AND DECREMENT THE COUNTER. 1122 C 1123 IF (LUN .NE. 5) GOTO 9000 1124 EVAL$REC(WSCN).BUFFER = ' ' 1125 WSCN = WSCN - 1 1126 WRITE(6,3100) 1127 ENDIF 1128 C 1129 C ** FOUND OUT IF 'AND' OF WHERE STATEMENT ISSUED, FOLLOW 'WHERE' PATTERN. 1130 C 1131 ELSE IF (CMDSTR(1:FSPC) .EQ. 'AND') THEN 1132 C 1133 C ** SET FLAG FOR WHERE 'AND' CLAUSE. 1134 C 1135 WSCN = WSCN + 1 1136 C 1137 EVAL$REC(WSCN).FUNC = 'A' 1138 C 1139 C ** CHECK FOR 'AND' STRING PARAMETERS. 1140 C 1141 IF (DBEVL$PARSE( EVAL$REC(WSCN), LINEIN(BQL:IQ) ) .EQ. USRDB$_FAILURE) THEN 1142 C 1143 C ** NO LEGAL VALUES EXIST, THEREFORE, DECREMENT AND CLEAR LOCATION. USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 14 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1144 C 1145 IF (LUN .NE. 5) GOTO 9000 1146 EVAL$REC(WSCN).BUFFER = ' ' 1147 WSCN = WSCN - 1 1148 WRITE(6,3100) 1149 ENDIF 1150 C 1151 C ** FOUND OUT IF 'OR' OF WHERE STATEMENT ISSUED, FOLLOW 'WHERE' PATTERN. 1152 C 1153 ELSE IF (CMDSTR(1:FSPC) .EQ. 'OR') THEN 1154 C 1155 WSCN = WSCN + 1 1156 C 1157 EVAL$REC(WSCN).FUNC = 'O' 1158 C 1159 C ** CHECK FOR 'OR' STRING PARAMETERS. 1160 C 1161 IF (DBEVL$PARSE( EVAL$REC(WSCN), LINEIN(BQL:IQ) ) .EQ. USRDB$_FAILURE) THEN 1162 C 1163 C ** NO LEGAL VALUES EXIST, THEREFORE, DECREMENT AND CLEAR LOCATION. 1164 C 1165 IF (LUN .NE. 5) GOTO 9000 1166 EVAL$REC(WSCN).BUFFER = ' ' 1167 WSCN = WSCN - 1 1168 WRITE(6,3100) 1169 ENDIF 1170 C 1171 C ** FOUND OUT IF 'EQV' OF WHERE STATEMENT ISSUED, FOLLOW 'WHERE' PATTERN. 1172 C 1173 ELSE IF (CMDSTR(1:FSPC) .EQ. 'EQV') THEN 1174 C 1175 WSCN = WSCN + 1 1176 C 1177 EVAL$REC(WSCN).FUNC = 'V' 1178 C 1179 C ** CHECK FOR 'EQV' STRING PARAMETERS. 1180 C 1181 IF (DBEVL$PARSE( EVAL$REC(WSCN), LINEIN(BQL:IQ) ) .EQ. USRDB$_FAILURE) THEN 1182 C 1183 C ** NO LEGAL VALUES EXIST, THEREFORE, DECREMENT AND CLEAR LOCATION. 1184 C 1185 IF (LUN .NE. 5) GOTO 9000 1186 EVAL$REC(WSCN).BUFFER = ' ' 1187 WSCN = WSCN - 1 1188 WRITE(6,3100) 1189 ENDIF 1190 C 1191 C ** FOUND OUT IF 'NEQV' OF WHERE STATEMENT ISSUED, FOLLOW 'WHERE' PATTERN. 1192 C 1193 ELSE IF (CMDSTR(1:FSPC) .EQ. 'NEQV') THEN 1194 C 1195 WSCN = WSCN + 1 1196 C 1197 EVAL$REC(WSCN).FUNC = 'N' 1198 C 1199 C ** CHECK FOR 'NEQV' STRING PARAMETERS. 1200 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 15 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1201 IF (DBEVL$PARSE( EVAL$REC(WSCN), LINEIN(BQL:IQ) ) .EQ. USRDB$_FAILURE) THEN 1202 C 1203 C ** NO LEGAL VALUES EXIST, THEREFORE, DECREMENT AND CLEAR LOCATION. 1204 C 1205 IF (LUN .NE. 5) GOTO 9000 1206 EVAL$REC(WSCN).BUFFER = ' ' 1207 WSCN = WSCN - 1 1208 WRITE(6,3100) 1209 ENDIF 1210 C 1211 C ** TELL PROGRAM TO EVALUATE PREVIOUS TWO WHERE CLAUSES USING 'OR'. 1212 C 1213 ELSE IF (CMDSTR(1:FSPC) .EQ. 'EOR') THEN 1214 C 1215 WSCN = WSCN + 1 1216 C 1217 EVAL$REC(WSCN).FUNC = 'R' 1218 C 1219 C ** TELL PROGRAM TO EVALUATE PREVIOUS TWO WHERE CLAUSES USING 'EQV'. 1220 C 1221 ELSE IF (CMDSTR(1:FSPC) .EQ. 'EEQV') THEN 1222 C 1223 WSCN = WSCN + 1 1224 C 1225 EVAL$REC(WSCN).FUNC = 'E' 1226 C 1227 C ** TELL PROGRAM TO EVALUATE PREVIOUS TWO WHERE CLAUSES USING 'NEQV'. 1228 C 1229 ELSE IF (CMDSTR(1:FSPC) .EQ. 'ENEQ') THEN 1230 C 1231 WSCN = WSCN + 1 1232 C 1233 EVAL$REC(WSCN).FUNC = 'Q' 1234 C 1235 C ** TELL PROGRAM TO FINISH EVALUATION OF WHERE CLAUSES. 1236 C 1237 ELSE IF (CMDSTR(1:FSPC) .EQ. 'FINISH') THEN 1238 C 1239 WSCN = WSCN + 1 1240 C 1241 EVAL$REC(WSCN).FUNC = 'F' 1242 C 1243 C ** EVALUATE INITIAL SORT COMMAND ISSUED FOR INITIALIZATION OF RECORD OPERATIONS. 1244 C 1245 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'SORT') .AND. (.NOT. DO_UPDATE)) THEN 1246 C 1247 ISTAT = DBEVL$DEF_SORT( LINEIN(BQL:IQ), SRT_KEY, SRT_STRING, SRT_MATCH ) 1248 C 1249 C ** IF EVALUATION OF SORT COMMAND WAS A SUCCESS THEN RESET SORT LOGICAL 1250 C 1251 IF (ISTAT .EQ. USRDB$_SUCCESS) THEN 1252 NEED_SORT = .FALSE. 1253 C 1254 ELSE IF (LUN .EQ. 5) THEN 1255 C 1256 C ** TELL USER THAT SORT COMMAND WAS A FAILURE. 1257 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 16 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1258 WRITE(6,3500) 1259 C 1260 ELSE 1261 C 1262 C ** BRANCH IF SORT NOT VALID AND FROM ANOTHER PROGRAM. 1263 C 1264 GOTO 9000 1265 ENDIF 1266 C 1267 C ** CAN NOT SORT AN UPDATE FUNCTION, TELL USER. 1268 C 1269 ELSE IF ((CMDSTR(1:FSPC) .EQ. 'SORT') .AND. (DO_UPDATE)) THEN 1270 C 1271 WRITE(6,3750) 1272 C 1273 ENDIF 1274 C 1275 C 1276 ENDIF 1277 C 1278 C ** REPROMPT FOR COMMAND. 1279 C 1280 4500 IF (LUN .EQ. 5) WRITE(6,1500) 1281 C 1282 C ** READ NEXT COMMAND PROVIDED. 1283 C 1284 READ(LUN,2000,IOSTAT=IERR) IQ, LINEIN 1285 C 1286 C ** END THE LOOP? 1287 C 1288 ENDDO 1289 C 1290 C ** CHECK THE STATUS OF LAST READ BEFORE PROCEEDING. 1291 C 1292 4000 IF ((IERR .NE. 0) .AND. (LUN .EQ. 5)) THEN 1293 USRDB$SQL = USRDB$_SUCCESS 1294 GOTO 9000 1295 ENDIF 1296 C 1297 C ** INITIALIZE THE LENGTH OF THE STRING READ IN FROM BUFFER. 1298 C 1299 LINEIN = ' ' 1300 IQ = 0 1301 C 1302 C ** CHECK THE WHERE LOOP EVALUATION FOR A FINISH FUNCTION. 1303 C 1304 IF ((EVAL$REC(WSCN).FUNC .NE. 'F') .AND. (WSCN .LT. USRDB$_NUM_FIELDS)) THEN 1305 WSCN = WSCN + 1 1306 EVAL$REC(WSCN).FUNC = 'F' 1307 ENDIF 1308 C 1309 C ** CHECK IF WE NEED TO SORT THE DATABASE OUTPUT. 1310 C 1311 IF (NEED_SORT) ISTAT = DBEVL$SORT( EVAL$REC, WSCN, SRT_KEY, SRT_STRING, SRT_MATCH ) 1312 C 1313 C ** GET LOGICAL UNIT NUMBERS FOR FILES TO BE WRITTEN 1314 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 17 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1315 CALL LIB$GET_LUN( NLUN ) 1316 C 1317 C ** OPEN THE FILE TO BE WRITTEN. 1318 C 1319 IF ((LIST_FILE) .AND. (.NOT. DUMP_FILE)) THEN 1320 C 1321 C ** WRITE A FIXED LENGTH RECORD WITH DATA FOR PASSING TO OTHER ROUTINES. 1322 C 1323 TLEN = TLEN + SCNT 1324 C 1325 OPEN( UNIT=NLUN, CARRIAGECONTROL='NONE', FORM='FORMATTED', 1326 & FILE=OU_FILE, TYPE='NEW', RECL=TLEN, RECORDTYPE='FIXED', 1327 & ORGANIZATION='SEQUENTIAL' ) 1328 C 1329 C ** WRITE A DUMP/UPDATE FILE OUTPUT FORMAT. 1330 C 1331 ELSE IF ((LIST_FILE) .AND. (DUMP_FILE)) THEN 1332 C 1333 OPEN( UNIT=NLUN, CARRIAGECONTROL='LIST', RECORDTYPE='VARIABLE', 1334 & FORM='FORMATTED', FILE=OU_FILE, TYPE='NEW', 1335 & ORGANIZATION='SEQUENTIAL' ) 1336 C 1337 ELSE IF (.NOT. LIST_FILE) THEN 1338 C 1339 C ** WRITE A FILE IN SCREEN LIST FORMAT. 1340 C 1341 OPEN( UNIT=NLUN, CARRIAGECONTROL='LIST', RECORDTYPE='VARIABLE', 1342 & FORM='FORMATTED', FILE='SYS$OUTPUT', TYPE='UNKNOWN', 1343 & ORGANIZATION='SEQUENTIAL' ) 1344 C 1345 ENDIF 1346 C 1347 C ** OPEN FILE FOR DISTRIBUTION LIST OUTPUT 1348 C 1349 IF (SCRN_OUT) THEN 1350 C 1351 CALL LIB$GET_LUN(DLUN) 1352 C 1353 OPEN( UNIT=DLUN, CARRIAGECONTROL='LIST', RECORDTYPE='VARIABLE', 1354 & FORM='FORMATTED', FILE='LOC_SCR:SCRATCH.DIS', 1355 & TYPE='NEW', ORGANIZATION='SEQUENTIAL' ) 1356 C 1357 ENDIF 1358 C 1359 C ** OPEN FILE FOR DISPLAY FUNCTION 1360 C 1361 IF (SCRN_OUT) THEN 1362 C 1363 CALL LIB$GET_LUN( CLUN ) 1364 C 1365 OPEN( UNIT=CLUN, CARRIAGECONTROL='LIST', RECORDTYPE='VARIABLE', 1366 & FORM='FORMATTED', FILE='SYS$OUTPUT', TYPE='UNKNOWN', 1367 & ORGANIZATION='SEQUENTIAL' ) 1368 C 1369 ENDIF 1370 C 1371 C ** IF WE ARE UPDATING RECORDS, THEN OPEN DATABASE WITH WRITE CAPABILITY. USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 18 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1372 C 1373 IF (DO_UPDATE) THEN 1374 C 1375 CALL USRDB$SYSTEM_OPEN 1376 C 1377 ELSE 1378 C 1379 C ** ELSE WE ONLY NEED READ CAPABILITY ON THE DATABASE. 1380 C 1381 CALL USRDB$USER_OPEN 1382 C 1383 ENDIF 1384 C 1385 C ** GET LENGTH OF THE SORTING STRING, RESET TO 1 IF BLANK. 1386 C 1387 CALL STR$TRIM( SRT_STRING, SRT_STRING, SLN ) 1388 IF (SLN .EQ. 0) SLN = 1 1389 C 1390 C ** INITIALIZE GET OPERATION USING SORT EVALUATION RESULTS. 1391 C 1392 LAST_WRITE = 0 1393 TOT_REC = 0 1394 TOT_FND = 0 1395 PCNT = 0 1396 C 1397 C ** DEFINE THE VARIABLE TO BE FALSE, THEN CHECK FOR SORT CONDITIONS. 1398 C 1399 SORT_CHECK = .FALSE. 1400 C 1401 IF ((SRT_MATCH .EQ. USRDB$_MATCH_EQ) .OR. (SRT_MATCH .EQ. USRDB$_MATCH_GE)) THEN 1402 C 1403 C ** BRANCH, NO SPECIFIC START VALUE HAS BEEN SPECIFIED. 1404 C 1405 IF ((SRT_MATCH .EQ. USRDB$_MATCH_GE) .AND. (SRT_STRING .EQ. ' ')) GOTO 4250 1406 C 1407 C ** SORT VALUE HAS BEEN SPECIFIED, GET PARAMETERS FOR READ INITIALIZE. 1408 C 1409 SORT_CHECK = .TRUE. 1410 FID_STR = IDX$_NAME( SRT_KEY+1 ) 1411 ISTAT1 = DBCRS$FIELD_IDENT( FID_STR, IPNT ) 1412 SFID = USRDB$_CROSS_FID( IPNT ) 1413 C 1414 ENDIF 1415 C 1416 C ** INITIALIZE THE READ OPERATION OF THE DATABASE. 1417 C 1418 4250 ISTAT = USRDB$GET_INIT(USRDB$REC, SRT_KEY, SRT_STRING, SRT_MATCH ) 1419 C 1420 C ** BEGIN RETRIEVAL OF DATA. 1421 C 1422 DO WHILE (ISTAT .EQ. USRDB$_SUCCESS) 1423 C 1424 C ** IF WE NEED TO CHECK FOR SORT IDENTITY, THEN GET VALUES AND COMPARE. 1425 C 1426 IF (SORT_CHECK) THEN 1427 C 1428 ISTAT9 = USRDB$GET_FIELD(USRDB$REC, SFID, CHKSRT, SCLEN) USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 19 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1429 IF (CHKSRT(1:SLN) .NE. SRT_STRING(1:SLN)) GOTO 1200 1430 C 1431 ENDIF 1432 C 1433 C ** INCREMENT THE COUNTER OF NUMBER OF RECORDS READ/WRITTEN. 1434 C 1435 TOT_REC = TOT_REC + 1 1436 C 1437 LAST_WRITE = LAST_WRITE + 1 1438 C 1439 C ** EVALUATE THE WHERE CLAUSE. 1440 C 1441 IF (DO_WHERE) THEN 1442 C 1443 C ** INITIALIZE WHERE CLAUSE DEFINITION TO FALSE. 1444 C 1445 WHOK = .FALSE. 1446 C 1447 C ** LOOP THRU THE EVALUATION OF WHERE CLAUSES. 1448 C 1449 DO JJ = 1,WSCN 1450 C 1451 C ** EVALUATE THE WHERE IDENTITY. 1452 C 1453 ISTAT2 = DBEVL$WHERE( USRDB$REC, EVAL$REC(JJ) ) 1454 C 1455 C ** IF SUCCESS OF WHERE, THEN SET BOOLEAN VALUE TO APPROPRIATE VALUE. 1456 C 1457 IF (ISTAT2 .EQ. USRDB$_SUCCESS) THEN 1458 IF (EVAL$REC(JJ).QUAL .EQ. 'E') THEN 1459 EVAL$REC(JJ).EVAL = .TRUE. 1460 ELSE IF (EVAL$REC(JJ).QUAL .EQ. 'N') THEN 1461 EVAL$REC(JJ).EVAL = .FALSE. 1462 ENDIF 1463 C 1464 C ** IF FAILURE OF WHERE, THEN SET BOOLEAN VALUE TO APPROPRIATE VALUE. 1465 C 1466 ELSE IF (ISTAT2 .EQ. USRDB$_FAILURE) THEN 1467 IF (EVAL$REC(JJ).QUAL .EQ. 'E') THEN 1468 EVAL$REC(JJ).EVAL = .FALSE. 1469 ELSE IF (EVAL$REC(JJ).QUAL .EQ. 'N') THEN 1470 EVAL$REC(JJ).EVAL = .TRUE. 1471 ENDIF 1472 ENDIF 1473 ENDDO 1474 C 1475 C ** ACCUMULATE EVALUATIONS OF TOTAL WHERE IDENTITY. 1476 C 1477 ISTAT3 = DBEVL$LOGICAL( EVAL$REC, WSCN ) 1478 C 1479 C ** DETERMINE THE FINAL WHERE EVALUATION. 1480 C 1481 IF (ISTAT3 .EQ. USRDB$_SUCCESS) WHOK = .TRUE. 1482 ENDIF 1483 C *C ** CHECK FOR ABORT CONDITION FOR CALLING ROUTINE. 1484 C 1485 IF ((SCRN_OUT) .AND. (.NOT. DUMP_ALL)) GOTO 1200 USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 20 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1486 C 1487 C ** OUTPUT THE RECORD FOUND. 1488 C 1489 IF (WHOK) THEN 1490 C 1491 C ** INITIALIZE AND INCREMENT THE COUNTERS. 1492 C 1493 LAST_WRITE = 0 1494 TOT_FND = TOT_FND + 1 1495 C 1496 C ** OUTPUT OF DATA AS REQUESTED. 1497 C 1498 IF ((.NOT. DO_UPDATE) .AND. (DO_SELECT)) THEN 1499 C 1500 C ** OUTPUT TO FILE, NOT IN 'LLUD' SCREEN OUTPUT FORMAT. 1501 C 1502 IF ((LIST_FILE) .AND. (.NOT. SCRN_OUT)) THEN 1503 C 1504 IF (.NOT. DUMP_FILE) CALL DBWRT$PUT_LIST( USRDB$REC, SEL_FIDS, SCNT, NLUN ) 1505 IF (DUMP_FILE) CALL DBWRT$DUMP_FIDS( USRDB$REC, SEL_FIDS, SCNT, NLUN ) 1506 C 1507 C ** DISPLAY DATA BEING WRITTEN TO FILE, TO THE SCREEN AS WELL. 1508 C 1509 IF (DISP_DATA) CALL DBWRT$PUT_OUTPUT( USRDB$REC, SEL_FIDS, SCNT, CLUN ) 1510 C 1511 ENDIF 1512 C 1513 C ** OUTPUT TO SCREEN, NOT IN ''LLUD SCREEN FORMAT. CHECK FOR NEED TO PROMPT TO CONTINUE. 1514 C 1515 IF ((.NOT. LIST_FILE) .AND. (.NOT. DUMP_FILE) .AND. (.NOT. SCRN_OUT)) THEN 1516 C 1517 CALL DBWRT$PUT_OUTPUT( USRDB$REC, SEL_FIDS, SCNT, NLUN ) 1518 C 1519 C ** INCREMENT SCREEN LINE COUNTER. 1520 C 1521 PCNT = PCNT + SCNT + 1 1522 C 1523 C ** IF SCREEN LINE COUNTER EXCEEDS SCREEN SIZE, THEN PROMPT FOR RETURN. 1524 C 1525 IF ((PAGE_FILE) .AND. (PCNT .GT. 20) .AND. (LUN .EQ. 5)) THEN 1526 IF (LUN .EQ. 5) WRITE(6,1550) 1527 READ(LUN,2000,IOSTAT=IER2,END=1200) IQ, LRET 1528 PCNT = 0 1529 ENDIF 1530 C 1531 ENDIF 1532 C 1533 C ** OUTPUT IN 'LLUD' SCREEN FORMAT. 1534 C 1535 IF (SCRN_OUT) THEN 1536 CALL DBWRT$PUT_SCREEN( USRDB$REC, SEL_FIDS, SCNT, NLUN, DLUN ) 1537 ENDIF 1538 C 1539 C ** UPDATE FUNCTION. 1540 C 1541 ELSE IF ((DO_UPDATE) .AND. (.NOT. DO_SELECT)) THEN 1542 C USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 21 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1543 C ** UPDATE REQUIRES WHERE FUNCTIONS. 1544 C 1545 IF (DO_WHERE) THEN 1546 C 1547 C ** OUTPUT TO A FILE FOR AUDIT PURPOSES. 1548 C 1549 IF ((LIST_FILE) .AND. (DUMP_FILE)) 1550 & CALL DBWRT$DUMP_FIDS( USRDB$REC, SEL_FIDS, SCNT, NLUN ) 1551 C 1552 C ** DISPLAY DATA BEING UPDATED, TO THE SCREEN ASPWELL. 1553 C 1554 IF (DISP_DATA) CALL DBWRT$PUT_OUTPUT( USRDB$REC, SEL_FIDS, SCNT, CLUN ) 1555 C 1556 C ** PERFORM THE UPDATE. 1557 C 1558 CALL DBUPD$RECORD( USRDB$REC, UPDVAL, UPDLEN, SRT_KEY, UPD_FID, UCNT ) 1559 ELSE 1560 C 1561 C ** TELL USER WE NEED A WHERE CLAUSE. 1562 C 1563 WRITE(6,3250) 1564 ENDIF 1565 C 1566 C ** MAKE COPY OF ANOTHER USERS RECORD. 1567 C 1568 ELSE IF (MAKCPY) THEN 1569 C 1570 ISTAT = DBCPY$COPY( USRDB$REC, NEWNAME, NWN ) 1571 C 1572 C ** BRANCH TO USER DATABASE CLOSE. 1573 C 1574 GOTO 1200 1575 C 1576 ENDIF 1577 C 1578 ENDIF 1579 C 1580 C ** GET NEXT RECORD IF WE ARE DOING A SELECT ONLY. 1581 C 1582 IF ((.NOT. DO_UPDATE) .AND. (.NOT. MAKCPY)) ISTAT = USRDB$GET_RECORD( USRDB$REC ) 1583 C 1584 C ** USER IS IN INTERACTIVE MODE, TELL USER IF NO RECORDS FOUND RECENTLY. 1585 C 1586 IF ((LAST_WRITE .GE. 50) .AND. (.NOT. LIST_FILE) .AND. (LUN .EQ. 5)) THEN 1587 WRITE(6,8500) TOT_REC 1588 LAST_WRITE = 0 1589 ELSE IF (( ((TOT_REC/50)*50) .EQ. TOT_REC) .AND. (LUN .EQ. 5)) THEN 1590 IF (LAST_WRITE .GE. 10) WRITE(6,8500) TOT_REC 1591 ENDIF 1592 C 1593 ENDDO 1594 C 1595 C ** REINITIALIZE, AND RESTART. 1596 C 1597 1200 CALL USRDB$CLOSE_DB 1598 C 1599 C ** CLOSE THE DISTRIBUTION LIST FILE CREATED. USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 22 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1600 C ** FOR 'LLUD' SCREEN OUTPUT, INFORM USER OF TOTAL RECORDS FOUND. 1601 C 1602 IF (SCRN_OUT) THEN 1603 CLOSE(DLUN) 1604 WRITE(NLUN,8555) TOT_FND 1605 ENDIF 1606 C 1607 C ** CLOSE REMAINING DATA FILES. 1608 C 1609 IF (DISP_DATA) CLOSE(CLUN) 1610 C 1611 CLOSE(NLUN) 1612 C 1613 C ** KEEP RUNNING THE SCRIPT FILE 1614 C 1615 IF ((IERR .EQ. 0) .AND. (LUN .NE. 5)) GOTO 1125 1616 C 1617 C ** NOT 'LLUD' SCREEN MODE, TELL TOTAL RECORDS, AND TOTAL FOUND. 1618 C 1619 IF (LUN .EQ. 5) THEN 1620 WRITE(6,8550) TOT_FND, TOT_REC 1621 C 1622 C ** BRANCH TO GET NEXT COMMAND. 1623 C 1624 GOTO 1250 1625 ENDIF 1626 C 1627 C ** RETURN TO CALLING ROUTINE. 1628 C 1629 9000 IF (GET_FILE) THEN 1630 C 1631 C ** CLEAR OUT VARIABLES, AND CLOSE THE RUN INTERFACE FILE. 1632 C 1633 CLOSE(LUN) 1634 IERR = 0 1635 LUN = 5 1636 GET_FILE = .FALSE. 1637 C 1638 C ** BRANCH TO GET COMMAND PROMPT. 1639 C 1640 GOTO 1250 1641 C 1642 ELSE IF (LUN .NE. 5) THEN 1643 C 1644 C ** CLoSE THE INPUT DATA FILE, AND EXIT SUBROUTINE. 1645 C 1646 CLOSE(LUN) 1647 C 1648 ENDIF 1649 C 1650 RETURN 1651 C 1652 1500 FORMAT(/1X,'LQL> ',$) 1653 1550 FORMAT(1X,' Press RETURN to Continue, or Control/Z to Abort',$) 1654 2000 FORMAT(Q,A) 1655 2500 FORMAT(' LQL%ERROR.SELECT: Invalid Query SELECTs Provided.') 1656 2550 FORMAT(' LQL%WARNING.SELECT: Bad Select, Re-Issue Last Command or INIT.') USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 23 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1657 3000 FORMAT(' LQL%ERROR.UPDATE: Invalid UPDATE Syntax Provided.') 1658 3020 FORMAT(' LQL%ERROR.UPDATE: Exceeded Allowed Number of Updates per Record.') 1659 3050 FORMAT(' LQL%WARNING.UPDATE: Bad UPDATE, Re-Issue Last Command or INIT.') 1660 3100 FORMAT(' LQL%WARNING.WHERE: Bad WHERE, Re-Issue Last Command or INIT.') 1661 3150 FORMAT(' LQL%WARNING.FILE: No File Name Provided!') 1662 3250 FORMAT(' LQL%ERROR.UPDATE: Must Provide a WHERE Clause for UDATEs.') 1663 3500 FORMAT(' LQL%WARNING.SORT: Invalid SORT Syntax Provided.') 1664 3750 FORMAT(' LQL%WARNING.SORT: Cannot SORT on a UPDATE Command.') 1665 4750 FORMAT(' LQL%ERROR.START: Cannot Start, No File Exist: ',A) 1666 6600 FORMAT(' LQL%WARNING.UPDATE: Cannot Perform SELECT after UPDATE Started.') 1667 6650 FORMAT(' LQL%WARNING.SELECT: Cannot Perform UPDATE after SELECT Started.') 1668 6675 FORMAT(' LQL%ERROR.WHERE: Must Provide a WHERE Clause for COPY & UPDATE.') 1669 6700 FORMAT(' LQL%INITIALIZATION: Re-Initializing Environment.') 1670 6750 FORMAT(' LQL%WARNING.SELECT: All Fields Have Been Selected.') 1671 6875 FORMAT(' LQL%ERROR.MODIFY: Security, Must have system privilege to MODIFY DB.') 1672 6900 FORMAT(' LQL%INITIALIZATION: Unable to Initialize, No CLEAR Sub-Type Provided.'// 1673 & ' LQL%INFO: Sub-Types: ALL, FILE, DUMP, SELECT, UPDATE, WHERE, or SORT.') 1674 7000 FORMAT('FILE ',A) 1675 7100 FORMAT('DUMP') 1676 7130 FORMAT('DISPLAY') 1677 7150 FORMAT('PAGE') 1678 7200 FORMAT('UPDATE ',A,'="',A,'"') 1679 7250 FORMAT('COPY ',A) 1680 7300 FORMAT('SELECT ',A15, 3( :, ',', A15 )) 1681 7400 FORMAT(A6,A,'.EQ."',A,'"') 1682 7450 FORMAT(A6,A,'.NE."',A,'"') 1683 7500 FORMAT(A6) 1684 7600 FORMAT('SORT ',A,A4,'"',A,'"') 1685 7650 FORMAT('SORT ',A) 1686 7900 FORMAT(//' Current LQL Definitions:'//) 1687 7950 FORMAT(//) 1688 8500 FORMAT(' LQL%INFO: Working on Record: ',I6) 1689 8550 FORMAT(' LQL%INFO: Records Processed: ',I6,5X,'Records Read: ',I6) 1690 8555 FORMAT(//25X,I4,' users listed.',/) 1691 C 1692 END USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 24 01 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 5498 PIC CON REL LCL SHR EXE RD NOWRT QUAD 1 $PDATA 1740 PIC CON REL LCL SHR NOEXE RD NOWRT QUAD 2 $LOCAL 15024 PIC CON REL LCL NOSHR NOEXE RD WRT QUAD Total Space Allocated 22262 ENTRY POINTS Address Type Name 0-00000000 I*4 USRDB$SQL VARIABLES Address Type Name Address Type Name 2-00003454 I*4 BQL 2-000033EB CHAR CHKSRT 2-000033E5 CHAR CLSTR 2-0000348C I*4 CLUN 2-0000338C CHAR CMDSTR ** I*4 DBEVL$COMPOSE 2-000034C4 R*4 DBUPD$SECURITY 2-000034BC L*4 DISP_DATA 2-0000347C I*4 DLUN ** CHAR DMPSTR 2-000034AC L*4 DO_SELECT 2-00003498 L*4 DO_UPDATE 2-000034A0 L*4 DO_WHERE ** L*4 DUMP_ALL 2-00003490 L*4 DUMP_FILE 2-000033D6 CHAR FID_STR ** I*4 FSPC ** CHAR GETNAME 2-000034B8 L*4 GET_FILE 2-000034F0 I*4 ICL ** I*4 IER2 2-000034C8 I*4 IERR 2-000034EC I*4 IFL 2-000034F4 I*4 IIN 2-000034D8 I*4 IOU 2-000034E0 I*4 IPNT 2-000034CC I*4 IQ 2-000034DC I*4 ISC ** I*4 ISTAT ** I*4 ISTAT1 ** I*4 ISTAT2 ** I*4 ISTAT3 ** I*4 ISTAT4 ** I*4 ISTAT9 2-000034E4 I*4 IX ** I*4 JJ ** I*4 KK ** I*4 LAST_WRITE 2-0000328D CHAR LINEIN 2-00003494 L*4 LIST_FILE ** I*4 LL 2-000034FC I*4 LRET AP-00000004@ I*4 LUN 2-000034D4 I*4 MAKCPY ** CHAR MAKNAME ** L*4 MAXCPY ** I*4 MM 2-000034A8 L*4 NEED_SORT 2-0000343B CHAR NEWNAME 2-00003450 I*4 NLUN 2-000034D0 I*4 NWN 2-000031F7 CHAR OU_FILE 2-000034B0 L*4 PAGE_FILE ** I*4 PCNT ** CHAR PRET 2-00003478 I*4 SCLEN 2-0000346C I*4 SCNT 2-000034A4 L*4 SCRN_OUT 2-00003396 CHAR SC_FILE ** L*4 SECURITY 2-00003474 I*4 SFID 2-00003468 I*4 SLEN 2-00003480 I*4 SLN 2-00003458 I*4 SLUN 2-000034B4 L*4 SORT_CHECK 2-0000345C I*4 SRT_KEY 2-00003460 I*4 SRT_MATCH ** I*4 SRT_PNTR 2-00003237 CHAR SRT_STRING AP-00000008@ CHAR TFILE USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 25 01 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 2-000034C0 L*4 TF_EXIST 2-00003464 I*4 TLEN 2-00003470 I*4 TOT_FND ** I*4 TOT_REC 2-00003484 I*4 UCNT 2-00003488 I*4 ULEN ** I*4 USRDB$CLEAR_RECORD ** I*4 USRDB$DELETE_RECORD ** I*4 USRDB$GET_DUMP ** I*4 USRDB$PUT_DUMP ** I*4 USRDB$PUT_FIELD ** I*4 USRDB$PUT_RECORD 2-00002DF7 CHAR USRDB$REC ** I*4 USRDB$UPDATE_RECORD 2-0000349C L*4 WHOK 2-0000344C I*4 WSCN 2-00003287 CHAR WSTR RECORDS Address Name Structure Bytes 2-000002C8 DBINT USRDB$INTERNAL 1024 2-00002264 EVAL$STR EVAL_WHERE 186 ARRAYS Address Type Name Bytes Dimensions 2-00002DBB CHAR FID_SEL 60 (4) 2-00000164 I*4 IDX$_FIDS 52 (13) 2-000026FC CHAR IDX$_NAME 195 (13) 2-00000130 I*4 IDX$_NMBR 52 (13) 2-0000049F CHAR MTCH$_NAME 12 (6) 2-00000198 I*4 SEL_FIDS 152 (38) 2-0000027C I*4 UPDLEN 76 (19) 2-000027CB CHAR UPDVAL 1520 (19) 2-00000230 I*4 UPD_FID 76 (19) 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-00002320 CHAR USRDB$_IDENTS 570 (38) RECORD ARRAYS Address Name Structure Bytes Dimensions 2-000006C8 EVAL$REC EVAL_WHERE 7068 (38) LABELS Address Label Address Label Address Label Address Label Address Label Address Label 0-00000020 1000 0-00000040 1125 0-00001464 1200 0-00000058 1250 1-00000021 1500' 1-0000002E 1550' 1-00000064 2000' 1-0000006C 2500' 1-000000A2 2550' 1-000000E5 3000' 1-0000011B 3020' 1-00000160 3050' 1-000001A3 3100' 1-000001E3 3150' 1-00000210 3250' 1-0000024E 3500' 1-00000284 3750' 0-00001074 4000 0-000011B9 4250 0-00001018 4500 1-000002BB 4750' 1-000002F6 6600' 1-0000033A 6650' ** 6675' 1-0000037E 6700' 1-000003B3 6750' 1-000003EA 6875' 1-00000433 6900' 1-000004C9 7000' 1-000004D7 7100' 1-000004DE 7130' 1-000004E8 7150' 1-000004EF 7200' 1-0000050C 7250' 1-0000051A 7300' 1-00000531 7400' 1-0000054A 7450' 1-00000563 7500' 1-00000566 7600' 1-00000582 7650' 1-00000590 7900' 1-000005B1 7950' USRDB$SQL 22-Mar-1991 18:18:19 VAX FORTRAN V5.5-98 Page 26 01 22-Mar-1991 18:14:57 LQL_DRIVER.FOR;2 1-000005B4 8500' 1-000005D9 8550' 1-00000613 8555' 0-000014F0 9000 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name I*4 DBCPY$COPY I*4 DBCRS$FIELD_IDENT 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 DBNET$COMP_STRING DBUPD$RECORD DBWRT$DUMP_FIDS DBWRT$PUT_LIST DBWRT$PUT_OUTPUT DBWRT$PUT_SCREEN FOR$CLOSE FOR$INQUIRE FOR$OPEN LIB$GET_LUN I*4 LIB$INDEX STR$TRIM STR$UPCASE USRDB$CLOSE_DB I*4 USRDB$GET_FIELD I*4 USRDB$GET_INIT I*4 USRDB$GET_RECORD I*4 USRDB$LOCATE USRDB$SYSTEM_OPEN USRDB$USER_OPEN OPTIONS QUALIFIERS /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /EXTEND_SOURCE /F77 /NOG_FLOATING /I4 COMMAND QUALIFIERS FOR/LIST/SHOW LQL_DRIVER /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_DRIVER.LIS;3 /OBJECT=LIB4:[LIFENET.USERDB.CURRENT_SOURCE]LQL_DRIVER.OBJ;3 COMPILATION STATISTICS Run Time: 12.63 seconds Elapsed Time: 39.05 seconds Page Faults: 1651 Dynamic Memory: 1436 pages