*DECK EXHAPCS 
USETEXT TIMF
USETEXT TIMFDEF 
USETEXT TXSTD 
      PROC EXHAPCS; 
      BEGIN 
#----------------------------------------------------------------------#
#                                                                      #
#     S T A R T    O F    X R E F S                                    #
  
      XREF PROC CMOVE;             # MOVE CHARACTER STRING             #
      XREF PROC DES$APT;           # FIND ACCESS PATH DESCRIPTION      #
      XREF PROC DES$CST;           # FIND COSET DESCRIPTION            #
      XREF PROC DES$REC;           # FIND RECORD DESCRIPTION           #
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC                  #
      XREF PROC LINE$OUT;          # WRITE LINE TO OUTPUT OR TERMINAL  #
  
      XREF ITEM IMFDBM B;          # TRUE IF IMF DATA BASE MODE        #
  
#----------------------------------------------------------------------#
#                                                                      #
#     S T A R T    O F    L O C A L    I T E M S                       #
  
      ITEM I I;                    # SCRATCH TEMPORARY                 #
      ITEM J I;                    # SCRATCH TEMPORARY                 #
      ITEM K 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 LINEA[0:11];           # IMAGE ARRAY FOR TERMINAL OUTPUT   #
        BEGIN 
        ITEM LINE         C(00,00,10);
        END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     A L L A P T H                                                    #
#                                                                      #
#     CALL APTHRECD FOR EACH RECORD TO EXHIBIT ALL ACCESS-PATHS FOR ALL#
#     RECORDS IN EXTERNAL SCHEMA.                                      #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC ALLAPTH;
      PROC ALLAPTH; 
      BEGIN 
      IF NOT IMFDBM                # IF NOT IMF DATA BASE MODE         #
        OR USERSSST EQ 0           # IF NO SCHEMA TABLE, COULD HAPPEN  #
                                   # WHILE RECORDING                   #
      THEN
        BEGIN 
        DIAG (1019);               # NO ACCESS PATHS EXIST             #
        STDYES; 
        END 
  
      FOR J = 1 STEP 1             # LOOP THROUGH ALL RECORDS          #
        UNTIL SICRCTN 
      DO
        BEGIN 
        RECORDID = J; 
        APTHRECD;                  # EXHIBIT ACCESS PATHS FOR RECORD   #
        END 
      STDYES; 
      END                          # END PROC    ALLAPTH               #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     A L L C S E T                                                    #
#                                                                      #
#     CALL CSETOWNMEM TO EXHIBIT EVERY COSET                           #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC ALLCSET;
      PROC ALLCSET; 
      BEGIN 
      IF NOT IMFDBM                # IF NOT IMF DATA BASE MODE         #
        OR USERSSST EQ 0           # IF NO SCHEMA TABLE, COULD HAPPEN  #
                                   # WHILE RECORDING                   #
      THEN
        BEGIN 
        DIAG (1020);               # NO COSETS EXIST                   #
        STDYES; 
        END 
  
      FOR K = 1 STEP 1             # LOOP THROUGH ALL COSETS           #
        UNTIL SICCSTN 
      DO
        BEGIN 
        COSETID = K;
        CSETOWNMEM;                # EXHIBIT OWNER-MEMBER OF COSET     #
        END 
      STDYES; 
      END                          # END PROC    ALLCSET               #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     A P T H R E C D                                                  #
#     EXHIBIT ALL ACCESS PATHS FOR A RECORD IN THE FOLLOWING FORMAT:   #
#         ACCESS TO -RECORD-NAME-                                      #
#             -ACCESS-PATH1-                                           #
#             -ACCESS-PATH2-                                           #
#                                                                      #
#     ON INPUT RECORDID CONTAINS RECORD ID                             #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC APTHRECD;
      BEGIN 
                                   # POSITION TO RECORD TABLE          #
      P<SRAT> = USERSSST + SICRCTD + (RECORDID - 1) * SRCTENL;
      LINE[0] = " ACCESS TO"; 
      LINE[1] = "          "; 
      P<EXHTEMP> = LOC(RECNAME);   # POSITION TO RECORD NAME           #
      CMOVE (EXHTEMP, 0, 30, LINEA, 11);
      LINE$OUT (LINEA, 41); 
      IF RECNRAP EQ 0              # IF NO ACCESS PATHS TO RECORD      #
      THEN
        BEGIN 
        LINE[0] = "    NONE  "; 
        LINE$OUT (LINEA, 10); 
        RETURN; 
        END 
  
      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 
      RETURN; 
      END                          # END PROC     APTHRECD             #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C S E T O W N M E M                                              #
