*DECK ERASEXH 
USETEXT TCLFN 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TLFNINF 
USETEXT TREPORT 
USETEXT TXSTD 
      PROC ERASEXH; 
  
#----------------------------------------------------------------------#
#                                                                      #
#  THE FOLLOWING PROCS ARE XDEF"D WITHIN THIS DECK:                    #
#                                                                      #
#     ERASENAME                                                        #
#     ERASEX                                                           #
#     ERASEXR                                                          #
#     ERASE$DESCR                  ERASE A DESCRIBE LIST               #
#     EREXINI                                                          #
#     EXHIBIR                                                          #
#     EXHIBIS                                                          #
#     STONSEL                      STORE *NO SELECT* OPTION            #
#     STOREAF                      STORE *AFTER* OPTION                #
#     STOREAL                      STORE *ANY* OPTION                  #
#     STOREBE                      STORE *BEFORE* OPTION               #
#     STORECW                      STORE SESSION ID                    #
#     STORELV                      STORE LEVEL NUMBER                  #
#     STORELX                      STORE LEXICAL ID                    #
#     STORESI                      STORE SESSION NAME                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
  
      XREF ITEM CDCSCAT  B;        # TRUE IF IN CDCS CATALOG MODE      #
      XREF ITEM LFNLIST U;
      XREF ITEM RA0;               # RA ZERO                           #
      ITEM BLKFORWRIT C(10) = " ";
      ITEM CATEOF C(10) = "0999999999";  # HIGHEST KEY IN CATALOG      #
      ITEM DISMINORKEY  B;         # TRUE IF SHOULD DISPLAY THE LOWEST #
                                   # 3 CHARACTERS OF CATALOG FILE KEY  #
                                   # (TRANSMISSION NUMBER IN A SESSION)#
  
      ITEM DUMMY I;                # DUMMY INDEX VARIABLES             #
      ITEM ERASE B; 
      ITEM ERASELENGTH  I;         # LENGTH OF ERASELIST ARRAY         #
                                   # DIRECTIVE.                        #
      ITEM I I;                    # INDEX                             #
      ITEM K I;                    # INDEX                             #
      ITEM L I;                    # INDEX                             #
      ITEM LAST$PTR U;             # LOCATION OF LAST LFNLIST POINTER  #
                                   # (THAT POINTS TO CURRENT LFNLIST). #
      ITEM LFNLIST$CURR U;         # POINTER TO CURRENT LFNLIST        #
      ITEM LOOKMAJOR I; 
      ITEM TEMPKA  I;              # ADDR OF *KA* IF SUBSCRIPTED ITEM  #
      XREF ITEM CURREG B;          # TRUE IF CURRENT-REGISTER          # QU3A334
      XREF ITEM DEFCAT       B;    # TRUE IF DEFAULT CATALOG EXISTS    #
      XREF ITEM MODCAT       B;    # TRUE IF CATALOG FILE WAS MODIFIED #
                                   # SINCE LAST CLOSE                  #
      ITEM RC           I;         # RETURN CODE                       #
      XREF BASED ARRAY DESPTR;
        BEGIN 
        ITEM DESCOUNT I(00,00,12); # NUMBER OF LOCAL FILES REFERENCING #
                                   # THIS LIST OF DESCRIBE ITEMS.      #
        ITEM DESSIZE U(0,24,18);   # SIZE OF DESCRIBED LIST IN CHAR    #
        ITEM DESADDR U(0,42,18);   # DESLIST FOR THIS FILE             #
        END 
      ARRAY ERASELIST [1:9];
        BEGIN 
        ITEM SESSID C(0,0,10);
        END 
      ARRAY TEST$LFN$A S(1);
        BEGIN 
        ITEM TEST$LFN U(00,00,42); # ZERO FILLED LFN NAME FOR TESTING  #
        END 
      BASED ARRAY ONE$WORD$BA;     # ONE WORD                          #
        BEGIN 
        ITEM ONE$WORD U(00,00,60); # ONE WORD                          #
        END 
      ITEM T            I;         # TEMP USED TO INDICATE ERASEXH OPT #
  
      XREF PROC AF$OPN;            # OPEN CATALOG FILE                 #
      XREF FUNC BINDEC C(10);      # BINARY TO DECIMAL CONVERSION      #
      XREF PROC CATCHK;            # CALL PROPER CATALOG-ACCESSING PROC#
      XREF PROC DLTE;              # CRM DELETE OF A RECORD            #
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC MESSAGE TO USER  #
      XREF PROC GET;               # CRM GET A RECORD                  #
      XREF PROC GETN;              # CRM GET NEXT RECORD               #
      XREF PROC LINE$OUT;          # WRITES LINES FOR EXHIBIT/ERASE    #
      XREF PROC OPNCAT;            # OPENS CATALOG FILE IF NOT ALREADY #
      XREF PROC RECNO;
      XREF PROC RECYES; 
      XREF PROC REWND;             # CRM REWIND OF A FILE              #
      XREF PROC WRTSESS;           # WRITES DIRECTIVES TO CATALOG FILE #
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
  
  
  
  
  
  
  
