*DECK EXHIMFN 
USETEXT TEXPRES 
USETEXT TIMF
USETEXT TIMFDEF 
      PROC EXHIMFN; 
      BEGIN 
#----------------------------------------------------------------------#
#     S T A R T    O F    X R E F S                                    #
#                                                                      #
  
      XREF FUNC BINDEC C(10);      # CONVERT BINARY TO DECIMAL, LEFT   #
                                   # JUSTIFIED                         #
      XREF PROC CMOVE;             # MOVE CHARACTER STRING             #
      XREF PROC DES$DIT;           # FIND DATA ITEM DESCRIPTION        #
      XREF FUNC EDIT C(10);        # RETURN CHAR STRING LEFT JUSTIFIED #
                                   # ZERO FILLED                       #
      XREF PROC LINE$OUT;          # WRITE LINE TO OUTPUT OR TERMINAL  #
      XREF PROC STDYES; 
  
      XREF ARRAY EXHTYPE[7];       # DISPLAY CODE VALUES FOR DATA TYPE #
        BEGIN 
        ITEM LITERAL      C(00,00,10);
        END 
  
      XREF ARRAY FIELDN [1:1] 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 BASED ARRAY SCHNAMA;    # EXTERNAL SCHEMA NAME AND          #
                                   # CONCEPTUAL SCHEMA NAME ARRAY      #
        BEGIN 
        ITEM SUBNAME      C(00,00,30);  # EXTERNAL SCHEMA NAME         #
        ITEM SCHNAME      C(03,00,30);  # CONCEPTUAL SCHEMA NAME       #
        END 
  
      XREF ITEM FIELDNAMELG I;     # NUM OF NAMES GIVEN                #
      XREF ITEM PRYPFID I;         # METADATABASE PERMANENT FILE ID    #
      XREF ITEM SCHMSDB U;         # METADATABASE PERMANENT FILE NAME  #
  
#----------------------------------------------------------------------#
#                                                                      #
#     S T A R T    O F    L O C A L    I T E M S                       #
  
      ITEM I I;                    # SCRATCH TEMPORARY                 #
      ITEM ITEMID I;               # SUBSCRIPT OF DIT WITHIN RECORD IF #
                                   # NAME FOUND, ELSE ZERO             #
      ITEM J I;                    # SCRATCH TEMPORARY                 #
  
#----------------------------------------------------------------------#
#                                                                      #
#     S T A R T    O F    L O C A L    A R R A Y S                     #
  
      BASED ARRAY EXHTEMP;;        # TEMPORARY BASED ARRAY FOR PASSING #
                                   # PARAMETERS TO CMOVE               #
  
      ARRAY HOSTA [1:4];           # ARRAY OF HOST LANGUAGES           #
        BEGIN 
        ITEM HOST         C(00,00,10) = [" COBOL   ", 
                                         " FORTRAN ", 
                                         " SYMPL   ", 
                                         " PASCAL   ",
                                         " FORTRAN5 "]; 
        END 
  
      ARRAY LINEA [6];             # IMAGE ARRAY FOR TERMINAL OUTPUT   #
        BEGIN 
        ITEM LINE         C(00,00,10);
        END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     E X H I S C N                                                    #
