*DECK CTL60 
USETEXT TBASCTB 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TDTABLE 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TIMF
USETEXT TIMFDEF 
USETEXT TLFNINF 
USETEXT TOPTION 
USETEXT TSBASIC 
USETEXT TXSTD 
USETEXT TINDTBL 
#----------------------------------------------------------------------#
#                                                                      #
#     C T L 6 0                                                        #
#                                                                      #
#     GENERAL PROCEDURE CONTAINING ALL THE ROUTINES THAT EXECUTE THE   #
#     IMF INTERFACE DIRECTIVES.                                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CTL60; 
      BEGIN 
                                   #------X D E F S--------------------#
      XDEF ITEM ENDREC  B;         # TRUE WHEN PASS THRU DATA BASE DONE#
      XDEF ITEM EXPRLOC I;         # ADDR OF *FOR* EXPRESSION STACK    #
      XDEF ITEM NEWDATA B;         # TRUE IF DATA IN CORE IS NEW       #
      XDEF ITEM ONALTERKEY B;      # TRUE IF RETRIEVAL BY ALTERNATE KEY#
  
  
                                   #------X R E F S--------------------#
      XREF PROC CLOSEM;            # CLOSE A CRM FILE                  #
      XREF PROC CLOSE$;            # CLOSE IMF DATA BASE               #
      XREF PROC CMOVE;             # CHARACTER MOVE                    #
      XREF PROC CONVERT;           # DO PROPER DATATYPE CONVERSION     #
      XREF PROC DIAG;              # DIAGNOSE ERROR                    #
      XREF PROC DIAGFLU;           # FLUSH DIAGNOSTIC BUFFER           #
      XREF PROC EXCEV;             # EXECUTE EVALUATE DIRECTIVE        #
      XREF PROC EXITCTL;           # ENTRY PT TO EXIT FROM OVERLAY     #
      XREF PROC EXPEVAL;           # EVALUATE EXPRESSION               #
      XREF PROC FROMERR;           # PRINTS CARD IMAGE IN ERR IF -FROM-#
      XREF PROC MOVEC;             # MOVE CHARACTERS                   #
      XREF PROC MOVEXE;            # *MOVE* EXECUTION ROUTINE          #
      XREF PROC NEXTREC;           # GET NEXT RECORD ACCORD TO R-TABLE #
      XREF PROC OPENM;             # OPEN CRM FILE                     #
      XREF PROC PUT;               # WRITE RECORD TO CRM FILE          #
      XREF PROC READ;              # READ A LINE OF INPUT              #
      XREF PROC SELPATH;           # CHOOSE AN ACCESS PATH             #
      XREF PROC USINGEX;           # READ, STORE USING/SETTING LISTS   #
      XREF PROC WRITE;             # WRITE A LINE OF OUTPUT            #
      XREF PROC WRITEBL;           # WRITE LINE TO OUTPUT              #
      XREF PROC UPBUN;
      XREF PROC FIGSUB; 
  
      XREF FUNC EXEC$ C(10);       # EXECUTE IMF FUNCTION ON DATA BASE #
  
      XREF ITEM CMM$PRS C(10);     # CMM$ALF PRESETS TO THIS VALUE     #
      XREF ITEM DIAGLEV I;         # DIAG FLAG, FULL=1, PART=0         #
      XREF ITEM FRMLFN  C(7);      # LFN OF -FROM- FILE                #
      XREF ITEM UPONLFN C(7);      # LFN OF UPON FILE                  #
      XREF ITEM FROMKEYINFIT I;    # ADDRESS OF -FROM- FILE-S FIT      #
      XREF ITEM IMF$GRP I;         # GROUP ID OF BLKS ALLOC-ED IN 60,0 #
      XREF ITEM RA0     I;         # VALUE 0                           #
      XREF ITEM TOAREA B;          # TRUE IF TARGET OF MOVE IS A DBI   #
      XREF ITEM UPDATING B;        # TRUE IF UPDATING AN AREA          #
      XREF ITEM UPDTEMP  B;        # TRUE IF UPDATING TEMPS            #
      XREF ITEM PROMTYPE I;        # PROMPT POSITION INDICATOR         #
  
      XREF BASED ARRAY LINE [0:0]; # LINE OF DATA TO BE OUTPUT         #
        BEGIN 
        ITEM ALINE   C(0,0,10); 
        END 
  
  
                                   #------D E F S----------------------#
      DEF IMFREM   # 82 #;         # IMF CODES FOR EXEC$ FUNCTIONS     #
      DEF IMFMOD   # 83 #;
      DEF IMFOBT   # 41 #;
      DEF OBTFIRST # 61 #;
      DEF OBTNEXT  # 63 #;
      DEF OBTNXTDUP# 65 #;
      DEF IMFSTO   # 81 #;
      DEF WDBOUND  # 10 #;         # CHARACTER WORD BOUNDARY           #
      DEF Z$TERM   # O"00" #;      # DISPLAY CODE FOR END OF RECORD    #
  
  
                                   #------I T E M S--------------------#
      ITEM ALLDONE B;              # TRUE WHEN PASS THRU DTABLE DONE   #
      ITEM BESTPATHID I;
      ITEM BTBLOOP I;              # DUMMY VARIABLE FOR BASICTABLE LOOP#
      ITEM CHARS   I;              # NO OF CHARS USED IN *PVV*         #
      ITEM CODE    I;              # DIRECTIVE CODE FROM BASICTABLE    #
      ITEM DIAGNOSED B=FALSE;      # TRUE IF DIAG 815 ALREADY GIVEN    #
      ITEM DTBLOOP I;              # DUMMY VARIABLE FOR DTABLE LOOP    #
      ITEM DUPLICATES B;           # TRUE IF DUPLICATE SEARCH KEYS     #
                                   # ALLOWED FOR ACCESS PATH TO        #
                                   # GIVEN RECORD                      #
      ITEM ENDBTBL B;              # TRUE WHEN PASS THRU B-TABLE DONE  #
      ITEM ENDTIO  I;              # CODE FOR END OF TERMINAL I/O      #
      ITEM ENTRYNO I;              # VERIFY LIST ENTRY NUMBER          #
      ITEM ERRCONV I;              # ERR CODE FROM CONVERT OR EXPEVAL  #
      ITEM GETKEY  B = TRUE;       # -USINGEX- SHOULD READ KEY ONLY    #
      ITEM GETREC  B = FALSE;      # -USINGEX- SHOULD READ WHOLE RECORD#
      ITEM HITONE  B;              # TRUE IF ANY -IF- SATISFIED BY REC #
      ITEM J       I; 
      ITEM K       I;              # LOOP VARIABLE                     #
      ITEM L       I; 
      ITEM LEVEL   I; 
      ITEM OLDDIAGLEV I;           # TO SAVE DIAGLEV CHANGED BY UPDATE #
      ITEM PVVFLAG I;              # FLAGS *PROCEED* RESPONSE (*VETO*) #
      ITEM RC      I;              # RETURN ERROR CODE                 #
      ITEM RECLGW  I;              # RECORD LENGTH IN WORDS            #
      ITEM RECLOOP I;              # DUMMY VBL FOR LOOP THRU DATA BASE #
      ITEM REPLY   C(1);           # RECEIVES USER RESPONSE FOR *VETO* #
      ITEM SMMOVE  B;              # TRUE IF MOVE CLAUSE, NOT DIRECTIVE#
      ITEM TRUEIF  B;              # TRUE IF LATEST -IF- SATISFIED     #
      ITEM TYPEIN  I;              # HOLDS USER RESPONSE FOR COMPARISON#
      ITEM V$ANSWER  C(10) = VETOANSW;  # PROMPT FOR USER RESPONSE     #
      ITEM V$EXIT    C(10) = VETOSTOP;  # POSSIBLE RESPONSE (*VETO*)   #
      ITEM V$LINE    C(50);             # SCRATCH OUTPUT LINE          #
      ITEM V$NO      C(10) = VETONO;    # POSSIBLE RESPONSE (*VETO*)   #
      ITEM V$ORD     I;                 # RECORD ORD OF VERIFY ITEM    #
      ITEM V$PROCEED C(10) = VETOGO;    # POSSIBLE RESPONSE (*VETO*)   #
      ITEM V$YES     C(10) = VETOYES;   # POSSIBLE RESPONSE (*VETO*)   #
      ITEM UPLG I;                 # OUTPUT LENGTH IN WORDS            #
      ITEM UPLGCH I;               # OUTPUT LENGTH IN CHARACTERS       #
      ITEM UPLGMAX I;              # SIZE OF LARGEST BUFFER NEEDED     #
  
  
                                   #------A R R A Y S------------------#
      ARRAY ERRORDESA [1:9] S(2);  # DESCRIPTION OF ERROR ARRAY        #
        BEGIN 
        ITEM ERRORDES1 C(00,00,10) = ["NOT-OPENED",  #                 #
                                      "DUPLICATE-",  #IDENTIFIER       #
                                      "NO-CURRENT",  #-RECORD          #
                                      "CONVERSION",  #-ERROR           #
                                      "NOT-FOUND ",  #                 #
                                      "DOUBLE-OPE",  #N                #
                                      "CONSTRAINT",  #-VIOLATION       #
                                      "          ",  #                 #
                                      "CANT-ATTAC"]; #H-FILE           #
        ITEM ERRORDES2 C(01,00,10) = ["          ", 
                                      "IDENTIFIER", 
                                      "-RECORD   ", 
                                      "-ERROR    ", 
                                      "          ", 
                                      "N         ", 
                                      "-VIOLATION", 
                                      "          ", 
                                      "H-FILE    "];
        END 
      ARRAY RESPOND [1:6];         # HELP TEXT FOR *VETO*              #
        BEGIN 
        ITEM RSP  = [" VALID RES","PONSES TO ","VETO ARE  ",
                     "PROCEED, E","XIT, YES, ","NO        "]; 
        END 
  
      BASED ARRAY DTABLEPTR;       # WRITE BUFFER FOR *VERIFY*         #
        BEGIN 
        ITEM DUMY        I(00,00,60);  # FULL WORD                     #
        ITEM TOCHAR      U(00,08,04);  # CHAR POSITION                 #
        ITEM CHARLENGTH  U(00,12,12);  # LENGTH IN CHARS               #
        ITEM DFROMAD     U(00,24,18);  # FROM ADDRESS                  #
        ITEM TOADDRESS   I(00,42,18);  # TO ADDRESS (ABSOLUTE)         #
        ITEM STACKADD    I(01,06,18);  # PROGRM STACK ADDRESS          #
        ITEM ADDRFROM    I(01,24,18);  # TO ADDRESS (RELATIVE)         #
        END 
  
      BASED ARRAY FROMLINE;        # CARD IMAGE IN ERROR               #
        BEGIN 
        ITEM CARRCTL C(00,00,01);  # CARRIAGE CONTROL CHARACTER        #
        END 
      BASED ARRAY RANGETABLE [0:MAXRANGE];
        BEGIN 
        END 
      BASED ARRAY RECORD [0:0]; 
        BEGIN 
        ITEM RECORDWORD  C(00,00,10); 
        ITEM IRECORDWORD I(00,00,60); 
        END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     P V V                                                            #