#----------------------------------------------------------------------#
#     E R A S E N A M E                                                #
  
  
# ERASENAME "ERASES" A NAME FROM QU"S DIRECTORY OF TEMPORY DATA-ITEMS  #
# BY DE-LINKING ITS ENTRY IN THE LIST OF SPECIFIED ITEMS AND RETURNING #
# THE SPACE TO THE FREE SPACE LIST.  ERASURE "UNDEFINES" THAT DATA-NAME#
# FOR FUTURE REFERENCES BUT HAS AN UNDEFINED EFFECT ON PREVIOUS USES   #
# OF THE DATA-NAME IN EXPRESSIONS.                                     #
  
      XDEF PROC ERASENAME;
      PROC      ERASENAME;
      BEGIN 
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      IF CURREG                    # IF CURRENT-REGISTER               # QU3A334
      THEN                                                               QU3A334
        BEGIN                                                            QU3A334
        STDNO;                     # ERROR EXIT                        # QU3A334
        END                                                              QU3A334
      P<DESATT1> = DATANAMEPTR;    # SET BASE TO ENTRY TO BE ERASED    #
      K = DABSPTR[0];              # SAVE LINK TO NEXT ENTRY           #
      IF FIGLITDATA EQ S"TEMPNAME"
        OR (INDICED AND FALL AND DATANAMEBASE EQ 0) THEN
        BEGIN 
        P<DESATT1> = DEFLIST;      # SET BASE TO 1ST ENTRY IN LIST     #
                                   # CONTAINING NAME.                  #
        END 
      ELSE
        BEGIN 
        IF FIGLITDATA EQ S"CONDEXPR" THEN 
          BEGIN 
          P<DESATT1> = SPELIST; 
          END 
        ELSE                       # NO RETURN IF ATTEMPTING TO ERASE  #
          BEGIN 
          STDNO;                   # OTHER THAN DEFINED OR SPECIFIED   #
                                   # NAMES.                            #
          END 
        END 
  
# PLUG IN CHECK HERE FOR SUBSCRIPTED NAME. IF TRUE, CALL DIAG(100)     #
# AND STDYES.                                                          #
  
      IF P<DESATT1> EQ DATANAMEPTR THEN  # IF 1ST ENTRY IN LIST...     #
        BEGIN                      # RESET LIST HEADER                 #
        IF P<DESATT1> EQ DEFLIST THEN 
          BEGIN 
          DEFLIST = DABSPTR[0]; 
          END 
        ELSE
          BEGIN 
          SPELIST = DABSPTR[0]; 
          END 
        FREEMURAL;                 # (SUBPROC) FREE MURAL              #
        END 
      FOR DUMMY = DUMMY WHILE DABSPTR[0] NQ DATANAMEPTR DO
        BEGIN 
        P<DESATT1> = DABSPTR[0];   # SEARCH LIST FOR ENTRY PRIOR TO    #
                                   # ENTRY BEING ERASED.               #
        END 
      DABSPTR[0] = K;              # DE-LINK ENTRY FROM LIST BY STORING#
                                   # ADDRESS OF FOLLOWING ENTRY IN     #
                                   # PRECEEDING ENTRY.                 #
      P<DESATT1> = DATANAMEPTR;    # SET BASE ENTRY BEING ERASED       #
      FREEMURAL;                   # FREE ASSOCIATED SPACE             #
      END  # ERASENAME #
  
  
  
  
  
  
#----------------------------------------------------------------------#
#     E R A S E $ D E S C R                                            #
  
# THIS PROC ERASES A DESCRIBE ENTRY.  IF NO LOCAL FILES REFER TO THE   #
# LFNLIST ENTRY FOR THE LFN, THE ENTRY IS DELINKED.  OTHERWISE THE     #
# DESCRIBE INFORMATION POINTER IS CLEARED.                             #
  
      XDEF PROC ERASE$DESCR;
      PROC      ERASE$DESCR;
      BEGIN 
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      TEST$LFN = 0;                # ZERO FILL FOR LFN                 #
      C<0,CURLENG>TEST$LFN = C<0,CURLENG>ICW[0];  # COPY LFN           #
      LFNLIST$CURR = LFNLIST;      # CURRENT LFNLIST TO LOOK AT        #
      LAST$PTR = LOC(LFNLIST);     # LAST LFNLIST POINTER              #
      FOR DUMMY = DUMMY WHILE LFNLIST$CURR NQ 0 DO  # SCAN LFNLIST     #
        BEGIN 
        P<LFNINFO> = LFNLIST$CURR; # LOOK AT CURRENT LFNLIST ENTRY     #
        P<FIT> = LOC(L$FITLOC);                                          EXHIBER
        IF TEST$LFN EQ C<0,7>FITLFN  #IF WEVE FOUND THE CORRECT ENTRY  # EXHIBER
        THEN                                                             EXHIBER
          BEGIN 
          P<DESPTR> = L$DESPTR;    #LOOK AT ARRAY DESPTR ENTRY FOR LFN # EXHIBER
          DESCOUNT[0] = DESCOUNT[0] - 1;  # 1 LESS LFN REFERING TO THIS#
                                          # LIST                       #
          IF DESCOUNT[0] LS 0 THEN # IF NUMBER OF REFERENCE NEGATIVE   #
            BEGIN 
            DIAG(321);             # "INTERNAL ERROR -- DESCOUNT       #
                                   # ENTRY NEGATIVE".                  #
            STDNO;                 # EXIT -- DESCRIBE ENTRY FOUND BUT  #
                                   # NOT ERASED.                       #
            END 
          IF DESCOUNT[0] EQ 0 THEN # IF NO LOCAL FILE REFERING TO THIS #
                                   # LIST OF DESCRIBE ITEMS...         #
            BEGIN 
            P<DESATT1> = DESADDR;  # GET EXTRACT/DESCRIBE LIST         #
                                   # SCAN THRU LIST UNTIL END REACHED  #
            FOR DUMMY = DUMMY WHILE P<DESATT1> NQ 0 DO
              BEGIN 
              CMM$FRF(P<DESATT1>); # RELEASE LIST ENTRY                #
              IF MURALPTR[0] NQ 0 THEN  # IF IT HAS AN EDIT MURAL...   #
                BEGIN 
                CMM$FRF(P<DESATT1>+MURALPTR[0]);  # RELEASE MURAL SPACE#
                END 
              P<DESATT1> = DABSPTR[0];  # LOCATE NEXT ENTRY TO EXAMINE #
              END 
  
            IF DESLIST EQ DESADDR  # IF DESLIST INDICATES ERASED LIST  #
            THEN
              BEGIN 
              DESLIST = 0;         # NO MORE DESLIST FOR NOW...        #
              END 
  
            DESADDR = 0;           # DESCRIBE LIST NO LONGER EXISTS    #
            CMM$FRF(L$DESPTR);     #FREE DESCRIBE ENTRIES              # EXHIBER
            END 
          P<ONE$WORD$BA> = LAST$PTR;     # LOCATE LAST FORWARD PTR TO  #
                                         # THIS LFNLIST ENTRY          #
          B<42,18>ONE$WORD[0] = L$NEXT;  # SET IT TO NEXT ENTRY        #
          CMM$FRF(LFNLIST$CURR);         # FREE LFN LIST ENTRY         #
          STDYES;                  # EXIT -- WEVE FINISHED THE ERASE   #
          END 
        LFNLIST$CURR = L$NEXT;     #GET READY TO LOOK AT NEXT ENTRY    # EXHIBER
        LAST$PTR = LOC(L$NEXT);    #SAVE LAST FORWARD POINTER          # EXHIBER
        END                        # CONTINUE LFNLIST SCAN             #
      DIAG(320);                   # "NO DESCRIBE ENTRY FOR THE FILE   #
                                   # <C>".                             #
      STDNO;                       # EXIT -- NO DESCRIBE ENTRY FOUND   #
      END  # ERASE$DESCR #
  
  
  
  