#                                                                      #
#     EXHIBITS A COSET IN THE FOLLOWING FORMAT:                        #
#         -COSET-NAME-                                                 #
#             OWNER  -RECORD-NAME-                                     #
#             MEMBER -RECORD-NAME-                                     #
#                                                                      #
#     ON INPUT COSETID CONTAINS COSET ID                               #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CSETOWNMEM;
      BEGIN 
                                   # POSITION TO COSET TABLE           #
      P<SCAT> = USERSSST + SICCSTD + (COSETID - 1) * SCTSENL; 
      LINE[0] = "          "; 
      P<EXHTEMP> = LOC(CSTNAME);
      CMOVE (EXHTEMP, 0, 30, LINEA, 1); 
      LINE$OUT (LINEA, 31); 
      LINE[0] = "    OWNER "; 
      LINE[1] = "          "; 
      P<SRAT> = USERSSST + SICRCTD;  # POSITION TO RECORD TABLE        #
      P<EXHTEMP> = LOC(RECNAME[CSTORID]);  # POSITION TO OWNER REC NAME#
      CMOVE (EXHTEMP, 0, 30, LINEA, 11);
      LINE$OUT (LINEA, 41); 
      LINE[0] = "    MEMBER"; 
      P<EXHTEMP> = LOC(RECNAME[CSTMRID]);  # POSITION TO MEMBER REC NAM#
      CMOVE (EXHTEMP, 0, 30, LINEA, 11);
      LINE$OUT (LINEA, 41); 
      RETURN; 
      END                          # END PROC    CSETOWNMEM            #
CONTROL EJECT;
#----------------------------------------------------------------------#
#     O N E A P T H                                                    #
#                                                                      #
#     CALL DES$APT TO FIND PATH-ID FOR PATH-NAME IN CURWORD            #
#     EXHIBIT ACCESS PATH IN THE FOLLOWING FORMAT:                     #
#         -ACCESS-PATH- TO RECORD -RECORD-NAME-                        #
#         SEARCH KEY(S):                                               #
#             -DIT1-                                                   #
#             -DIT2-                                                   #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC ONEAPTH;
      PROC ONEAPTH; 
      BEGIN 
      IF NOT IMFDBM                # IF NOT IMF DATA BASE MODE         #
        OR USERSSST EQ 0           # IF NO SCHEMA TABLE, COULD HAPPEN  #
                                   # WHILE RECORDING                   #
      THEN
        BEGIN 
        DIAG (1019);               # NO ACCESS PATHS EXIST             #
        STDYES; 
        END 
  
      DES$APT (CURWORD);           # FIND PATHID                       #
      IF PATHID EQ 0               # IF ACCESS PATH NOT FOUND          #
      THEN
        BEGIN 
        DIAG (506, "PATH", CURWORD);  # CAN-T FIND -PATH-              #
        STDNO;
        END 
  
                                   # POSITION TO ACCESS PATH TABLE     #
      P<SAAT> = USERSSST + SICAPTD + (PATHID - 1) * SAPTENL;
      P<EXHTEMP> = LOC(APTNAME);   # POSITION TO ACCESS-PATH NAME      #
      LINE[0] = "          "; 
      CMOVE (EXHTEMP, 0, CURLENG, LINEA, 1);
      CMOVE (" TO RECORD ", 0, 11, LINEA, CURLENG + 1); 
                                   # POSITION TO RECORD TABLE          #
      P<SRAT> = USERSSST + SICRCTD + (RECORDID - 1) * SRCTENL;
      P<EXHTEMP> = LOC(RECNAME);   # POSITION TO RECORD NAME           #
      CMOVE (EXHTEMP, 0, 30, LINEA, CURLENG + 12);
      LINE$OUT (LINEA, CURLENG + 42); 
      LINE[0] = " SEARCH KE"; 
      LINE[1] = "Y(S):     "; 
      LINE$OUT (LINEA, 16); 
      LINE[0] = "          "; 
                                   # POSITION TO DATA ITEM TABLE       #
      P<SDID> = USERSSST + SICDITD + (RECFSDI[1] - 1) * SDITENL;
      FOR I = 1 STEP 1
        UNTIL APTKYNR              # LOOP THROUGH ALL SEARCH KEYS      #
      DO
        BEGIN 
        J = C<I - 1, 1>APTENCM;    # DIT ORDINAL                       #
        P<EXHTEMP> = LOC(SDTNAME[J]);  # POSITION TO ITEM NAME         #
        CMOVE (EXHTEMP, 0, 30, LINEA, 4); 
        LINE$OUT (LINEA, 34); 
        END 
      STDYES; 
      END                          # END PROC    ONEAPTH               #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     O N E C S E T                                                    #
