*DECK EXHIBIT 
USETEXT TAREATB 
USETEXT TCRMDEF 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TOPTION 
USETEXT TRELTBL 
USETEXT TSBASIC 
USETEXT TXSTD 
      PROC EXHIBIT; 
  
#----------------------------------------------------------------------#
#                                                                      #
#  THE FOLLOWING PROCS ARE XDEF"D WITHIN THIS DECK:                    #
#                                                                      #
#     EXHAREA                                                          #
#     EXHIBOP                                                          #
#     EXHINAM                                                          #
#     EXH$NAME$REL                                                     #
#     EXH$RELATION                                                     #
#     EXTEMP                                                           #
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
  
      DEF $PFUN$       #O"14"#;    # PF ID CODE FOR UN - NOS           #
      DEF $PFM$        #O"30"#;    # PF ID CODE FOR M  - NOS           #
      DEF $PFPN$       #O"40"#;    # PF ID CODE FOR PN - NOS           #
  
      DEF $PFID$       #O"14"#;    # PF ID CODE FOR ID - NOS/BE        #
      DEF $PFCY$       #O"03"#;    # PF ID CODE FOR CY - NOS/BE        #
      DEF $PFSN$       #O"40"#;    # PF ID CODE FOR SN - NOS/BE        #
  
      DEF $PFPWH$      #O"24"#;    # PF ID CODE FOR PW - NOS(/BE) (HI) #
      DEF $PFPWL$      #O"20"#;    # PF ID CODE FOR PW - NOS(/BE) (LOW)#
  
      DEF BLANK #O"55"#;           # ONE BLANK CHARACTER               #
      DEF CRMSBITMLGC #100#;       # CRM SUBSCHEMA ITEM ENTRY MAXIMUM  #
                                   # LENGTH IN CHARACTERS              #
      DEF ENDOFAREA #O"77"#;
      DEF RECORDNAME #7#; 
      DEF RENAMINTLVL #O"62"#;     # RENAMES INTERNAL LEVEL NUMBER     #
      DEF RENMEXTLVLDC #"66"#;     # RENAMES EXTERNAL LEVEL NUMBER IN  #
                                   # DISPLAY CODE                      #
*CALL COMHDRLEN 
  
      ITEM AT$CURR U;              # BASED ARRAY PTR FOR AREA TABLE    #
      ITEM BIT$PATH U;             # HOLDS BIT PATH FLAGS FOR TESTS    #
      ITEM DCSAMENAME I;           # SAME NAME ADDRESS                 #
      ITEM DOMWORDADDR; 
      ITEM EXIT         B;         # LOOP CONTROL                      #
      ITEM I            I;         # SCRATCH TEMPORARY                 #
      ITEM J            I;         # SCRATCH TEMPORARY                 #
      ITEM K            I;         # SCRATCH TEMPORARY                 #
      ITEM L            I;         # SCRATCH VARIABLE                  #
      ITEM LINE C(70);             # IMAGE LINE FOR WRITE              #
      ITEM M I;                    # INDEX                             #
      ITEM MAXADDR I;              # LARGEST DATANAME ADDRESS IN       #
                                   # RENAMES ENTRIES                   #
      ITEM N I;                    # INDEX                             #
      ITEM NUMRECS I;              # NUMBER OF RECORDS IN AREA         #
      ITEM RCDFLG B;               # FLAG WHICH IS SET WHEN RECORDFLAG #
                                   # HAS BEEN TURNED OFF FOR A         #
                                   # DATA-NAME SEARCH ON AN *EXHIBIT*  #
      ITEM RECDCOUNT I;            # NUMBER OF RECORDS PROCESSED SO FAR#
      ITEM RNMADDR I;              # ADDRESS OF RENAME ENTRY           #
      ITEM NXTWORDADDR; 
      ITEM RR$CURR U;              # BASED ARRAY PTR FOR REL/RANK TABLE#
      ITEM RT$CURR U;              # BASED ARRAY PTR FOR RELATION TABLE#
      ITEM WRECADDR I;             # WA ADDR OF SUBSCHEMA RECORD LIST  #
                                   # ENTRY WITHIN REALM/RELATION TABLE #
      ARRAY ATTDISP[0] S(3);
        BEGIN 
        ITEM TYPENM C(0,0,10) = [" TYPE     "]; 
        ITEM SIZEPC C(1,0,10) = [" PIC SIZE "]; 
        ITEM OFLFN  C(2,0,10) = [" FROM LFN "]; 
        END 
      ARRAY DBIENTRY [0:0] S(DFSBITMLG);  # ARRAY TO READ DBIENTRY     #
          BEGIN 
  
                                   # DESCRIPTION OF ITEM ENTRY         #
  
*CALL SBIHDDCLS 
  
                                   # DESCRIPTION OF RECORD ENTRY       #
  
*CALL SBRHDDCLS 
          END 
  
      ARRAY DIRECTENTRY3 S(3);
        BEGIN 
        ITEM RECOTYP U(0, 0, 6);
        ITEM NXTPTR3 U(0,48,12);
        ITEM ITMLVL  U(0, 6, 6);
        ITEM DOMPTR  U(0,24,12);   # DOMINENT ITEM PTR                 #
        ITEM PRIPTR  U(0,36,12);   # PRIOR ITEM PTR                    #
        ITEM NAMLNGC U(1, 0, 6);   # LENGTH OF NAME IN CHARACTERS      #
        ITEM NAMLNGW U(1, 6, 6);   # LENGTH OF NAME IN WORDS           #
        ITEM OCCURS3 B(2, 2, 1);   # TRUE IF ITEM IS OCCURING          #
        END 
      ARRAY DIRECTENTRY4 [0:0] S(1);  # CONTINUATION OF DIRECTENTRY3   #
        BEGIN 
        ITEM OCCURSM U(0, 6,18);
        ITEM ITMNAM  C(0, 0,10);   # NAME OF ITEM, 1 TO 52 CHARS       #
        END 
      ARRAY DIRECTENTRY5 [0:5];;   # CONTINUATION OF DIRECTENTRY4      #
                                   # AND DIRECTENTRY5                  #
      XDEF ARRAY OPWRIT[6];        # IMAGE ARRAY FOR TERMINAL OUTPUT   #
        BEGIN 
        ITEM LINE1 C(0,0,10); 
        END 
      ARRAY RECDLIST [0:0]  S(DFSBRECLST);   # ARRAY TO READ RECORD    #
                                             # LIST POINTED TO BY      #
                                             # REALM/RELATION LIST     #
          BEGIN 
*CALL SBRECLST
          END 
      ARRAY RLMLSTENT [0:0] S(DFSBRLMLST);  # ARRAY TO READ REALM ENTRY#
                                            # IN REALM/RELATION LIST   #
          BEGIN 
*CALL SBRLMLST
          END 
  
  
      ARRAY RNMARRAY [0:0] S(DFSBRRNLEN);  # RENAME INFORMATION ARRAY  #
          BEGIN 
*CALL SBIRRDCLS 
          END 
  
      ARRAY SCHEMA$REC$A S(8);     # SUBSCHEMA STRUCTURE FOR REC. INFO.#
        BEGIN 
        ITEM SCHEMA$REC   U(00,00,60);  # FIRST WORD OF SCHEMA RECORD  #
        ITEM SS$NAME$SIZE U(01,00,06);  # SIZE OF SUBSCHEMA RECORD NAME#
        ITEM SS$NAME      C(04,00,40);  # SUBSCHEMA RECORD NAME        #
        END 
      BASED ARRAY EXHTEM [0];;
      BASED ARRAY FDB$FORMAT S(15);  # FILE DEFINITION BLOCK           #
        BEGIN 
        ITEM FDB$NAME     C(00,00,40);  # PERMANENT FILE NAME          #
        ITEM FDB$1ST$PARM U(05,00,60);  # FIRST PF PARAMETER           #
        END 
      BASED ARRAY FDB$PARM S(1);   # PARAMETER ENTRY FOR FDB           #
        BEGIN 
        ITEM FDB$PARM$VAL C(00,00,09);  # PARAMETER VALUE              #
        ITEM FDB$PARM$ID  C(00,54,01);  # PARAMETER ID                 #
        ITEM FDB$PARM$INT I(00,00,54);  # INTEGRAL PARAMETER VALUE     #
        END 
      BASED ARRAY NEXT$WORD$BA[0]; # WILL BE BASED ON NEXWORD         # 
        BEGIN 
        ITEM NEXT$WORD C(00,00,40);      #  NEXT WORD IN TRANSMISSION  #
        END 
  
 CONTROL IFEQ OS$NAME,NOS;
      ARRAY NOS$PF$MODE[8] S(1);   # TABLE FOR LOOKING UP DISPLAY CODE #
                                   # VALUES FOR NOS PF MODE (M) CODES. #
        BEGIN 
        ITEM NOS$PF$M C(0,0,10) = 
         ["W         ",            # 0                                 #
          "R         ",            # 1                                 #
          "A         ",            # 2                                 #
          "E         ",            # 3                                 #
          "N         ",            # 4                                 #
          "M         ",            # 5                                 #
          "RM        ",            # 6                                 #
          "RA        "];           # 7                                 #
        END 
 CONTROL ENDIF; 
  
      XREF ITEM DEFLIST      I;    # POINTER TO HEAD OF DEFINE LIST    #
      XREF BASED ARRAY DESPTR;
        BEGIN 
        ITEM DESCOUNT I(00,00,12); # NUMBER OF LOCAL FILES REFERENCING #
                                   # THIS LIST OF DESCRIBE ITEMS.      #
        ITEM DESADDR  U(00,42,18); # ADDRESS OF LIST OF ITEMS          #
        END 
      XREF ITEM DUMMY        I; 
      XREF ITEM FRMLFN C(7);       # LFN OF -FROM- FILE                #
      XREF ITEM FROMKEYINFIT I;    # ADDR OF -FROM- FILE FIT           #
      XREF ITEM RA0          I;    # LOCATION OF ZERO FOR PARAM LISTS  #
      XREF BASED ARRAY SCHEMAFIT S(19);  # TO ACCESS CURRENT REC, KEY, #
        BEGIN                      # AREA FIT, AREA NAME, ETC., WHOSE  #
                                   # ADDRS ARE IN COMMON BLOCK CBASIC. #
        END 
      XREF ITEM SPELIST      I;    # POINTER TO HEAD OF SPECIFY LIST   #
      ITEM T            I;         # SCRATCH VARIABLE                  #
      XDEF ARRAY EXHTYPE[7];
        BEGIN 
        ITEM LITERAL C(0,0,10) =
         ["CHAR ITEM ", 
          "NUMERIC   ", 
          "BIN INTEG ", 
          "UNNORMALIZ", 
          "NORMALIZED", 
          "DOUBLE PRE", 
          "COMPLEX   ", 
          "LOGICAL   "];
        END 
  
      XREF ITEM AREATBLPTR U;      # BASE FOR START OF AREA TABLE      #
      XREF ITEM CDCSDBM B;         # TRUE IF CDCS DATA BASE MODE       #
      XREF ITEM IMFDBM B;          # TRUE IF IMF DATA BASE MODE        #
      XREF ITEM MXTRNLG I;         # MAX TRANSM LENGTH IN CHARS.       #
      XREF ITEM RELATBLPTR U;      # BASE FOR START OF RELATION TABLE  #
      XREF ITEM UNIVERSAL;         # UNIVERSAL CHARACTER               #
      XREF FUNC BINDEC C(10);      # CONVERT BIN. TO DEC., L. JUSTIFIED#
      XREF ARRAY FIELDN S(4);      # (DEFINED IN PROC DATANAM.)  THE   #
                                   # 1ST ENTRY OF ARRAY CONTAINS NAME  #
                                   # TO EXHIBIT OR 1ST PART OF NAME IF #
                                   # IT WAS QUALIFIED.                 #
        BEGIN 
        ITEM FN   C(00,00,30);     # NAME OF ITEM TO EXHIBIT           #
        ITEM FNWA U(03,00,18);     # DIRECTORY WORD ADDR OF ITEM DESCR.#
        ITEM FNLG U(03,24,18);     # ITEM NAME LENGTH IN CHARACTERS    #
        END 
  
      XREF PROC CMOVE;             # CHARACTER MOVE ROUTINE            #
      XREF PROC DIAG;              # DIAGNOSTIC DISPLAY ROUTINE        #
      XREF PROC EXHIMFN;           # EXHIBIT IMF ITEM OR RECORD NAME   #
      XREF PROC EXHISCN;           # EXHIBIT IMF EXTERNAL, CONCEPTUAL, #
                                   # SCHEMA NAMES, METADB NAME, AND    #
                                   # RECORD NAMES                      #
      XREF PROC GET;
      XREF PROC LINE$OUT; 
      XREF PROC OPENM;             # CRM ROUTINE TO OPEN A FILE        #
      XREF PROC TRNSDBI;           # TRANSFORM CDCS DBI ENTRY          #
                                   # TO CRM DBI ENTRY FORMAT           #
  
  
  
  
