*DECK STKSCAN 
USETEXT TAREATB 
USETEXT TBASCTB 
USETEXT TCMMDEF 
USETEXT TCOMMON 
USETEXT TCONVRT 
USETEXT TFIT
USETEXT TIMF
USETEXT TINDTBL 
USETEXT TPSTACK 
USETEXT TSBASIC 
      PROC STKSCAN (RC);
      BEGIN 
#                                                                      #
#     S T K S C A N                                                    #
#                                                                      #
# THIS PROC AND SUB-PROCS PERFORM THE NECESSARY PREPROCESSING BEFORE   #
# CONTROL PASSES TO THE EXECUTION OVERLAYS.  THE ARRAY -SAVDAREA-,     #
# CONTAINING THE ADDRESSES OF THE -AREATABLES- IN USE, IS BUILT, AND   #
# ORDINAL VALUES IN THE PROGRAMSTACK AND DISPLAY TABLES ARE REPLACED   #
# WITH ADDRESSES.                                                      #
#                                                                      #
      XREF BASED ARRAY SAVDAREA;       # SAVES ADDRESSES OF AREA TABLES#
        BEGIN 
        ITEM AREASAVE U(00,42,18);     # ADDRESS OF TABLE.             #
        ITEM AREASAVEWD  U(00,00,60);  # WHOLE WORD.                   #
        ITEM AREAINUSE   B(00,00,01);  # TRUE--THIS AREA IS USED IN THE#
        END                            # DIRECTIVE BEING PROCESSED.    #
      XREF ITEM ATPTR I;           # P<AREA$TABLE> AT CALL TO *NEXTGET*#
                                   # OR *CALLOWN* OR, IF SINGLE AREA   #
                                   # UPDATE OR QUERY IN CDCS DATA BASE #
                                   # MODE, AT CALL TO *CTL50*.         #
      XREF ITEM FRMLFN C(7);       # LFN OF -FROM- OR -KEY IN- FILE    #
      XREF ITEM FROMKEYINFIT I;    # ADDRESS OF -KEY IN- FIT           #
      XREF ITEM IMFDBM B;          # TRUE IF IN IMF DATABASE MODE      #
      XREF ITEM RECDORD I;         # RECORD ORDINAL USED BY THIS XMISSN#
      XREF ITEM RESTRICTPROC B;    # TRUE--PROCESSING RESTRICT.        #
      XREF ITEM SAVEDTYPE;         # USED TO HOLD -DATATYPE- ON A -KEY-#
                                   # DIRECTIVE                         #
      XREF ITEM RESTACKLOC;        # LOCATION OF RESTRICT STACK.       #
      XREF ITEM RSTKLEN;           # LENGTH OF RESTRICT STRING.        #
      XREF BASED ARRAY RESLIST;    # RESTRICT CHARACTER STRING.        #
        BEGIN 
        ITEM NEXTRES   B(0,0,1);   # TRUE--THERE IS ANOTHER RESTRICT.  #
        ITEM RESLENGTH U(0,1,8);   # LENGTH (WORDS) OF STRING.         #
        ITEM RESADDR   U(0,42,18); # ADDRESS OF RESTRICT STACK.        #
        ITEM RESWORD   U(0,0,60); 
        END 
      XREF ITEM AREATBLPTR;            # POINTER TO FIRST AREA TABLE.  #
      XREF ITEM LOWAREA I;         # IF RELATION, AREA ORD OF ROOT RANK#
                                   # IF SINGLE AREA QUERY OR UPDATE,   #
                                   # AREA ORDINAL OF THAT AREA         #
      XREF ITEM TARGETAREA;        # AREA TO BE UPDATED.               #
      XREF ITEM UPDATEAREA B;      # TRUE IF -UPDATE AREANAME- WAS DONE#
      XREF PROC DIAG; 
      XREF ITEM UPDATING B;        # TRUE--UPDATE OPERATION.           #
      XREF ITEM CURRELATION;       # RELATION BIT PATHS.               #
      ITEM TEMPI I; 
      ITEM DUMMY1 I;                   # LOOP INDUCTION VARIABLE.      #
      ITEM FINISHED B;                 # LOOP CONTROL VARIABLE.        #
      ITEM STEPPER;                    # LOOP INDUCTION VARIABLE.      #
      ITEM PREVIOUS;
      ITEM TOBASE;
      ITEM LOOPCON B; 
      ITEM LOOPCON2 B;             # FOR LOOP EXIT INDICATOR           #
      ITEM NOAREAS;                # NUMBER OF AREAS IN USE            #
      ITEM DUMMY; 
      ITEM TBLPTR;
      ITEM PREVAREA;               # USED TO KEEP TRACK OF AREAS.      #
      ITEM RC;                     # RETURN CODES.                     #
      ITEM RC1; 
      ITEM I;                      # INDEX INTO EVALUATE TABLE         #
      ITEM DISKEY B;               #TRUE IF XMISSN CONTAINS DISPLAY KEY#
      ITEM MULTREC B;              # TRUE IF XMSSN USES MULTIPLE RECORD#
      ITEM SVKEY3LOC I;            # ADDRESS OF BASIC TBL ENTRY FOR    #
                                   # DISPLAY KEY                       #
      ITEM SMMOVE  B;              # TRUE IF *SCANDTABLE* IS BEING     #
                                   # CALLED FOR *STORE/MOD* *MOVE* CLS #
      ITEM WORDBASE;               # LOC(AREAKA) IF EXCLUDED PRIMARY   #
                                   # KEY, ELSE LOC(AREAWSA)            #
      ARRAY EXPRSTACK[9];              # HOLDING AREA FOR SUB-         #
        BEGIN                          # EXPRESSION INFO.              #
        ITEM STACKADDR U(0,42,18);
        ITEM PSTKPTR   U(0,24,18);
        END 
      BASED ARRAY DTABLE;              # DISPLAY TABLE.                #
        BEGIN                          # THIS IS A 3 WORD ENTRY        #
        ITEM CPTYPE     U(0,0,3);      # CONTAINING INFORMATION        #
        ITEM CPEDIT     B(0,3,1);      # NEEDED FOR CALLING MOVEC,     #
        ITEM CPFCHAR    U(0,4,4);      # CONVERT, FIGSUB, ETC.         #
        ITEM CPTCHAR    U(0,8,4); 
        ITEM CPCHARLG   U(0,12,12);  # LENGTH OF FIELD IN CHARS        #
        ITEM CPFROMADDR I(0,24,18); 
        ITEM CPTOADDR   I(0,42,18); 
        ITEM CPCVTCD    I(0,0,6); 
        ITEM CPSTACK    I(0,6,18);
        ITEM CPADDRFROM I(0,24,18); 
        ITEM CPADDRTO   I(0,42,18); 
        ITEM CPPKEY     B(2,0,1);      # TRUE IF PRIMARY KEY           #
        ITEM CPKEYEXCL  B(2,1,1);      # TRUE PART/ALL OF EXCLUDED KEY #
        ITEM CPRECDORD  U(2,27,12);    # RECORD ORD IF CDCS AREA ITEM  #
                                       # 1 IF CRM AREA ITEM, ELSE 0    #
        ITEM CPITEMORD  U(2,39,15);    # ITEM ORDINAL IF CDCS, ELSE 0  #
        ITEM DAREAORD   U(2,54,06);    # ORDINAL TO ADDRESS OF AREA    #
                                       # TABLE IN ARRAY -SAVDAREA-     #
                                       # IF IMF MODE, RECORD ID OF DBI #
        ITEM CPENTRY    U(0,0,60);
        ITEM OVERFLOW   I(0,42,18); 
        END 
      BASED ARRAY LFNSAVE;
        BEGIN 
        ITEM SAVEDLFN C(0,0,7); 
        END 
      BASED ARRAY EVALDATA;        # EVALUATE TABLE                    #
        BEGIN 
        ITEM DATACNVT I(0,6,18);   # POINTER TO MOVE TABLE             #
        ITEM DATASTACK I(0,24,18);  # POINTER TO PROGRAM STACK         #
        ITEM EVALWD I(0,0,60);     # ENTIRE EVALUATE ENTRY             #
        END 
      XREF BASED ARRAY ORDSAVE;         # HOLDING AREA FOR ORDINALS    #
        BEGIN                          # FOUND IN PROGRAMSTACK.        #
        ITEM SAVEORD U(0,0,60); 
        END 
      P<BASICTABLE> = BASTABLOC;   # SET UP BASIC TABLE.               #
      DISKEY = FALSE;              # ASSUME XMISSN HAS NO DISPLAY KEY  #
      RECDORD = 0;                 # INITIAL ASSUMPTIONS               #
      MULTREC = FALSE;
      CURRELATION = O"37777777777777777777";
      IF NOT RESTRICTPROC THEN
        BEGIN 
      IF AREATBLPTR NQ 0
      THEN
        BEGIN 
        GETAREAS;                  # EXTRACT TABLE ADDRESSES           #
        END 
                                         # BEGIN LOOKING AT BASIC TABLE#
      PREVAREA = -1;
      LOOPCON = TRUE; 
      FOR BASTABIND = 0 STEP 1 WHILE LOOPCON DO 
        BEGIN 
        IF BASCODE[BASTABIND] EQ IFCODE THEN
          BEGIN 
          TBLPTR = BASCADDR[BASTABIND];  # ADDR OF PROGRAM STACK       #
          SCANPRGSTACK (TBLPTR, RC1);  # SCAN PROGRAM STACK            #
          RC = RC1; 
          IF RC NQ 0 THEN 
            BEGIN 
            RETURN; 
            END 
          END 
        IF BASCODE[BASTABIND] EQ EVALCODE THEN
          BEGIN 
          I = 0;
          P<EVALDATA> = BASCADDR[BASTABIND];  #POSITION TO EVALUATE TBL#
          LOOPCON2 = TRUE;         # FORCE ENTRY INTO LOOP             #
          FOR DUMMY1 = 0 STEP 1 WHILE LOOPCON2 DO 
            BEGIN 
            IF EVALWD[I] EQ 0 THEN # IF NO MORE EVALUATE ENTRIES...    #
              BEGIN 
              LOOPCON2 = FALSE;    # FORCE EXIT FROM LOOP              #
              TEST DUMMY1;         # EXIT LOOP                         #
              END 
            TBLPTR = DATASTACK[I];  # ADDR OF PROGRAM STACK            #
            IF TBLPTR EQ 0 THEN 
              BEGIN 
              TBLPTR = DATACNVT[I];  # ADDRESS OF MOVE TABLE           #
              SCANDTABLE(TBLPTR, RC1);  # SCAN MOVE TABLE              #
              END 
            ELSE
              BEGIN 
              SCANPRGSTACK(TBLPTR, RC1);  # SCAN PROGRAM STACK         #
              END 
            RC = RC1; 
            IF RC NQ 0 THEN 
              BEGIN 
              RETURN; 
              END 
            I = I + 1;
            IF I NQ 6 THEN         # IF MORE ENTRIES IN BLOCK          #
              BEGIN 
              TEST DUMMY1;         # LOOP BACK FOR NEXT EVALUATE ENTRY #
              END 
            P<EVALDATA> = EVALWD[6];  # POSITION TO NEXT BLOCK         #
            I = 0;
            END 
          END 
        IF (BASCODE[BASTABIND] GQ DISPCODE AND   # THESE DIRECTIVES ALL#
           BASCODE[BASTABIND] LQ UPDUCODE) OR    # USE A DISPLAY TABLE.#
           (BASCODE[BASTABIND] EQ MOVECODE) OR   # SCAN DISPLAY TABLE  #
           (BASCODE[BASTABIND] GQ STORCODE
             AND BASCODE[BASTABIND] NQ CONTCODE) OR 
           (BASCODE[BASTABIND] EQ EXTRCODE) THEN
          BEGIN 
          TBLPTR = BASCADDR[BASTABIND]; 
          IF TBLPTR NQ 0           # MIGHT BE ZERO FOR UPDATE/DELETE   #
          THEN
          BEGIN 
          SCANDTABLE (TBLPTR, RC1); 
          RC = RC1; 
          IF RC NQ 0 THEN 
            BEGIN 
            RETURN; 
            END 
          END 
          TBLPTR = BASCMOVADDR[BASTABIND];
          IF TBLPTR NQ 0           # IF NO *MOVE* CLAUSE IN DIRECTIVE  #
          THEN
            BEGIN 
            SMMOVE = TRUE;         # THIS IS A *MOVE* CLAUSE, NOT DIR  #
            SCANDTABLE (TBLPTR, RC1); 
            SMMOVE = FALSE; 
            RC = RC1; 
            IF RC NQ 0
            THEN
              BEGIN 
              RETURN; 
              END 
            END 
          TEST BASTABIND; 
          END 
        IF BASCODE[BASTABIND] EQ CONTCODE THEN   # CONTINUE TO NEW     #
          BEGIN                                  # BASIC TABLE.        #
          P<BASICTABLE> = BASCLAST[BASTABIND];   # RESTART LOOP.       #
          BASTABIND = -1; 
          TEST BASTABIND; 
          END 
        IF BASCODE[BASTABIND] EQ ENDCODE THEN    # END OF BASIC TABLE. #
          BEGIN                                  # EXIT LOOP AND RETURN#
          LOOPCON = FALSE;
          TEST BASTABIND; 
          END 
        END                                      # END OF BASTABIND    #
                                   # CHECK TO SEE IF ONLY ONE AREA IS  #
                                   # BEING USED. LOOK AT THE           #
                                   # -AREAINUSE- FLAGS.                #
      DUMMY = 0;
      PREVIOUS = 0; 
      NOAREAS = 0;                 # INITIALIZE NUMBER OF AREAS.       #
      IF IMFDBM                    # IF IN IMF DATABASE MODE           #
      THEN                         # DETERMINE IF ACCESSING DBI'S      #
        BEGIN 
        FOR DUMMY1 = 1 STEP 1      # STEP THROUGH ARRAY -RECORDS-      #
          WHILE RECORDENTRY[DUMMY1] NQ 0
        DO
          BEGIN 
          IF RECORDSEEN[DUMMY1]   # IF ACCESSING THIS RECORD           #
          THEN
            BEGIN                  # SET VARIABLE TO INDICATE THIS     #
            PREVIOUS = PREVIOUS + 1;
            END 
          END 
        END                        # END  - IF IMF DATABASE -          #
      ELSE                         # IF, IN CRM OR CDCS DATABASE MODE, #
        BEGIN                      # DETERMINE IF ACCESSING DBI'S      #
        FOR BASTABIND = 1 STEP 1   # STEP THROUGH ARRAY -SAVDAREA-     #
          WHILE AREASAVE[BASTABIND] NQ 0
        DO
          BEGIN                    # IF AREA IS ACCESSED               #
          IF AREAINUSE[BASTABIND] 
          THEN
            BEGIN 
            PREVIOUS = PREVIOUS + 1;     # INDICATE AREA USED          #
            DUMMY = AREASAVE[BASTABIND]; # POINTER TO -AREA$TABLE-     #
            LOWAREA = BASTABIND;         # ORDINAL OF LAST AREA IN USE #
            END 
          NOAREAS = NOAREAS + 1;         # INCREMENT NUMBER OF AREAS   #
          END 
        END 
      IF PREVIOUS GR 0             # IF XMISSN USES AREA(S)            #
      THEN
        BEGIN 
        IF NOT FILEPASS            # IF NO FILE ACCESS FLAG SET.  THIS #
                                   # COULD OCCUR WHEN EVALUATING       #
                                   # DEFINED ITEMS                     #
          AND NOT USINGFLAG 
          AND NOT DISKEY
          AND REFERFILE NQ O"77"   # NOT INSERT MOVE ... ON AK FILE    #
        THEN
          BEGIN 
          FILEPASS = TRUE;         # SET FILE ACCESS FLAG              #
          IF REFERFILE EQ 0 
          THEN
            BEGIN 
            REFERFILE = 1;         # READ FILE                         #
            END 
          END 
        END 
      ATPTR = DUMMY;               # AREATBL PTR OF LAST AREA IN USE   #
      IF DISKEY THEN               # IF DISPLAY KEY                    #
        BEGIN 
        IF PREVIOUS GR 1 THEN      # IF MORE THAN ONE AREA             #
          BEGIN 
          DIAG(349);               # CANNOT DISPLAY KEY FROM MULT FILE #
          RC = 1;                  # ERROR RETURN CODE                 #
          RETURN; 
          END 
        IF PREVIOUS EQ 1 THEN      # IF ONE AREA                       #
          BEGIN 
          P<AREA$TABLE> = DUMMY;   # POSITION TO AREA TABLE            #
          IF AT$FITFO EQ 0 THEN    #IF SEQUENTIAL FILE                 # STKSCAN
            BEGIN 
            DIAG(202);             # CANNOT DISPLAY KEY FROM SEQ FILE  #
            RC = 1;                # ERROR RETURN CODE                 #
            RETURN; 
            END 
          IF MULTREC               # IF MULTIPLE RECORDS IN XMISSN     #
          THEN
            BEGIN 
            DIAG(377);             # DATA NAMES REFERENCE > 1 RECORD   #
            RC = 1;                # ERROR RETURN CODE                 #
            RETURN; 
            END 
          IF KEYLIT NQ 0 THEN 
            BEGIN 
            P<BASICTABLE> = B<42,18>KEYLIT;  # POSITION TO BASICTABLE.# 
            DUMMY1 = B<0,18>KEYLIT;  # PICK UP INDEX INTO BASIC TABLE  #
            P<DTABLE> = BASCADDR[DUMMY1];  # POSITION TO KEY ELEMENTARY#
                                           # ENTRY                     #
            P<KEY$TBL> = AT$PKEYDPTR;  # POSITION TO KEY DESC TABLE    #
            CPCVTCD[1] = C<KT$TYPE[RECDORD],1>CCODE[SAVEDTYPE]; 
            END 
          END 
      IF PREVIOUS EQ 0             # IF TEMP ITEMS ONLY                #
      THEN
        BEGIN 
        IF KEYLIT NQ 0             # IF DIS KEY DATANAME               #
        THEN
                                   # -DISPLAY KEY- DIRECTIVE WITH ONLY #
                                   # TEMPORARY ITEMS FOLLOWING. ZERO   #
                                   # OUT -KEYLIT- SO THAT THERE WILL   #
                                   # NO ATTEMPTED FILEPASS.            #
          BEGIN 
          KEYLIT = 0; 
          END 
        ELSE                       # IF DIS KEY IN FILE                #
          BEGIN 
          P<BASICTABLE> = SVKEY3LOC;  # ADDRESS OF BASCKEY3 = TRUE     #
          BASCKEY3[0] = FALSE;     # DISCARD -KEY IN FILE-             #
          FROMKEYINFIT = 0; 
          FRMLFN = " "; 
          END 
        END 
        END 
                                   # IF AN UPDATE DIRECTIVE INCLUDES A #
                                   # LITERAL AND NO OTHER AREA ITEMS   #
                                   # THERE WILL BE NO AREAS IN USE AND #
                                   # PREVIOUS WILL BE ZERO. IN THIS    #
                                   # CASE, CHECK THE NUMBER OF AREAS   #
                                   # AND THE TARGETAREA TO SEE IF THE  #
                                   # PROPER AREA CAN BE ISOLATED.      #
      IF PREVIOUS EQ 0
        AND UPDATING
        AND NOT UPDATEAREA
      THEN                         # UPDATING WITH NO -UPDATE AREANAME-#
        BEGIN 
        IF NOAREAS NQ 1 THEN       # CANT ISOLATE PROPER AREA.         #
          BEGIN 
          DIAG (345); 
          RC = 1; 
          RETURN; 
          END 
        ELSE                       # THERE IS ONLY ONE AREA IN USE.    #
          BEGIN 
          TARGETAREA = AREASAVE[1]; 
          ATPTR = TARGETAREA;      # AREATBL PTR OF SINGLE AREA IN USE #
          P<AREA$TABLE> = TARGETAREA;  # POSITION TO AREA TABLE        #
          DUMMY = TARGETAREA; 
          AREAINUSE[1] = TRUE;
          CURRELATION = 0;
          IF MULTREC               # IF MULTIPLE RECORDS IN XMISSN     #
          THEN
            BEGIN 
            DIAG(377);             # DATA NAMES REFERENCE > 1 RECORD   #
            RC = 1;                # ERROR RETURN CODE                 #
            RETURN; 
            END 
          IF KEYLIT NQ 0           # IF UPDATE KEY                     #
          THEN
            BEGIN 
            IF RECDORD EQ 0        # EXAMPLE, DELETE LITERAL           #
            THEN
              BEGIN 
              RECDORD = 1;         # ASSUME FIRST RECORD DESCRIPTION   #
              END 
            P<BASICTABLE> = B<42,18> KEYLIT;  # POSITION TO BASICTABLE #
            DUMMY1 = B<0,18>KEYLIT;  # PICK UP INDEX INTO BASIC TABLE  #
            P<DTABLE> = BASCADDR[DUMMY1];  # POSITION TO KEY ELEMENTARY#
                                           # ENTRY                     #
            P<KEY$TBL> = AT$PKEYDPTR;  # POSITION TO KEY DESC TABLE    #
            CPCVTCD[1] = C<KT$TYPE[RECDORD],1>CCODE[SAVEDTYPE]; 
            END 
          RC = 0; 
          RETURN; 
          END 
        END 
      IF PREVIOUS EQ 0 AND UPDATING AND UPDATEAREA THEN 
                                   # -UPDATE AREANAME- HAS BEEN DONE.  #
                                   # SET AREAINUSE FLAG TO TRUE FOR    #
                                   # THE PROPER AREA.                  #
        BEGIN 
        IF NOAREAS EQ 1 THEN       # THERE IS ONLY ONE AREA            #
          BEGIN 
          PREVIOUS = 1; 
          DUMMY = AREASAVE[1];
          AREAINUSE[1] = TRUE;
          END 
        ELSE
                                   # MORE THAN ONE AREA--MUST LOCATE   #
                                   # THE ONE THAT IS THE TARGET AREA.  #
          BEGIN 
          FOR BASTABIND = 1 STEP 1 WHILE AREASAVE[BASTABIND] NQ 0 DO
            BEGIN 
            IF TARGETAREA EQ AREASAVE[BASTABIND] THEN 
              BEGIN 
              PREVIOUS = PREVIOUS + 1;
              DUMMY = AREASAVE[BASTABIND];
              AREAINUSE[BASTABIND] = TRUE;
              TEST BASTABIND; 
              END 
            END 
          IF PREVIOUS EQ 0 THEN    # COULD NOT FIND TARGET AREA        #
            BEGIN 
            DIAG (339); 
            RC = 1; 
            RETURN; 
            END 
          END 
        END 
      IF CURRELATION EQ 0 AND PREVIOUS GR 1 THEN
                                   # MORE THAN ONE AREA BUT NO RELATION#
        BEGIN 
        DIAG (323);                # NO RELATION CONNECTS AREAS.       #
        RC = 1; 
        RETURN; 
        END 
      IF CURRELATION NQ 0 AND PREVIOUS EQ 1 THEN
        BEGIN 
        CURRELATION = 0;           # ONLY ONE AREA--DON"T DO RELATIONAL#
        END                        # PROCESSING.                       #
      IF UPDATING THEN
        BEGIN 
        IF PREVIOUS NQ 1 THEN 
          BEGIN 
          DIAG (338);              # UPDATING MORE THAN ONE AREA.      #
          RC = 1; 
          RETURN; 
          END 
        ELSE
          BEGIN 
          IF TARGETAREA NQ 0 AND UPDATEAREA THEN
            BEGIN 
            IF TARGETAREA NQ DUMMY THEN 
              BEGIN 
              DIAG (339);          # TARGET AREA DOESN"T MATCH.        #
              RC = 1; 
              RETURN; 
              END 
            END 
          TARGETAREA = DUMMY; 
          P<AREA$TABLE> = TARGETAREA;  # AREATABLE POINTER OF SINGLE   #
                                       # AREA IN USE                   #
          ATPTR = TARGETAREA; 
          IF MULTREC               # IF MULTIPLE RECORDS IN XMISSN     #
          THEN
            BEGIN 
            DIAG(377);             # DATA NAMES REFERENCE > 1 RECORD   #
            RC = 1;                # ERROR RETURN CODE                 #
            RETURN; 
            END 
          IF KEYLIT NQ 0           # IF UPDATE KEY                     #
          THEN
            BEGIN 
            IF RECDORD EQ 0        # EXAMPLE, DELETE LITERAL           #
            THEN
              BEGIN 
              RECDORD = 1;         # ASSUME FIRST RECORD DESCRIPTION   #
              END 
            P<BASICTABLE> = B<42,18> KEYLIT;  # POSITION TO BASICTABLE #
            DUMMY1 = B<0,18>KEYLIT;  # PICK UP INDEX INTO BASIC TABLE  #
            P<DTABLE> = BASCADDR[DUMMY1];  # POSITION TO KEY ELEMENTARY#
                                           # ENTRY                     #
            P<KEY$TBL> = AT$PKEYDPTR;  # POSITION TO KEY DESC TABLE    #
            CPCVTCD[1] = C<KT$TYPE[RECDORD],1>CCODE[SAVEDTYPE]; 
            END 
          END 
        END 
      IF NOT (UPDATING             # NO UPDATE DIRECTIVE               #
        OR DISKEY)                 # NO *DISPLAY KEY*                  #
      THEN
        BEGIN 
        RECDORD = 0;               # STKSCAN DOES NOT COMPUTE RECDORD  #
        END 
        END 
      ELSE                         # RESTRICT PROCESSING--SET UP TBLPTR#
                                   # TO POINT TO THE CURRENT RESTRICT  #
                                   # STACK.                            #
        BEGIN 
        TBLPTR = RESTACKLOC;
                                   # CALL -SCANPRGSTACK- TO EXAMINE    #
                                   # THE RESTRICT STACK.               #
        SCANPRGSTACK (TBLPTR, RC1); 
        RC = RC1; 
        IF RC NQ 0 THEN 
          BEGIN 
          RETURN; 
          END 
        END 
      CONTROL EJECT;
      PROC GETAREAS;