#                                                                      #
#     CALL DES$CST TO FIND COSETID FOR COSET-NAME IN CURWORD           #
#     CALL CSETOWNMEM TO EXHIBIT OWNER AND MEMBER OF COSET             #
#     EXHIBIT MATCHING ITEMS IN THE FOLLOWING FORMAT:                  #
#         OWNER MATCHING ITEMS:    MEMBER MATCHING ITEMS:              #
#             -DIT1-                    -DIT2-                         #
#             -DIT3-                    -DIT4-                         #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC ONECSET;
      PROC ONECSET; 
      BEGIN 
      IF NOT IMFDBM                # IF NOT IMF DATA BASE MODE         #
        OR USERSSST EQ 0           # IF NO SCHEMA TABLE, COULD HAPPEN  #
                                   # WHILE RECORDING                   #
      THEN
        BEGIN 
        DIAG (1020);               # NO COSETS EXIST                   #
        STDYES; 
        END 
  
      DES$CST (CURWORD);           # FIND COSET ID                     #
      IF COSETID EQ 0              # IF COSET NOT FOUND                #
      THEN
        BEGIN 
        DIAG (506, "COSET", CURWORD);  # CAN-T FIND COSET              #
        STDNO;
        END 
  
      CSETOWNMEM;                  # EXHIBIT OWNER AND MEMBER          #
      LINE[0] = " OWNER MAT"; 
      LINE[1] = "CHING ITEM"; 
      LINE[2] = "S:        "; 
      LINE[3] = "       MEM"; 
      LINE[4] = "BER MATCHI"; 
      LINE[5] = "NG ITEMS: "; 
      LINE$OUT (LINEA, 60); 
                                   # POSITION TO COSET TABLE           #
      P<SCAT> = USERSSST + SICCSTD + (COSETID - 1) * SCTSENL; 
      P<SRAT> = USERSSST + SICRCTD;  # POSITION TO RECORD TABLE        #
      P<SDID> = USERSSST + SICDITD;  # POSITION TO ITEM TABLE          #
      LINE[0] = "          "; 
      LINE[3] = "          "; 
      FOR I = 1 STEP 1             # LOOP THROUGH ALL MATCHING ITEMS   #
        UNTIL CSTMTNR 
      DO
        BEGIN 
        J = C<I - 1, 1>CSTENCO;    # INDEX OF OWNER DIT WITHIN RECORD  #
                                   # POSITION TO OWNER DIT NAME        #
        P<EXHTEMP> = LOC(SDTNAME[J + RECFSDI[CSTORID] - 1]);
        CMOVE (EXHTEMP, 0, 30, LINEA, 4); 
        J = C<I - 1, 1>CSTENCM;    # INDEX OF MEMBER DIT WITHIN RECORD #
                                   # POSITION TO MEMBER DIT NAME       #
        P<EXHTEMP> = LOC(SDTNAME[J + RECFSDI[CSTMRID] - 1]);
        CMOVE (EXHTEMP, 0, 30, LINEA, 39);
        LINE$OUT (LINEA, 69); 
        END 
  
      STDYES; 
      END                          # END PROC    ONECSET               #
      END 
      TERM