#                                                                      #
#     *PVV* EXECUTES THE *VETO* AND *VERIFY* DIRECTIVES AND(OR)        #
#     THE *PASS/VETO* OPTIONS SPECIFIED FOR A STORE, MODIFY OR         #
#     REMOVE DIRECTIVE.  PVV IS SET TRUE IF THE USER RESPONDS          #
#     *YES*, FALSE IF THE RESPONSE IS *NO* OR *PROCEED*.  *PROCEED*    #
#     ALSO SETS PVVFLAG TO 1 AND VETO WILL BE TURNED OFF FOR           #
#     THE REMAINDER OF THE TRANSMISSION.  *EXIT* WILL CAUSE AN         #
#     EXIT FROM THE OVERLAY.                                           #
#                                                                      #
#----------------------------------------------------------------------#
  
      FUNC PVV B; 
      BEGIN 
  
      PVV = FALSE;                 # INITIALIZE FUNCTION               #
      V$ORD = VERAREATBL;          # SET RECORD ORDINAL                #
  
      IF TERMINAL EQ 0             # IF IN BATCH MODE                  #
        OR PVVFLAG EQ 1            # OR *PROCEED* PREVIOUSLY SPECIFIED #
        OR BASCPASS[BASTABIND]     # OR *PASS* OPTION SPECIFIED        #
        OR NOT (VETOFLAG OR BASCVETO[BASTABIND]) # OR NO *VETO* STATED #
      THEN
        BEGIN 
        RETURN;                    # ALLOW CHANGE TO DATABASE          #
        END 
                                   # IF NO VERIFY LIST FOR THIS RECORD #
      IF P<RECORD> NQ RECORDWSA[V$ORD]
      THEN
        BEGIN 
  
        C<00,10>V$LINE = " ";      # CARRIAGE CONTROL FOR WRITE        #
        K = RECORDLGW[RECORDID];   # RECORD LENGTH IN WORDS            #
  
                                   # DETERMINE RECORD LENGTH IN CHARS  #
        K = K - 1;                 # NUMBER OF FULL WORDS              #
        J = K * 10;                # TRANSFER INTO CHARACTERS          #
  
        FOR L = 0 STEP 1
          WHILE L LS WDBOUND       # EXAMINE CHAR POSITION OF LAST WORD#
        DO
          BEGIN 
          IF C<L,1>RECORDWORD[K] NQ Z$TERM  # IF NOT THE END OF RECORD #
          THEN
            BEGIN 
            J = J + 1;             # INCREMENT THE CHARACTER COUNTER   #
            END 
          ELSE                     # IF WE HIT THE END OF RECORD       #
            BEGIN 
            L = WDBOUND;           # FORCE EXIT FROM LOOP              #
            END 
          END 
  
        IF J LS 40
        THEN
          BEGIN 
          C<J,50-J>V$LINE = " ";   # CLEAR REST OF OUTPUT LINE         #
          CMOVE (RECORD, 0, J, V$LINE, 1);  # POSITN INFO TO BE WRITTEN#
          END 
        ELSE
          BEGIN 
          C<40,10>V$LINE = " "; 
          CMOVE (RECORD, 0, 40, V$LINE, 1); 
          END 
  
        WRITE (V$LINE, 41, RC);    # WRITE LINE TO OUTPUT              #
  
        END 
      ELSE                         # IF VERIFY LIST FOR RECORD EXISTS  #
        BEGIN 
  
        IF VERIBUF EQ 0            # ALLOCATE VERIFY BUFFER IF NEED BE #
        THEN
          BEGIN 
          VERIBUF = CMM$ALF (REC$VERLEN[V$ORD], 0, 0);
          END 
  
        P<DTABLEPTR> = VERIBUF;    # PLACE ARRAY OVER BUFFER SPACE     #
  
        FOR J = 0 STEP 1
          UNTIL REC$VERLEN[V$ORD] -1
        DO
          BEGIN 
          DUMY[J] = "          ";  # CLEAR IN CASE PREVIOUSLY USED     #
          END 
                                   # MOVE VERIFY LIST INTO DTABLE      #
        P<DTABLE> = REC$VERILOC[V$ORD]; 
        ENTRYNO = 0;               # INITIALIZE ENTRY NUMBER TO ZERO   #
  
        FOR K = 0 STEP EESIZE 
          WHILE CPENTRY[K] NQ 0    # FOR EACH NON 0 ENTRY IN LIST      #
        DO
          BEGIN 
  
          IF CPTYPE[K] EQ 0        # IF NO INFORMATION EXISTS IN TABLE #
          THEN
            BEGIN 
            P<DTABLE> = OVERFLOW[K];  # CHECK TO SEE IF ANOTHER TABLE  #
            K = -EESIZE;           # RESET LOOP COUNTER                #
            TEST K;                # RETURN TO K LOOP                  #
            END 
  
          ELSE                     # IF VERIFY INFO IN THIS ENTRY      #
            BEGIN 
                                   # DETERMINE NUMBER OF CHARS         #
            CHARS = CPTCHAR[K] + 10 * CPTOADDR[K] + CPCHARLG[K];
            ENTRYNO = ENTRYNO + 1; # UP THE ENTRY NUMBER               #
  
            MEC ( DTABLE[K] );     # MOVE, EVAL OR CONVERT EXPRESSION  #
  
            IF ERRCONV NQ 0        # IF MOVE,CONVERSION ERROR          #
            THEN
              BEGIN 
              DIAG (511, ERRCONV, ENTRYNO);  # DIAGNOSE IT             #
              END 
            END 
          END                      # END K LOOP THROUGH VERIFY LIST    #
  
        WRITE (DTABLEPTR, CHARS, RC);  # WRITE VERIFY ITEMS TO OUTPUT  #
  
        END                        # END VERIFY LIST PROCESSING        #
  
      FOR K = K                    # DETERMINE ACTION BY USER RESPONSE #
      DO
        BEGIN 
  
        PROMTYPE = 54;             # INSERT OCTAL 13 FOR RESPONSE      #
                                   # ON SAME LINE.                     #
        WRITE (V$ANSWER, 6, RC);   # ASK USER FOR RESPONSE             #
  
        READ (REPLY, CHARS, 10, RC);   # READ RESPONSE                 #
  
        IF CHARS GR 10             # IF RESPONSE MORE THAN 10 CHARS    #
        THEN
          BEGIN 
          J = 60;                  # ONLY USE FIRST 10                 #
          END 
        ELSE                       # IF RESPONSE LESS THAN 10 CHARS    #
          BEGIN 
          J = CHARS * 6;           # USE ALL FOR COMPARISION           #
          END 
  
        TYPEIN = B<0,J>REPLY;      # STORE THE RESPONSE                #
  
        IF TYPEIN EQ B<0,J>V$YES   # IF USER SAID *YES*                #
        THEN
          BEGIN 
          RETURN;                  # DO NOT VETO THE DATABASE CHANGE   #
          END 
  
        IF TYPEIN EQ B<0,J>V$NO    # IF USER SAID *NO*                 #
        THEN
          BEGIN 
          PVV = TRUE;              # VETO THE DATABASE CHANGE          #
          RETURN; 
          END 
  
        IF TYPEIN EQ B<0,J>V$PROCEED   # IF USER SAID *PROCEED*        #
        THEN
          BEGIN 
          PVVFLAG = 1;             # TURN VETO OFF FOR REST OF TRANS   #
          RETURN; 
          END 
  
        IF TYPEIN EQ B<0,J>V$EXIT   # IF USER SAID *EXIT*              #
        THEN
          BEGIN 
          EXIT;                    # RELEASE ALL TABLES AND POINTERS   #
          EXITCTL;                 # EXIT OVERLAY                      #
          END 
  
                                   # IF USERS ANSWER WAS NOT ONE ABOVE #
        WRITE (RESPOND, 60, RC);   # EXPLAIN WHAT IS A VALID REPLY     #
  
        END                        # END ACTION BY USERS RESPONSE      #
  
      END                          # PROC *PVV*                        #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     B A S I C L O O P                                                #