#----------------------------------------------------------------------#
#     E R E X I N I                                                    #
  
# THIS PROC SETS ERASE LENGTH TABLE LENGTHS AND FLAGS TO ZERO          #
  
      XDEF PROC EREXINI;
      PROC      EREXINI;
      BEGIN 
      DISMINORKEY = FALSE;         # ASSUME DONT DISPLAY LOW 3 CHARS   #
                                   # OF CATALOG FILE KEY               #
      ERASELENGTH = 0;
      ILFN[IREP] = " "; 
      K = 0;
      L = 0;
      T = 0;
      STDNO;
      END  # EREXINI #
  
  
  
  
#----------------------------------------------------------------------#
#     E X H B T $ R E P O R T                                          #
  
# "EXHIBIT REPORT"                                                     #
  
      PROC      EXHBT$REPORT; 
      BEGIN 
      CATAFITES = 0;                                                     EXHIBER
      CATCHK (REW, LOC(CATAFIT), CDCSCAT);
      BLKFORWRIT = " "; 
      FOR DUMMY = DUMMY DO
        BEGIN 
        CATAFITWSA = P<KEYWSA>; 
        CATAFITKA = CATAFITWSA; 
        CATCHK (CGETN, LOC(CATAFIT), CDCSCAT);
        IF CATAFITES EQ ENDOFILE                                         EXHIBER
          OR KEYAREA[0] GR "Z999999"                                     EXHIBER
        THEN                                                             EXHIBER
          BEGIN 
          STDYES; 
          END 
        IF C<0,7>KEYAREA[0] NQ C<1,7>BLKFORWRIT THEN
          BEGIN 
          C<1,7>BLKFORWRIT = C<0,7>KEYAREA[0];
          LINE$OUT(BLKFORWRIT,8); 
          END 
        END 
      END  # EXHBT$REPORT # 
  
  
  
  
#----------------------------------------------------------------------#
#     E X H I B I T $ S E S S                                          #
  
# "EXHIBIT SESSION"                                                    #
  
      PROC      EXHIBIT$SESS; 
      BEGIN 
      BLKFORWRIT = "0";            # POSITION THE CATALOG FOR THE      #
                                   # FIRST SESSION.                    #
      CATAFITWSA = P<KEYWSA>; 
      CATAFITKA = LOC(BLKFORWRIT);
      CATAFITKP = 0;
      CATAFITMKL = 1; 
      CATCHK (CGET, LOC(CATAFIT), CDCSCAT); 
      IF B<0,42>KEYAREA[0] GQ B<0,42>CATEOF THEN
        BEGIN 
        STDYES; 
        END 
      C<0,1>KEYAREA = " ";         # CARRIAGE CONTROL IS BLANK         #
      LINE$OUT(KEYWSA,7); 
      FOR DUMMY = DUMMY DO
        BEGIN 
        CATAFITWSA = P<KEYWSA>; 
        CATAFITKA = CATAFITWSA; 
        CATCHK (CGETN, LOC(CATAFIT), CDCSCAT);
        IF B<0,42>KEYAREA[0] GQ B<0,42>CATEOF THEN
          BEGIN 
          STDYES; 
          END 
        IF C<0,7>KEYAREA[0] NQ C<0,7>BLKFORWRIT THEN
          BEGIN 
          BLKFORWRIT = KEYAREA[0];
          KEYAREA[0] = " "; 
          C<1,6>KEYAREA[0] = C<1,6>BLKFORWRIT;
          LINE$OUT(KEYWSA,7); 
          END 
        END 
      END  # EXHIBIT$SESS # 
  
  
  
  