#----------------------------------------------------------------------#
#     D E L Z E R O                                                    #
  
# FUNC TO DELETE LEADING ZEROS IN A BLANK FILLED WORD                  #
  
      FUNC      DELZERO((WORD)) C(10);
      BEGIN 
      ITEM WORD C(10);
      J = -1;                      # INDICATE NO ZEROS FOUND YET       #
      FOR I = 0 STEP 1 UNTIL 8 DO  # SCAN THRU (MOST OF) WORD          #
        BEGIN 
        IF C<I,1>WORD EQ "0" THEN  # LOOK FOR (ANOTHER) LEADING ZERO   #
          BEGIN 
          J = I;                   # COUNT - 1 OF NUMBER OF LEADING 0S #
          END 
        ELSE
          BEGIN 
          I = 10;                  # FORCE EXIT FROM LOOP              #
          END 
        END 
      IF J GQ 0 THEN               # IF ZEROS FOUND...                 #
        BEGIN 
        C<0,J + 1>WORD = " ";      # BLANK THEM OUT                    #
        END 
      DELZERO = WORD;              # RETURN EDITED WORD                #
      END  # DELZERO #
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     E D I T                                                          #
#                                                                      #
# FUNC TO RETURN LEFT JUSTIFIED BLANK FILLED WORD WITH A CHAR STRING   #
# EXTRACTED FROM RIGHT OR LEFT JUSTIFIED ZERO FILLED PARAMETER WORD.   #
  
      XDEF FUNC EDIT; 
      FUNC      EDIT((PARAM)) C(10);
      BEGIN 
      ITEM PARAM;                  # WORD TO BE EDITED                 #
      ITEM RESULT C(10);           # RESULT CHAR STRING                #
      EXIT = FALSE;                # TO GET US INTO LOOP               #
      FOR DUMMY = 0 STEP 1 WHILE NOT EXIT DO  # COUNT LEADING ZEROS (N)#
        BEGIN 
        IF DUMMY GR 9 THEN         # IF WEVE REACHED END OF WORD...    #
          BEGIN 
          N = 10;                  # THE WORD IS FULL OF ZEROS         #
          EXIT = TRUE;             # WERE DONE SO EXIT LOOP            #
          END 
        ELSE
          BEGIN 
          IF C<DUMMY,1>PARAM NQ 0 THEN  # IF THIS CHARACTER NOT ZERO...#
            BEGIN 
            N = DUMMY;             # SAVE NUMBER OF LEADING ZEROS      #
            EXIT = TRUE;           # WERE DONE SO EXIT LOOP            #
            END 
          END 
        END 
      EXIT = FALSE;                # TO GET US INTO LOOP               #
      FOR DUMMY = N + 1 STEP 1 WHILE NOT EXIT DO  # FIND STRING LENGTH #
        BEGIN 
        IF DUMMY GR 9              # IF END OF WORD OR STRING...       #
            OR C<DUMMY,1>PARAM EQ 0 THEN
          BEGIN 
          L = DUMMY - N;           # COMPUTE STRING LENGTH             #
          EXIT = TRUE;             # WERE DONE SO EXIT LOOP            #
          END 
        END 
      RESULT = C<N,L>PARAM;        # COPY STRING, LEFT-JUSTIFIED AND   #
                                   # BLANK FILLED.                     #
      EDIT = RESULT;               # RETURN EDITED WORD                #
      END   # EDIT #
  
  
  
  
#----------------------------------------------------------------------#
#     L E N G T H                                                      #
  
# THIS FUNCTION RETURNS THE LENGTH OF A CHARACTER STRING (LEFT         #
# JUSTIFIED, ZERO FILLED IN AN N CHARACTER STRING).                    #
  
      FUNC LENGTH(STRING,(N)) U;
      BEGIN 
      ITEM INDEX I; 
      ITEM STRING C(40);           # CHARACTER STRING                  #
      ITEM N I;                    # LENGTH OF STRING TO SEARCH        #
      FOR INDEX = 0 STEP 1 UNTIL (N-1) DO # SCAN THRU STRING           #
        BEGIN 
        IF C<INDEX,1>STRING EQ O"00" THEN  # IF ZERO CHARACTER...      #
          BEGIN 
          LENGTH = INDEX;          # RETURN LENGTH                     #
          RETURN; 
          END 
        END 
      LENGTH = N;                  # RETURN MAXIMUM LENGTH             #
      END  # LENGTH # 
  
  
  
  
#----------------------------------------------------------------------#
#     D B I $ O F $ R E C                                              #
  
# THIS PROC TAKES A RELATION TABLE RANK ENTRY, FINDS THE ASSOCIATED    #
# DBI AND RECORD NAMES AND DISPLAYS THEM IN THE FORMAT:                #
#    <DBI> OF <RECORD>                                                 #
# J IS THE CURSOR INDICATING THE NEXT UNUSED CHARACTER IN LINE UPON    #
# ENTRY AND EXIT.                                                      #
  
      PROC      DBI$OF$REC; 
      BEGIN 
                                   # GET NAME OF DBI                   #
      GET(SCHEMAFIT,SCHEMA$REC$A,RR$ITEMWA,0,0,80,RA0); 
      K = SS$NAME$SIZE[0];         # GET DBI NAME LENGTH               #
      C<J,K>LINE = C<0,K>SS$NAME[0];  # COPY DBI NAME                  #
      J = J + K;                   # UPDATE LINE INDEX TO NEXT SPACE   #
      C<J,4>LINE = " OF ";         # <DBI> OF ...                      #
      J = J + 4;
      P<AREA$TABLE> = RR$AREAPTR;  # GET AREA ENTRY OF DBI             #
                                   # GET RECORD NAME OF DBI            #
      GET(SCHEMAFIT,SCHEMA$REC$A,AT$RECWA,0,0,80,RA0);
      K = SS$NAME$SIZE[0];         # GET RECORD NAME LENGTH            #
      C<J,K> LINE = C<0,K>SS$NAME[0];  # COPY RECORD NAME              #
      J = J + K;
      P<REL$RANKINFO> = P<REL$RANKINFO> + RANKSIZE;  # GET NEXT RANK   #
                                                     # ENTRY           #
      END  # DBI$OF$REC # 
  
  
  
  
#----------------------------------------------------------------------#
#     D O M S T R I N G                                                #
  