#                                                                      #
#     *BASICLOOP* IS CALLED BY *CTL60* TO EXECUTE EVERY DIRECTIVE IN   #
#     *BASICTABLE* FOR EVERY QUALIFYING RECORD IN THE DATA BASE.  IT   #
#     DOES THIS THROUGH CALLS TO THE INDIVIDUAL PROCS FOR EACH         #
#     DIRECTIVE.                                                       #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC BASICLOOP; 
      BEGIN 
      ITEM DE$RC   I;              # RETURN CODE FROM -DE$EXE-: 0 KEEP #
                                   # DISPLAYING, 1 END DISPLAY         #
      SWITCH DIREXEC               # SWITCHES ON DIRECTIVE CODE        #
        ENDTBL,    #  0 # 
        DISPLAYL,  #  1 # 
        UNUSED,    #  2 # 
        UNUSED,    #  3 # 
        UNUSED,    #  4 # 
        UNUSED,    #  5 # 
        UNUSED,    #  6 # 
        UNUSED,    #  7 # 
        UNUSED,    #  8 # 
        MOVEL,     #  9 # 
        EVALUATEL, # 10 # 
        IFL,       # 11 # 
        EXTRACTL,  # 12 # 
        STOREL,    # 13 # 
        STORSETL,  # 14 # 
        CONTINUEL, # 15 # 
        MODIFYL,   # 16 # 
        MODUSEL,   # 17 # 
        REMOVEL,   # 18 # 
        REMUSEL;   # 19 # 
  
      IF REFERFILE NQ 0            # IF DATA BASE TO BE ACCESSED       #
        AND FILEPASS               # AND ACCESS NOT BY -USING-         #
      THEN
        BEGIN                      # SELECT BEST PATH TO RECORDS       #
        P<RANGETABLE> = CMM$ALF (30, FIXED$LWA, IMF$GRP); 
        SELPATH (RECORDS[THISRECORDID[1]], RANGETABLE, BESTPATHID); 
        IF BESTPATHID NQ 0         # IF FOUND BETTER PATH USING -IF-S  #
        THEN
          BEGIN 
          PATHCOSETID[1] = BESTPATHID;   # REPLACE DEFAULT PATH WITH IT#
          END 
        END 
  
      LEVEL = 0;                   # TO START THE QUERY                #
  
      ENDREC = FALSE; 
      FOR RECLOOP = RECLOOP        # FOR EVERY ELIGIBLE TUPLE          #
        WHILE NOT ENDREC
      DO
        BEGIN 
        IF FILEPASS                # NOT WAITING FOR -USING- TO GET REC#
        THEN
          BEGIN 
          NEXTREC (RANGETABLE, LEVEL);   # GET NEXT RECORD             #
  
          IF ENDREC                # IF FATAL ERROR ON OBTAIN          #
          THEN
            BEGIN 
            RETURN;                # GIVE UP ON THIS TRANSMISSION      #
            END 
  
          IF LEVEL EQ 0            # IF END OF DATA BASE REACHED       #
          THEN
            BEGIN 
            ENDREC = TRUE;         # FINISHED WITH -RECLOOP-           #
            TEST RECLOOP; 
            END 
          ACCESSES = ACCESSES + 1; # ONE MORE SUCCESSFUL ACCESS        #
          END 
  
        HITONE = FALSE;            # SET TRUE IF ANY -IF- SATISFIED    #
        TRUEIF = TRUE;
        BASCPTR = BASTABLOC;       # POSN TO 1ST ENTRY OF BASICTABLE   #
        P<BASICTABLE> = BASTABLOC;
        BASTABIND = -1; 
  
        ENDBTBL = FALSE;
        FOR BTBLOOP = BTBLOOP      # FOR EVERY ENTRY IN BASICTABLE     #
          WHILE NOT ENDBTBL        # (IE. EVERY DIRECTIVE IN XMISSN)   #
        DO
          BEGIN 
          BASTABIND = BASTABIND + 1;   # POINT TO NEXT BASICTABLE ENTRY#
          CODE = BASCODE[BASTABIND];   # PICK UP CODE FOR DIRECTIVE    #
  
          IF TRUEIF                # IF LAST -IF- WAS SATISFIED        #
            OR CODE EQ IFCODE      # OR NEW -IF- UP NEXT               #
            OR CODE EQ CONTCODE    # OR BASICTABLE TO BE CONTINUED     #
            OR CODE EQ ENDCODE     # OR FINAL BASICTABLE ENTRY         #
          THEN
            BEGIN 
            GOTO DIREXEC[CODE];    # EXECUTE THIS DIRECTIVE            #
  
ENDTBL:                            # END OF BASICTABLE                 #
            ENDBTBL = TRUE;        # LEAVE -BTBLOOP- LOOP              #
            TEST BTBLOOP; 
DISPLAYL: 
EXTRACTL: 
            DE$EXE (DE$RC);        # EXECUTE -DISPLAY- OR -EXTRACT-    #
            IF DE$RC NQ 0          # IF USER ENDED DISPLAY             #
            THEN
              BEGIN 
              ENDBTBL = TRUE;      # SIGNAL END OF PASS THRU B-TABLE   #
              ENDREC = TRUE;       # END OF PASS THRU RECORDS          #
              END 
            TEST BTBLOOP; 
MOVEL:  
            SMMOVE = FALSE;        # SIGNAL MOVE DIRECTIVE, NOT CLAUSE #
            MOV$EXE;               # EXECUTE STANDALONE -MOVE-         #
            TEST BTBLOOP; 
EVALUATEL:  
            EXCEV;                 # EXECUTE -EVALUATE-                #
            TEST BTBLOOP; 
IFL:  
            IF$EXE;                # TEST -IF-                         #
            TEST BTBLOOP; 
STOREL: 
            STO$EXE;               # EXECUTE -STORE-                   #
            TEST BTBLOOP; 
STORSETL: 
            STOS$EXE;              # EXECUTE -STORE SETTING-           #
            TEST BTBLOOP; 
CONTINUEL:                         # ADVANCE TO NEXT BASICTABLE BLOCK  #
            BASCPTR = BASCLAST[BASTABIND];
            P<BASICTABLE> = BASCPTR;
            BASTABIND = 0;
            TEST BTBLOOP; 
MODIFYL:  
            MOD$EXE;               # EXECUTE -MODIFY-                  #
            TEST BTBLOOP; 
MODUSEL:  
            MODU$EXE;              # EXECUTE -MODIFY USING-            #
            TEST BTBLOOP; 
REMOVEL:  
            REM$EXE;               # EXECUTE -REMOVE-                  #
            TEST BTBLOOP; 
REMUSEL:  
            REMU$EXE;              # EXECUTE -REMOVE USING-            #
            TEST BTBLOOP; 
  
UNUSED:                            # IGNORE DIRECTIVE CODES THAT ARE   #
            TEST BTBLOOP;          # RESERVED FOR FUTURE USE OR NOT    #
                                   # SUPPORTED BY IMF                  #
  
            END                    # END IF CAN EXECUTE DIRECTIVE      #
          END                      # END -BTBLOOP- LOOP                #
  
        IF FILEPASS                # IF NOT -USING-                    #
        THEN
          BEGIN 
          IF HITONE                # IF RECORD QUALIFIED               #
            OR TRUEIF 
          THEN
            BEGIN 
            HITS = HITS + 1;       # INCREMENT HITS FOR MESSAGE 1006   #
            END 
          END                      # END IF -FILEPASS-                 #
  
        ELSE                       # IF RECORD SELECTED BY -USING-     #
          BEGIN 
          ENDREC = TRUE;           # ALL DONE, DON-T GET ANOTHER RECORD#
          END 
  
        END                        # END -RECLOOP- LOOP                #
  
      RETURN;                      # RETURN TO -IMFEXE-                #
      END                          # PROC *BASICLOOP*                  #
      CONTROL EJECT;