#----------------------------------------------------------------------#
#     E X H I B $ E R A S E                                            #
  
# THIS PROC AND ITS ENCLOSED PROCS EXECUTE THE EXHIBIT/ERASE DIRECTIVES#
  
      XDEF PROC ERASEX; 
      XDEF PROC ERASEXR;
      XDEF PROC EXHIBIR;
      XDEF PROC EXHIBIS;
      XDEF PROC EXHIB$ERASE;
      PROC      EXHIB$ERASE;
      BEGIN 
 ENTRY PROC ERASEXR;               #----E R A S E X R------------------#
      WDIRFLAG = TRUE;             # THIS *ERASE* IS NOT RECORDABLE    #
      ERASE = TRUE; 
      IF ILFN[IREP] NQ CURREPT     # IF NOT CURRENT REPORT             #
      THEN
        BEGIN 
        CURREPT = ILFN[IREP];      # SET TO REPORT NAME IN *ERASE* DIR #
        AF$OPN(RC);                # OPEN CATALOG, SEE IF REPORT EXISTS#
        END 
      ELSE
        BEGIN 
        IF PFCATAL                 # IF *VERSION* CATALOG AVAILABLE    #
          OR DEFCAT                # OR DEFAULT CATALOG EXISTS         #
        THEN
          BEGIN 
          OPNCAT(CATAFIT, PD$IO, RC);  # OPEN EXISTING CATALOG FOR I/O #
          END 
        ELSE
          BEGIN 
          RC = 1;                  # INDICATE UNKNOWN REPORT NAME      #
          END 
        END 
  
      IF DUMMY NQ DUMMY            # ALWAYS SKIP THIS BLOCK IF WE      #
      THEN                         # CAME FROM ABOVE ENTRY             #
        BEGIN 
 ENTRY  PROC EXHIBIR;              #----E X H I B I R------------------#
        ERASE = FALSE;             # INDICATE NOT ERASING              #
        OPNCAT(CATAFIT, PD$INPUT, RC);  # OPEN FOR INPUT               #
        END 
  
      IF RC NQ 0                   # IF SOME ERROR CODE FROM THE OPEN  #
      THEN
        BEGIN 
        IF RC EQ 1                 # IF UNKNOWN REPORT NAME            #
        THEN
          BEGIN 
          ICW[0] = ILFN[IREP];     # CURWORD GETS REPORT NAME FOR DIAG #
          CURLENG = 7;             # CURLENG GETS MX REPORT NAME LNGTH #
          DIAG(103);               # DIAGNOSE UNKNOWN REPORT           #
          END 
        CURREPT = " ";             # CLEAR CURRENT REPORT NAME         #
        STDYES;                    # EXIT BEFORE ANY WORK DONE         #
        END 
  
      IF ERASELENGTH EQ 0 THEN
        BEGIN 
        IF ILFN[IREP] EQ " " THEN 
          BEGIN 
          EXHBT$REPORT;            # "EXHIBIT REPORT"                  #
          END 
        REPORT$NAME;               # "EXHIBIT/ERASE REPORT"            #
                                   # <REPORT-NAME>                     #
        END 
      RPT$NAME$DIR;                # "EXHIBIT/ERASE REPORT             #
                                   # <REPORT-NAME> <DIRECTIVE> ...     #
  
# NO CONTROL PASSES THIS POINT                                         #
  
  
 ENTRY PROC ERASEX;                #----E R A S E X--------------------#
      WDIRFLAG = TRUE;             # THIS *ERASE* IS NOT RECORDABLE    #
      ERASE = TRUE;                # WE WANT TO ERASE SESSION          #
      IF DUMMY NQ DUMMY THEN       # ALWAYS SKIP THIS BLOCK IF WE      #
        BEGIN                      # CAME FROM ABOVE ENTRY             #
 ENTRY  PROC EXHIBIS;              #----E X H I B I S------------------#
        ERASE = FALSE;             # WE WANT TO EXHIBIT SESSION        #
        END 
      IF ERASE                     # IF MUST ELIMINATE SOMETHING FROM  #
                                   # THE CATALOG FILE                  #
      THEN
        BEGIN 
        IF PFCATAL                 # IF *VERSION* CATALOG AVAILABLE    #
          OR DEFCAT                # OR DEFAULT CATALOG EXISTS         #
        THEN
          BEGIN 
          IF NOT PERMI             # IF NOT ALLOWED TO MODIFY CATALOG  #
          THEN
            BEGIN 
            DIAG(87);              # DIAGNOSE PRIVACY VIOLATION        #
            STDYES;                # GOOD AND BAD RETURN               #
            END 
  
          OPNCAT(CATAFIT, PD$IO, RC);  # OPEN EXISTING CATALOG FOR I/O #
          END 
  
        ELSE
          BEGIN 
          RC = 1;                  # FLAG NO EXISTING CATALOG          #
          END 
        END 
  
      ELSE
        BEGIN 
        OPNCAT(CATAFIT, PD$INPUT, RC);  # TRY TO OPEN FOR INPUT        #
        END 
  
      IF RC NQ 0                   # IF CATALOG NOT OPENED             #
      THEN
        BEGIN 
        IF ERASELENGTH NQ 0        # IF SOME OPTIONS SPECIFIED         #
        THEN
          BEGIN 
          DIAG(119);               # DIAGNOSE UNKNOWN SESSION          #
          END 
  
        STDYES;                    # EXIT BEFORE ANY WORK DONE         #
        END 
  
        BEGIN                      #----CASE STATEMENT-----------------#
        SWITCH SESSION$TYPE        # SELECT OPTION PROCESSING          #
          EXHIBIT$SES$, 
          SESSION$ID$ , 
          SES$ID$DRID$, 
          S$ID$DRID$2$, 
          EXIT$SESS;               # EXIT LABEL.  INSERT NEW LABELS    #
                                   # BEFORE THIS POINT.                #
        GOTO SESSION$TYPE[ERASELENGTH];  # NONE OF THESE PROCS RETURNS #