#                                                                      #
#                   G E T A R E A S                                    #
#                                                                      #
# THIS PROC STEPS THROUGH THE LIST OF AREA TABLES, IGNORING THE        #
# SUB-SCHEMA ENTRY, AND STORES THE ADDRESS OF EACH TABLE IN THE ARRAY  #
# SAVDAREA.                                                            #
      BEGIN 
      ITEM LOOPCON B; 
      BASED ARRAY LFNSAVE;                   # ARRAY FOR SAVING LFNS   #
        ITEM SAVEDLFN C(0,0,7);              # FOR ALPHABETIZING.      #
      ITEM TEMPI I; 
      ITEM DUMMY; 
      ITEM DUMMY1;
      P<AREA$TABLE> = AREATBLPTR;            # SUBSCHEMA ENTRY--IGNORE.#
      P<AREA$TABLE> = AT$FORWARD[0];         # FIRST AREA TABLE.       #
      P<SAVDAREA> = CMM$ALF(66, FIXED$LWA, 0);
      P<LFNSAVE>  = CMM$ALF(66, FIXED$LWA, 0);
      P<ORDSAVE>  = CMM$ALF(66, FIXED$LWA, 0);
      LOOPCON = TRUE; 
      FOR DUMMY = 1 STEP 1 WHILE LOOPCON DO 
        BEGIN 
        AREASAVE[DUMMY] = P<AREA$TABLE>;
        P<AREAFIT> = LOC(AT$AFITPOS[0]);
        P<FIT> = P<AREAFIT>;                                             STKSCAN
        SAVEDLFN[DUMMY] = C<0,7>FITLFN;      #SAVE THE LFN.            # STKSCAN
        SAVEORD[DUMMY] = DUMMY;              # SAVE ORDINAL VALUE      #
        IF AT$FORWARD[0] NQ 0 THEN           # MOVE TO NEXT TABLE IN   #
          BEGIN                              # CHAIN AND CONTINUE      #
          P<AREA$TABLE> = AT$FORWARD[0];     # LOOPING.                #
          TEST DUMMY; 
          END 
        ELSE
          BEGIN                              # NO MORE TABLES. EXIT    #
          AREASAVE[DUMMY + 1] = 0;           # LOOP AND RETURN.        #
          LOOPCON = FALSE;
          TEST DUMMY; 
          END 
        END 
                                             # THE FOLLOWING LOOPS SORT#
                                             # THE ARRAY -ORDSAVE-    # 
                                             # ALPHABETICALLY BY THE   #
                                             # SAVED LFNS. THE SORT IS #
                                             # LINEAR SELECTION WITH   #
                                             # EXCHANGE.               #
      FOR DUMMY = 1 STEP 1 WHILE SAVEDLFN[DUMMY] NQ 0 DO
        BEGIN 
        FOR DUMMY1 = DUMMY + 1 STEP 1 WHILE SAVEDLFN[DUMMY1] NQ 0 DO
          BEGIN 
          IF SAVEDLFN[DUMMY] LQ SAVEDLFN[DUMMY1] THEN 
            BEGIN 
            TEST DUMMY1;
            END 
          ELSE
            BEGIN 
            TEMPI = SAVEORD[DUMMY]; 
            SAVEORD[DUMMY] = SAVEORD[DUMMY1]; 
            SAVEORD[DUMMY1] = TEMPI;
            TEST DUMMY1;
            END 
          END 
        END 
      TEMPI = P<LFNSAVE>; 
      CMM$FRF (TEMPI);
      RETURN; 
      END 
      CONTROL EJECT;
      PROC SCANDTABLE (TABLEPTR, RC1);