*CALL CLOSEFILE 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     D E $ E X E                                                      #
#                                                                      #
#     *DE$EXE* IS CALLED BY *BASICLOOP* TO DISPLAY OR EXTRACT GIVEN    #
#     FIELDS FROM THE RECORD IN CORE. THEY ARE SENT TO THE *UPON* FILE #
#     IF GIVEN, OTHERWISE TO OUTPUT. THE FIELDS WANTED ARE LISTED IN   #
#     THE TABLE POINTED TO BY BASICTABLE.                              #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC DE$EXE (DE$RC);
      BEGIN 
      ITEM DE$RC   I;              # 0 - CONTINUE DISPLAY, 1 - END IT  #
  
  
      P<DTABLE> = BASCADDR[BASTABIND];   # POSN TO DIS/EXT TABLE       #
      UPLGCH = SAVFSIZE[30];       # OUTPUT LENGTH SAVED DURING SYNTAX #
      UPLG = (UPLGCH + 9) / 10;    # OUTPUT LENGTH IN WORDS            #
  
      IF BASCUPON[BASTABIND]       # IF -UPON- FILE TO BE USED         #
      THEN
        BEGIN 
        P<FIT> = BASFITUPON[BASTABIND];      # POSN TO -UPON- FILE FIT #
        P<LFNINFO> = P<FIT> - L$FITOFFSET;   # OTHER INFO ABOUT IT     #
  
        IF L$WSA EQ 0              # IF WSA NEVER ASSIGNED TO FILE     #
        THEN
          BEGIN 
          FITMRL = UPLGCH;         # SET MAX RL TO FIRST REC-S RL      #
          GETWSA (FIT);            # ALLOCATE A WSA TO -UPON- FILE     #
          END 
  
        ELSE                       # IF WSA FOR FILE ALREADY EXISTS    #
          BEGIN 
          IF FITMRL LS UPLGCH      # IF WSA SMALLER THAN NEEDED        #
          THEN
            BEGIN 
            CMM$FRF (L$WSA);       # FREE OLD WSA                      #
            FITMRL = UPLGCH;       # SET MRL TO NEW, LARGER VALUE      #
            GETWSA (FIT);          # ALLOCATE NEW WSA                  #
            END 
          END 
  
        TORECORDLOC = FITWSA;      # USED FOR MOVE/CONVERT LOCN        #
        P<LINE> = FITWSA;          # USED FOR XFER TO FILE             #
  
        IF FITOC NQ OC$OPEN        # IF -UPON- FILE NOT OPEN           #
        THEN
          BEGIN 
          FITBBH = TRUE;           # TO ALLOC BUFFERS BELOW HHA        #
          OPENM (FIT, $IO$, $N$, RA0);   # OPEN -UPON- FILE            #
          IF FITES NQ 0            # IF ERROR ON OPEN, DIAGNOSE IT     #
          THEN
            BEGIN 
            DIAG (819, FITES, FITLFNC); 
            RETURN; 
            END                    # END ERROR ON OPEN                 #
          END                      # END OPEN -UPON- FILE              #
        END                        # END IF -UPON-                     #
  
      ELSE                         # IF DISPLAY TO OUTPUT              #
        BEGIN 
        IF DATALOC EQ 0            # IF BUFFER NOT YET ALLOCATED       #
        THEN
          BEGIN 
          UPLGMAX = UPLG;          # SAVE BUFFER SIZE                  #
          DATALOC = CMM$ALF (UPLG, FIXED$LWA, IMF$GRP); 
          END 
  
        ELSE                       # IF BUFFER ALREADY EXISTS          #
          BEGIN 
          IF UPLGMAX LS UPLG       # IF NEED LARGER BUFFER             #
          THEN
            BEGIN 
            CMM$FRF (DATALOC);     # FREE OLD, TOO-SMALL BUFFER        #
            UPLGMAX = UPLG;        # SAVE NEW, LARGER BUFFER SIZE      #
            DATALOC = CMM$ALF (UPLG, FIXED$LWA, IMF$GRP); 
            END 
          END 
  
        P<LINE> = DATALOC;         # POSN BASED ARRAY OVER OUTPUT LINE #
        END                        # END IF DISPLAY TO OUTPUT          #
  
      FOR K = 0 STEP 1             # INIT OUTPUT BUFFER TO BLANKS      #
        UNTIL UPLG - 1
      DO
        BEGIN 
        ALINE[K] = "          ";
        END 
  
      ALLDONE = FALSE;
      FOR DTBLOOP = 0 STEP EESIZE  # FOR EVERY ENTRY IN -DTABLE-       #
        WHILE NOT ALLDONE 
      DO
        BEGIN 
        IF CPENTRY[DTBLOOP] EQ 0   # IF END OF TABLE                   #
        THEN
          BEGIN 
          ALLDONE = TRUE;          # FLAG TO LEAVE -DTBLOOP-           #
          TEST DTBLOOP; 
          END 
  
        IF DTBLOOP EQ 30           # IF LAST WORD OF -DTABLE- BLOCK    #
        THEN
          BEGIN 
          IF OVERFLOW[30] EQ 0     # IF END OF WHOLE TABLE             #
          THEN
            BEGIN 
            ALLDONE = TRUE;        # FLAG TO LEAVE -DTBLOOP-           #
            TEST DTBLOOP; 
            END 
  
          ELSE                     # IF OVERFLOW ENTRY                 #
            BEGIN 
            P<DTABLE> = OVERFLOW[30];  # POSN TO NEXT DTABLE BLOCK     #
            DTBLOOP = -EESIZE;     # TO START AT ENTRY 0 OF NEW BLOCK  #
            TEST DTBLOOP; 
            END 
          END                      # END -- IF LAST WORD OF BLOCK      #
  
        P<DTABLEPTR>  = P<DTABLE> + DTBLOOP;
  
        MEC (DTABLE[DTBLOOP]);     # DO WHATEVER TO MOVE DATA          #
  
        END                        # END -DTBLOOP- LOOP                #
  
      IF BASCUPON[BASTABIND]       # IF OUTPUT GOING TO -UPON- FILE    #
      THEN
        BEGIN 
        PUT (FIT, LINE, UPLGCH, RA0);  # CRM PUT TO FILE               #
        END 
  
      ELSE                         # IF GOING TO OUTPUT                #
        BEGIN 
        WRITEBL (LINE, UPLGCH, ENDTIO);  # WRITE LINE TO OUTPUT        #
        DE$RC = ENDTIO;            # PASS BACK RETURN CODE FROM WRITE  #
        END 
  
      RETURN; 
      END                          # PROC *DE$EXE*                     #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     D I A G 5 1 0                                                    #
#                                                                      #
#     ISSUE DIAG 510                                                   #
#            IMF ERROR CODE *ERROR CODE*, *ERROR MESSAGE*, TRYING TO   #
#            *DML FUNCTION* YOUR RECORD                                #
#                                                                      #
#     CALL EXIT TO CLEANUP AND EXIT OVERLAY IF ERRCODE GQ STV$FILEBUSY #
#                                                                      #
#     ON INPUT:                                                        #
#     ERRCODE SET UP                                                   #
#     DMLCODE CONTAINS DISPLAY CODE VALUE OF DML FUNCTION              #
#                                                                      #
#     ON OUTPUT:                                                       #
#     ENDREC = TRUE IF ERROR WAS FATAL AND MUST EXIT OVERLAY           #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC DIAG510;
      PROC DIAG510 (DMLCODE); 
      BEGIN 
      ITEM DMLCODE C(10);          # DML FUNCTION IN DISPLAY CODE      #
  
      IF ERRCODE EQ STV$FILEBUSY   # IF DATA FILE IS BUSY              #
      THEN
        BEGIN 
        ENDREC = TRUE;             # SIGNAL TO LEAVE -CTL60-           #
        RETURN; 
        END 
  
      IF ERRCODE GQ STV$INTERROR   # IF IMF INTERNAL ERROR             #
      THEN
        BEGIN 
        DIAG (510, ERRCODE, USERSTV, " ", DMLCODE); 
        ENDREC = TRUE;             # SIGNAL TO LEAVE -CTL60-           #
        RETURN; 
        END 
  
      DIAG (510, ERRCODE, ERRORDES1[ERRCODE], 
            ERRORDES2[ERRCODE], DMLCODE); 
  
      IF ERRCODE EQ STV$NOATTACH   # CANNOT ATTACH DATA BASE FILE      #
      THEN
        BEGIN 
        ENDREC = TRUE;             # SIGNAL TO LEAVE -CTL60-           #
        END 
  
      RETURN; 
      END                          # END PROC    DIAG510               #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     E X I T                                                          #