EXHIBIT$SES$: 
        EXHIBIT$SESS; 
SESSION$ID$:  
        SESSION$ID; 
SES$ID$DRID$: 
        SESS$ID$DRID; 
S$ID$DRID$2$: 
        S$ID$DRID$2;
EXIT$SESS:  
        END                        #----END-CASE-----------------------#
      END  # EXHIB$ERASE #
  
  
  
  
#----------------------------------------------------------------------#
#     F R E E M U R A L                                                #
  
      PROC      FREEMURAL;
      BEGIN 
      IF DEXPPTR[0] NQ 0 THEN      # FREE ANY EXPRESSION STACK         #
        BEGIN 
       CMM$FRF(DEXPPTR[0]); 
        END 
      IF DCNVTBL[0] NQ 0           # IF MOVE/CONVERT TABLE EXISTS      #
        AND FIGLITDATA NQ S"CONDEXPR"  # IF NOT ERASE SPECIFIED ITEM   #
      THEN
        BEGIN 
        CMM$FRF(DCNVTBL[0]);
        CMM$FRF(VALULOC[0]);
        END 
      IF MURALPTR NQ 0 THEN        # IF A MURAL EXISTS FOR THIS ENTITY #
        BEGIN 
        CMM$FRF(P<DESATT1>+MURALPTR);  # FREE THE MURAL SPACE          #
        END 
      CMM$FRF(P<DESATT1>);         # FREE ENTRY ITSELF                 #
      STDYES; 
      END  # FREEMURAL #
  
  
  
  
#----------------------------------------------------------------------#
#     I F L O O K                                                      #
  
#                                                                      #
  
      PROC      IFLOOK; 
      BEGIN 
      IF   (LOOKMAJOR EQ 1 AND B<0,49>KEYAREA[0] EQ B<0,49>SESSID[I]) 
        OR (LOOKMAJOR EQ 2 AND B<0,53>KEYAREA[0] EQ B<0,53>SESSID[I]) 
        OR (LOOKMAJOR EQ 3 AND B<0,54>KEYAREA[0] EQ B<0,54>SESSID[I]) 
        OR (LOOKMAJOR EQ 4 AND B<0,52>KEYAREA[0] EQ B<0,52>SESSID[I]) 
        THEN
        BEGIN 
        T = 1;
        XEQEREX;
        END 
      END  # IFLOOK # 
  
  
  
  
  
#----------------------------------------------------------------------#
#     R E P O R T $ N A M E                                            #
  
# "EXHIBIT/ERASE REPORT <REPORT-NAME>"                                 #
  
      PROC      REPORT$NAME;
      BEGIN 
      CATAFITES = 0;                                                     EXHIBER
      CATAFITWSA = P<KEYWSA>; 
      TEMPKA = ILFN[IREP];
      CATAFITKA = LOC(TEMPKA);
      CATAFITKP = 0;
      CATAFITMKL = 7; 
      CATCHK (CGET, LOC(CATAFIT), CDCSCAT); 
      IF CATAFITES EQ UNKNOWNKEY                                         EXHIBER
      THEN                                                               EXHIBER
        BEGIN 
        ICW[0] = ILFN[IREP];
        DIAG(103);                 # "<C> UNKNOWN REPORT NAME"         #
        STDNO;
        END 
  
# GET THE FIRST RECORD WITH A MAJOR KEY EQUAL TO THE REPORT NAME TO    #
# EXHIBIT -- IF IT EXISTS.                                             #
  
      FOR DUMMY = DUMMY DO
        BEGIN 
        BLKFORWRIT = KEYAREA[0];
        XEQEREX;
        CATAFITWSA = P<KEYWSA>; 
        CATAFITKA = LOC(BLKFORWRIT);
        CATCHK (CGETN, LOC(CATAFIT), CDCSCAT);
        IF CATAFITES EQ ENDOFILE                                         EXHIBER
          OR C<0,7>KEYAREA[0] NQ C<0,7>ILFN[IREP]                        EXHIBER
        THEN                                                             EXHIBER
          BEGIN 
          STDYES; 
          END 
        END 
      END  # REPORT$NAME #
  
  
  
  
#----------------------------------------------------------------------#
#     R P T $ N A M E $ D I R                                          #
  