# THIS PROC GETS THE NAMES OF THE HIERARCHY OF DOMINANT ITEMS, STRINGS #
# THEM OUT IN THE FORMAT A OF B..., STARTING WITH THE NAME TO EXHIBIT  #
# AND ENDING WITH THE RECORD NAME.  THE STRING OF NAMES IS THEN        #
# PRINTED OUT.  IF A NAME DOES NOT FIT BETWEEN THE PREVIOUS NAME AND   #
# THE END OF THE LINE, IT WILL BE PLACED ON THE NEXT LINE.             #
  
      PROC      DOMSTRING;
      BEGIN 
      CMOVE(FIELDN,0,FNLG[0],OPWRIT,1);  # COPY NAME FOLLOWING EXHIBIT #
                                         # TO OUTPUT LINE              #
      N = FNLG[0] + 1;             # N IS USED TO TRACK LINE LENGTH    #
                                   # (INCLUDING CARRAGE CONTROL)       #
  
                                   # GET ADDRESS OF DOMINANT ITEM      #
  
      IF CDCSDBM                   # IF CDCS DATA BASE MODE            #
      THEN
        BEGIN 
        DOMWORDADDR = SBITMDOMADR[0]; 
        END 
  
      ELSE                         # IF CRM DATA BASE MODE             #
        BEGIN 
        DOMWORDADDR = DIRWORDADDR - DOMINANTPTR[0]; 
        END 
  
      FOR DUMMY = DUMMY            # GET ALL DOMINANT ITEMS            #
      DO
        BEGIN 
        IF CDCSDBM                 # IF CDCS DATA BASE MODE            #
        THEN
          BEGIN 
                                   # READ DOMINANT ITEM                #
          GET (SCHEMAFIT, DBIENTRY, DOMWORDADDR, 0, 0,
               DFSBITMLG * 10, RA0);
          IF SBITMENTRY[0] EQ SE$ITEM  # IF ITEM ENTRY                 #
          THEN
            BEGIN 
            GET (SCHEMAFIT, DIRECTENTRY5, DOMWORDADDR + SBITMNAMEPTR[0],
                 0, 0, SBITMNMELENC[0], RA0);  # READ NAME             #
            M = SBITMNMELENC[0] + 4;  # NAME LENGTH + 4 CHARACTERS FOR #
                                      # " OF "                         #
            DOMWORDADDR = SBITMDOMADR[0];  # WA ADDR OF DOMINANT ITEM  #
            END 
  
          ELSE                     # IF ENTRY IS RECORD                #
            BEGIN 
            GET (SCHEMAFIT, DIRECTENTRY5, DOMWORDADDR + SBRECNAMEPTR[0],
                 0, 0, SBRECNMELENC[0], RA0);  # READ NAME             #
            M = SBRECNMELENC[0] + 4;  # NAME LENGTH + 4 CHARACTERS FOR #
                                      # "OF "                          #
            END 
          END 
  
        ELSE                       # IF CRM DATA BASE MODE             #
          BEGIN 
                                   # READ ITEM ENTRY                   #
          GET (SCHEMAFIT, DIRECTENTRY3, DOMWORDADDR, 0, 0,
               CRMSBITMLGC, RA0); 
          M = NAMLNGC[0] + 4;      # NAME LENGTH + 4 CHARACTERS FOR    #
                                   # " OF "                            #
          DOMWORDADDR = DOMWORDADDR - DOMPTR[0];
          END 
  
        ITMNAM[0] = "       OF ";  # WE CAN USE THE WORD JUST PRECEDING#
                                   # THE ITEM NAME SINCE IT DOES NOT   #
                                   # CONTAIN RELEVENT POINTERS         #
        IF (M + N) GR 50 THEN 
          BEGIN 
          LINE$OUT(OPWRIT,N);      # WRITE LINE BEFORE IT OVERFLOWS    #
          N = 3;                   # RESET LINE ORIGIN AT COL 4        #
          LINE1[0] = " ";          # CLEAR BEGINNING OF LINE           #
          END 
        CMOVE(DIRECTENTRY4,6,M,OPWRIT,N);  # MOVE DOMONANT NAME        #
        N = N + M;                 # UPDATE LINE LENGTH                #
        IF (CDCSDBM                # IF CDCS DATA BASE MODE            #
            AND SBITMENTRY[0] EQ SE$RECORD)  # RECORD ENTRY            #
          OR (NOT CDCSDBM          # IF CRM DATA BASE MODE             #
            AND RECOTYP[0] EQ 7)   # RECORD ENTRY                      #
        THEN
          BEGIN 
          LINE$OUT (OPWRIT, N);    # WRITE STRING OF NAMES             #
          RETURN; 
          END 
  
        END 
      END  # DOMSTRING #
  
  
  
  
#----------------------------------------------------------------------#
#     E X H A R E A                                                    #
  
# THIS PROC EXHIBITS INFORMATION ABOUT THE AREA NAMED IN NEXTWORD IF   #
# NEXTWORD CONTAINS A VALID AREA NAME.                                 #
  
      XDEF PROC EXHAREA;
      PROC      EXHAREA;
      BEGIN 
      IF AREATBLPTR EQ 0 THEN      # IF AREA TABLE IS MISSING          #
        BEGIN 
        STDNO;                     # NO AREA NAMES EXIST, EXIT         #
        END 
  
      P<FIT> = LOC(SCHEMAFIT);     # POSITION TO SUBSCHEMA FIT         #
      IF FITOC NQ OC$OPEN          # IF SUBSCHEMA NOT OPEN             #
      THEN
        BEGIN 
        FITBBH = FALSE;            # ALLOCATE BUFFERS ABOVE HHA        #
        OPENM(FIT, $INPUT$, RA0);  # OPEN SUBSCHEMA FOR READING        #
        END 
  
      P<NEXT$WORD$BA> = LOC(INWI[0]);  # THIS IS WHERE WE PICK UP NAME #
                                       # OF AREA                       #
      P<AREA$TABLE> = AREATBLPTR;  # THIS IS THE SUBSCHEMA ENTRY       #
      AT$CURR = AT$FORWARD[0];     # GET NEXT AREA TABLE ENTRY         #
      FOR DUMMY = DUMMY WHILE AT$CURR NQ 0 DO # SEARCH AREA TABLE      #
        BEGIN 
        P<AREA$TABLE> = AT$CURR;   # SET BASE TO CURRENT AREA ENTRY    #
                                   # IF AREA NAMES MATCH               #
        IF NEXLENG EQ LENGTH(AT$AFDB$NAME,(33)) 
          AND C<0,NEXLENG>NEXT$WORD EQ C<0,NEXLENG>AT$AFDB$NAME 
        THEN
          BEGIN 
          DIRWORDADDR = 0;         # TELLS NXTATTR TO GET AREA"S RECORD#
          EXH$REC$KEYS;            # DISPLAY RECORD NAME, KEY AND      #
                                   # ALTERNATE KEYS.                   #
          IF CDCSDBM               # IF CDCS DATA BASE MODE            #
          THEN
            BEGIN 
            C<0,13>LINE = " AREA NAME = ";
            T = 13; 
            END 
  
          ELSE                     # IF CRM DATA BASE MODE             #
            BEGIN 
            C<0,16>LINE = " AREA PF NAME = "; 
            T = 16; 
            END 
  
                                   # LIST AREA NAME AND PF PARAMETERS  #
          EX$PF$PARAMS (T, LOC(AT$AFDBPOS));
          IF AT$INDFDB NQ 0        # IF INDEX FILE PRESENT             #
          THEN
            BEGIN 
            C<0,17>LINE = " INDEX PF NAME = ";
                                   # LIST INDEX PF PARAMETERS          #
            EX$PF$PARAMS(17,AT$INDFDB+AT$CURR); 
            END 
          STDYES;                  # EXIT -- ALLS WELL                 #
          END 
        AT$CURR = AT$FORWARD[0];   # GET NEXT AREA TABLE ENTRY         #
        END 
      STDNO;                       # EXIT -- NO AREA TBL ENTRY FOUND   #
      END  # EXHAREA #
  
  
  
  
#----------------------------------------------------------------------#
#     E X H I B O P                                                    #
  
# "EXHIBIT"                                                            #
  
      XDEF PROC EXHIBOP;
      PROC      EXHIBOP;
      BEGIN 
      C< 0,30>LINE = " MAXIMUM TRANSMISSION LENGTH  ";
      C<30,10>LINE = DELZERO(BINDEC(MXTRNLG,7));  # ZERO SUPPRESS NUM. #
      LINE$OUT(LINE,40);
      C< 0,20>LINE = " TL OF CATALOG FILE ";
      C<20,10>LINE = DELZERO(BINDEC(VERSTL,7)); 
      LINE$OUT(LINE,30);
      C< 0,20>LINE = " SEPARATOR"; # PRINT SEPARATOR CHARACTER         #
      C<12, 1>LINE = C<0,1>SEPARATOR; 
      IF ITEMSIZE THEN
        BEGIN 
        C<20,20>LINE = "ITEM-SIZE  ON"; 
        LINE$OUT(LINE,33);
        END 
      ELSE
        BEGIN 
        LINE$OUT(LINE,13);
        END 
      C< 0,10>LINE = " UNIVERSAL"; # DISPLAY DEFAULT OPTIONS           #
      IF UNIVERSAL GR 63 THEN 
        BEGIN 
        C<10,10>LINE = " OFF "; 
        END 
      ELSE
        BEGIN 
        C<10,10>LINE = " "; 
        C<12, 1>LINE = C<9,1>UNIVERSAL; 
        END 
      LINE$OUT(LINE,20);
      REPORTS;
      IF IMFDBM                    # IF IMF DATA BASE MODE             #
      THEN
        BEGIN 
        EXHISCN;                   # EXHIBIT IMF EXTERNAL, CONCEPTUAL, #
                                   # SCHEMA NAMES, METADB NAME, AND    #
                                   # RECORD NAMES                      #
        STDNO;
        END 
  
      IF AREATBLPTR EQ 0 THEN      # IF AREA TABLE IS MISSING...       #
        BEGIN 
        STDNO;                     # NO AREA NAMES TO DISPLAY, EXIT    #
        END 
      P<AREA$TABLE> = AREATBLPTR;  # THIS IS THE SUBSCHEMA ENTRY       #
      AT$CURR = AT$FORWARD[0];     # SKIP OVER IT                      #
      IF AT$CURR NQ 0 THEN         #IF AREAS IN USE                    #
        BEGIN 
        C<00,20>LINE = " AREA NAME(S):";  # PUT OUT AREA LIST HEADING  #
        LINE$OUT(LINE,20);         # WRITE TO TERMINAL                 #
        END 
      FOR DUMMY = DUMMY WHILE AT$CURR NQ 0 DO  # SEARCH AREA TABLE     #
        BEGIN 
        P<AREA$TABLE> = AT$CURR;   # SET BASE TO CURRENT AREA ENTRY    #
        L = LENGTH(AT$AFDB$NAME,(33));  # FIND LENGTH OF AREA NAME     #
        C<0,4>LINE = " ";          # CARRAGE CONTROL FOR OUTPUT LINE   #
        C<4,L>LINE = C<0,L>AT$AFDB$NAME;  # COPY AREA NAME             #
        LINE$OUT(LINE,L+4);        # DISPLAY LINE ON TERMINAL          #
        AT$CURR = AT$FORWARD[0];   # GET NEXT AREA ENTRY POINTER       #
        END                        # REPEAT LOOP                       #
      C<0,18>LINE = " SUBSCHEMA NAME = "; 
      P<AREA$TABLE> = AREATBLPTR;  # GET SUBSCHEMA ENTRY               #
      IF AT$SBSCNAME NQ 0          # IF DIFFERENT LIBRARY NAME         #
      THEN
        BEGIN 
        P<FDB$FORMAT> = P<AREA$TABLE> + AT$SBSCNAME;  #POSITION TO NAME#
        L = LENGTH (FDB$NAME, (40));  # FIND LENGTH OF NAME            #
        C<18,L>LINE = C<0,L>FDB$NAME;  # COPY PF NAME                  #
        LINE$OUT (LINE, 18 + L);   # WRITE OUT LINE                    #
        C<0,26>LINE = " SUBSCHEMA LIBRARY NAME = "; 
        EX$PF$PARAMS ((26), (LOC(AT$AFDBPOS)));  # LIST LIBRARY NAME   #
                                                 # AND PF PARAMS       #
        END 
  
      ELSE
        BEGIN 
        EX$PF$PARAMS ((18), (LOC(AT$AFDBPOS)));  # LIST SUBSCHEMA NAME #
                                                 # AND PF PARAMS       #
        END 
  
      STDNO;
      END  # EXHIBOP #
  
  
  
  