#                                                                      #
#     *EXIT* IS CALLED BEFORE A NORMAL OR ERROR RETURN FROM *CTL60*    #
#     TO CLOSE ALL OPEN FILES, FREE ALL BLOCKS ALLOCATED DURING THIS   #
#     TRANSMISSION, AND RESET GLOBAL VARIABLES.                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC EXIT;
      BEGIN 
      IF ACCESSES + HITS + IOS NQ 0  # IF DATA BASE ACTIVITY           #
      THEN
        BEGIN 
        DIAG (1006, ACCESSES, HITS, IOS);  # INFORM USER OF COUNTS     #
        ACCESSES = 0;              # RE-INITIALIZE ACTIVITY COUNTS     #
        HITS = 0; 
        IOS = 0;
        END 
  
      IF REFERFILE NQ 0            # IF IMF DATA BASE ACCESSED         #
      THEN
        BEGIN                      # CLOSE AND RETURN DATA BASE AND    #
        CLOSE$;                    # RELEASE MEMORY ACQUIRED BY IMF    #
        END 
  
      IF FROMKEYINFIT NQ 0         # IF -FROM- FILE USED               #
      THEN
        BEGIN 
        P<FIT> = FROMKEYINFIT;     # POSN TO ITS FIT                   #
        CLOSEFILE;                 # CLOSE FILE AND RELEASE ITS WSA    #
        END 
  
      IF BASTABLOC NQ 0            # IF BASICTABLE EXISTS              #
      THEN
        BEGIN 
        P<BASICTABLE> = BASTABLOC; # POSN TO BASICTABLE                #
        BASTABIND = 0;             # START WITH FIRST ENTRY            #
        ENDBTBL = FALSE;
        FOR BTBLOOP = BTBLOOP      # FOR EVERY ENTRY IN BASICTABLE     #
          WHILE NOT ENDBTBL 
        DO
          BEGIN 
          CODE = BASCODE[BASTABIND];  # PICK UP CODE FOR DIRECTIVE     #
          IF CODE EQ ENDCODE       # IF LAST ENTRY IN TABLE            #
          THEN
            BEGIN 
            ENDBTBL = TRUE;        # DROP OUT OF -BTBLOOP- LOOP        #
            TEST BTBLOOP; 
            END 
  
          IF CODE EQ CONTCODE      # IF LAST ENTRY IN THIS BLOCK       #
          THEN
            BEGIN 
            CMM$FRF (P<BASICTABLE>);   # FREE THIS BLOCK OF BASICTABLE #
            P<BASICTABLE> = BASCLAST[BASTABIND];   # POSN TO NEXT BLOCK#
            BASTABIND = 0;                         # FIRST ENTRY       #
            TEST BTBLOOP; 
            END 
  
          IF BASCUPON[BASTABIND]   # IF ENTRY OWNS AN -UPON- FILE      #
          THEN
            BEGIN 
            P<FIT> = BASFITUPON[BASTABIND];  # POSN TO ITS FIT         #
            CLOSEFILE;             # CLOSE FILE AND RELEASE ITS WSA    #
            END 
                                           # IF OTHER TABLES ARE       #
          IF BASC$GROUPID[BASTABIND] NQ 0  # ASSOCIATED WITH THIS ENTRY#
          THEN
            BEGIN 
            CMM$FGR (BASC$GROUPID[BASTABIND]);   # RELEASE ALL OF THEM #
            END 
  
          BASTABIND = BASTABIND + 1;   # INCREMENT TO NEXT ENTRY       #
          END                      # END -BTBLOOP- LOOP                #
  
        CMM$FRF (P<BASICTABLE>);   # FREE LAST BLOCK OF BASICTABLE     #
        END                        # END IF BASICTABLE EXISTS          #
  
      CMM$FGR (IMF$GRP);           # FREE MEM ALLOCATED IN THIS OVERLAY#
  
      BASCPTR = 0;                 # RESET ALL OTHER GLOBAL VARIABLES  #
      BASTABIND = 0;
      BASTABLOC = 0;
      DATALOC = 0;
      DIAGLEV = OLDDIAGLEV; 
      FILEPASS = FALSE; 
      FRMLFN = " "; 
      UPONLFN = " ";
      FROMKEYINFIT = 0; 
      REFERFILE = 0;
      SEARCHFLAG = FALSE; 
      TORECORDLOC = 0;
      UPDATING = FALSE; 
      UPDTEMP = FALSE;
      USINGFLAG = FALSE;
  
      RETURN; 
      END                          # PROC *EXIT*                       #
*CALL GETWSA
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     I F $ E X E                                                      #
#                                                                      #
#     *IF$EXE* EVALUATES THE *IF* CONDITION FOR THE RECORD CURRENTLY   #
#     IN CORE.  IF THE RESULT IS TRUE, *TRUEIF* IS RETURNED TRUE,      #
#     OTHERWISE FALSE.                                                 #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC IF$EXE;
      BEGIN 
                                   # PICK UP PTR TO PROGRAM STACK      #
      PROGSTACKLOC = BASCADDR[BASTABIND]; 
      LOGICALRESLT = TRUE;         # RESULT RETURNED IN THIS WORD      #
  
      EXPEVAL (RC);                # EVALUATE CONDITION                #
      TRUEIF = LOGICALRESLT;       # SAVE RESULT                       #
  
      IF TRUEIF                    # IF THIS RECORD QUALIFIES          #
      THEN
        BEGIN 
        HITONE = TRUE;             # FLAG USED TO INCREMENT HITS       #
        END 
  
      RETURN; 
      END                          # PROC *IF$EXE*                     #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     M E C                                                            #
#                                                                      #
#     *MEC* DECIDES WHETHER A MOVE, EVALUATE, OR CONVERT IS NEEDED     #
#     ON THE GIVEN ENTRY AND CALLS THE APPROPRIATE PROC.               #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC MEC (TABLE); 
      BEGIN 
      ARRAY TABLE [0:0] S(EESIZE);
        BEGIN 
        ITEM ENTRYCODE U(0,0,03);  # 0,1 = MOVE: 2 = CONVERSION:       #
                                   # 3 = EVALUATION: 4,5 = SUBSCRIPT   #
        ITEM STACKADDR U(1,6,18);  # ADDRESS OF EXPRESSION STACK       #
        END 
  
      ITEM JJ,KK,LL,M,PP,UB,DTPTEMP;
  
      SWITCH WHATLABEL             # SWITCHES ON ENTRYCODE             #
        STRAIGHTMOVE, 
        STRAIGHTMOVE, 
        CONVERSION, 
        EVALUATION, 
        DISSUB, 
        DISSUB; 
  
      ERRCONV = 0;                 # ASSUME PROCEDURE WILL SUCCEED     #
      GOTO WHATLABEL[ENTRYCODE[0]]; 
  
STRAIGHTMOVE:                      # SIMPLE CALL TO MOVEC              #
      MOVEC (TABLE);
      RETURN; 
  
EVALUATION:                        # EVALUATE EXPRESSION               #
      LOGICALRESLT = FALSE; 
      PROGSTACKLOC = STACKADDR; 
      EXPEVAL (ERRCONV);
      IF ERRCONV NQ 0              # IF ERROR IN EXPRESSION            #
        OR CODE EQ EXTRCODE        # OR DIRECTIVE IS -EXTRACT-         #
      THEN
        BEGIN 
        DIAG(511,ERRCONV,DTBLOOP/3 + 1);
        RETURN;                    # DON-T CONVERT EXPRESSION RESULT   #
        END 
  
CONVERSION:                        # SIMPLE CALL TO CONVERT            #
      CONVERT (TABLE, ERRCONV); 
      IF ERRCONV NQ 0 
      THEN
        BEGIN 
        DIAG(511,ERRCONV,DTBLOOP/3 + 1);
        END 
      RETURN; 
  
DISSUB:                            # FIGURATIVE SUBSCRIPT HANDLING     #
      P<INDTBL> = STACKADD[0];
      JJ = TBLGS[0] - 1;
  
      FOR KK = 0 STEP 1 UNTIL JJ DO 
        BEGIN 
        IF ALLFG[KK] OR DEPNDFG[KK] 
        THEN
          BEGIN 
          LL = ADDRFROM[0]; 
          UPBUN(INDTBL,UB,LL,RC); 
          IF RC NQ 0
          THEN
            BEGIN 
            DIAG(RC); 
            RETURN; 
            END 
          IF ALLFG[KK] THEN GOTO ALLFOUND;
          JJ = JJ -1; 
          END 
        END 
  
      GOTO NOALL; 
  
ALLFOUND: 
      P<INDTBL> = P<INDTBL> + KK; 
      JJ = TOCHAR[0]; 
      KK = TOADDRESS[0];
      LL = 0; 
      IF NOT ITEMSIZE OR NOT BASCUPON[BASTABIND] THEN LL = 1; 
      LL = CHARLENGTH[0] + LL;
      CONSUB[0] = TRUE; 
      ALLFG[0] = FALSE; 
      M = KK * 10 + JJ; 
  
      FOR PP = 1 STEP 1 UNTIL UB DO 
      BEGIN 
        INDCE[0] = PP;
        RC = M / 10;
        TOADDRESS[0] = RC;
        RC = M - RC * 10; 
        TOCHAR[0] = RC; 
        M = M + LL; 
        FIGSUB(DTABLEPTR, RC);
        IF RC NQ 0 THEN GOTO RESETALL;
      END 
  
RESETALL: 
      CONSUB[0] = FALSE;
      ALLFG[0] = TRUE;
      INDCE[0] = 1; 
      TOADDRESS[0] = KK;
      M = RC; 
      TOCHAR[0] = JJ; 
      DTPTEMP = DTBLOOP + EESIZE;  # POINT TO NEXT DISPLAY ITEM        #
                                   # IF LAST ITEM IN DISPLAY TO OUTPUT,#
                                   # DONT DISPLAY PAST *DEP ON* COUNT  #
      IF NOT BASCUPON[BASTABIND]
        AND (CPENTRY[DTPTEMP] EQ 0
        OR  (DTPTEMP GQ 29 AND OVERFLOW[30] EQ 0))
      THEN
        BEGIN                      # SUBTRACT UNUSED WORDS FROM        #
                                   # DISPLAY LENGTH.                   #
        UPLG = UPLG - (UPBND[0] - UB) * LL / 10;
        UPLGCH = UPLG * 10;        # SET NEW CHAR LENGTH FOR WRITE     #
        END 
      GOTO CHKM;
  