#                                                                      #
#               S C A N D T A B L E                                    #
#                                                                      #
# THIS PROC SCANS THE DISPLAY TABLE LOOKING AT THE FIELD -CPADDRFROM-. #
# IF THIS FIELD CONTAINS AN ORDINAL (VALUE @ 64), THEN THIS ORDINAL IS #
# USED TO LOCATE THE PROPER AREA TABLE ADDRESS IN THE ARRAY SAVDAREA.  #
# THEN THE LOCATION OF THE WSA (AREAWSA) ADDRESS IS PUT INTO THE     #
# FIELD CPADDRFROM.  THE ORDINAL IS SAVED IN THE DISPLAY TABLE IN A    #
# FIELD CALLED DAREAORD.                                               #
# IF IN IMF MODE, THE ORDINAL IS USED TO LOCATE THE PROPER RECORD      #
# OF ARRAY RECORDS.  THE ADDRESS IS PUT INTO CPADDRFROM, LATER TO      #
# BE REPLACED BY THE WSA.  THE ORDINAL IS SAVED INTO DAREAORD AS ABOVE.#
      BEGIN 
      ITEM TABLEPTR;               # PTR TO TABLE TO SCAN.             #
      ITEM RC1;                    # RETURN CODE.                      #
      ITEM RC2;                    # RETURN CODE.                      #
      ITEM LOOPCON B;              # LOOP CONTROL VARIABLE.            #
      ITEM FINISHED B;
      ITEM STEPPER;                # LOOP INDUCTION VARIABLE.          #
      ITEM DUMMY; 
      ITEM TIMETHRU I;             # NO OF TIMES THROUGH LOOP          #
  
  
  
      P<DTABLE> = TABLEPTR;                  # SET UP DISPLAY TABLE    #
      LOOPCON = TRUE;                        # AND LOOP CONTROL.       #
      FOR STEPPER = STEPPER WHILE LOOPCON DO
        BEGIN 
        FINISHED = FALSE; 
        FOR DUMMY = 0 STEP 3 WHILE NOT FINISHED DO
          BEGIN 
        IF (BASCODE[BASTABIND] EQ EVALCODE  # IF EVALUATE              #
          OR BASCODE[BASTABIND] EQ DELTCODE  # IF DELETE               #
          OR BASCODE[BASTABIND] EQ INSTCODE  # IF INSERT               #
          OR BASCODE[BASTABIND] EQ UPDCODE)  # IF UPDATE               #
          AND DUMMY NQ 0           # IF NOT 1ST ENTRY                  #
        THEN
          BEGIN 
          LOOPCON = FALSE;         # EXIT LOOP, BECAUSE ONLY ONE ENTRY #
          TEST STEPPER; 
          END 
          IF DUMMY EQ 30 THEN                # END OF THIS TABLE.  MOVE#
            BEGIN                            # TO NEXT TABLE IN CHAIN, #
            IF OVERFLOW[DUMMY] NQ 0 THEN     # IF THERE IS ONE.  IF NOT#
              BEGIN                          # PROCESSING IS COMPLETE. #
              P<DTABLE> = OVERFLOW[DUMMY];
              TEST STEPPER; 
              END 
            ELSE
              BEGIN 
              LOOPCON = FALSE;
              TEST STEPPER; 
              END 
            END 
          IF CPTYPE[DUMMY] EQ 0 AND DUMMY NQ 0 THEN 
                                   # NO MORE TABLE ENTRIES.            #
            BEGIN 
            LOOPCON = FALSE;
            TEST STEPPER; 
            END 
  
          IF CPTYPE[DUMMY] EQ 3    # SUB-EXPRESSION EXISTS,NEED        #
            OR CPTYPE[DUMMY] EQ 7  # TO OPERATE ON ITS STACK ENTRIES   #
          THEN
            BEGIN 
            IF CPTYPE[DUMMY] EQ 7  # FOR SUBSCRIPTED DESTINATION       #
            THEN
              BEGIN 
              P<INDTBL> = CPSTACK[DUMMY+1];  # LOCATE INDICE TABLE     #
              TABLEPTR = INDCE[2];  # EXTRACT PROGRAMSTACK ADDRESS     #
              END 
            ELSE
              BEGIN 
              TABLEPTR = CPSTACK[DUMMY+1];  # PROGRAMSTACK ADDRESS     #
              END 
            RC2 = 0;
            SCANPRGSTACK (TABLEPTR, RC2); 
            RC1 = RC2;
            IF RC1 NQ 0 THEN
              BEGIN 
              RETURN; 
              END 
            END 
          IF CPTYPE[DUMMY] NQ 0 THEN               # CHECK CPFROMADDR  #
            BEGIN                                  # FOR ELEMENTARY    #
                                                   # ENTRY. REPLACE    #
                                                   # ADDRESS WITH      #
                                                   # POINTER TO WSA.   #
            TIMETHRU = 0;          # FIRST TIME THROUGH                #
  
