| -SET &MASTER =' ';
-SET &SDDNAME =' ';
-SET &SRELNAME=' ';
-SET &WRITE =' ';
-SET &FUNC ='R';
-SET &DEFNAMES = 0;
-SET &KEYCOUNT='0';
-SET &RDBFILE =' ';
-SET &AFILE =' ';
-SET &MFILE =' ';
-SET &LOOP =' ';
-SET &MSG1 =' ';
-SET &MSG2 =' ';
-SET &TYP_I2 = 7;
-SET &TYP_I4 = 8;
-SET &TYP_I8 = 9;
-SET &TYP_F4 = 10;
-SET &TYP_T = 14;
-SET &TYP_VT = 37;
-SET &TYP_ADT = 35;
-SET &TYP_F8 = 27;
-TOP
-CRTFORM
-"<12 ������������������������������������������������������"
-"<12 � RELATIONAL TABLE DESCRIPTOR FACILITY FOR FOCUS/RDB �"
-"<12 � VERSION 1.2 �"
-"<12 � INFORMATION BUILDERS, INCORPORATED �"
-"<12 ������������������������������������������������������ </3"
-"<6 RDB FILENAME �> <.I.T.&RDBFILE "
-"<6 RELATION-NAME �> <.I.T.&SRELNAME </2"
-"<6 MASTER FILENAME ��������> <.I.T.&MASTER "
-"<6 RDB RELATION-DDNAME ����> <.I.T.&SDDNAME <48 (QUOTES ARE UNNECESSARY)"
-"<6 LEVEL OF FUNCTIONALITY �> <T.&FUNC <48 (R=READ, W=WRITE) </1"
-"<5 <.H.D.&MSG1 "
-"<5 <.H.D.&MSG2 </1 "
-"<14 PRESS PF3 KEY TO TERMINATE PROCEDURE "
SET MSG=OFF
-SET &WRITE=DECODE &FUNC('R' 'NO' 'W' 'YES' ELSE ' ');
-IF &FUNC EQ 'R' OR 'W' THEN GOTO CHKDBFIL;
-SET &MSG1='YOU HAVE CHOSEN AN INVALID "LEVEL OF FUNCTIONALITY"';
-SET &MSG2=' PLEASE CHOOSE EITHER AN "R" OR A "W" ';
-GOTO TOP
-*
-CHKDBFIL
-IF (&RDBFILE EQ ' ') OR (&SRELNAME EQ ' ') THEN GOTO BLANKS;
-VMS DEFINE/NOLOG/JOB AUTORDBX &RDBFILE
VMS STATE AUTORDBX:
-RUN
-IF &RETCODE EQ 0 GOTO CHKBLANK;
-SET &MSG1=' RDB FILE NOT FOUND OR INVALID ';
-SET &MSG2=' RE-ENTER USING FULL RDB FILENAME ';
-GOTO TOP
-*
-CHKBLANK
-SET &DEFNAMES = IF (&MASTER EQ ' ') THEN 1 ELSE 0;
-IF (&DEFNAMES EQ 0) THEN GOTO CHKFILE;
-SET &MASTER = IF &MASTER EQ ' ' THEN
-SUBSTR(48,&SRELNAME,1,8,8,'A8')
-ELSE &MASTER;
-SET &MSG1=' DEFAULT SELECTED FOR MASTER FILE NAME ';
-SET &MSG2=' PRESS <ENTER> TO CONTINUE ';
-GOTO TOP
-*
-BLANKS
-SET &MSG1=' PLEASE INPUT A NON-BLANK ENTRY FOR RDB FILENAME ';
-SET &MSG2=' AND RDB RELATION-NAME ';
-GOTO TOP
-*
-CHKFILE
-SET MFILE = &MASTER || .MAS;
VMS STATE &MFILE
-RUN
-IF &RETCODE NE 0 GOTO OK1;
-SET &MSG1=' THIS MASTER FILENAME EXISTS ALREADY ';
-SET &MSG2=' CHOOSE ANOTHER OR DELETE THIS FILENAME ';
-GOTO TOP
-*
-OK1
-SET AFILE = &MASTER || .ACX;
VMS STATE &AFILE
-RUN
-IF &RETCODE NE 0 GOTO OK2;
-SET &MSG1=' THIS ACCESS FILENAME EXISTS ALREADY ';
-SET &MSG2=' CHOOSE ANOTHER OR DELETE THIS FILENAME ';
-GOTO TOP
-*
-OK2
-*
-* ACCESS RDBFILE TABLE IN RDB FOR SELECTED RDB TABLE AND EXTRACT
-* INFORMATION NEEDED TO BUILD FOCUS MASTER
-*
-TYPE
-TYPE PROCESS INITIATION ... PLEASE STAND BY
FILEDEF RDBFILE DISK AUTORDBX:
-*
DEFINE FILE RDBFILE
FLD_SCALE/I9=FLD_SCALE;
FLD_DATATYPE/I9=FLD_DATATYPE;
END
TABLE FILE RDBFILE
PRINT RFLD_POSIT
FLD_DATATYPE FLD_LENGTH FLD_SCALE BY RFLD_NAME
IF RELNAME CONTAINS '&SRELNAME'
ON TABLE HOLD AS IXTEMP
END
-IF &LINES NE 0 GOTO AOK;
-SET &MSG1=' ZERO RECORDS RETRIEVED FROM RDB TABLE DEFINITION: ';
-SET &MSG2=' RDB FILE AND/OR RELATION NAME NOT FOUND ';
-GOTO TOP
-*
-AOK
DEFINE FILE RDBFILE
ACCEPT/I1=IF IXFLD_NAME EQ LAST IXFLD_NAME THEN 0 ELSE 1;
END
TABLE FILE RDBFILE
PRINT IXFLD_NUMBER
BY IXFLD_NAME
IF RELNAME CONTAINS '&SRELNAME'
IF IDX_UNIQUE EQ 1
IF ACCEPT EQ 1
ON TABLE HOLD AS IXDESC
END
-RUN
-IF &RECORDS NE 0 THEN GOTO JOINIT;
-WRITE IXDESC 123
-JOINIT
JOIN RFLD_NAME IN IXTEMP TO IXFLD_NAME IN IXDESC AS 01
TABLE FILE IXTEMP
PRINT IXFLD_NUMBER
IF IXFLD_NUMBER NE 0
ON TABLE HOLD
END
-RUN
-SET &KEYCOUNT=&LINES;
-* START TO BUILD FOCUS MASTER
-*
-* -TYPE
-* -TYPE OPEN MASTER FILE
FILEDEF MAS DISK &MFILE DISP MOD
-RUN
-WRITE MAS FILE=&MASTER, SUFFIX=RDB
-WRITE MAS SEGNAME=&MASTER, SEGTYPE=S0
-*
-* SET UP DEFINES TO PARSE RDB TABLE
-*
DEFINE FILE IXTEMP
FLD_NAME/A31=RFLD_NAME;
FNAME/A12 = EDIT(FLD_NAME,'999999999999$$$$$$');
P12/A6 = SUBSTR(18,FLD_NAME,13,18,6,P12);
ANAME/A12 = IF P12 EQ ' ' THEN FNAME ELSE ' ';
AFLEN/A7 = IF (FLD_LENGTH LT 9)
THEN EDIT( EDIT(FLD_LENGTH), '$$9 ')
ELSE IF (FLD_LENGTH LT 99)
THEN EDIT( EDIT(FLD_LENGTH), '$99 ')
ELSE
EDIT(FLD_LENGTH);
ULEN/A7 = IF (FLD_DATATYPE EQ &TYP_T) OR (FLD_DATATYPE EQ &TYP_VT)
THEN EDIT(AFLEN, '999 ')
ELSE
DECODE FLD_DATATYPE (
&TYP_I8 '15' &TYP_I4 '10 ' &TYP_I2 '6 '
&TYP_F4 '8.2 ' &TYP_ADT 'YYMD' &TYP_F8 '15.2'
ELSE '???????');
UTYP/A1 = DECODE FLD_DATATYPE ( &TYP_T 'A' &TYP_VT 'A'
&TYP_I8 'D' &TYP_I4 'I' &TYP_I2 'I'
&TYP_F4 'F' &TYP_F8 'D'
&TYP_ADT '' ELSE '?');
ATYP/A1 = IF FLD_DATATYPE EQ &TYP_I8 THEN 'I'
ELSE UTYP;
ALEN/A7 = IF (FLD_DATATYPE EQ &TYP_T) OR (FLD_DATATYPE EQ &TYP_VT)
THEN EDIT(AFLEN, '999 ')
ELSE
DECODE FLD_DATATYPE (
&TYP_I8 '8 ' &TYP_I4 '4 ' &TYP_I2 '2 '
&TYP_F4 '4 ' &TYP_F8 '8' &TYP_ADT 'DATE'
ELSE '???????');
ABSDEC/I1 = IF ABS(FLD_SCALE) GT 32767 THEN
65536 - ABS(FLD_SCALE) ELSE ABS(FLD_SCALE);
-*
-* SINCE WE CANT SCALE UP (I.E. TIMES A POWER OF 10) IGNORE IT
-*
ADEC/A2 = IF (FLD_SCALE GE 0) AND (FLD_SCALE LE 32767) THEN ' '
ELSE '.' | EDIT(ABSDEC);
-* MIS/A11=IF NULLS EQ 'Y' THEN ',MISSING=ON'
-* ELSE ' ';
XLINE/A79= 'FIELD='|FNAME|',' |'ALIAS='|ANAME|',' |'USAGE='||UTYP||ULEN
|','||ATYP||ALEN||ADEC|',MISSING=ON,$';
INUMBER/I5=IF IXFLD_NUMBER NE 0 THEN IXFLD_NUMBER ELSE 99999;
LINE/A80= IF UTYP EQ '?' THEN '$' | XLINE ELSE ' ' | XLINE;
END
-RUN
-* -TYPE
-* -TYPE IXTEMP HAS BEEN DEFINED
-*
-* CREATE THE FOCUS MASTER FIELD DEFINITIONS
-*
TABLE FILE IXTEMP
PRINT LINE
BY INUMBER NOPRINT
ON TABLE SAVE AS MAS
END
-*
-* CREATE RDB ACCESS FILE
FILEDEF ACC DISK &AFILE DISP MOD
-RUN
-SET &DOT=IF &SDDNAME EQ ' ' THEN ' ' ELSE '.';
-SET &TABLE='"' || &SDDNAME || &DOT || &SRELNAME || '"';
-SET &NULL = ' ';
-WRITE ACC SEGNAME=&MASTER,TABLENAME=&TABLE , &NULL
-WRITE ACC KEYS=&KEYCOUNT,WRITE=&WRITE,$
DEFINE FILE IXTEMP ADD
TYPE/A10=IF ATYP EQ ' ' THEN ',TYPE=ADT'
ELSE IF ATYP EQ 'D' THEN ',TYPE=G' ELSE ' ';
LINE_ACC/A80=IF UTYP EQ '?' THEN
'$'|' FIELD='''|FNAME|''', ALIAS='''|FLD_NAME|''''|TYPE||',$'
ELSE ' FIELD='''|FNAME|''', ALIAS='''|FLD_NAME|''''|TYPE||',$';
ACCEPT/I1=IF ANAME EQ ' ' THEN 1
ELSE IF TYPE NE ' ' THEN 1 ELSE 0;
END
TABLE FILE IXTEMP
PRINT LINE_ACC
-*BY &XFLD_SORT NOPRINT
IF ACCEPT EQ 1
ON TABLE SAVE AS ACC
END
-RUN
-SET &MODE=DECODE &FUNC('R' 'READ' 'W' 'WRITE');
-CRTFORM
-"<12 ������������������������������������������������������"
-"<12 � RELATIONAL TABLE DESCRIPTOR FACILITY FOR FOCUS/RDB �"
-"<12 � VERSION 1.2 �"
-"<12 � INFORMATION BUILDERS, INCORPORATED �"
-"<12 ������������������������������������������������������ </3"
-"<17 THIS PROCEDURE HAS TERMINATED SUCCESSFULLY </3 "
-"<11 FOCUS <D.&MODE FUNCTIONALITY ENABLED WITH <D.&KEYCOUNT KEY FIELDS "
-"<22 MASTER FILE DESCRIPTION = <D.&MFILE "
-"<22 ACCESS FILE DEFINITION = <D.&AFILE "
-" "
-"<6 UNSUPPORTED FIELDTYPES IN MASTER FILE DESCRIPTION WITH LEADING '$'"
-" "
-" "
-"<6 ENTER 'Y' TO RUN THIS PROCEDURE AGAIN ������������> <T.&LOOP "
-SET &MSG1=' ';
-SET &MSG2=' ';
-VMS DEASSIGN/JOB AUTORDBX
-VMS DELETE IXTEMP.*.*
-VMS DELETE IXDESC.*.*
-IF &LOOP EQ 'Y' THEN GOTO TOP;
SET MSG=ON
-EXIT
|