# "EXHIBIT/ERASE REPORT <REPORT-NAME> <DIRECTIVE> ..."                 #
  
      PROC      RPT$NAME$DIR; 
      BEGIN 
      FOR I = 1 STEP 1 UNTIL ERASELENGTH DO 
        BEGIN                      # EXHIBIT REPORT NAME AND DIRECTIVES#
        CATAFITES = 0;                                                   EXHIBER
        IF LOOKMAJOR GR 0 AND LOOKMAJOR LS 5 THEN 
          BEGIN 
          CATAFITWSA = P<KEYWSA>; 
          TEMPKA = SESSID[I]; 
          CATAFITKA = LOC(TEMPKA);
          CATAFITKP = 0;
          CATAFITMKL = 8; 
          CATCHK (CGET, LOC(CATAFIT), CDCSCAT); 
          IFLOOK; 
          FOR DUMMY = DUMMY DO
            BEGIN 
            CATAFITWSA = P<KEYWSA>; 
            CATAFITKA = CATAFITWSA; 
            CATCHK (CGETN, LOC(CATAFIT), CDCSCAT);
            IF CATAFITES EQ ENDOFILE                                     EXHIBER
              OR C<0,7>KEYAREA[0] NQ C<0,7>SESSID[I] THEN 
              BEGIN 
              IF T EQ 0 THEN
                BEGIN 
                C<7,3>SESSID[I] = " ";
                DIAG(133,SESSID[I]);
                END 
              STDYES; 
              END 
            IFLOOK; 
            END 
          END 
        ELSE
          IF LOOKMAJOR EQ 5 THEN
            BEGIN 
            CATAFITWSA = P<KEYWSA>; 
            TEMPKA = SESSID[I]; 
            CATAFITKA = LOC(TEMPKA);
            CATAFITKP = 0;
            CATAFITMKL = 10;
            CATCHK (CGET, LOC(CATAFIT), CDCSCAT); 
            IF CATAFITES EQ 0                                            EXHIBER
              AND SESSID[I] EQ KEYAREA[0]                                EXHIBER
            THEN                                                         EXHIBER
              BEGIN 
              XEQEREX;
              END 
            ELSE
              IF CATAFITES EQ UNKNOWNKEY THEN                            EXHIBER
                BEGIN 
                C<7,3>SESSID[I] = " ";
                DIAG(133,SESSID[I]);  # "UNKNOWN REPORT NAME IN <A>"   #
                STDYES; 
                END 
            FOR DUMMY = DUMMY DO
              BEGIN 
              CATAFITWSA = P<KEYWSA>; 
              CATAFITKA = CATAFITWSA; 
              CATCHK (CGETN, LOC(CATAFIT), CDCSCAT);
              IF CATAFITES EQ ENDOFILE                                   EXHIBER
                OR C<0,7>KEYAREA[0] NQ C<0,7>SESSID[I] THEN 
                BEGIN 
                TEST I; 
                END 
              IF SESSID[I] EQ KEYAREA[0] THEN 
                BEGIN 
                XEQEREX;
                END 
              END 
            END 
        CATAFITWSA = P<KEYWSA>; 
        TEMPKA = SESSID[I]; 
        CATAFITKA = LOC(TEMPKA);
        CATAFITKP = 0;
        CATAFITMKL = 8; 
        CATCHK (CGET, LOC(CATAFIT), CDCSCAT); 
        IF CATAFITES EQ 0                                                EXHIBER
          AND C<0,8>SESSID[I] EQ C<0,8>KEYAREA[0]                        EXHIBER
        THEN                                                             EXHIBER
          BEGIN 
          XEQEREX;
          END 
        ELSE
          IF CATAFITES EQ UNKNOWNKEY THEN                                EXHIBER
            BEGIN 
            C<7,3>SESSID[I] = " ";
            DIAG(133,SESSID[I]);   # "UNKNOWN REPORT NAME IN <A>"      #
            TEST I; 
            END 
        FOR DUMMY = DUMMY DO
          BEGIN 
          CATAFITWSA = P<KEYWSA>; 
          CATAFITKA = CATAFITWSA; 
          CATCHK (CGETN, LOC(CATAFIT), CDCSCAT);
          IF CATAFITES EQ ENDOFILE                                       EXHIBER
            OR C<0,7>KEYAREA[0] NQ C<0,7>SESSID[I] THEN 
            BEGIN 
            TEST I; 
            END 
          IF C<0,8>SESSID[I] EQ C<0,8>KEYAREA[0] THEN 
            BEGIN 
            XEQEREX;
            END 
          END 
        END 
      STDYES; 
      END  # RPT$NAME$DIR # 
  
  
  
  
#----------------------------------------------------------------------#
#     S E S S I O N $ I D                                              #
  
# "EXHIBIT/ERASE SESSION <SESSION-ID>"                                 #
  
      PROC      SESSION$ID; 
      BEGIN 
      BLKFORWRIT = "0000000000";
      C<0,7>BLKFORWRIT = C<0,7>SESSID[1]; 
      SESSID[1] = BLKFORWRIT; 
      CATAFITES = 0;                                                     EXHIBER
      CATAFITWSA = P<KEYWSA>; 
      CATAFITKA = LOC(BLKFORWRIT);
      CATAFITKP = 0;
      CATAFITMKL = 7; 
      CATCHK (CGET, LOC(CATAFIT), CDCSCAT); 
      IF CATAFITES EQ UNKNOWNKEY                                         EXHIBER
      THEN                                                               EXHIBER
        BEGIN 
        STDNO;
        END 
      FOR DUMMY = DUMMY DO
        BEGIN 
        XEQEREX;
        CATAFITWSA = P<KEYWSA>; 
        CATAFITKA = LOC(BLKFORWRIT);
        CATCHK (CGETN, LOC(CATAFIT), CDCSCAT);
        IF KEYAREA[0] GQ "0999999999" 
          OR C<0,7>BLKFORWRIT NQ C<0,7>SESSID[1] THEN 
          BEGIN 
          STDYES; 
          END 
        END 
      END  # SESSION$ID # 
  
  
  
  
  
#----------------------------------------------------------------------#
#     S E S S $ I D $ D R I D                                          #
  