#----------------------------------------------------------------------#
#     E X H I N A M                                                    #
  
# "EXHIBIT <RECORD-NAME>"                                              #
# "EXHIBIT <DATA-NAME>"                                                #
  
      XDEF PROC EXHINAM;
      PROC      EXHINAM;
      BEGIN 
      N = 0;
      FOR K = 0 STEP 1 UNTIL 5 DO 
        BEGIN 
        LINE1[K] = " "; 
        END 
      IF NOT AREAITM THEN 
        BEGIN                      # WE HAVE A TEMPORARY DATA NAME     #
        LINE1[1] = TYPENM[0]; 
        LINE1[2] = LITERAL[DATATYPE]; 
        LINE$OUT(OPWRIT,30);
        LINE1[1] = SIZEPC[0]; 
        LINE1[2] = BINDEC(RESULTSIZE,4);  # MAX ITEM SIZE IS 2047      #
        LINE$OUT(OPWRIT,30);
        IF DESITM                  # IF ITEM IS DESCRIBED              #
        THEN
          BEGIN 
          LINE1[1] = OFLFN[0];     # ALSO PRINT LFN OF FILE IT-S FROM  #
          LINE1[2] = FRMLFN;
          LINE$OUT (OPWRIT, 30);
  
          FROMKEYINFIT = 0;        # CLEAR OUT -OF- FILE INFO          #
          FRMLFN = " "; 
          DESPASS = FALSE;
          END 
  
        STDYES; 
        END 
  
      IF IMFDBM                    # IF IMF DATA BASE ITEM             #
      THEN
        BEGIN 
        EXHIMFN;                   # EXHIBIT IMF ITEM OR RECORD NAME   #
        END 
  
      P<FIT> = LOC(SCHEMAFIT);     # POSITION TO SUBSCHEMA FIT         #
      IF FITOC NQ OC$OPEN          # IF SUBSCHEMA NOT OPEN             #
      THEN
        BEGIN 
        FITBBH = FALSE;            # ALLOCATE BUFFERS ABOVE HHA        #
        OPENM(FIT, $INPUT$, RA0);  # OPEN SUBSCHEMA FOR READING        #
        END 
  
      DIRWORDADDR = FNWA[0];       # RESTORE THE WORD ADDRESS OF THE   #
                                   # NAME TO EXHIBIT SINCE IT MAY HAVE #
                                   # BEEN QUALIFIED BY THE USER, IN    #
                                   # WHICH CASE DIRWORDADDR WOULD      #
                                   # CONTAIN THE WORD ADDRESS OF THE   #
                                   # LAST QUALIFIER GIVEN.             #
  
      NUMRECS = 1;                 # TELL NXTATTR TO READ ONE RECORD   #
      RECDCOUNT = 1;
      FOR DUMMY = DUMMY DO
        BEGIN 
        MAINLOOP; 
        END 
      END  # EXHINAM #
  
  
  
  
#----------------------------------------------------------------------#
#     E X H $ N A M E S                                                #
  
#                                                                      #
  
      PROC      EXH$NAMES;
      BEGIN 
      IF T EQ 1                    # IF ELEMENTARY ITEM                #
        OR T EQ 4                  #   OR VECTOR                       #
        OR T EQ 5                  #   OR VECTOR WITHIN REPEATING GROUP#
      THEN
        BEGIN                      # EXHIBIT ELEMENTARY-ITEM           #
        DOMSTRING;                 # PRINT ITEM NAME AND ITS DOMINANT  #
                                   # NAMES.                            #
        IF T EQ 4                  # IF VECTOR                         #
          OR T EQ 5                #   OR VECTOR WITHIN REPEATING GROUP#
        THEN
          BEGIN 
          PRINTOCC;                # PRINT NUMBER OF OCCURENCES        #
          END 
        LINE1[0] = TYPENM[0]; 
        LINE1[1] = LITERAL[DATATYPE]; 
        LINE1[2] = SIZEPC[0]; 
        LINE1[3] = BINDEC(INCPICSIZE[0],4);  # ITEM LENGTH LE 2047     #
        LINE$OUT(OPWRIT,34);       # WRITE THIS LINE OF INFO           #
        END 
      ELSE
        BEGIN 
        DOMSTRING;                 # PRINT ITEM NAME AND ITS DOMONANT  #
                                   # NAMES.                            #
        IF T EQ 2                  # IF REPEATING GROUP                #
          OR T EQ 3                #   OR REPEATING GRP WITHIN REP. GRP#
        THEN
          BEGIN 
          PRINTOCC;                # PRINT NUMBER OF OCCURENCES        #
          END 
  
        IF CDCSDBM                 # IF CDCS DATA BASE MODE            #
        THEN
          BEGIN 
          GET (SCHEMAFIT, DBIENTRY, DIRWORDADDR,
               0, 0, DFSBITMLG * 10, RA0);  # REREAD ITEM ENTRY        #
          END 
  
        IF CDCSDBM                 # IF CDCS DATA BASE MODE            #
          AND SBITMLEVEL EQ RENAMINTLVL  # IF RENAMES                  #
        THEN
          BEGIN 
          RNMADDR = DIRWORDADDR + SBITMRNRDPTR[0];  # ADDR RENAMES INFO#
          LINE1[0] = " RENAMES "; 
                                   # READ RENAMES INFORMATION          #
          GET (SCHEMAFIT, RNMARRAY, RNMADDR,
               0, 0, DFSBRRNLEN * 10, RA0); 
          GET (SCHEMAFIT, DBIENTRY, SBITMLRNDNAD[0],
               0, 0, DFSBITMLG * 10, RA0);  # READ ITEM ENTRY          #
          N = SBITMNMELENC[0];     # LENGTH OF NAME IN CHARACTERS      #
          GET (SCHEMAFIT, DIRECTENTRY5, SBITMLRNDNAD[0] + 
               SBITMNAMEPTR[0], 0, 0, N, RA0);  # READ NAME            #
          CMOVE (DIRECTENTRY5, 0, N, OPWRIT, 9);  # MOVE NAME TO LINE  #
          N = N + 9;
          MAXADDR = 0;             # INITIALIZE TO FIND LARGEST ADDR   #
          EXIT = FALSE; 
          FOR DUMMY = DUMMY        # SCAN RENAMES INFO FOR LARGEST ADDR#
                                   # THIS IS ADDRESS OF *C* IF SUBSCHMA#
                                   # SAID *A* RENAMES *B* THRU *C*     #
            WHILE NOT EXIT
          DO
            BEGIN 
            IF SBITMLRNDNAD[0] GR MAXADDR  # IF LARGER THAN LAST LARGST#
            THEN
              BEGIN 
              MAXADDR = SBITMLRNDNAD[0];  # SAVE NEW MAXIMUM           #
              END 
  
            IF NOT SBITMLRNNXT[0]  # IF NO MORE ENTRIES                #
            THEN
              BEGIN 
              EXIT = TRUE;         # EXIT LOOP                         #
              TEST DUMMY; 
              END 
  
            IF SBITMRRNDNAD[0] GR MAXADDR  # IF LARGER THAN LAST LARGST#
            THEN
              BEGIN 
              MAXADDR = SBITMRRNDNAD[0];  # SAVE NEW MAXIMUM           #
              END 
  
            IF NOT SBITMRRNNXT[0]  # IF NO MORE ENTRIES                #
            THEN
              BEGIN 
              EXIT = TRUE;         # EXIT LOOP                         #
              TEST DUMMY; 
              END 
  
            RNMADDR = RNMADDR + 1;  # INCREMENT TO NEXT RENAMES WORD   #
                                   # READ NEXT RENAMES WORD            #
            GET (SCHEMAFIT, RNMARRAY, RNMADDR,
                 0, 0, DFSBRRNLEN * 10, RA0); 
            END 
  
                                   # READ ITEM ENTRY OF ITEM AT MAX ADR#
          GET (SCHEMAFIT, DBIENTRY, MAXADDR, 0, 0,
               DFSBITMLG * 10, RA0);
          J = SBITMNMELENC[0];     # LENGTH OF NAME IN CHARACTERS      #
          GET (SCHEMAFIT, DIRECTENTRY5, MAXADDR +  # READ ITEM NAME    #
               SBITMNAMEPTR[0], 0, 0, J, RA0);
          IF N + J + 9 GR 70       # IF NEXT NAME WONT FIT IN LINE     #
          THEN
            BEGIN 
            LINE$OUT (OPWRIT, N);  # WRITE OUT *RENAMES NAME1*         #
            N = 5;                 # INITIALIZE FOR NEXT LINE          #
            C<0,10>LINE1[0] = " ";
            END 
  
          CMOVE (" THROUGH ", 0, 9, OPWRIT, N); 
          N = N + 9;
          CMOVE (DIRECTENTRY5, 0, J, OPWRIT, N);  # MOVE NAME TO LINE  #
          LINE$OUT (OPWRIT, N + J);  # RENAMES NAME1 THROUGH NAME2     #
          RETURN; 
          END 
  
        LINE1[0] = " CONTAINS ";
        J = ITEMLEVEL[0]; 
        N = 11; 
        NXTWORDADDR = DIRWORDADDR + NXTPTR[0];
        EXIT = FALSE; 
        FOR DUMMY = DUMMY WHILE NOT EXIT DO 
          BEGIN 
          IF CDCSDBM               # IF CDCS DATA BASE MODE            #
          THEN
            BEGIN 
                                   # READ NEXT DBI                     #
            GET (SCHEMAFIT, DBIENTRY, NXTWORDADDR, 0, 0,
                 DFSBITMLG * 10, RA0);
            IF SBITMLEVEL LQ J
              OR SBITMLEVEL EQ RENAMINTLVL  # RENAMES IS NOT WITHIN GRP#
            THEN
              BEGIN 
              EXIT = TRUE;         # WHEN THE LEVEL                    #
                                   # NUMBER IS < OR = THE ONE OF THE   #
                                   # ITEM BEING EXHIBITED, THE ITEM    #
                                   # JUST FOUND DOES NOT BELONG TO THE #
                                   # SAME GROUP.                       #
              END 
  
            ELSE                   # STILL PART OF GROUP               #
              BEGIN 
              N = SBITMNMELENC[0];  # LENGTH OF NAME IN CHARACTERS     #
                                   # READ NAME                         #
              GET (SCHEMAFIT, DIRECTENTRY5, NXTWORDADDR + 
                   SBITMNAMEPTR[0], 0, 0, SBITMNMELENC[0], RA0);
                                   # ADDRESS OF NEXT ITEM              #
              NXTWORDADDR = NXTWORDADDR + SBITMNEXTP[0];
              END 
            END 
  
          ELSE                     # IF CRM DATA BASE MODE             #
            BEGIN 
                                   # READ NEXT DBI                     #
            GET (SCHEMAFIT, DIRECTENTRY3, NXTWORDADDR,
                 0, 0, CRMSBITMLGC, RA0); 
            IF ITMLVL[0] LQ J 
            THEN
              BEGIN 
              EXIT = TRUE;         # END OF GROUP                      #
              END 
  
            ELSE                   # STILL PART OF GROUP               #
              BEGIN 
              N = NAMLNGC[0];      # LENGTH OF NAME IN CHARACTERS      #
                                   # ADDRESS OF NEXT ITEM              #
              NXTWORDADDR = NXTWORDADDR + NXTPTR3[0]; 
              END 
            END 
  
          IF NOT EXIT              # IF PART OF GROUP                  #
          THEN
            BEGIN 
            CMOVE(DIRECTENTRY4,10,N,OPWRIT,10);  # PLACE NAME OF ITEM  #
                                   # BELONGING TO ITEM BEING EXHIBITED #
            N = N + 10; 
            LINE$OUT(OPWRIT,N);    # SET LINE LENGTH AND PRINT IT      #
            IF CDCSDBM             # IF CDCS DATA BASE MODE            #
              AND SBITMNEXTP[0] EQ 0  # NO MORE ITEMS IN RECORD        #
            THEN
              BEGIN 
              EXIT = TRUE;         # END OF GROUP                      #
              END 
            END 
          END 
        END 
      END  # EXH$NAMES #
  
  
  
  