NOALL:  
      FIGSUB(DTABLEPTR,ERRCONV);
  
CHKM: 
      IF ERRCONV EQ 51 THEN M = 217;
      IF ERRCONV NQ 0 
      THEN
        BEGIN 
        DIAG(ERRCONV);
        END 
  
      RETURN;                      # END FIG SUB HANDLING              #
      END                          # PROC *MEC*                        #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     M O D $ E X E                                                    #
#                                                                      #
#     *MOD$EXE* PROCESSES A *MODIFY* COMMAND WITH NO *USING* CLAUSE.   #
#     IT IS ASSUMED THAT THE RECORD WAS SELECTED BY A PREVIOUS *IF*,   #
#     OR ELSE ONLY TEMPORARY ITEMS ARE TO BE MODIFIED. IF THE *SETTING*#
#     OPTION WAS SPECIFIED, *USINGEX* IS CALLED ONCE TO READ AND STORE #
#     THE DATA VALUES IN THE RECORD AREA. *MOV$EXE* IS CALLED IF A     #
#     *MOVE* CLAUSE IS PRESENT.                                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC MOD$EXE; 
      BEGIN 
      IF BASCSET[BASTABIND]        # IF -SETTING- CLAUSE GIVEN         #
      THEN
        BEGIN 
        FOR RC = 2                 # READ UNTIL VALID DATA GIVEN       #
          WHILE RC EQ 2 
        DO
          BEGIN 
          NEWDATA = FALSE;         # READ NEW DATA                     #
          USINGEX (GETREC, RC);    # MOVE CONVERTED DATA INTO RECORD   #
          END 
        END 
  
      IF BASCMOVADDR[BASTABIND] NQ 0   # IF -MOVE- CLAUSE GIVEN        #
      THEN
        BEGIN 
        SMMOVE = TRUE;             # SIGNAL MOVE CLAUSE, NOT DIRECTIVE #
        MOV$EXE;                   # PERFORM MOVE INTO RECORD AREA     #
        END 
  
      IF BASCTEMP[BASTABIND]       # IF NO AREA ITEMS REFERENCED       #
      THEN
        BEGIN 
        RETURN;                    # THE MODIFY IS NOW COMPLETE        #
        END 
  
      IF PVV                       # IF USER WISHES TO VETO THE MODIFY #
      THEN
        BEGIN 
        RETURN;                    # DO NOT ALTER THE DATABASE         #
        END 
  
      DML = IMFMOD;                # MODIFY THE RECORD                 #
      ERRSTATEMENT = EXEC$ (RECORD);
      IOS = IOS + 1;
  
      IF ERRSTATEMENT NQ STV$OK    # IF ERROR ON MODIFY                #
      THEN
        BEGIN 
        DIAG510 ("MODIFY");        # DIAGNOSE IT                       #
        END 
  
      RETURN; 
      END                          # PROC *MOD$EXE*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     M O D U $ E X E                                                  #
#                                                                      #
#     *MODU$EXE* EXECUTES A *MODIFY* DIRECTIVE WHICH CONTAINS A        #
#     *USING* CLAUSE. *USINGEX* IS CALLED TO GET THE KEY, AND AFTER    #
#     THE RECORD IS OBTAINED, IT IS CALLED AGAIN TO SET ANY DATA IN    #
#     *SETTING* LIST INTO THE RECORD. *MOV$EXE* MAY ALSO BE CALLED IF  #
#     NEEDED TO PROCESS A *MOVE* CLAUSE.                               #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC MODU$EXE;
      BEGIN 
      DIAGFLU;                     # FLUSH ACCUMULATED DIAGNOSTICS     #
      DIAGLEV = 1;                 # FORCE -DIAG FULL-                 #
  
                                   # FLAG WHETHER DUPLICATES POSSIBLE  #
                                   # OR NOT FOR THIS RECORD            #
      IF B<0,1>DUPLICLIST[RECORDID] EQ 1
      THEN
        BEGIN 
        DUPLICATES = TRUE;
        END 
      ELSE
        BEGIN 
        DUPLICATES = FALSE; 
        END 
  
      FOR RC = 0                   # LOOP UNTIL END OF DATA ENCOUNTERED#
        WHILE RC NQ 1 
      DO
        BEGIN 
        USINGEX (GETKEY, RC);      # READ VALUE OF KEY                 #
        IF RC NQ 0                 # IF ERROR OR END OF DATA           #
        THEN
          BEGIN 
          TEST RC;                 # EITHER READ MORE DATA OR QUIT     #
          END 
  
        DML = IMFOBT;              # SIGNAL IMF TO READ RECORD         #
        ERRSTATEMENT = EXEC$ (RECORD);
        IOS = IOS + 1;
  
        IF ERRSTATEMENT NQ STV$OK  # IF ERROR ON OBTAIN                #
        THEN
          BEGIN 
          DIAG510 ("OBTAIN");      # DIAGNOSE IT                       #
          IF ENDREC                # IF SERIOUS IMF ERROR              #
          THEN
            BEGIN 
            RETURN;                # GIVE UP ON THIS TRANSMISSION      #
            END 
          ELSE                     # IF MINOR USER ERROR               #
            BEGIN 
            FROMERR (RC);          # PRINT CARD IMAGE IN ERROR         #
            TEST RC;               # GIVE HIM ANOTHER CHANCE AT INPUT  #
            END 
          END                      # END IF ERROR ON OBTAIN            #
  
        ELSE                       # IF NO PROBLEM WITH OBTAIN         #
          BEGIN 
          ACCESSES = ACCESSES + 1; # COUNT AS ACCESS AND HIT           #
          HITS = HITS + 1;
          END 
  
        FOR K = K                  # FOR EVERY RECORD WITH THIS KEY    #
        DO
          BEGIN 
          USINGEX (GETREC, RC);    # MOVE -SETTING- LIST INTO RECORD   #
          IF RC NQ 0               # IF CONVERSION ERROR               #
          THEN
            BEGIN 
            TEST RC;               # ASK FOR INPUT DATA AGAIN          #
            END 
  
          IF BASCMOVADDR[BASTABIND] NQ 0   # IF -MOVE- CLAUSE PRESENT  #
          THEN
            BEGIN 
            SMMOVE = TRUE;         # SIGNAL MOVE CLAUSE, NOT DIRECTIVE #
            MOV$EXE;               # MOVE DATA TO RECORD AREA          #
            END 
  
          IF NOT PVV               # IF VETO NOT SPECIFIED FOR MODIFY # 
          THEN
            BEGIN 
  
            DML = IMFMOD;          # MODIFY THE RECORD                 #
            ERRSTATEMENT = EXEC$(RECORD); 
            IOS = IOS + 1;
  
            IF ERRSTATEMENT NQ STV$OK  # IF ERROR ON MODIFY            #
            THEN
              BEGIN 
              DIAG510 ("MODIFY");  # DIAGNOSE IT                       #
              IF ENDREC            # IF SERIOUS IMF ERROR              #
              THEN
                BEGIN 
                RETURN;            # GIVE UP ON THE TRANSMISSION       #
                END 
              ELSE                 # IF MINOR IMF ERROR                #
                BEGIN 
                FROMERR (RC);      # PRINT CARD IMAGE IN ERROR         #
                TEST RC;
                END 
              END                  # END IF ERROR ON MODIFY            #
  
            END                    # END NON VETOED MODIFY             #
  
          IF NOT DUPLICATES        # IF NO DUPLICATE KEYS POSSIBLE     #
          THEN
            BEGIN 
            TEST RC;               # LOOP BACK FOR NEXT KEY VALUE      #
            END 
  
          DML = OBTNXTDUP;         # GET POSSIBLE DUPLICATE RECORD     #
          ERRSTATEMENT = EXEC$ (RECORD);
          IOS = IOS + 1;
  
          IF ERRSTATEMENT NQ STV$OK  # IF DUPLICATE NOT FOUND          #
          THEN
            BEGIN 
            TEST RC;               # LOOP BACK FOR ANOTHER KEY VALUE   #
            END 
  
          ELSE                     # IF FOUND DUPLICATE                #
            BEGIN 
            ACCESSES = ACCESSES + 1;   # COUNT AS ACCESS AND HIT       #
            HITS = HITS + 1;
            TEST K;                # GO MODIFY THIS DUPLICATE          #
            END 
          END                      # END -K- LOOP THROUGH DUPLICATES   #
  
        END                        # END -RC- LOOP THRU -USINGEX- CALLS#
  
      DIAGLEV = OLDDIAGLEV;        # RESTORE ORIGINAL DIAGNOSTIC LEVEL #
      RETURN; 
      END                          # PROC *MODU$EXE*                   #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     M O V $ E X E                                                    #
#                                                                      #
#     THIS ROUTINE WILL CAUSE THE EXECUTION OF THE *MOVE* DIRECIVE     #
#     OR CLAUSE.  IF THE TARGET IS A DATABASE ITEM, QUERY UPDATE MUST  #
#     BE PROCESSING THE MOVE CLAUSE GIVEN WITHIN A *STORE* OR *MODIFY* #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC MOV$EXE; 
      BEGIN 
  
      MOVEXE;                      # EXECUTE THE MOVE                  #
  
      IF TOAREA                    # IF TARGET IS A DATABASE ITEM      #
        AND NOT SMMOVE             # IF EXECUTING A *MOVE* DIRECTIVE   #
      THEN
        BEGIN 
        IF NOT DIAGNOSED           # IF PROBLEM NOT ALREADY DIAGNOSED  #
        THEN
          BEGIN 
          DIAG ( 815 );            # ISSUE -ILLEGAL MOVE TARGET- ERROR #
          END 
        END 
  
      RETURN; 
      END                          # PROC *MOV$EXE*                    #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     R E M $ E X E                                                    #