# "EXHIBIT/ERASE SESSION <SESSION-ID> <DIRECTIVE-ID>"                  #
  
      PROC      SESS$ID$DRID; 
      BEGIN 
      BLKFORWRIT = SESSID[2]; 
      C<0,7>BLKFORWRIT = C<0,7>SESSID[1]; 
      CATAFITWSA = P<KEYWSA>; 
      CATAFITKA = LOC(BLKFORWRIT);
      CATAFITKP = 0;
      CATAFITMKL = 10;
      CATCHK (CGET, LOC(CATAFIT), CDCSCAT); 
      IF CATAFITES EQ UNKNOWNKEY                                         EXHIBER
      THEN                                                               EXHIBER
        BEGIN 
        STDNO;
        END 
      XEQEREX;
      STDYES; 
      END  # SESS$ID$DRID # 
  
  
  
  
#----------------------------------------------------------------------#
#     S T O N S E L                                                    #
  
      XDEF PROC STONSEL;
      PROC      STONSEL;
  
# THIS PROC INDICATES "NO SELECT" FOLLOWING REPORT OPTION              #
  
      BEGIN 
      B<53>SESSID[ERASELENGTH] = 1; 
      LOOKMAJOR = 3;
      B<49,3>SESSID[ERASELENGTH] = CP1B[0]; 
      K = 0;
      L = 1;
      STDNO;
      END  # STONSEL #
  
  
  
  
#----------------------------------------------------------------------#
#     S T O R E A F                                                    #
  
# THIS PROC WILL STORE AFTER OPTION FOLLOWING MOVE OR EVALUATE         #
# DIRECTIVES.                                                          #
  
      XDEF PROC STOREAF;
      PROC      STOREAF;
      BEGIN 
      B<48,1>SESSID[ERASELENGTH] = 1; 
      LOOKMAJOR = 1;
      STDNO;
      END  # STOREAF #
  
  
  
  
#----------------------------------------------------------------------#
#     S T O R E A L                                                    #
  
# THIS PROC STORES "ANY" OPTION FOLLOWING MOVE OR EVLAUATE             #
  
      XDEF PROC STOREAL;
      PROC      STOREAL;
      BEGIN 
      B<52,1>SESSID[ERASELENGTH] = 1; 
      LOOKMAJOR = 2;
      STDNO;
      END 
  
#----------------------------------------------------------------------#
#     S T O R E B E                                                    #
  
# THIS PROC INDICATES PRESENCE OF BEFORE OPTION                        #
  
      XDEF PROC STOREBE;
      PROC      STOREBE;
      BEGIN 
      B<48,1>SESSID[ERASELENGTH] = 0; 
      LOOKMAJOR = 1;
      STDNO;
      END  # STOREBE #
  
  
  
  
#----------------------------------------------------------------------#
#     S T O R E C W                                                    #
  
# THIS PROC STORES THE DIRECTIVE-ID IF IT LOOKS VALID                  #
  
      XDEF PROC STORECW;
      PROC      STORECW;
      BEGIN 
      IF CURLENG GR 3 THEN         # IF ID IS TOO LONG...              #
        BEGIN 
        STDNO;                     # TAKE FAILURE RETURN               #
        END 
      ERASELENGTH = ERASELENGTH + 1;
      SESSID[ERASELENGTH] = "0000000000";  # STORE SESSION ID, RIGHT   #
                                   # JUSTIFIED AND ZERO FILLED.        #
      C<10 - CURLENG,CURLENG>SESSID[ERASELENGTH] = C<0,CURLENG>ICW[0];
      STDYES; 
      END  # END STORECW #
  
  
  
  
#----------------------------------------------------------------------#
#     S T O R E L V                                                    #
  
# THIS PROCEDURE STORES THE LEVEL NUMBER FOLLOWING THE DETAIL, SELECT, #
# HEADING, FOOTING OR BREAK DIRECTIVES.                                #
  
      XDEF PROC STORELV;
      PROC      STORELV;
      BEGIN 
      IF L NQ 0 THEN
        BEGIN 
        IF ICWI[5] GR 63           # IF LEVEL NUMBER TOO HIGH          #
        THEN
          BEGIN 
          STDNO;                   # TAKE FAILURE RETURN               #
          END 
        B<54,6>SESSID[ERASELENGTH] = B<54,6>ICW[5]; 
        LOOKMAJOR = 5;
        STDYES; 
        END 
  
      IF ICWI[5] GR 63             # IF LEVEL NUMBER TOO HIGH          #
      THEN
        BEGIN 
        STDNO;                     # TAKE FAILURE RETURN               #
        END 
  
      C<8,2>SESSID[ERASELENGTH] = BINDEC(ICWI[5], 2);  # TWO DIGITS    #
      L = 0;
      LOOKMAJOR = 5;
      STDYES; 
      END  # STORELV #
  
  
  
  
#----------------------------------------------------------------------#
#     S T O R E L X                                                    #
  