#----------------------------------------------------------------------#
#     E X H $ N A M E $ R E L                                          #
  
# IF IN CRM DATA BASE MODE, THIS PROC EXHIBITS THE RECORD AND DBI      #
# NAMES FOR THE GIVEN RELATION NAME IN THE FOLLOWING FORMAT:           #
#                                                                      #
#   <DBI1> OF <RECORD1> = <DBI2> OF <RECORD2>                          #
#   <DBI3> OF <RECORD2> = <DBI4> OF <RECORD3>                          #
#   ...                                                                #
#                                                                      #
# THIS IS DONE BY FINDING THE RELATION TABLE ENTRY THAT MATCHES THE    #
# GIVEN NAME.  IF NO MATCH IS FOUND, CONTROL IS RETURNED VIA STDNO TO  #
# EXHIBIT.  THE RANK ENTRIES OF THE RELATION ENTRY ARE USED TO EXTRACT #
# KEYS FOR READING THE DBI NAMES FROM THE SUBSCHEMA.  THE RANK ENTRIES #
# ALSO CONTAIN POINTERS TO AREA TABLE ENTRIES, WHICH IN TURN HAVE KEYS #
# FOR READING RECORD NAMES FROM THE SUBSCHEMA.  THESE ITEMS ARE THEN   #
# DISPLAYED IN THE FORMAT SHOWN ABOVE.  RETURN IS VIA STDYES, EVEN IF  #
# AN INTERNAL ERROR IS FOUND.                                          #
#                                                                      #
# IF IN CDCS DATA BASE MODE, THIS PROC CALLS *RECINAREACTL*            #
# TO EXHIBIT THE RECORD AND AREA NAMES IN THE FOLLOWING FORMAT:        #
#     <RELATION-NAME> RELATES THE RECORDS                              #
#         <RECORD-NAME> IN <AREA-NAME>                                 #
#         ...                                                          #
# IF IN CDCS DATA BASE MODE, THE JOIN TERMS CANNOT BE EXHIBITED        #
# BECAUSE THEY ARE NOT GIVEN IN THE SUBSCHEMA.                         #
  
      XDEF PROC EXH$NAME$REL; 
      PROC      EXH$NAME$REL; 
      BEGIN 
                                   # THIS IS WHERE WE GET THE NEXT     #
                                   # WORD, HOPEFULLY A RELATION NAME   #
      P<NEXT$WORD$BA> = LOC(INWI[0]); 
      RT$CURR = RELATBLPTR;        # START WITH 1ST RELATION TBL ENTRY #
      FOR DUMMY = DUMMY WHILE RT$CURR NQ 0 DO  # SCAN THRU RELATIONS   #
        BEGIN 
        P<FIT> = LOC(SCHEMAFIT);   # POSITION TO SUBSCHEMA FIT         #
        IF FITOC NQ OC$OPEN        # IF SUBSCHEMA NOT OPEN             #
        THEN
          BEGIN 
          FITBBH = FALSE;          # ALLOCATE BUFFERS ABOVE HHA        #
          OPENM(FIT, $INPUT$, RA0);  # OPEN SUBSCHEMA FOR READING      #
          END 
  
        P<REL$TABLE> = RT$CURR;    # SET BASE TO CURRENT RELATION ENTRY#
        IF NEXT$WORD[0] EQ RT$RELNAME[0] THEN  # IF WE HAVE FOUND NAME #
          BEGIN 
          IF CDCSDBM               # IF CDCS DATA BASE MODE            #
          THEN
            BEGIN 
            RECINAREACTL;          # EXHIBIT RELATION IN CDCS FORMAT   #
            END 
  
          ELSE                     # IF CRM DATA BASE MODE             #
          BEGIN 
          C<0,1>LINE = " ";        # BLANK FOR CARRAGE CONTROL         #
          P<REL$RANKINFO> = LOC (RT$RANKPOS);  # START OF RANK ENTRIES #
                                   # SCAN RANK ENTRIES IN RELATION TBL #
          FOR I = 1 STEP 1 UNTIL RT$NORANKS DO
            BEGIN 
            J = 1;                 # START FILLING LINE HERE           #
            DBI$OF$REC;            # <DBI1> OF <REC1>                  #
            C<J,3>LINE = " = ";    # <DBI1> OF <REC1> =                #
            J = J + 3;
            DBI$OF$REC;            # <DBI1> OF <REC1> = <DBI2> OF <REC2#
            LINE$OUT(LINE,J);      # WRITE LINE TO TERMINAL            #
            END 
          END 
  
          STDYES;                  # EXIT -- WERE ALL DONE             #
          END 
        RT$CURR = RT$FORWARD[0];   # GET POINTER TO NEXT RELATION ENTRY#
        END                        # CONTINUE SCAN OF RELATION TABLE   #
      STDNO;                       # EXIT -- NAME NOT IN RELATION TABLE#
      END  # EXH$REL$NAME # 
  
  
  
  
#----------------------------------------------------------------------#
#     E X H $ R E C $ K E Y S                                          #
  