#                                                                      #
#     *REM$EXE* EXECUTES A *REMOVE* WITH NO *USING* CLAUSE, IE. THE    #
#     RECORD WAS SELECTED BY A PREVIOUS *IF*.                          #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC REM$EXE; 
      BEGIN 
  
      IF PVV                       # IF USER WISHES TO VETO THE REMOVE #
      THEN
        BEGIN 
        RETURN;                    # DO NOT ALTER DATABASE             #
        END 
  
      DML = IMFREM;                # SIGNAL IMF TO DELETE THE RECORD   #
      ERRSTATEMENT = EXEC$ (RECORD);
      IOS = IOS + 1;               # INCREMENT IOS FOR MESSAGE 1006    #
  
      IF ERRSTATEMENT NQ STV$OK    # IF ERROR ON DELETE                #
      THEN
        BEGIN 
        DIAG510 ("REMOVE");        # DIAGNOSE IT                       #
        END 
  
      RETURN; 
      END                          # PROC *REM$EXE*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     R E M U $ E X E                                                  #
#                                                                      #
#     *REMU$EXE* PROCESSES A *REMOVE* WHICH INCLUDES A *USING* CLAUSE. #
#     *USINGEX* IS CALLED TO READ THE KEY FOR EACH RECORD OCCURRENCE   #
#     TO BE DELETED.                                                   #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC REMU$EXE;
      BEGIN 
      DIAGFLU;                     # FLUSH ACCUMULATED DIAGNOSTICS     #
      DIAGLEV = 1;                 # FORCE -DIAG FULL-                 #
  
                                   # FLAG WHETHER DUPLICATES POSSIBLE  #
                                   # OR NOT FOR THIS RECORD            #
      IF B<0,1>DUPLICLIST[RECORDID] EQ 1
      THEN
        BEGIN 
        DUPLICATES = TRUE;
        END 
      ELSE
        BEGIN 
        DUPLICATES = FALSE; 
        END 
  
      FOR RC = 0                   # LOOP UNTIL END OF DATA ENCOUNTERED#
        WHILE RC NQ 1 
      DO
        BEGIN 
        USINGEX (GETKEY, RC);      # READ VALUE OF KEY                 #
        IF RC NQ 0                 # IF ERROR OR END OF DATA           #
        THEN
          BEGIN 
          TEST RC;                 # EITHER READ MORE DATA OR QUIT     #
          END 
  
        DML = IMFOBT;              # SIGNAL IMF TO READ RECORD         #
        ERRSTATEMENT = EXEC$ (RECORD);
        IOS = IOS + 1;             # INCREMENT IOS FOR MESSAGE 1006    #
  
        IF ERRSTATEMENT NQ STV$OK  # IF ERROR ON OBTAIN                #
        THEN
          BEGIN 
          DIAG510 ("OBTAIN");      # DIAGNOSE IT                       #
          IF ENDREC                # IF SERIOUS IMF ERROR              #
          THEN
            BEGIN 
            RETURN;                # GIVE UP ON THIS TRANSMISSION      #
            END 
          ELSE                     # IF MINOR USER ERROR               #
            BEGIN 
            FROMERR (RC);          # PRINT CARD IMAGE IN ERROR         #
            TEST RC;               # GIVE HIM ANOTHER CHANCE AT USINGEX#
            END 
          END                      # END IF ERROR ON OBTAIN            #
  
        ELSE                       # IF OBTAIN WAS SUCCESSFUL          #
          BEGIN 
          ACCESSES = ACCESSES + 1; # COUNT AS ACCESS AND HIT           #
          HITS = HITS + 1;
          END 
  
        FOR K = K                  # FOR EVERY RECORD WITH THIS KEY    #
        DO
          BEGIN 
          IF NOT PVV               # IF DELETE NOT VETOED BY USER      #
          THEN
            BEGIN 
  
            DML = IMFREM;          # DELETE THE RECORD                 #
            ERRSTATEMENT = EXEC$(RECORD); 
            IOS = IOS + 1;
  
            IF ERRSTATEMENT NQ STV$OK   # IF ERROR ON DELETE           #
            THEN
              BEGIN 
              DIAG510 ( "REMOVE" ); 
              IF ENDREC            # IF SERIOUS IMF ERROR              #
              THEN
                BEGIN 
                RETURN;            # GIVE UP ON THIS TRANSMISSION      #
                END 
              ELSE                 # IF MINOR IMF ERROR                #
                BEGIN 
                FROMERR ( RC );    # PRINT CARD IMAGE IN ERROR         #
                TEST RC;           # GO READ ANOTHER KEY VALUE         #
                END 
              END                  # END IF ERROR ON DELETE            #
  
            END                    # END NON VETOED DELETE             #
  
          IF NOT DUPLICATES        # IF NO DUPLICATE KEYS POSSIBLE     #
          THEN
            BEGIN 
            TEST RC;               # GO BACK FOR NEXT KEY VALUE        #
            END 
  
          DML = OBTNXTDUP;         # GET POSSIBLE DUPLICATE RECORD     #
          ERRSTATEMENT = EXEC$ (RECORD);
          IOS = IOS + 1;
  
          IF ERRSTATEMENT NQ STV$OK  # IF DUPLICATE NOT FOUND          #
          THEN
            BEGIN 
            TEST RC;               # LOOP BACK FOR ANOTHER KEY VALUE   #
            END 
  
          ELSE                     # IF DUPLICATE FOUND                #
            BEGIN 
            ACCESSES = ACCESSES + 1;   # COUNT AS ACCESS AND HIT       #
            HITS = HITS + 1;
            TEST K;                # GO BACK TO REMOVE DUPLICATE       #
            END 
          END                      # END -K- LOOP THROUGH DUPLICATES   #
  
        END                        # END -RC- LOOP THRU -USINGEX- CALLS#
  
      DIAGLEV = OLDDIAGLEV;        # RESTORE ORIGINAL DIAGNOSTIC LEVEL #
      RETURN; 
      END                          # PROC *REMU$EXE*                   #
      CONTROL EJECT;
*CALL SETDISFRO 
CONTROL EJECT;
      #----------------------------------------------------------------#
      #                                                                #
      #           S E T N U L L                                        #
      #                                                                #
      #   THIS PROCEDURE SETS NULL VALUES OF ZEROS INTO NON-DISPLAY    #
      #   FIELDS OF THE RECORD AREA BEFORE ANY STORE TAKES PLACE.      #
      #                                                                #
      #   ASSUMPTIONS:  POINTERS TO IMF TABLES,SYMSST$ AND SST$        #
      #                 ARE SET BY INVOKE$.   POINTER TO AREA RECORDS  #
      #                 HAS ALSO BEEN SET BEFORE ENTRY.                #
      #                                                                #
      #   FLOW:        THE TORTUOUS CHAIN THROUGH THE IMF TABLES IS    #
      #                FOLLOWED IN ORDER TO  FIND THE DATA TYPE.  ONCE #
      #                THE TYPE IS FOUND, THE NULL VALUE IS INSERTED   #
      #                INTO THE RECORD AREA WHOSE ADDRESS IS AT        #
      #                RECORDWSA AT THE OFFSET DESCRIBED IN THE DID    #
      #                                                                #
      #   OUTPUT:      ONE OR MORE PRESET RECORD AREAS.                #
      #                                                                #
      #----------------------------------------------------------------#
  
      PROC SETNULL; 
      BEGIN 
      DEF CHARTYPE  #4#;           # CHARACTER TYPE                    #
      DEF NUMERIC  #1#;            # DISPLAY NUMERIC TYPE              #
  
      ITEM DATALENGTH   I;         # LENGTH OF FIELD                   #
      ITEM DITCNT       I;         # COUNTER FOR NUMBER OF DITS        #
      ITEM NDITS        I;         # NUMBER OF DITS FOR RECORD         #
      ITEM NRECS        I;         # NUMBER OF RECORDS TO CHECK        #
      ITEM NULLVALUE    I;         # FILL WORD                         #
      ITEM NUMCHAR      I;         # NO. OF CHARACTERS                 #
      ITEM RECCNT       I;         # COUNTER FOR NUMBER OF RECORDS     #
      ITEM STARTBIT     I;         # START POSITION WITHIN WORD        #
      ITEM TARGET       I;         # OFFSET WORD WITHIN RECORD         #
  
      NRECS = SICRCTN;             # NO. OF RECORDS                    #
      P<SRAT> = USERSSST + SICRCTD; 
      FOR RECCNT = 1 STEP 1 UNTIL NRECS 
      DO
        BEGIN 
        IF RECORDSEEN[RECCNT]      # RECORD USED IN TRANSMISSION       #
        THEN
          BEGIN 
          P<SRAT> = P<SRAT> + (RECCNT - 1) * SRCTENL; 
          P<SDID> = USERSSST + SICDITD + (RECFSDI[1] - 1) * SDITENL;
          P<RECORD> = RECORDWSA[RECCNT];
          NDITS = RECNRDI[1]; 
          FOR DITCNT = 1 STEP 1 UNTIL NDITS 
          DO
            BEGIN 
            P<DID> = USERSSCT + SDTDIDD;   # ONLY DID POINTS TO FORMAT #
            DATALENGTH = DIDLBIT/6; 
            P<DFM> = USERSSCT + DIDDFMD;
            TARGET = DIDRWA;       # WORD OFFSET                       #
            STARTBIT = DIDRBP;     # START POSITION WITHIN WORD        #
  
           # SET NULLVALUE ACCORDING TO TYPE                           #
  
            IF DFMDTYP EQ CHARTYPE
              OR DFMDTYP EQ NUMERIC 
            THEN
              BEGIN 
              NULLVALUE = O"55555555555555555555";
              END 
            ELSE
              BEGIN 
              NULLVALUE = 0;
              END 
            IF STARTBIT NQ 0       # PARTIAL WORD AT START             #
            THEN
              BEGIN 
              STARTBIT = STARTBIT / 6;  # CHARACTER POSITION           #
              NUMCHAR = 10 - STARTBIT;
              C<STARTBIT,NUMCHAR>RECORDWORD[TARGET] = 
                C<0,NUMCHAR>NULLVALUE;
              DATALENGTH = DATALENGTH - NUMCHAR;
              STARTBIT = 0; 
              TARGET = TARGET + 1;
              END 
            FOR J = J 
              WHILE DATALENGTH GQ 10   # PROCESS FULL WORD             #
            DO
              BEGIN 
              RECORDWORD[TARGET] = NULLVALUE; 
              TARGET = TARGET + 1;
              DATALENGTH = DATALENGTH - 10; 
              END 
            IF DATALENGTH GR 0    # DO ANY LEFTOVERS                   #
            THEN
              BEGIN 
              C<0,DATALENGTH>RECORDWORD[TARGET] = 
                C<0,DATALENGTH>NULLVALUE; 
              END 
            P<SDID> = P<SDID> + SDITENL; # POINT TO NEXT SDID          #
            END 
          END 
        END 
        RETURN; 
      END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S T O $ E X E                                                    #