SCANDTBLOOP:  
            IF BASCODE[BASTABIND] EQ DISPCODE OR
               BASCODE[BASTABIND] EQ EVALCODE OR  # IF EVALUATE        #
               BASCODE[BASTABIND] EQ EXTRCODE OR
               ((BASCODE[BASTABIND] EQ MOVECODE   # IF MOVE DIRECTIVE  #
                 OR SMMOVE)        # OR *MOVE* CLAUSE                  #
                 AND TIMETHRU EQ 0)  # FIRST TIME THROUGH              #
            THEN
              BEGIN 
              TOBASE = CPADDRFROM[DUMMY + 1]; 
              END 
            ELSE                   # IF UPDATE OPERATION, CHECK        #
                                   # CPADDRTO FOR AREA ORDINAL.        #
              BEGIN 
              TOBASE = CPADDRTO[DUMMY + 1]; 
              END 
            IF TOBASE LQ O"100" AND   # REPLACE ORDINAL WITH POINTER TO#
                TOBASE GR 0 THEN      # WSA.                           #
              BEGIN 
              IF IMFDBM            # IF IN IMF DATABASE MODE           #
              THEN
                BEGIN              # SET POINTER INDIRECTLY TO WSA     #
                WORDBASE = LOC(RECORDS[TOBASE]);
                END 
              ELSE                 # IF IN CRM OR CDCS MODES           #
              BEGIN 
              P<AREA$TABLE> = AREASAVE[TOBASE];    # POINTER TO WSA.   #
              CURRELATION = CURRELATION LAN AT$PATHFLAGS; 
              P<AREAFIT> = LOC(AT$AFITPOS[0]);
              P<FIT> = P<AREAFIT>;                                       STKSCAN
              IF CPKEYEXCL[DUMMY]  # IF PART/ALL OF EXCLUDED KEY       #
              THEN
                BEGIN 
                                   # STORE ABS ADDRESS OF KEY IN FIT   #
                                   # THIS ASSUMES SEQUENTIAL FILES     #
                                   # CANNOT HAVE EXCLUDED KEYS         #
                FITKA = AT$CURRKEY + P<AREA$TABLE>;                      STKSCAN
                WORDBASE = LOC(FITKA);                                   STKSCAN
                END 
              ELSE
                BEGIN 
                WORDBASE = LOC(FITWSA);                                  STKSCAN
                END 
              IF NOT AREAINUSE[TOBASE] THEN 
                BEGIN 
                AREAINUSE[TOBASE] = TRUE;          # PROCESSING IS COM-#
                END                                # PLETE FOR THIS    #
                                                   # AREA.             #
              END                  # END PROCESSING DIFFERENCES        #
                                   # BETWEEN IMF AND CRM/CDCS          #
              IF BASCODE[BASTABIND] EQ DISPCODE OR
               BASCODE[BASTABIND] EQ EVALCODE OR  # IF EVALUATE        #
               BASCODE[BASTABIND] EQ EXTRCODE OR
               ((BASCODE[BASTABIND] EQ MOVECODE   # IF MOVE DIRECTIVE  #
                 OR SMMOVE)        # OR *MOVE* CLAUSE                  #
                 AND TIMETHRU EQ 0)  # FIRST TIME THROUGH              #
              THEN
                BEGIN 
                CPADDRFROM[DUMMY + 1] = WORDBASE; 
                END 
              ELSE
                BEGIN 
                CPADDRTO[DUMMY + 1] = WORDBASE; 
                END 
              DAREAORD[DUMMY] = TOBASE; 
              IF RECDORD EQ 0      # IF NO RECORD ORDINAL YET          #
              THEN
                BEGIN 
                RECDORD = CPRECDORD[DUMMY];  # INITIALIZE IT           #
                END 
              ELSE
                BEGIN 
                IF RECDORD NQ CPRECDORD[DUMMY]  # IF DIFFERENT RECORDS #
                  AND CPRECDORD[DUMMY] NQ 0 
                THEN
                  BEGIN 
                  MULTREC = TRUE; 
                  END 
                END 
              END 
                                   # SKIP OVER IF IN IMF MODE SINCE    #
            IF NOT IMFDBM          # IMF DOES NOT USE FOLLOWING ITEMS  #
              AND ( TOBASE EQ 0    # IF CPADDRFROM NOT AN ORDINAL      #
                OR TOBASE GR O"100" ) 
            THEN
                                   # CHECK TO SEE IF -DAREAORD- IS SET #
                                   # ALREADY.                          #
              BEGIN 
              IF DAREAORD[DUMMY] NQ 0 THEN
                BEGIN 
                AREAINUSE[DAREAORD[DUMMY]] = TRUE;
                P<AREA$TABLE> = AREASAVE[DAREAORD[DUMMY]];
                CURRELATION = CURRELATION LAN AT$PATHFLAGS; 
                IF RECDORD EQ 0    # IF NO RECORD ORDINAL YET          #
                THEN
                  BEGIN 
                  RECDORD = CPRECDORD[DUMMY];  # INITIALIZE IT         #
                  END 
                ELSE
                  BEGIN 
                  IF RECDORD NQ CPRECDORD[DUMMY]   # IF DIFFERENT RECS #
                    AND CPRECDORD[DUMMY] NQ 0 
                  THEN
                    BEGIN 
                    MULTREC = TRUE; 
                    END 
                  END 
                END 
              END 
            IF (BASCODE[BASTABIND] EQ MOVECODE    # IF MOVE DIRECTIVE  #
              OR SMMOVE)           # OR *MOVE* CLAUSE                  #
              AND TIMETHRU EQ 0    # IF FIRST TIME THROUGH             #
            THEN
              BEGIN 
              TIMETHRU = 1;        # SECOND TIME THROUGH               #
              GOTO SCANDTBLOOP;    # GO THROUGH LOOP AGAIN             #
              END 
            TEST DUMMY; 
            END 
          END                      # END OF -DUMMY- LOOP               #
        END                        # END OF -LOOPCON- LOOP             #
      IF BASCODE[BASTABIND] EQ DISPCODE AND    # IF *DISPLAY KEY*      #
         (BASCKEY1[BASTABIND] OR BASCKEY2[BASTABIND] OR 
          BASCKEY3[BASTABIND]) THEN 
        BEGIN 
        DISKEY = TRUE;             # XMISSN CONTAINS DISPLAY KEY       #
        SVKEY3LOC = LOC(BASCKEY3[BASTABIND]);  # SAVE ADDRESS OF BASIC #
                                               # TABLE ENTRY FOR       #
                                               # DISPLAY KEY           #
        END 
      RC1 = 0;
      RETURN;                      # RETURN TO -ATTACHM-.              #
      END                          # END OF -SCANDTABLE-.              #
      CONTROL EJECT;
      PROC SCANPRGSTACK (TABLEPTR, RC1);