# THIS PROC EXHIBITS THE RECORD NAME, PRIMARY KEY AND ALTERNATE KEYS   #
# FOR AN AREA.                                                         #
  
      PROC      EXH$REC$KEYS; 
      BEGIN 
      FOR DUMMY = DUMMY DO
        BEGIN 
        NXTATTR;
        IF DIRWORDADDR EQ 0 THEN
          BEGIN 
          RETURN; 
          END 
        IF KEYFLAG[0]              # IF PRIMARY KEY                    #
          OR ALTERKEYFLG[0]        # IF ALTERNATE KEY                  #
          OR (NOT ALTERKEYFLG[0]   # IF MAJOR KEY                      #
            AND MAJORKEYFLG[0]) 
        THEN
          BEGIN 
          IF KEYFLAG[0]            # IF PRIMARY KEY                    #
          THEN
            BEGIN 
            LINE1[0] = " KEY IS"; 
            END 
          ELSE
            BEGIN 
            IF ALTERKEYFLG[0]      # IF ALTERNATE KEY                  #
            THEN
              BEGIN 
              LINE1[0] = " ALT KEY";
              END 
            ELSE                   # IF MAJOR KEY                      #
              BEGIN 
              LINE1[0] = " MAJ KEY";
              END 
            END 
          FOR K = 0 STEP 1 UNTIL NAMELGW[0] DO
            BEGIN 
            LINE1[1+K] = ITEMNAME[K+1]; 
            END 
          LINE$OUT(OPWRIT,NAMELGC[0]+10);  # EXHIBIT ALTERNATE KEY     #
          END 
        IF RCTYPE[0] EQ RECORDNAME THEN 
          BEGIN 
          LINE1[0] = " RECORD NA";
          LINE1[1] = "ME IS     ";
          FOR K = 0 STEP 1 UNTIL NAMELGW[0] DO
            BEGIN 
            LINE1[2+K] = ITEMNAME[K+1]; 
            END 
          LINE$OUT(OPWRIT,NAMELGC[0]+20);  # EXHIBIT RECORD-NAME       #
          END 
        END 
      END  # EXH$REC$KEYS # 
  
  
  
  
#----------------------------------------------------------------------#
#     E X H $ R E L A T I O N                                          #
  
# THIS PROC EXHIBITS RELATIONS IN THE FOLLOWING FORMAT:                #
#                                                                      #
#   <RELATION-NAME> RELATES THE RECORDS                                #
#       <RECORD-NAME> IN <AREA-NAME>                                   #
#       ...                                                            #
#   ...                                                                #
#                                                                      #
# THIS IS DONE BY SCANNING THE RELATION TABLE FOR THE RELATION NAMES   #
# AND CALLING *RECINAREACTL* FOR EACH RELATION.                        #
  
      XDEF PROC EXH$RELATION; 
      PROC      EXH$RELATION; 
      BEGIN 
      IF RELATBLPTR EQ 0 THEN      # IF NO RELATION TABLE ENTRIES...   #
        BEGIN 
        DIAG(1010);                # "NO RELATION EXISTS"              #
        STDYES;                    # EVERYTHING WAS OK -- EXIT         #
        END 
  
      P<FIT> = LOC(SCHEMAFIT);     # POSITION TO SUBSCHEMA FIT         #
      IF FITOC NQ OC$OPEN          # IF SUBSCHEMA NOT OPEN             #
      THEN
        BEGIN 
        FITBBH = FALSE;            # ALLOCATE BUFFERS ABOVE HHA        #
        OPENM(FIT, $INPUT$, RA0);  # OPEN SUBSCHEMA FOR READING        #
        END 
  
      RT$CURR = RELATBLPTR;        # START WITH 1ST RELATION TBL ENTRY #
      FOR DUMMY = DUMMY WHILE RT$CURR NQ 0 DO  # SCAN THRU RELATIONS   #
        BEGIN 
        P<REL$TABLE> = RT$CURR;    # SET BASE TO CURRENT RELATION ENTRY#
        RECINAREACTL;              # EXHIBIT RELATION                  #
        RT$CURR = RT$FORWARD[0];   # GET NEXT ENTRY POINTER AND EXIT   #
                                   # LOOP IF ITS ZERO                  #
        END 
      STDYES;                      # EXIT -- EVERYTHING LOOKS GOOD...  #
      END  # EXH$RELATION # 
  
  
  
  
#----------------------------------------------------------------------#
#     E X T E M P                                                      #
  
# EXHIBIT TEMPORARY NAMES                                              #
  
      XDEF PROC EXTEMP; 
      PROC      EXTEMP; 
      BEGIN 
      LINE1[0] = " ";              # CARRIAGE CONTROL IS BLANK         #
      P<DESATT1> = SPELIST;        # LOOK AT SPECIFY LIST IF IT EXISTS #
                                   # DO WHILE SPECIFY ENTRIES EXIST    #
      FOR DUMMY = DUMMY WHILE P<DESATT1> NQ 0 DO
        BEGIN 
        P<EXHTEM> = P<DESATT1> + 3;  # SPECIFY NAME STARTS HERE        #
        CMOVE(EXHTEM,0,DECNLG[0],OPWRIT,1);  # MOVE NAME TO OUTPUT LINE#
        LINE$OUT(OPWRIT,DECNLG[0]+1);  # WRITE OUT TO TERMINAL         #
        P<DESATT1> = DABSPTR[0];   # LOOK FOR NEXT SPECIFY ENTRY       #
        END 
      IF DEFLIST EQ 0 THEN
        BEGIN 
        STDNO;
        END 
      P<DESATT1> = DEFLIST;        # SET POINTER IN DEFINE LIST        #
      FOR DUMMY = DUMMY DO
        BEGIN 
        IF DIMOCC[0] THEN 
          BEGIN 
          P<EXHTEM> = P<DESATT1> + 4; 
          END 
        ELSE
          BEGIN 
          P<EXHTEM> = P<DESATT1> + 3; 
          END 
        IF C<0,1>DDATNAM[0] NQ "." AND C<0,1>DDATNAM[0] NQ "," THEN 
          BEGIN 
          CMOVE(EXHTEM,0,DECNLG[0],OPWRIT,1); 
          LINE$OUT(OPWRIT,DECNLG[0]+1); 
          END 
        IF DABSPTR[0] EQ 0 THEN 
          BEGIN 
          STDNO;
          END 
        P<DESATT1> = DABSPTR[0];
        END 
      END  # EXTEMP # 
  
  
  
  
#----------------------------------------------------------------------#
#     E X $ P F $ P A R A M S                                          #
  
# THIS PROC EXHIBITS PF INFO (NAME, ID, AND CYCLE).                    #
# START         = STARTING POSITION TO USE IN LINE FOR PF NAME.        #
# FDB$FWA       = ABSOLUTE ADDRESS OF PF FDB.                          #
  
      PROC EX$PF$PARAMS((START),(FDB$FWA)); 
      BEGIN 
      ITEM START U;                # STARTING CHARACTER POSITION       #
      ITEM FDB$FWA U;              # FDB TO USE                        #
      P<FDB$FORMAT> = FDB$FWA;     # LOCATE FDB                        #
      L = LENGTH(FDB$NAME,(40));   # FIND LENGTH OF PF NAME            #
      C<START,L>LINE = C<0,L>FDB$NAME;  # COPY PF NAME                 #
      LINE$OUT(LINE,START+L);      # WRITE OUT LINE                    #
      P<FDB$PARM> = LOC(FDB$1ST$PARM);  # LOCATE START OF PF PARAMETERS#
  
 CONTROL IFEQ OS$NAME,SCOPE;
  
      FOR DUMMY = DUMMY WHILE FDB$PARM$ID NQ O"00" DO  # SCAN LIST     #
        BEGIN 
        IF FDB$PARM$ID EQ $PFID$ THEN  # IF PF ID -- EXHIBIT IT        #
          BEGIN 
          C<00,10>LINE = "     ID = ";
          C<10,10>LINE = EDIT(FDB$PARM$VAL);
          LINE$OUT(LINE,20);
          END 
        IF FDB$PARM$ID EQ $PFCY$ THEN  # IF PF CY -- EXHIBIT IT        #
          BEGIN 
          C<00,10>LINE = "     CY = ";
          C<10,10>LINE = DELZERO(BINDEC(FDB$PARM$INT,3)); 
          LINE$OUT(LINE,20);
          END 
        IF FDB$PARM$ID EQ $PFSN$ THEN  # IF PF SN -- EXHIBIT IT        #
          BEGIN 
          C<00,10>LINE = "     SN = ";
          C<10,10>LINE = EDIT(FDB$PARM$VAL);
          LINE$OUT(LINE,20);
          END 
        IF FDB$PARM$ID GQ $PFPWL$      # IF PF PW -- EXHIBIT *---*     #
            AND FDB$PARM$ID LQ $PFPWH$ THEN 
          BEGIN 
          C<00,10>LINE = "     PW = ";
          C<10,10>LINE = "*---*     ";  # DO NOT DISPLAY PW            #
          LINE$OUT(LINE,20);
          END 
        P<FDB$PARM> = P<FDB$PARM> + 1;  # LOOK AT NEXT PF PARAM ENTRY  #
        END 
  
 CONTROL ENDIF; 
  
  
 CONTROL IFEQ OS$NAME,NOS;
  
        IF FDB$PARM$VAL NQ 0 THEN  # IF PF UN -- EXHIBIT IT            #
          BEGIN 
          C<00,10>LINE = "     UN = ";
          C<10,10>LINE = EDIT(FDB$PARM$VAL);
          LINE$OUT(LINE,20);
          END 
        P<FDB$PARM> = P<FDB$PARM> + 1;  # LOOK AT NEXT PF PARAM. ENTRY #
        IF FDB$PARM$VAL NQ 0       # IF PF PW -- EXHIBIT *---*         #
        THEN
          BEGIN 
          C<00,10>LINE = "     PW = ";
          C<10,10>LINE = "*---*     ";  # DO NOT DISPLAY PW            #
          LINE$OUT(LINE,20);
          END 
        P<FDB$PARM> = P<FDB$PARM> + 1;  # LOOK AT NEXT PF PARAM. ENTRY #
        IF FDB$PARM$VAL NQ 0 THEN  # IF PF M  -- EXHIBIT IT            #
          BEGIN 
          C<00,10>LINE = "     M  = ";
          C<10,10>LINE = NOS$PF$M[FDB$PARM$VAL - O"40"];
          LINE$OUT(LINE,20);
          END 
        P<FDB$PARM> = P<FDB$PARM> + 1;  # LOOK AT NEXT PF PARAM. ENTRY #
        IF FDB$PARM$VAL NQ 0 THEN  # IF PF PN -- EXHIBIT IT            #
          BEGIN 
          C<00,10>LINE = "     PN = ";
          C<10,10>LINE = EDIT(FDB$PARM$VAL);
          LINE$OUT(LINE,20);
          END 
  
 CONTROL ENDIF; 
  
      END  # EX$PF$PARAMS # 
  
  
  
  
