<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">
                                                                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         &amp;			LINEIN*255, CMDSTR*10, SC_FILE*64, FID_STR*15, CLSTR*6,
0425         &amp;			PRET*64, UPDVAL(SQL$_MAX_UPDATE)*80, CHKSRT*80, FID_SEL(4)*15,
0426         &amp;			MAKNAME*20, GETNAME*20, NEWNAME*12
0427    	INTEGER*4	LUN, WSCN, NLUN, FSPC, BQL, SEL_FIDS(USRDB$_NUM_FIELDS), SLUN,
0428         &amp;			SRT_KEY, SRT_MATCH, TLEN, SLEN, UPD_FID(SQL$_MAX_UPDATE), SCNT,
0429         &amp;			LAST_WRITE, TOT_REC, TOT_FND, PCNT, UPDLEN(SQL$_MAX_UPDATE),
0430         &amp;			SFID, SCLEN, DLUN, SLN, SRT_PNTR, UCNT, ULEN, CLUN
0431    	LOGICAL		DUMP_FILE, LIST_FILE, DO_UPDATE, WHOK, DO_WHERE, SCRN_OUT,
0432         &amp;			NEED_SORT, DO_SELECT, PAGE_FILE, SORT_CHECK, GET_FILE, MAXCPY,
0433         &amp;			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         &amp;			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         &amp;				.AND. (SECURITY)
0572         &amp;				.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         &amp;						(CLSTR(1:ICL) .EQ. 'SELECT') .OR.
0957         &amp;						(CLSTR(1:ICL) .EQ. 'SCREEN') .OR.
0958         &amp;						(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         &amp;				 (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         &amp;			FILE=OU_FILE, TYPE='NEW', RECL=TLEN, RECORDTYPE='FIXED',
1327         &amp;			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         &amp;			FORM='FORMATTED', FILE=OU_FILE, TYPE='NEW', 
1335         &amp;			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         &amp;			FORM='FORMATTED', FILE='SYS$OUTPUT', TYPE='UNKNOWN', 
1343         &amp;			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         &amp;			FORM='FORMATTED', FILE='LOC_SCR:SCRATCH.DIS', 
1355         &amp;			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         &amp;			FORM='FORMATTED', FILE='SYS$OUTPUT', TYPE='UNKNOWN', 
1367         &amp;			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         &amp;						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&gt;  ',$)
1653    1550	FORMAT(1X,'	Press RETURN to Continue, or Control/Z to Abort',$)
1654    2000	FORMAT(Q,A&lt;IQ&gt;)
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&lt;IIN&gt;)
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 &amp; 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         &amp;	       ' LQL%INFO:  Sub-Types:  ALL, FILE, DUMP, SELECT, UPDATE, WHERE, or SORT.')
1674    7000	FORMAT('FILE ',A&lt;IOU&gt;)
1675    7100	FORMAT('DUMP')
1676    7130	FORMAT('DISPLAY')
1677    7150	FORMAT('PAGE')
1678    7200	FORMAT('UPDATE ',A&lt;IX&gt;,'="',A&lt;ULEN&gt;,'"')
1679    7250	FORMAT('COPY ',A&lt;NWN&gt;)
1680    7300	FORMAT('SELECT ',A15, 3( :, ',', A15 ))
1681    7400	FORMAT(A6,A&lt;IX&gt;,'.EQ."',A&lt;IFL&gt;,'"')
1682    7450	FORMAT(A6,A&lt;IX&gt;,'.NE."',A&lt;IFL&gt;,'"')
1683    7500	FORMAT(A6)
1684    7600	FORMAT('SORT ',A&lt;IX&gt;,A4,'"',A&lt;SLN&gt;,'"')
1685    7650	FORMAT('SORT ',A&lt;IX&gt;)
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
</pre></body></html>