#                                                                      #
#                S C A N P R O G S T A C K                             #
#                                                                      #
# THIS PROC SCANS THE PROGRAMSTACK LOOKING AT THE FIELD -TOWORDBASE-.  #
# IF THIS FIELD CONTAINS AN ORDINAL (VALUE @ 64) RATHER THAN AN        #
# ABSOLUTE ADDRESS, THE ORDINAL IS USED TO LOCATE THE PROPER AREA      #
# TABLE BY INDEXING INTO THE ARRAY -SAVDAREA-.  THE LOCATION OF THE    #
# WSA (AREAWSA) ADDRESS IS PUT INTO THE FIELD TOWORDBASE, AND THE    #
# ORDINAL IS MOVED TO AREAORD.                                         #
# IF IMF MODE, THE ORDINAL IS USED TO LOCATE THE PROPER RECORD         #
# IN ARRAY RECORDS.  ITS ADDRESS IS PLACED INTO TOWORDBASE, LATER      #
# TO BE REPLACED BY THE RECORDS WSA.  THE ORDINAL IS MOVED INTO        #
# AREAORD AS ABOVE.                                                    #
        BEGIN 
        ITEM TABLEPTR;                 # PTR TO STACK TO SCAN.         #
        ITEM RC1;                      # RETURN CODE                   #
        ITEM RC2;                      # RETURN CODE                   #
        ITEM LOOPCON B;                # LOOP CONTROL VARIABLE.        #
        ITEM DUMMY; 
        ITEM FINISHED B;
        ITEM STEPPER;                  # LOOP INDUCTION VARIABLE.      #
        ITEM PREVIOUS;
        ARRAY EXPRSTACK [9];           # ARRAY FOR HOLDING INFO IN CASE#
          BEGIN 
          ITEM STACKADDR  U(0,42,18);  # THERE IS A SUB-EXPRESSION.    #
          ITEM PSTKPTR    U(0,24,18); 
          END 
  
  
  
        PREVIOUS = -1;
        P<PROGRAMSTACK> = TABLEPTR;                  # SET UP TABLE TO #
        LOOPCON = TRUE;                              # BE SCANNED.     #
        FOR STEPPER = STEPPER WHILE LOOPCON DO
          BEGIN 
          FINISHED = FALSE; 
          FOR DUMMY = 0 STEP 1 WHILE NOT FINISHED DO
            BEGIN                                    # A SUB-EXPRESSION#
            IF ENTRYTYPE[DUMMY] EQ 3 OR              # EXISTS, SAVE    #
               ENTRYTYPE[DUMMY] EQ 6 THEN            # INFO AND RESTART#
              BEGIN                                  # LOOP.           #
              PREVIOUS = PREVIOUS + 1;
              STACKADDR[PREVIOUS] = P<PROGRAMSTACK>;
              PSTKPTR[PREVIOUS] = DUMMY;
              P<PROGRAMSTACK> = EXPRESSTACK[DUMMY]; 
              TEST STEPPER; 
              END 
            IF ENTRYTYPE[DUMMY] NQ 7 THEN            # THIS IS AN ELEM-#
              BEGIN                                  # ENTARY ENTRY.   #
              TOBASE = TOWORDBASE[DUMMY];            # CHECK FOR ORD1- #
              IF TOBASE LQ O"100" AND               # NAL.            # 
                   TOBASE GR 0 THEN 
                BEGIN 
                IF IMFDBM          # IF IN IMF DATABASE MODE           #
                THEN
                  BEGIN            # SET POINTER INDIRECTLY TO WSA     #
                  WORDBASE = LOC(RECORDS[TOBASE]);
                  END 
                ELSE               # IF IN CRM OR CDCS MODES           #
                BEGIN 
                P<AREA$TABLE> = AREASAVE[TOBASE]; 
                P<AREAFIT> = LOC(AT$AFITPOS[0]);
                IF NOT RESTRICTPROC       # A RESTRICTED AREA IS NOT   #
                THEN                      # CONSIDERED IN USE UNLESS IT#
                                          # IS REFERENCED. DURING      #
                                          # RESTRICT PROCESSING, DONT  #
                                          # FORCE  AREAS TO BE IN USE. #
                                          # IF NOT PROCESSING RESTRICTS#
                  BEGIN 
                  AREAINUSE[TOBASE] = TRUE; 
                  CURRELATION = CURRELATION LAN AT$PATHFLAGS; 
                  END 
                                   # IF EXCLUDED KEY                   #
                P<FIT> = P<AREAFIT>;                                     STKSCAN
                IF KEYEXCL[DUMMY]  # IF PART/ALL OF EXCLUDED KEY       #
                THEN
                  BEGIN 
                                   # STORE ABS ADDRESS OF KEY IN FIT   #
                                   # THIS ASSUMES SEQUENTIAL FILES     #
                                   # CANNOT HAVE EXCLUDED KEYS         #
                  FITKA = AT$CURRKEY + P<AREA$TABLE>;                    STKSCAN
                  WORDBASE = LOC(FITKA);                                 STKSCAN
                  END 
                ELSE
                  BEGIN 
                  WORDBASE = LOC(FITWSA);                                STKSCAN
                  END 
                END                # END PROCESSING DIFFERENCES        #
                                   # BETWEEN IMF AND CRM/CDCS          #
                IF ENTRYTYPE[DUMMY] EQ 2 OR    # CONVERSION--SET FROM- #
                   ENTRYTYPE[DUMMY] EQ 3 OR    # WORDBASE TO WSA LOC.  #
                   ENTRYTYPE[DUMMY] EQ 4 THEN 
                  BEGIN 
                  FROMWORDBASE[DUMMY] = WORDBASE; 
                  TOWORDBASE[DUMMY] = 0;
                  END 
                ELSE
                  BEGIN            # NO CONVERSION REQUIRED.           #
                  TOWORDBASE[DUMMY] = WORDBASE; 
                  END 
                IF RECDORD EQ 0    # IF NO RECORD ORDINAL YET          #
                THEN
                  BEGIN 
                  RECDORD = RECDORDINAL[DUMMY];  # INITIALIZE IT       #
                  END 
                ELSE
                  BEGIN 
                  IF RECDORD NQ RECDORDINAL[DUMMY]  # IF DIFFERENT RECS#
                    AND RECDORDINAL[DUMMY] NQ 0 
                  THEN
                    BEGIN 
                    MULTREC = TRUE; 
                    END 
                  END 
                AREAORD[DUMMY] = TOBASE;             # PROCESSING IS   #
                END                                  # COMPLETE FOR    #
                                                     # THIS AREA.      #
              ELSE
                BEGIN 
                                   # CHECK -AREAORD- TO SEE IF IT IS   #
                                   # ALREADY SET.  SKIP OVER IF IMF AS #
                IF NOT IMFDBM      # IMF DOES NOT USE FOLLOWING ITEMS  #
                  AND AREAORD[DUMMY] NQ 0 
                THEN
                  BEGIN 
                  AREAINUSE[AREAORD[DUMMY]] = TRUE; 
                  P<AREA$TABLE> = AREASAVE[AREAORD[DUMMY]]; 
                  CURRELATION = CURRELATION LAN AT$PATHFLAGS; 
                  IF RECDORD EQ 0  # IF NO RECORD ORDINAL YET          #
                  THEN
                    BEGIN 
                    RECDORD = RECDORDINAL[DUMMY];  # INITIALIZE IT     #
                    END 
                  ELSE
                    BEGIN 
                    IF RECDORD NQ RECDORDINAL[DUMMY]  # IF DIFFERENT   #
                      AND RECDORDINAL[DUMMY] NQ 0 
                    THEN
                      BEGIN 
                      MULTREC = TRUE; 
                      END 
                    END 
                  TEST DUMMY; 
                  END 
                END 
              END 
            ELSE
              BEGIN 
              IF OPCODE[DUMMY] EQ O"70" THEN         # END OF STACK.   #
                BEGIN                                # IF THERE WAS A  #
                IF PREVIOUS LS 0 THEN                # SUB-EXPRESSION, #
                  BEGIN                              # RESET VALUES AND#
                  LOOPCON = FALSE;                   # CONTINUE. IF NOT#
                  TEST STEPPER;                      # PROCESSING IS   #
                  END                                # COMPLETE.       #
                ELSE
                  BEGIN 
                  P<PROGRAMSTACK> = STACKADDR[PREVIOUS];
                  DUMMY = PSTKPTR[PREVIOUS];
                  PREVIOUS = PREVIOUS - 1;
                  TEST DUMMY; 
                  END 
                END 
              END 
            END                   # END OF -DUMMY- LOOP.               #
          END                     # END OF -STEPPER- LOOP.             #
        IF RESTRICTPROC            # RESTRICT PROCESSING               #
        THEN
          BEGIN 
          RESADDR[0] = P<PROGRAMSTACK>;  # SAVE STACK ADDRESS IN       #
                                         # RESTRICT STRING FIRST WORD  #
          END 
        RC1 = 0;
        RETURN; 
        END                       # END OF -SCANPRGSTACK-.            # 
      END 
      TERM; 