#----------------------------------------------------------------------#
#     M A I N L O O P                                                  #
  
# REREAD THE ATTRIBUTES OF THE NAME TO EXHIBIT.  THIS IS DONE BECAUSE  #
# THE REGULAR ROUTINE THAT GETS THE ATTRIBUTES (GETNAM) HAS OVERLAYED  #
# THE 4TH WORD (WHICH CONTAINS THE SAME-NAME POINTER IN THE DIRECTORY) #
# WITH THE ITEM NAME OR THE OCCURING ATTRIBUTES.  THE SAME-NAME        #
# POINTER IS NEEDED BY EXHIBIT PROCS.                                  #
  
      PROC      MAINLOOP; 
      BEGIN 
      IF CDCSDBM                   # IF CDCS DATA BASE MODE            #
      THEN
        BEGIN 
                                   # READ ITEM ENTRY                   #
      GET (SCHEMAFIT, DBIENTRY, DIRWORDADDR, 0, 0, DFSBITMLG * 10,
           RA0);
        IF SBITMENTRY[0] EQ SE$ITEM  # IF ITEM ENTRY                   #
        THEN
          BEGIN 
          DCSAMENAME = SBITMSAMEPTR[0];  # SAVE SAME ADDRESS           #
          END 
  
        ELSE                       # IF RECORD ENTRY                   #
          BEGIN 
          DCSAMENAME = SBRECSMENMEA[0];  # SAVE SAME ADDRESS           #
          END 
        IF OCCURS[0]               # IF OCCURRING WORD IS PRESENT      #
        THEN
          BEGIN 
          OCCURWORD[NAMELGW + 1] = OCCURWORD[0];  # STORE OCCURRING WOR#
                                                  # AFTER NAME         #
          END 
        END 
  
      ELSE                         # IF CRM DATA BASE MODE             #
        BEGIN 
                                   # READ ITEM ENTRY                   #
        GET (SCHEMAFIT, DIRECTENTRY, DIRWORDADDR, 
             0, 0, CRMSBITMLGC, RA0); 
        END 
  
      T = RCTYPE[0];               # POSSIBLE VALUES FOR RCTYPE ARE:   #
                                   #   0  GROUP ITEM                   #
                                   #   1  ELEMENTARY ITEM              #
                                   #   2  OCCURING GROUP               #
                                   #   3  REPEATING GRP WITHIN REP. GRP#
                                   #   4  OCCURING ITEM                #
                                   #   5  VECTOR WITHIN REPEATING GRP. #
                                   #   7  RECORD                       #
                                   #  10  AREA ENTRY                   #
                                   #  77  END OF AREA DESCRIPTION      #
      IF T EQ RECORDNAME THEN 
        BEGIN 
        FOR DUMMY = DUMMY DO
          BEGIN 
          NXTATTR;
          T = RCTYPE[0];
          IF        KEYFLAG[0]       THEN LINE1[0] = "    (KEY) ";
            ELSE IF ALTERKEYFLG[0]   THEN LINE1[0] = "    (ALT) ";
            ELSE IF MAJORKEYFLG[0]   THEN LINE1[0] = "    (MAJ) ";
            ELSE IF T EQ 1 OR T EQ 4 OR T EQ 5
                                     THEN LINE1[0] = "    (ELM) ";
            ELSE IF T EQ 0 OR T EQ 2 OR T EQ 3
                                     THEN LINE1[0] = "    (GRP) ";
            ELSE STDYES;
          IF CDCSDBM               # IF CDCS DATA BASE MODE            #
            AND ITEMLEVEL[0] EQ RENAMINTLVL  # IF RENAMES              #
          THEN
            BEGIN 
            C<1,2>LINE1[0] = RENMEXTLVLDC;  # RENAMES LEVEL NUMBER     #
            END 
  
          ELSE
            BEGIN 
            C<1,2>LINE1[0] = BINDEC(ITEMLEVEL[0],2);  # CONVERT LVL NO #
            END 
  
          N = NAMELGC[0]; 
          CMOVE(DIRECTENTRY2,10,N,OPWRIT,10);  # MOVE ITEM NAME        #
          N = N + 10; 
          LINE$OUT(OPWRIT,N); 
          END 
        END 
      ELSE
        BEGIN 
        EXH$NAMES;
        END 
      IF CDCSDBM                   # IF CDCS DATA BASE MODE            #
      THEN
        BEGIN 
        IF DCSAMENAME EQ 0         # IF NO MORE ITEMS WITH SAME NAME   #
        THEN
          BEGIN 
          STDYES;                  # TAKE SUCCESS RETURN               #
          END 
  
        DIRWORDADDR = DCSAMENAME;  # ADDRESS OF NEXT ITEM WITH SAME NME#
        END 
  
      ELSE                         # IF CRM DATA BASE MODE             #
        BEGIN 
        IF SAMENAME[0] EQ 0        # IF NO MORE ITEMS WITH SAME NAME   #
        THEN
          BEGIN 
          STDYES;                  # TAKE SUCCESS RETURN               #
          END 
  
        DIRWORDADDR = SAMENAME[0];  # ADDR OF NEXT ITEM WITH SAME NAME #000880
        END 
  
      END  # MAINLOOP # 
  
  
  
  
#----------------------------------------------------------------------#
#     N X T A T T R                                                    #
# THIS PROC FETCHES THE NEXT DBI ENTRY IN CRM FORMAT                   #
#                                                                      #
#      ON ENTRY                                                        #
#                                                                      #
# P<AREA$TABLE> POINTS TO AREA TABLE                                   #
# DIRWORDADDR CONTAINS ADDRESS OF LAST DBI ENTRY OR ZERO IF THERE      #
# WAS NO PREVIOUS DBI ENTRY.                                           #
#                                                                      #
#     ON EXIT                                                          #
#                                                                      #
# ARRAY DIRECTENTRY CONTAINS DBI ENTRY IN CRM FORMAT                   #
# DIRWORDADDR CONTAINS ADDRESS OF ITEM ENTRY READ OR ZERO IF NO        #
# MORE ITEMS                                                           #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC      NXTATTR;
      BEGIN 
      IF CDCSDBM                   # IF CDCS DATA BASE MODE            #
      THEN
        BEGIN 
        IF DIRWORDADDR EQ 0        # IF FIRST CALL TO NXTATTR          #
        THEN
          BEGIN 
          RECDCOUNT = 1;           # INITIALIZE COUNT OF RECORDS       #
          GET (SCHEMAFIT, RLMLSTENT, AT$RLMLSTADR + AT$RLMLSTENT, 
               0, 0, DFSBRLMLST * 10, RA0);  # READ REALM LIST ENTRY   #
          NUMRECS = REALMRECLEN[0];  # NUMBER OF RECORDS IN AREA       #
          WRECADDR = REALMRECLIST[0] + AT$RLMLSTADR;
                                   # WA ADDR OF RECORD LIST ENTRY      #
                                   # WITHIN REALM/RELATION TABLE       #
          GET (SCHEMAFIT, RECDLIST, WRECADDR, 0, 0, DFSBRECLST * 10,
               RA0);               # READ RECORD LIST ENTRY WITHIN     #
                                   # REALM/RELATION TABLE              #
          DIRWORDADDR = RECLISTLADR[0];  # ADDR OF FIRST RECORD        #
          END 
  
        ELSE                       # PREVIOUS ENTRY HAS BEEN READ      #
          BEGIN 
          IF SBITMENTRY[0] EQ SE$RECORD  # IF PREVIOUS ENTRY WAS RECORD#
          THEN
            BEGIN 
                                   # ADDR OF 1ST ITEM WITHIN RECORD    #
            DIRWORDADDR = DIRWORDADDR + SBRECNXITEMP[0];
            END 
  
          ELSE                     # IF PREVIOUS ENTRY WAS ITEM        #
            BEGIN 
            IF SBITMNEXTP[0] EQ 0  # IF PREVIOUS WAS LAST ITEM IN RECRD#
            THEN
              BEGIN 
              IF RECDCOUNT EQ NUMRECS  # IF LAST RECORD                #
              THEN
                BEGIN 
                RCTYPE[0] = ET$ENDOFAREA;  # INDICATE NO MORE ITEMS    #
                DIRWORDADDR = 0;
                RETURN; 
                END 
  
              RECDCOUNT = RECDCOUNT + 1;  # PROCESS NEXT RECORD        #
              WRECADDR = WRECADDR + 1;  # ADDR OF NEXT RECRD LIST ENTRY#
                                        # IN REALM/RELATION LIST       #
              GET (SCHEMAFIT, RECDLIST, WRECADDR, 0, 0, 
                   DFSBRECLST * 10, RA0);  # READ RECORD LIST ENTRY    #
              DIRWORDADDR = RECLISTLADR[0];  # ADDR OF RECORD ENTRY    #
              END 
  
            ELSE                   # ITEM IS NOT LAST ITEM IN RECORD   #
              BEGIN 
                                   # ADDRESS OF NEXT ITEM              #
              DIRWORDADDR = DIRWORDADDR + SBITMNEXTP[0];
              END 
            END 
          END 
  
        GET (SCHEMAFIT, DBIENTRY, DIRWORDADDR, 0, 0,
             DFSBITMLG * 10, RA0);  # READ DBI ENTRY                   #
                                   # TRANSFORM CDCS DBI ENTRY INTO CRM #
                                   # DBI ENTRY                         #
        TRNSDBI (DBIENTRY, DIRECTENTRY, DIRWORDADDR); 
        IF OCCURS[0]               # IF OCCURRING WORD IS PRESENT      #
        THEN
          BEGIN 
                                   # REVERSE NAME AND OCCURRING WORD   #
          T = OCCURWORD[1];        # SAVE OCCURRING WORD               #
          FOR I = 1 STEP 1         # MOVE ALL WORDS OF NAME            #
            UNTIL NAMELGW[0]
          DO
            BEGIN 
            ITEMNAME[I] = ITEMNAME[I + 1];
            END 
          OCCURWORD[NAMELGW + 1] = T;  # STORE OCCURRING WORD AFTR NAME#
          END 
        END 
  
      ELSE                         # IF CRM DATA BASE MODE             #
      BEGIN 
      IF DIRWORDADDR EQ 0 THEN
        BEGIN 
        GET (SCHEMAFIT, DIRECTENTRY, AT$AREAWA, 0, 0, 100, RA0);
        DIRWORDADDR = RECORDPTR;   # ADDRESS OF RECORD ENTRY           #
        END 
      ELSE
        BEGIN 
        DIRWORDADDR = DIRWORDADDR + NXTPTR[0];
        END 
      GET(SCHEMAFIT,DIRECTENTRY,DIRWORDADDR,0,0,100,RA0); 
      IF NXTPTR[0] EQ 0 OR RCTYPE[0] EQ ENDOFAREA THEN
        BEGIN 
        DIRWORDADDR = 0;
        RETURN; 
        END 
      END 
      DATATYPE = CLASS[0];
      RESULTSIZE = INCPICSIZE[0]; 
      END  # NEXTATTR # 
  
  
  
  