# THIS PROC STORES THE REPORT DIRECTIVE CODE (6 RIGHTMOST BITS OF      #
# CURRENT LEXID) AS A MINOR KEY OF THE REPORT ENTRY TO EXHIBIT OR      #
# DELETE FROM THE CATALOG                                              #
  
      XDEF PROC STORELX;
      PROC      STORELX;
      BEGIN 
      IF ERASELENGTH GQ 9 THEN     # IF ERASE TABLE OVERFLOW EXISTS... #
        BEGIN 
        STDNO;                     # TAKE FAILURE RETURN               #
        END 
      IF K EQ 1 THEN
        BEGIN 
        B<49,3>SESSID[ERASELENGTH] = CP1B[0]; 
        IF LOOKMAJOR NQ 2          # IF NOT *ANY*                      #
        THEN
          BEGIN 
          LOOKMAJOR = 4;           # SELECT ALL REFERENCES TO THIS     #
                                   # DIRECTIVE                         #
          END 
  
        K = 0;
        L = 1;
        STDYES; 
        END 
      ERASELENGTH = ERASELENGTH + 1;
      LOOKMAJOR = 0;
      SESSID[ERASELENGTH] = ILFN[IREP]; 
      B<42, 6>SESSID[ERASELENGTH] = B<54, 6>CLX[0];  # DIRECTIVE CODE  #
      B<48,12>SESSID[ERASELENGTH] = 0;
      K = 1;
      STDYES; 
      END  # STORELX #
  
  
  
  
#----------------------------------------------------------------------#
#     S T O R E S I                                                    #
  
# THIS PROC STORES THE SESSION-ID IF IT LOOKS VALID                    #
  
      XDEF PROC STORESI;
      PROC      STORESI;
      BEGIN 
      IF CURLENG GR 6 THEN         # IF ID IS TOO LONG...              #
        BEGIN 
        STDNO;                     # TAKE FAILURE RETURN               #
        END 
      DISMINORKEY = TRUE;          # DISPLAY LOW 3 CHARS OF KEY        #
      ERASELENGTH = 1;
      SESSID[1] = "0";             # PUT IN LEADING ZERO AND BLANK FILL#
      C<1,CURLENG>SESSID[1] = ICW[0]; 
      STDYES; 
      END  # STORESI #
  
  
  
  
#----------------------------------------------------------------------#
#     S $ I D $ D R I D $ 2                                            #
  
# "EXHIBIT/ERASE"                                                      #
  
      PROC      S$ID$DRID$2;
      BEGIN 
      C<0,7>SESSID[2] = C<0,7>SESSID[1];
      C<0,7>SESSID[3] = C<0,7>SESSID[1];
      CATAFITWSA = P<KEYWSA>; 
      TEMPKA = SESSID[2]; 
      CATAFITKA = LOC(TEMPKA);
      CATAFITKP = 0;
      CATAFITMKL = 10;
      CATCHK (CGET, LOC(CATAFIT), CDCSCAT); 
      IF CATAFITES EQ UNKNOWNKEY                                         EXHIBER
      THEN                                                               EXHIBER
        BEGIN 
        STDNO;
        END 
      FOR DUMMY = DUMMY DO
        BEGIN 
        SESSID[2] = KEYAREA[0]; 
        IF C<0,7>SESSID[2] NQ C<0,7>SESSID[3] THEN
          BEGIN 
          STDYES; 
          END 
        IF SESSID[2] GR SESSID[3] OR KEYAREA[0] GQ "0999999999" THEN
          BEGIN 
          STDYES; 
          END 
        XEQEREX;
        CATAFITWSA = P<KEYWSA>; 
        TEMPKA = SESSID[2]; 
        CATAFITKA = LOC(TEMPKA);
        CATCHK (CGETN, LOC(CATAFIT), CDCSCAT);
        END 
      STDNO;                       # WE SHOULD NEVER FALL THRU HERE    #
                                   # UNLESS ERASE LENGTH IS BADLY SET  #
      END  # S$ID$DRID$2 #
  
  
  
  
#----------------------------------------------------------------------#
#     X E Q E R E X                                                    #
  
# THIS PROC DELETES THE DIRECTIVE FROM THE CATALOG FILE FOR ERASE.  IT #
# PRINTS OUT THE CONTENT OF THE DIRECTIVE FOR BOTH ERASE AND EXHIBIT   #
# BY CALLING WRITEBL.                                                  #
  
      PROC      XEQEREX;
      BEGIN 
      P<FIT> = LOC(CATAFIT);                                             EXHIBER
      IF FITES NQ 0 THEN                                                 EXHIBER
        BEGIN 
                                   # "CATALOG FILE AREA <D> ON <A>"    #
        DIAG(105, FITES, C<0,7>FITLFN);                                  EXHIBER
        STDYES; 
        END 
      IF ERASE THEN 
        BEGIN 
        FITWSA = P<KEYWSA>; 
        FITKP = 0;
        FITPOS = "C"; 
        CATCHK (DEL, P<FIT>, CDCSCAT);
        MODCAT = TRUE;             # CATALOG FILE WAS MODIFIED         #
        END 
  
      IF DISMINORKEY               # IF SHOULD DISPLAY LOW 3 CHARS  OF #
                                   # THE CATALOG FILE KEY              #
      THEN
        BEGIN 
        C<0,7>KEYAREA[0] = " "; 
        C<1,3>KEYAREA[0] = C<7,3>KEYAREA[0];
        IF C<1,1>KEYAREA[0] EQ "0" THEN 
          BEGIN 
          C<1,1>KEYAREA[0] = " "; 
          IF C<2,1>KEYAREA[0] EQ "0" THEN 
            BEGIN 
            C<2,1>KEYAREA[0] = " "; 
            END 
          END 
        C<7,3>KEYAREA[0] = " "; 
        END 
      ELSE
        BEGIN 
        KEYAREA[0] = " "; 
        END 
      LINE$OUT(KEYWSA, FITRL);                                           CHANGES
      END  # XEQEREX #
  
  
  
  
#----------------------------------------------------------------------#
  
  
      END 
      TERM