#                                                                      #
#     EXHIBIT IMF SCHEMA AND RECORD NAMES IN THE FOLLOWING FORMAT:     #
#             -LANGUAGE- EXTERNAL SCHEMA = -EXTERNAL-SCHEMA-NAME-      #
#             CONCEPTUAL SCHEMA = -CONCEPTUAL-SCHEMA-NAME-             #
#             METADB = -METADB-                                        #
#                 ID-UN = -ID/UN-                                      #
#             RECORD NAME(S):                                          #
#                 -RECORD-NAME1-                                       #
#                 -RECORD-NAME2-                                       #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC EXHISCN;
      PROC EXHISCN; 
      BEGIN 
      IF USERSSST EQ 0             # IF NO SCHEMA TABLE, COULD HAPPEN  #
                                   # DURING RECORDING                  #
      THEN
        BEGIN 
        RETURN; 
        END 
  
      LINE[0] = HOST[SSTHOST];     # GET HOST LANGUAGE                 #
      LINE[1] = "EXTERNAL S"; 
      LINE[2] = "CHEMA =   "; 
      P<EXHTEMP> = LOC(SUBNAME);   # POSITION TO EXTERNAL SCHEMA NAME  #
      CMOVE (EXHTEMP, 0, 30, LINEA, 28);
      LINE$OUT (LINEA, 58); 
      LINE[0] = " CONCEPTUA"; 
      LINE[1] = "L SCHEMA ="; 
      LINE[2] = "          "; 
      P<EXHTEMP> = LOC(SCHNAME);   # POSITION TO CONCEPTUAL SCHEMA NAME#
      CMOVE (EXHTEMP, 0, 30, LINEA, 21);
      LINE$OUT (LINEA, 51); 
      LINE[0] = " METADB = "; 
      LINE[1] = EDIT (SCHMSDB);    # METADB NAME, LEFT JUSTIFIED, BLANK#
                                   # FILLED                            #
      LINE$OUT (LINEA, 20); 
      LINE[0] = "  UN/ID = "; 
      LINE[1] = EDIT (PRYPFID);    # ID OR UN, LEFT JUST, BLANK FILLED #
      LINE$OUT (LINEA, 20); 
      LINE[0] = " RECORD NA"; 
      LINE[1] = "ME(S):    "; 
      LINE$OUT (LINEA, 20); 
      LINE[0] = "          "; 
      P<SRAT> = USERSSST + SICRCTD;  # POSITION TO RECORD TABLE        #
      FOR I = 1 STEP 1             # LOOP THROUGH ALL RECORDS          #
        UNTIL SICRCTN 
      DO
        BEGIN 
        P<EXHTEMP> = LOC(RECNAME[I]);  # POSITION TO RECORD NAME       #
        CMOVE (EXHTEMP, 0, 30, LINEA, 4); 
        LINE$OUT (LINEA, 34); 
        END 
      RETURN; 
      END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     O N E I T E M                                                    #
#                                                                      #
#     ONEITEM EXHIBITS IMF DATA ITEMS (DIT) IN THE FOLLOWING FORMAT:   #
#         -DIT- OF -RECORD-NAME-                                       #
#         TYPE -TYPE- PIC SIZE -NUMBER-                                #
#                                                                      #
#     ON INPUT FIELDN ARRAY, CEXPRESS, RECORDID SET UP                 #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC ONEITEM; 
      BEGIN 
      LINE[0] = "          "; 
      I = FNLG[1];                 # LENGTH OF ITEM NAME               #
      P<EXHTEMP> = LOC(FN[1]);     # POSITION TO ITEM NAME             #
      CMOVE (EXHTEMP, 0, I, LINEA, 1);  # ITEM NAME                    #
      CMOVE ( " OF ", 0, 4, LINEA, I + 1);
                                   # POSITION TO RECORD TABLE          #
      P<SRAT> = USERSSST + SICRCTD + (RECORDID - 1) * SRCTENL;
      P<EXHTEMP> = LOC(RECNAME[1]);  # POSITION TO RECORD NAME         #
      CMOVE (EXHTEMP, 0, 30, LINEA, I + 5);  # RECORD NAME             #
      LINE$OUT (LINEA, I + 35); 
      LINE[0] = " TYPE     "; 
      LINE[1] = LITERAL[DATATYPE];
      LINE[2] = " PIC SIZE "; 
      LINE[3] = BINDEC (INCPICSIZE, 4); 
      LINE$OUT (LINEA, 34); 
      RETURN; 
      END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     E X H I M F N                                                    #