#----------------------------------------------------------------------#
#     P R I N T O C C                                                  #
  
# THIS PROC PRINTS THE NUMBER OF OCCURANCES OF AN OCCURING ITEM OR     #
# GROUP, AS WELL AS THE NAME OF THE DEPENDING ON FIELD IF ANY.  THE    #
# ATTRIBUTES OF THE DATA FIELD WHOSE OCCURANCES ARE TO BE PRINTED      #
# RESIDE IN THE DIRECTENTRY AND DIRECTENTRY1 AT THE TIME PRINTOCC      #
# IS CALLED.                                                           #
  
      PROC      PRINTOCC; 
      BEGIN 
      LINE1[0] = " OCCURS"; 
      I = NAMELGW[0] + 1;          # OFFSET TO OCCURING DATA           #
      LINE1[1] = BINDEC(OCCURCOUNT[I],5);  # CONVERT NUM. OF OCCURANCES#
      N = 15; 
      LINE$OUT(OPWRIT,N);          # PRINT NUMBER OF OCCURANCES        #
      END  # PRINTOCC # 
  
  
  
  
#----------------------------------------------------------------------#
#     R C D O F F                                                      #
  
# THIS PROC TURNS THE RECORDING FLAG OFF TEMPORARILY SO THAT A         #
# DATA-NAME SEARCH IS PERFORMED ON AN *EXHIBIT <DATA-NAME>* COMMAND.   #
  
      XDEF PROC RCDOFF; 
      PROC RCDOFF;
      BEGIN 
      IF NOT RECORDFLAG            # IF NOT RECORDING                  #
      THEN
        BEGIN 
        RCDFLG = FALSE;            # CLEAR FLAG TO INDICATE THAT       #
                                   # RECORDFLAG WAS NOT TURNED OFF     #
        STDYES; 
        END 
      RECORDFLAG = FALSE;          # TURN OFF RECORDFLAG TEMPORARILY   #
      RCDFLG = TRUE;               # SET FLAG TO INDICATE RECORDFLAG   #
                                   # HAS BEEN TURNED OFF TEMPORARILY   #
      STDYES; 
      END 
  
  
  
  
#----------------------------------------------------------------------#
#     R C D O N                                                        #
  
# THIS PROC TURNS THE RECORDING FLAG BACK ON AFTER THE SEARCH FOR A    #
# DATA-NAME ON AN *EXHIBIT <DATA-NAME>* COMMAND HAS BEEN COMPLETED.    #
  
      XDEF PROC RCDON;
      PROC RCDON; 
      BEGIN 
      IF RCDFLG                    # IF RECORDING FLAG WAS TURNED OFF  #
                                   # FOR AN *EXHIBIT <DATA-NAME>*      #
      THEN
        BEGIN 
        RECORDFLAG = TRUE;         # TURN IT BACK ON                   #
        END 
      STDYES; 
      END 
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     R E C I N A R E A C T L                                          #
#                                                                      #
#     THIS PROC WRITES THE CHARACTERS                                  #
#         <RELATION-NAME> RELATES THE RECORDS                          #
#                                                                      #
#     THEN IT SCANS THE RANK ENTRIES OF THE RELATION TABLE.  FOR       #
#     EACH RANK IT CALLS REC$IN$AREA, PASSING IT THE AREATABLE ADDRESS #
#     OF THE RANK.                                                     #
#                                                                      #
#     ON INPUT P<REL$TABLE> POINTS TO THE RELATION TABLE               #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC RECINAREACTL;
      BEGIN 
      FOR I = 0 STEP 1             # SCAN CHARACTERS IN RT$RELNAME     #
        UNTIL 33
      DO
        BEGIN 
        IF C<I,1>RT$RELNAME EQ " "  # IF FIRST TRAILING BLANK          #
        THEN
          BEGIN 
          J = I + 1;               # SAVE INDEX: LENGTH OF NAME + BLANK#
          I = 40;                  # FORCE EXIT FROM LOOP              #
          END 
        END 
  
      C<0,1>LINE = BLANK;          # FOR CARRIAGE CONTROL              #
      C<1,J>LINE = RT$RELNAME;     # COPY NAME                         #
      C<J + 1,20>LINE = "RELATES THE RECORDS:";  # COMPLETE LINE       #
      J = J + 21;                  # COMPUTE SIZE OF LINE              #
      LINE$OUT (LINE, J);          # WRITE OUT LINE TO TERMINAL        #
      P<REL$RANKINFO> = LOC(RT$RANKPOS);  # POSITION TO RANK ENTRIES   #
      P<AREA$TABLE> = RR$AREAPTR[0];  # AREA TABLE OF ROOT RANK        #
      REC$IN$AREA;                 # WRITE <RECORD-NAME> IN <AREA-NAME>#
      FOR I = 1 STEP 1             # LOOP THROUGH OTHER RANKS          #
        UNTIL RT$NORANKS
      DO
        BEGIN 
        P<AREA$TABLE> = RR$AREAPTR[(I * 2) - 1];  # POSITION TO AREA TB#
        REC$IN$AREA;               # WRITE <RECORD-NAME> IN <AREA-NAME>#
        END 
      RETURN; 
      END 
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     R E C $ I N $ A R E A                                            #
#                                                                      #
#     THIS PROC WRITES THE CHARACTERS                                  #
#         <RECORD-NAME> IN <AREA-NAME>                                 #
#                                                                      #
#     IT READS RECORD SUBSCHEMA ENTRY (WHOSE ADDRESS GIVEN IN AT$RECWA)#
#     TO OBTAIN RECORD NAME.  IT OBTAINS AREA NAME FROM AT$AFDB$NAME.  #
#                                                                      #
#     ON INPUT P<AREA$TABLE> POINTS TO AREA TABLE                      #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC REC$IN$AREA; 
      BEGIN 
      IF CDCSDBM                   # IF CDCS DATA BASE MODE            #
      THEN
        BEGIN 
                                   # READ RECORD ENTRY                 #
        GET (SCHEMAFIT, DBIENTRY, AT$RECWA, 0, 0, DFSBRCLG * 10, RA0);
        GET (SCHEMAFIT, DIRECTENTRY5, AT$RECWA + SBRECNAMEPTR[0], 
             SBRECNMELENC[0], RA0);  # READ RECORD NAME                #
        J = SBRECNMELENC[0];       # LENGTH OF NAME IN CHARACTERS      #
        END 
  
      ELSE                         # IF CRM DATA BASE MODE             #
        BEGIN 
                                   # READ RECORD ENTRY                 #
        GET (SCHEMAFIT, DIRECTENTRY3, AT$RECWA, 
             0, 0, CRMSBITMLGC, RA0); 
        J = NAMLNGC[0];            # LENGTH OF NAME IN CHARACTERS      #
        END 
  
      C<0,4>LINE = " ";            # LEADING BLANKS FOR INDENTATION    #
      CMOVE (DIRECTENTRY5, 0, J, LINE, 4);  # COPY RECORD NAME         #
      C<J + 4, 4>LINE = " IN "; 
      J = J + 8;
      K = LENGTH (AT$AFDB$NAME, (32));  # GET LENGTH OF NAME           #
      C<J,K>LINE = C<0,K>AT$AFDB$NAME[0];  # COPY AREA NAME            #
      J = J + K;
      LINE$OUT (LINE, J);          # WRITE OUT LINE TO TERMINAL        #
      RETURN; 
      END 
  
  
  
#----------------------------------------------------------------------#
#     R E P O R T S                                                    #
  
# THIS PROC EXHIBITS REPORT INFORMATION                                #
  
      PROC      REPORTS;
      BEGIN 
      C< 0,30>LINE = " MAX NUMBER OF LINES";
      C<22, 3>LINE = BINDEC(MAXLINE,3); 
      LINE$OUT(LINE,25);           # MAX NUMBER OF LINES               #
      C< 0,30>LINE = " MAX NUM. OF COLUMNS";
      C<22, 3>LINE = BINDEC(MAXCOL,3);
      LINE$OUT(LINE,25);           # MAX NUMBER OF COLUMNS             #
      C< 0,30>LINE = " MAX NO. OF SECTIONS";
      C<22, 3>LINE = BINDEC(MAXSECTS,3);
      LINE$OUT(LINE,25);           # MAX NUMBER OF SECTIONS            #
      C< 0,30>LINE = " MAX IMAGES PER PAGE";
      C<22, 3>LINE = BINDEC(MAXIMAGE,3);
      LINE$OUT(LINE,25);           # MAX NUMBER OF IMAGES PER PAGE     #
      END  # REPORTS #
  
  
  
  
#----------------------------------------------------------------------#
  
  
      END 
      TERM