#                                                                      #
#     *STO$EXE* IS CALLED TO PROCESS A *STORE* WITH NO *SETTING*       #
#     CLAUSE, WHICH MEANS THE *MOVE* CLAUSE DOES ALL THE WORK.         #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC STO$EXE; 
      BEGIN 
      SETNULL;                     # INIT RECORD AREAS TO NULL VALUES  #
  
      SMMOVE = TRUE;               # INDICATE THE *MOVE* CLAUSE        #
      MOV$EXE;                     # MOVE NEW VALUES INTO RECORD       #
  
      IF PVV                       # IF USER WISHES TO VETO THE STORE  #
      THEN
        BEGIN 
        RETURN;                    # DO NOT ALTER THE DATABASE         #
        END 
  
      DML = IMFSTO;                # STORE THE NEW RECORD              #
      ERRSTATEMENT = EXEC$ (RECORD);
      IOS = IOS + 1;               # INCREMENT IOS FOR MESSAGE 1006    #
  
      IF ERRSTATEMENT NQ STV$OK    # IF PROBLEM WITH THE STORE         #
      THEN
        BEGIN 
        DIAG510 ("STORE");         # DIAGNOSE IT                       #
        END 
  
      ELSE                         # IF SUCCESSFUL STORE               #
        BEGIN 
        HITS = HITS + 1;           # INCREMENT HITS FOR MESSAGE 1006   #
        END 
  
      RETURN; 
      END                          # PROC *STO$EXE*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S T O S $ E X E                                                  #
#                                                                      #
#     *STOS$EXE* EXECUTES A *STORE* IF THE *SETTING* CLAUSE IS GIVEN.  #
#     A CALL TO *USINGEX*, ALONG WITH THE OPTIONAL *MOVE* CLAUSE,      #
#     FURNISHES THE VALUES FOR EACH NEW RECORD.                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC STOS$EXE;
      BEGIN 
      DIAGFLU;                     # FLUSH ACCUMULATED DIAGNOSTICS     #
      DIAGLEV = 1;                 # FORCE -DIAG FULL-                 #
  
      FOR RC = 0
        WHILE RC NQ 1              # REPEAT UNTIL END OF DATA REACHED  #
      DO
        BEGIN 
        SETNULL;                   # INITIALIZE EMPTY RECORD           #
        NEWDATA = FALSE;           # SIGNAL TO READ IN NEW DATA        #
        USINGEX (GETREC, RC);      # READ DATA, CONVERT, AND MOVE      #
                                   # INTO NEW RECORD                   #
        IF RC NQ 0                 # IF ERROR OR END OF DATA           #
        THEN
          BEGIN 
          TEST RC;                 # EITHER READ MORE DATA OR QUIT     #
          END 
  
        IF BASCMOVADDR[BASTABIND] NQ 0   # IF -MOVE- CLAUSE GIVEN      #
        THEN
          BEGIN 
          SMMOVE = TRUE;           # SIGNAL MOVE CLAUSE, NOT DIRECTIVE #
          MOV$EXE;                 # MOVE MORE VALUES INTO NEW RECORD  #
          END 
  
        IF PVV                     # IF USER WISHES TO VETO THE STORE  #
        THEN
          BEGIN 
          TEST RC;                 # TRY ANOTHER RECORD                #
          END 
  
        DML = IMFSTO;              # STORE NEW RECORD                  #
        ERRSTATEMENT = EXEC$ (RECORD);
        IOS = IOS + 1;
  
        IF ERRSTATEMENT NQ STV$OK  # IF ERROR ON STORE                 #
        THEN
          BEGIN 
          DIAG510 ("STORE");       # DIAGNOSE IT                       #
          IF ENDREC                # IF SERIOUS IMF ERROR              #
          THEN
            BEGIN 
            RETURN;                # GIVE UP ON THIS TRANSMISSION      #
            END 
          ELSE                     # IF MINOR USER ERROR               #
            BEGIN 
            FROMERR (RC);          # PRINT CARD IMAGE IN ERROR         #
            TEST RC;               # GIVE HIM ANOTHER CHANCE AT USINGEX#
            END 
          END                      # END IF ERROR ON STORE             #
  
        ELSE                       # IF NO PROBLEM WITH STORE          #
          BEGIN 
          HITS = HITS + 1;         # INCREMENT HITS FOR MESSAGE 1006   #
          TEST RC;                 # LOOP BACK FOR ANOTHER RECORD      #
          END 
        END                        # END -RC- LOOP THROUGH -USINGEX-   #
  
      DIAGLEV = OLDDIAGLEV;        # RESTORE ORIGINAL DIAGNOSTIC LEVEL #
      RETURN; 
      END                          # PROC *STOS$EXE*                   #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C T L 6 0                                                        #
#                                                                      #
#     THIS IS THE MAIN BODY OF *CTL60*. IT SETS UP THE *FROM* FILE, IF #
#     ONE EXISTS, ALLOCATES THE RECORD AREA(S), CALLS *BASICLOOP* TO   #
#     EXECUTE EACH DIRECTIVE FOR EACH QUALIFYING RECORD AND *EXIT* TO  #
#     DO ALL THE CLEAN-UP.                                             #
#                                                                      #
#----------------------------------------------------------------------#
  
      ACCESSES = 0; 
      HITS = 0; 
      IOS = 0;
      OLDDIAGLEV = DIAGLEV;        # SAVE DIAG FLAG IN CASE CHANGED    #
  
      IF FROMKEYINFIT NQ 0         # IF -FROM- FILE EXISTS             #
      THEN
        BEGIN 
        SETDISFROM (RC);           # OPEN -FROM- FILE AND ALLOC WSA    #
        IF RC NQ 0                 # IF ERROR ON OPEN                  #
        THEN
          BEGIN 
          EXIT;                    # CLEAN UP AND EXIT OVERLAY         #
          RETURN; 
          END 
        END 
                                       # ACTIVATE A GROUP-ID TO ALLOC  #
      IMF$GRP = CMM$AGR (BELOW$HHA);   # ALL BLKS BELOW HHA IF FEASIBLE#
      FOR K = 1 STEP 1             # FOR EVERY RECORD TYPE             #
        WHILE RECORDENTRY[K] NQ 0 
      DO
        BEGIN 
        IF RECORDSEEN[K]           # IF RECORD INVOLVED IN TRANSMISSION#
        THEN
          BEGIN 
          RECLGW = RECORDLGW[K];   # RECORD LENGTH IN WORDS            #
          CMM$PRS = " ";           # PRESET RECORD AREA TO BLANKS      #
          P<RECORD> = CMM$ALF (RECLGW, FIXED$LWA, IMF$GRP); 
          RECORDWSA[K] = P<RECORD>;  # POINTER TO RECORD AREA          #
          END 
        END                        # END -K- LOOP THROUGH -RECORDS-    #
  
      BASICLOOP;                   # EXEC EACH DIR FOR EACH TUPLE      #
  
      EXIT;                        # CLEAN UP AND EXIT OVERLAY         #
      RETURN; 
END 
TERM