#                                                                      #
#     EXHIMFN EXHIBITS IMF RECORD NAMES IN THE FOLLOWING FORMAT:       #
#         PERMISSIONS:                                                 #
#             -PERMISSIONS-                                            #
#         ACCESS:                                                      #
#             -ACCESS-PATH1                                            #
#             -ACCESS-PATH2-                                           #
#         ITEMS:                                                       #
#             -DIT1-                                                   #
#             -DIT2-                                                   #
#                                                                      #
#     EXHIMFN CALLS ONEITEM TO EXHIBIT IMF DATA ITEMS (DIT)            #
#                                                                      #
#     ON INPUT FIELDN ARRAY, CEXPRESS, RECORDID SET UP                 #
#                                                                      #
#----------------------------------------------------------------------#
  
      IF RCTYPE EQ ET$RECORD       # IF EXHIBIT RECORD-NAME            #
      THEN
        BEGIN 
        LINE$OUT (" PERMISSIONS:", 13); 
                                   # POSITION TO RECORD TABLE          #
        P<SRAT> = USERSSST + SICRCTD + (RECORDID - 1) * SRCTENL;
        IF RECPERM[1] EQ O"37"     # IF ALL PERMISSIONS                #
        THEN
          BEGIN 
          LINE[0] = "    ALL   "; 
          LINE$OUT (LINEA, 10); 
          END 
  
        ELSE
          BEGIN 
          IF RECPERM[1] EQ 0       # IF NO PERMISSIONS                 #
          THEN
            BEGIN 
            LINE[0] = "    NONE  "; 
            LINE$OUT (LINEA, 10); 
            END 
  
          ELSE                     # SOME PERMISSIONS, SO LIST EACH    #
                                   # ONE SEPARATELY                    #
            BEGIN 
            IF RECMODF[1] NQ 0     # IF MODIFY PERMISSION              #
            THEN
              BEGIN 
              LINE[0] = "    MODIFY"; 
              LINE$OUT (LINEA, 10); 
              END 
  
            IF RECDELF[1] NQ 0     # IF REMOVE                         #
            THEN
              BEGIN 
              LINE[0] = "    REMOVE"; 
              LINE$OUT (LINEA, 10); 
              END 
  
            IF RECSTDF[1] NQ 0     # IF STORE                          #
            THEN
              BEGIN 
              LINE[0] = "    STORE "; 
              LINE$OUT (LINEA, 10); 
              END 
  
            IF RECOBTF[1] NQ 0     # IF OBTAIN                         #
            THEN
              BEGIN 
              LINE[0] = "    QUERY "; 
              LINE$OUT (LINEA, 10); 
              END 
            END 
          END 
  
      LINE$OUT ( " ACCESS:", 8);
      IF RECNRAP EQ 0              # IF NO ACCESS PATHS TO RECORD      #
      THEN
        BEGIN 
        LINE[0] = "    NONE  "; 
        LINE$OUT (LINEA, 10); 
        END 
  
      ELSE
      BEGIN 
      LINE[0] = "          "; 
                                   # POSITION TO ACCESS PATH TABLE     #
      P<SAAT> = USERSSST + SICAPTD + (RECFSAP - 1) * SAPTENL; 
      FOR I = 1 STEP 1             # LOOP THROUGH ALL ACCESS PATHS     #
        UNTIL RECNRAP 
      DO
        BEGIN 
        P<EXHTEMP> = LOC(APTNAME[I]);  # POSITION TO ACCESS PATH NAME  #
        CMOVE (EXHTEMP, 0, 30, LINEA, 4); 
        LINE$OUT (LINEA, 34); 
        END 
      END 
  
      LINE$OUT (" ITEMS:", 7);
                                   # POSITION TO FIRST DIT TABLE       #
        P<SDID> = USERSSST + SICDITD + (RECFSDI[1] - 1) * SDITENL;
        LINE[0] = "          "; 
        FOR I = 1 STEP 1           # LOOP THROUGH ALL DATA ITEM NAMES  #
          UNTIL RECNRDI[1]
        DO
          BEGIN 
          P<EXHTEMP> = LOC(SDTNAME[I]); 
          CMOVE (EXHTEMP, 0, 30, LINEA, 4); 
          LINE$OUT (LINEA, 34); 
          END 
  
        STDYES;                    # EXIT                              #
        END                        # END OF EXH RECORD NAME            #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     EXHIBIT IMF DATA ITEM                                            #
#                                                                      #
#----------------------------------------------------------------------#
  
      ONEITEM;                     # EXHIBIT IMF DATA ITEM             #
      IF FIELDNAMELG EQ 1          # IF NOT QUALIFIED BY RECORD-NAME   #
        AND RECORDID LS SICRCTN    # IF NOT FOUND IN LAST RECORD       #
      THEN
        BEGIN 
        FOR J = RECORDID + 1 STEP 1     # SEARCH REST OF RECORDS FOR   #
                                        # SAME NAME                    #
          UNTIL SICRCTN 
        DO
          BEGIN 
          RECORDID = J; 
          DES$DIT (FIELDN[1], ITEMID);
          IF ITEMID NQ 0           # IF NAME FOUND                     #
          THEN
            BEGIN 
            ONEITEM;               # EXHIBIT IMF DATA ITEM             #
            END 
          END 
        END 
      STDYES; 
      END 
      TERM
