*DECK USINGEX 
USETEXT TAREATB 
USETEXT TBASCTB 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TOPTION 
USETEXT TSBASIC 
      PROC USINGEX (GETKEY, XRC); 
#----------------------------------------------------------------------#
#                                                                      #
#     U S I N G E X                                                    #
#                                                                      #
#     THIS PROCEDURE GETS INPUT USED FOR MODIFY, REMOVE AND STORE      #
#     DIRECTIVES.  THE DATA IS THEN MOVED TO THE RECORD AREA.          #
#                                                                      #
#     CALLING SEQUENCE:  USINGEX(GETKEY, XRC)                          #
#        WHERE GETKEY IS A BOOLEAN ITEM WITH TRUE MEANING TO MOVE      #
#                     ONLY THE KEY FOR USING WHILE FALSE MEANS MOVE    #
#                     ALL THE DATA                                     #
#        AND XRC IS THE RETURN CODE                                    #
#                     0 = NORMAL RETURN                                #
#                     1 = *END OR EOI                                  #
#                     2 = ERROR                                        #
#                                                                      #
#     ENTRY CONDITIONS                                                 #
#        IF NOT GETKEY OR NEWDATA, THE RECORD IS IN CORE               #
#        THE USING TABLE WAS BUILT DURING SYNTAX PROCESSING            #
#        THE FLAG IMFDBM IS SET TRUE IF CALL FROM IMF                  #
#        KEY FLAGS SET IF NOT IMF                                      #
#                                                                      #
#     EXIT CONDITIONS                                                  #
#        IF GETKEY THEN KEY(S) CONVERTED AND MOVED TO RECORD AREA      #
#        IF NOT IMF KEYS SAVED IN KEY ARRAY OF AREATABLE               #
#        IF NOT GETKEY ALL NON-KEY DATA MOVED TO RECORD AREA           #
#                                                                      #
#     PROCESSING                                                       #
#        INITIALIZE                                                    #
#        GET INPUT                                                     #
#        IF ITEMSIZE GET ENOUGH CHARACTER FOR FULL FIELD LENGTH        #
#        ELSE                                                          #
#          IF CHARACTER INPUT, CHECK FOR SEPARATOR                     #
#        MOVE, CONVERTING WHEN NECESSARY, TO RECORD AREA               #
#        CHECK ERRCODE WRITING MESSAGES AS REQUIRED                    #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      BEGIN 
                                   # PROC PARAMETERS                   #
      ITEM GETKEY           B;     # TRUE MEANS GET KEY ONLY           #
                                   # FALSE MEANS GET ALL DATA          #
      ITEM XRC              I;     # RETURN CODE                       #
  
#----------------------------------------------------------------------#
#     THE FOLLOWING PROCS ARE XDEF WITHIN USINGEX:                     #
#           FROMERR                 PRINT CARD IN ERROR IF *FROM*      #
#----------------------------------------------------------------------#
  
  
                                   # XREF PROCS                        #
      XREF PROC CMOVE;             # MOVE CHARACTERS                   #
      XREF PROC CONVERT;           # CONVERT DATA                      #
      XREF PROC DIAG;              # WRITE ERROR MESSAGES              #
      XREF PROC FIGSUB2;           # USED WHEN FIGURATIVE SUBSCRIPT    #
      XREF PROC FIGSUB3;           # USED WHEN FIGURATIVE SUBSCRIPT    #
      XREF PROC GET;               # READ FROM FILE                    #
      XREF PROC READ;              # READ FROM TERMINAL                #
      XREF PROC WRITE;             # WRITE TO TERMINAL                 #
      XREF PROC WRITEBL;           # WRITE AND STOP WHEN PAGE FULL     #
  
                                   # XREF ITEMS                        #
      XREF ITEM AKCHPOS     I;     # ALT KEY CHARACTER POSITION        #
      XREF ITEM AKITORD     I;     # ITEM ORDINAL IF CDCS ELSE 0       #
      XREF ITEM AKLNGTH     I;     # ALT KEY LENGTH                    #
      XREF ITEM AKTYPE      I;     # ALTERNATE KEY TYPE                #
      XREF ITEM AKWOPOS     I;     # ALT KEY WORD POSITION             #
      XREF ITEM ALKEYLOC    I;     # ALT KEY LOCATION                  #
      XREF ITEM CONCTED     B;     # CONNECTED FILE INPUT FLAG         #
      XREF ITEM IMFDBM      B;     # IMF MODE IN EFFECT                #
      XREF ITEM LINES       I;     # NUMBER OF LINES ON TERMINAL       #
      XREF ITEM MKL         I;     # LENGTH OF MAJOR KEY IF *GET* ON   #
                                   # MAJOR - 0 IF *GET* ON FULL KEY    #
      XREF ITEM MKT         I;     # KEY TYPE FOR GET ON MAJOR KEY     #
      XREF ITEM MXTRNLG     I;     # MAX TRANSMISSION SIZE IN CHARS    #
      XREF ITEM NEWDATA     B;     # TRUE IF NEW DATA NEEDED           #
      XREF ITEM NEXTON      B;     # FIGSUB2 NEXT FLAG                 #
      XREF ITEM ONALTERKEY  B;     # UPDATE ALT KEY FLAG               #
      XREF ITEM QUIWLGW     I;     # WHOLE WORDS CONTAINING MXTRNLNG   #
      XREF ITEM RA0         I;
      XREF ITEM RECDORD     I;     # RECORD ORDINAL USED BY THIS XMISSN#
      XREF ITEM TARGETAREA  I;     # PTR TO AREA TO BE UPDATED         #
      XREF ITEM TIMES       I;     # UPPER BOUND SET BY FIGSUB2        #
      XREF ITEM USECONVERT  B;     # CONVERT CALLED FROM USINGEX       #
      XREF ITEM OPROCESSED  B;     # -O-  PARAMETER FLAG               #
      XREF ITEM PROMTYPE I;        # QU PROMPT/POSITION INDICATOR      #
  
                                   # XREF ARRAYS                       #
      XREF ARRAY P S(EESIZE);      # CONVERT PARAMETERS SET BY MOV40   #
        BEGIN 
        END 
      XREF BASED ARRAY QUIWSA;     # XMISSION ARRAY IN HIGH CORE       #
        BEGIN 
        END 
  
                                   #       LOCAL  DECLARATIONS         #
      ITEM ANUMBER           I;    # ENTRY NO. OF CURRENT USING LIST   #
      ITEM BITPOS            I;    # BIT POSITION                      #
      ITEM CHAR           C(1);    # TEMPORARY STORAGE FOR A CHARACTER #
      ITEM CHARCNT           I;    # CHARACTER COUNT OF STORED WORD    #
      ITEM CHARPOS           I;    # CHARACTER POSITION                #
      ITEM CHARPTR           I;    # POINTER TO NEXT INPUT CHARACTER   #
      ITEM CHKING            B;    # TRUE IF CHECKING OVER 14 DIGITS   #
      ITEM CURTABLE          I;    # ADDR OF CURRENT ATTRIBTABLE ENTRY #
      ITEM DIGITCT           I;    # COUNT OF DIGITS                   #
      ITEM ERRCODE           I;    # NUMBER OF DIAG TO BE PRINTED      #
      ITEM FIGSUBF           B;    # TRUE IF COPYATT BUT NOT FIGSUB    #
      ITEM FINIS             B;    # FINISH FLAG                       #
      ITEM FLDLNG            I;    # LENGTH OF FIELD                   #
      ITEM FOUNDKEY          B;    # TRUE IF AREA ITEM KEY             #
      ITEM K                 I;    # SCRATCH VARIABLE                  #
      ITEM LOOPER            I;    # LOOP VARIABLE                     #
      ITEM MULTI$KEYS        B;    # INDICATES MULTI SEARCH KEYS (IMF) #
      ITEM NCHBUF            I;    # NUMBER OF CHARACTERS READ         #
      ITEM PICSIZE           I;    # PICTURE SIZE INCLUDING INSERTS    #
      ITEM RC                I;    # RETURN CODE                       #
      ITEM STEPPER           I;    # LOOP VARIABLE                     #
      ITEM USINGWSALEN       I;    # LENGTH OF WSA - 1                 #
      ITEM WORDCNT           I;    # WORD INDEX INTO STORED ARRAY      #
      ITEM WORDPOS           I;    # ADDRESS OF WORD                   #
      ITEM WORDPTR           I;    # POINTER TO WORD OF INPUT          #
  
                                   #    BASED ARRAYS                   #
      BASED ARRAY ANYTABLE S(1);   # USED FOR ALTERNATE KEYS           #
        BEGIN 
        ITEM ANYWD      I(0,0,60);
        END 
      BASED ARRAY ATTRIBTABLE S(EESIZE);  # USING/SETTING TABLE        #
        BEGIN 
        ITEM ATTRIB  I(00,00,60);  # FULL WORD ENTRY                   #
        ITEM ATTRIB2 I(01,00,60);  # FULL WORD ENTRY                   #
        ITEM ATTRIB3 I(02,00,60);  # FULL WORD ENTRY                   #
        END 
      BASED ARRAY LINE  S(1);      # CARD IMAGE IN ERROR               #
        BEGIN 
        ITEM CARRCTL    C(0,0,1);  # CARRIAGE CONTROL CHARACTER        #
        END 
      BASED ARRAY USINGWSA [0:0] P(1);  # LOCAL VERSION OF QUIWSA      #
        BEGIN 
        ITEM CHSTRING   C(0,0,10);
        ITEM CHEND      C(0,0,04);
        END 
  
                                   #      LOCAL ARRAYS                 #
      ARRAY CK$ATTRIB  S(2);       # ATTRIBUTE TABLE FOR CONVERT KEY   #
        BEGIN 
        ITEM ATTRCLS    U(0,12, 6);  # CLASS                           #
        ITEM ATTRWP     U(0,18,18);  # WORD POSITION                   #
        ITEM ATTRBP     U(0,36, 6);  # BIT POSITION                    #
        ITEM ATTRSIZE   U(0,42,18);  # USESIZE OF ITEM                 #
        ITEM ATTDPTLC   U(1,21, 6);  # CHAR POS OF DECIMAL POINT       #
        END 
  
      ARRAY CVTPARAM S(3);           # CONVERT PARAMETERS              #
        BEGIN 
        ITEM ATYPE       U(0, 0, 3);  # ENTRY TYPE WHERE               #
                                      # 1=MOVE, 2=CONVERT, 3=EVALUATE  #
        ITEM ATOCHAR     U(0, 8, 4);  # *TO* ITEM CHAR POS             #
        ITEM ACHARLG     U(0,12,12);  # NUMBER OF CHARS                #
        ITEM AFROMADDR   U(0,24,18);  # FROM ITEM REL WORD POS         #
        ITEM ATOADDR     U(0,42,18);  # TO ITEM REL WORD POS           #
        ITEM CONVERTCODE U(1, 0, 6);  # CONVERT CODE                   #
        ITEM ASUBTBL     U(1, 6,18);  # SUBSCRIPT TABLE PTR            #
        ITEM STACKADDR   U(1, 6,18);  # SUBSCRIPT TABLE PTR            #
        ITEM AAFROMADDR  U(1,24,18);  # FROM ITEM PTR TO BASE          #
        ITEM AATOADDR    U(1,42,18);  # TO ITEM PTR TO BASE            #
        ITEM AAKEY       B(2, 0, 1);  # KEY FLAG                       #
        ITEM AKEYEXC     B(2, 1, 1);  # KEY EXCLUDED FLAG              #
        ITEM AALTKEY     B(2, 2, 1);  # ALTERNATE KEY FLAG             #
        ITEM APRMAJKEY   B(2, 4, 1);  # PRIMARY MAJOR KEY              #
        ITEM AALTMAJKEY  B(2, 5, 1);  # ALTERNATE MAJOR KEY            #
        ITEM AATTRIB     U(2, 6,18);  # ATTRIBUTE LENGTH               #
        ITEM ATOLNG      U(2,12,12);  # RECEIVING FIELD LENGTH         #
        ITEM AUSING      B(2,24, 1);  # INDICATE ITEM IS USING ENTRY   #
        ITEM ARECDORD    U(2,27,12);  # RECORD ORDINAL                 #
        ITEM AITEMORD    U(2,39,15);  # ITEM ORDINAL                   #
        ITEM C1          U(0, 0,60);  # FIRST FULL WORD                #
        ITEM C2          U(1, 0,60);  # SECOND FULL WORD               #
        ITEM C3          U(2, 0,60);  # THIRD FULL WORD                #
        END 
  
      ARRAY DD[0:6];
        BEGIN 
        ITEM DDEWPOS     U(0,18,18);
        ITEM DDBITPOS    U(0,36, 6);
        ITEM DDW         U(0, 0,60);
        END 
  
      ARRAY STORED [0:25];         # INPUT STORED                      #
        BEGIN 
        ITEM CHSTORE      C(0, 0,10); 
        END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C H A R W D                                                      #
#                                                                      #
#       PROCEDURE TO CALCULATE BIT AND WORD POSITION FOR (ALL)         #
#       CALLED BY CVT AND SKIP                                         #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CHARWD;
      BEGIN 
      IF TIMES NQ 1                # IF NOT SUBSCRIPTED OR LAST SUB    #
      THEN
        BEGIN 
        CHARPOS = CHARPOS + FLDLNG * 6;  # NEXT CHARACTER POSITION     #
        WORDPOS = CHARPOS / 60;          # NEXT WORD POSITION          #
        BITPOS = CHARPOS - WORDPOS * 60; # NEXT BIT POSITION           #
        ATOCHAR[0] = BITPOS / 6;         # LOCATION OF NEXT CHAR       #
  
        IF ATOADDR[0] EQ LOC(DD)   # IF ATTRIBUTE TABLE                #
        THEN
          BEGIN 
          P<DESATT1> = LOC(DD); 
          DDEWPOS[1] = WORDPOS;    # WORD POSITION TO ATTR TABLE       #
          DDBITPOS[1] = BITPOS;    # BIT POSITION TO ATTR TABLE        #
          END 
        ELSE
          BEGIN 
          ATOADDR[0] = WORDPOS; 
          END 
  
        TIMES = TIMES - 1;         # SET FOR NEXT SUBSCRIPT            #
        END 
  
      ELSE
        BEGIN 
        IF NEXTON                  # IF FIG SUB *NEXT*                 #
        THEN
          BEGIN 
          CONVERT (P, RC);
          END 
  
        COPYATT;                   # GET NEXT ENTRY                    #
        END 
  
      RETURN; 
      END                          # END PROC CHARWD                   #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C O N V K E Y                                                    #
#                                                                      #
#     THIS PROCEDURE SETS UP THE ATTRIBUTE ENTRIES AND CALLS CONVERT   #
#     THIS PROC SHOULD NOT BE CALLED IF IMFDBM TRUE                    #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CONVKEY; 
      BEGIN 
      IF APRMAJKEY[0]              # IF PRIMARY MAJOR KEY              #
      THEN
        BEGIN 
        P<DESATT1> = ATOADDR[0];   # POSITION TO ITS ATTRIBUTE TABLE   #
        MKL = DECLSLG[0];          # AND PICK UP ITS MAJOR KEY LENGTH  #
        MKT = DECLASS[0];          # PICK UP MAJOR KEY TYPE            #
        END 
      ELSE                         # IF NOT A MAJOR KEY                #
        BEGIN 
        MKL = 0;                   # SET MAJOR KEY LENGTH TO 0         #
        MKT = 0;                   # SET MAJOR KEY TYPE TO 0           #
        END 
  
      ATOADDR[0] = P<AREA$TABLE> + AT$CURRKEY[0]; 
      AATOADDR[0] = 0;
      IF KT$TYPE[RECDORD] LQ 7     # ATTRIBUTE POINTER IS NEEDED       #
      THEN                         # EXCEPT FOR LOGICAL KEY            #
        BEGIN 
        ATOADDR[0] = LOC(CK$ATTRIB) - 1;
        ATTRWP[0] = AT$CURRKEY[0] + P<AREA$TABLE>;
        ATTRBP[0] = 0;
        IF APRMAJKEY[0]            # IF MAJOR KEY                      #
        THEN
          BEGIN 
          ATTRCLS[0] = DECLASS[0]; # SET OTHER VALUES FROM ATTRIB TABLE#
          ATTRSIZE[0] = DECLSLG[0]; 
          ATTDPTLC[0] = DPTLOC[0];
          END 
        ELSE                       # IF FULL KEY                       #
          BEGIN 
          ATTRCLS[0] = KT$TYPE[RECDORD];  # GET VALUES FROM KEY TABLE  #
          ATTRSIZE[0] = KT$LENGTH[RECDORD]; 
          ATTDPTLC[0] = KT$DPTLOC[RECDORD]; 
          END 
        END 
  
      FOUNDKEY = TRUE;
      CONVERT (CVTPARAM, RC); 
      RCTEST; 
  
      RETURN; 
      END                          # END PROC CONVKEY                  #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C O P Y A T T                                                    #
#                                                                      #
#         THIS PROCEDURE COPIES AN ENTRY FROM THE USETABLE TO THE      #
#         LOCAL ARRAY ATTRIB                                           #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC COPYATT; 
      BEGIN 
      FIGSUBF = FALSE;             # ASSUME CVT MUST NOT CALL FIGSUBX  #
      MULTI$KEYS = FALSE;          # ASSUME SINGLE SEARCH KEY          #
      P<ATTRIBTABLE> = P<ATTRIBTABLE> + EESIZE; 
      ANUMBER = ANUMBER + 1;       # INCREMENT USING LIST ENTRY        #
  
                                   # POSN TO NEXT BLOCK OF TABLE       #
      IF P<ATTRIBTABLE> GQ CURTABLE + 30   # IF NECESSARY              #
        AND ATTRIB[0] NQ 0
      THEN
        BEGIN 
        CURTABLE = ATTRIB[0]; 
        P<ATTRIBTABLE> = CURTABLE;
        END 
  
      IF ATTRIB[0] NQ 0            # IF ANOTHER ENTRY EXPECTED         #
      THEN
        BEGIN 
                                   # MOVE CURRENT USING/SETTING ENTRY  #
        C1[0] = ATTRIB[0];         # INTO CONVERT PARAMETER TABLE      #
        C2[0] = ATTRIB2[0]; 
        C3[0] = ATTRIB3[0]; 
        NEXTON = FALSE; 
        TIMES = 1;
  
        IF IMFDBM                  # IF IN IMF DATABASE MODE           #
        THEN
          BEGIN 
          IF AUSING[0]             # IF ITEM IS A USING ENTRY          #
          THEN
            BEGIN 
            USIPTR = P<ATTRIBTABLE>;  # STORE TABL ADDR TO FLAG *USING*#
  
            P<ATTRIBTABLE> = USIPTR + EESIZE;  # LOOK AT NEXT ENTRY   # 
            C3[0] = ATTRIB3[0]; 
  
            IF AUSING[0]           # IF THIS IS A *USING* ITEM         #
            THEN
              BEGIN 
              MULTI$KEYS = TRUE;   # INDICATE MULTIPLE SEARCH KEYS     #
              END 
  
            P<ATTRIBTABLE> = USIPTR;  # RESTORE POINTER                #
            C3[0] = ATTRIB3[0];    # RESTORE THIRD WORD OF TABLE       #
            END 
  
          ELSE
            BEGIN 
            USIPTR = 0;            # SET AS SETTING ENTRY              #
            END 
          END                      # END IF IMF MODE                   #
  
        ELSE                       # IF CRM OR CDCS MODE               #
          BEGIN 
          IF ATYPE[0] NQ 2         # IF NOT CONVERT                    #
            AND NOT GETKEY         # IF RECORD IN CORE                 #
          THEN
            BEGIN 
            FIGSUBF = TRUE;        # CONVERT SHOULD CALL FIGSUB        #
            END 
          END                      # END CRM OR CDCS MODE              #
        END                        # END IF ANOTHER ENTRY EXPECTED     #
  
      RETURN; 
      END                          # END PROC COPYATT                  #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C V T                                                            #
#                                                                      #
#     THIS PROCEDURE ANALYZES INPUT FOR KEYS AND DETERMINES IF CONVERT #
#     IS NEEDED.  GOTO EXIT IS USED TO AVOID EXCESSIVE NESTING         #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CVT; 
      BEGIN 
      IF BASCUSING[BASTABIND]      # IF KEY IS IN *USING* CLAUSE       #
        AND BASCODE[BASTABIND] GR STORCODE  # STORE SETTING, MODIFY    #
                                            # USING, OR REMOVE USING   #
      THEN
        BEGIN 
        IF (GETKEY                 # IF TO CONVERT KEY AND THIS IS     #
          AND USIPTR NQ P<ATTRIBTABLE>)  # NOT THE KEY                 #
          OR (NOT GETKEY                 # OR TO CONVERT SETTING LIST  #
          AND USIPTR EQ P<ATTRIBTABLE>)  # AND THIS IS THE USING LIST  #
        THEN
          BEGIN 
          GOTO SETNEW;             # SKIP TO NEXT ENTRY                #
          END 
        END 
  
      IF CHKING                    # IF INTEGER OF 15 OR MORE DIGITS   #
        AND DIGITCT GQ 15 
      THEN
        BEGIN 
        ERRCODE = 26; 
        GOTO EXIT;
        END 
  
      IF ATTRIB[0] EQ 0            # PREMATURE END OF TABLE            #
      THEN
        BEGIN 
        ERRCODE = 809;
        GOTO EXIT;
        END 
  
      IF FIGSUBF                   # IF FIGSUB SHOULD BE CALLED        #
      THEN
        BEGIN 
        FIGSUB2 (CVTPARAM, RC); 
        IF RC NQ 0
        THEN
          BEGIN 
          ERRCODE = RC; 
          GOTO EXIT;
          END 
        FLDLNG = AATTRIB[0];
        FIGSUB3 (CVTPARAM, DD, FLDLNG, CHARPOS);
        FIGSUBF = FALSE;           # DO NOT CALL FIGSUBX AGAIN         #
        END 
  
      AFROMADDR[0] = LOC(STORED); 
      IF IMFDBM 
      THEN
        BEGIN 
        AAFROMADDR[0] = 0;         # CLEAR OLD FROM ADDR               #
        END 
      ACHARLG[0] = WORDCNT * 10 + CHARCNT;
  
      IF GETKEY                    # IF TO SAVE ONLY KEY               #
      THEN
        BEGIN 
                                   # NOTE THAT IMF SHOULD NEVER HAVE   #
                                   # ONALTERKEY SET.  IF THIS SHOULD   #
                                   # EVER CHANGE, THIS PORTION OF      #
                                   # CODE SHOULD BE CHANGED SINCE      #
                                   # IT WORKS WITH FIELDS SET BY       #
                                   # THE AREA$TABLE POINTER            #
        IF ONALTERKEY              # IF RETRIEVAL ON ALTERNATE KEY     #
        THEN
          BEGIN 
          IF NOT(AALTKEY[0]        # IF NEITHER ALTERNATE KEY          #
            OR AALTMAJKEY[0])      # NOR ALTERNATE MAJOR KEY           #
          THEN
            BEGIN 
            GOTO SETNEW;
            END 
  
          P<DESATT1> = ATOADDR[0];
          AKLNGTH = DECLSLG[0]; 
          AKTYPE = DECLASS[0];     # SET KEY TYPE FROM ATTRIB TABLE    #
          IF AALTMAJKEY[0]         # IF ALTERNATE MAJOR KEY            #
          THEN
            BEGIN 
            MKL = AKLNGTH;         # SET MAJOR KEY LENGTH              #
            AKLNGTH = ATOLNG[0];   # SAVE FULL KEY LENGTH              #
            MKT = AKTYPE;          # SET MAJOR KEY TYPE                #
            ATTRCLS[0] = DECLASS[0];  # SET TYPE FROM ATTRIB TABLE     #
            END 
          ELSE                     # IF NOT A MAJOR KEY                #
            BEGIN 
            MKL = 0;               # SET MAJOR KEY LENGTH TO 0         #
            MKT = 0;               # SET MAJOR KEY TYPE TO 0           #
            END 
          AKWOPOS = DEWPOS[0];
          AKITORD = AITEMORD[0];
          AKCHPOS = ATOCHAR[0]; 
          CHARCNT = (AKLNGTH + AKCHPOS) / 10 + 1; 
  
          IF ALKEYLOC EQ 0
          THEN
            BEGIN 
            ALKEYLOC = CMM$ALF(CHARCNT, 0, 0);
            END 
          P<ANYTABLE> = ALKEYLOC; 
          DEWPOS[0] = ALKEYLOC; 
          DBITPOS[0] = 0; 
          AATOADDR[0] = 0;         # NO BASE ADDRESS FOR CONVERT       #
          ATOCHAR[0] = 0; 
  
          IF CONVERTCODE[0] EQ 1   # PRESET ALTERNATE KEY AREA         #
          THEN
            BEGIN 
            FOR K = 0 STEP 1       # FOR EVERY CHAR OF ALTERNATE KEY   #
              UNTIL CHARCNT - 1 
            DO
              BEGIN 
              ANYWD[K] = "          ";
              END 
            END 
  
          ELSE
            BEGIN 
            ANYWD[0] = 0;          # INTEGER                           #
            END 
  
          CONVERT (CVTPARAM, RC); 
          FOUNDKEY = TRUE;
          DEWPOS[0] = AKWOPOS;
          DBITPOS[0] = AKCHPOS * 6; 
          RCTEST;                  # CHECK RETURN FROM CONVERT         #
          IF ERRCODE LQ 0 
          THEN
            BEGIN 
            ERRCODE=88888;         # SET FOR KEY EXIT                  #
            END 
          GOTO EXIT;
          END                      # END ONALTERKEY                    #
  
        ELSE                       # IF RETRIEVAL BY PRIMARY KEY       #
          BEGIN 
          IF NOT (AAKEY[0]         # IF NEITHER PRIMARY KEY            #
            OR APRMAJKEY[0])       # NOR PRIMARY MAJOR KEY             #
          THEN
            BEGIN 
            GOTO SETNEW;
            END 
  
          IF IMFDBM                # CAN-T CALL CONVKEY FROM IMF MODE  #
          THEN
            BEGIN 
            FOUNDKEY = TRUE;
            CONVERT (CVTPARAM, RC);  # CONVERT IMF KEY                 #
            RCTEST; 
            END 
  
          ELSE                     # IF IN CRM/CDCS MODE               #
            BEGIN 
            CONVKEY;               # CONVERT AND PUT KEY IN KEYLOC     #
            END 
  
          IF ERRCODE LQ 0          # IF ALL OK, TAKE KEY EXIT          #
          THEN
            BEGIN 
                                   # IF MULTI SEARCH KEYS COMPRISE     #
            IF MULTI$KEYS          # THE ACCESS PATH (IMF ONLY)        #
            THEN
              BEGIN 
                                   # ERROR CODE IS LEFT AS IS          #
              GOTO SETNEW;         # POSN TABLE TO THE NEXT KEY        #
              END 
            ELSE                   # IF SINGLE KEY                     #
              BEGIN 
              ERRCODE = 88888;     # SET ERROR CODE TO FORCE IMMED EXIT#
              END 
            END 
          GOTO EXIT;
          END                      # END NOT ONALTERKEY                #
        END                        # END GETKEY                        #
  
      IF AAKEY[0]                  # IF PRIMARY KEY                    #
        OR APRMAJKEY[0]            # OR PRIMARY MAJOR KEY              #
      THEN
        BEGIN 
        FOUNDKEY = TRUE;
        IF AKEYEXC[0] 
        THEN
          BEGIN 
          GOTO SETNEW;
          END 
        END 
  
      IF ONALTERKEY                # IF SEARCH ON ALTERNATE KEY        #
        AND (AALTKEY[0]            # AND THIS IS AN ALTERNATE KEY      #
          OR AALTMAJKEY[0])        # OR ALTERNATE MAJOR KEY            #
      THEN
        BEGIN 
        FOUNDKEY = TRUE;
        END 
  
      CONVERT (CVTPARAM, RC);      # CONVERT THIS ENTRY                #
      RCTEST;                      # TEST RETURN CODE                  #
SETNEW: 
      CHARCNT = 0;
      WORDCNT = 0;
      CHARWD; 
  
  
EXIT: 
      RETURN; 
      END                          # END PROC CVT                      #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     F R O M E R R                                                    #
#                                                                      #
#     THE LAST CARD IMAGE READ FROM THE *FROM* FILE HAD AN ERROR       #
#     COPY IT TO THE OUTPUT FILE                                       #
#     EXIT FRC = 0 TO CONTINUE PROCESSING DIRECTIVE                    #
#          FRC = 1  FOR USER REQUESTED TERMINATION                     #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC FROMERR;
      PROC FROMERR (FRC); 
      BEGIN 
      ITEM FRC     I;              # RETURN CODE                       #
                                   # ALLOCATE ENOUGH WORDS TO HOLD     #
                                   # CARD IMAGE PLUS ONE CHARACTER     #
      P<LINE> = CMM$ALF (NCHBUF / 10 + 1, 0, 0);
      CARRCTL[0] = " ";            # INSERT CARRIAGE CONTROL           #
                                   # COPY LINE TO BE WRITTEN           #
      CMOVE (USINGWSA, 0, NCHBUF, LINE, 1); 
      LINES = LINES + 1;           # LEAVE ROOM FOR DIAGNOSTIC         #
      WRITEBL (LINE, NCHBUF + 1, FRC); # WRITE CARD IMAGE CAUSING ERROR#
      CMM$FRF (P<LINE>);               # FREE BUFFER SPACE             #
  
      RETURN; 
      END                          # END PROC FROMERR                  #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     I N C S A V E                                                    #
#                                                                      #
#     THIS PROCEDURE CHECKS THAT THE NEXT CHARACTER OF *USING* INPUT   #
#     (POINTED TO BY *CHARPTR* AND *WORDPTR*) IS WITHIN THE LENGTH     #
#     OF THE INPUT RECORD.  IF IT IS NOT *ERRCODE* IS SET TO ZERO AND  #
#     NO FURTHER PROCESSING IS PERFORMED.  IF THE CHARACTER IS PART    #
#     OF THE INPUT RECORD, IT IS MOVED TO *CHAR* AND *CHARPTR* AND     #
#     *WORDPTR* ARE INCREMENTED TO POINT TO THE NEXT CHARACTER TO BE   #
#     CHECKED.                                                         #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC INCSAVE; 
      BEGIN 
      IF (WORDPTR * 10 + CHARPTR) GQ NCHBUF  # IF NOT PART OF THIS REC #
      THEN
        BEGIN 
        CHAR = " ";                # EOL SO GIVE TRAILING BLANK        #
        ERRCODE = 0;               # CODE FOR END OF INPUT RECORD      #
        END 
  
      ELSE
        BEGIN 
        CHAR = C<CHARPTR, 1>CHSTRING[WORDPTR];  # SAVE THIS CHARACTER  #
        CHARPTR = CHARPTR + 1;     # POINT TO NEXT CHARACTER           #
        IF CHARPTR GR 9            # IF NEXT CHARACTER NOT IN THIS WORD#
        THEN
          BEGIN 
          CHARPTR = 0;             # SET FOR FIRST POSITION OF         #
          WORDPTR = WORDPTR + 1;   # NEXT WORD                         #
          END 
        END 
  
      RETURN; 
      END                          # END PROC INCSAVE                  #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     I T M S I Z E                                                    #
#                                                                      #
#  THIS PROCEDURE PROCESSES ALL INPUT WHEN ITEMSIZE IS IN EFFECT       #
#  THE NUMBER OF CHARACTERS DEFINED FOR A FIELD IS MOVED TO THE FIELD  #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC ITMSIZE; 
      BEGIN 
      INCSAVE;                     # GET FIRST CHARACTER               #
      FOR LOOPER = LOOPER          # PROCESS ALL INPUT                 #
        WHILE ATTRIB[0] NQ 0
      DO
        BEGIN 
        IF CONVERTCODE[0] EQ 1     # NON-NUMERIC ITEMS                 #
          OR CONVERTCODE[0] EQ 8
        THEN
          BEGIN 
          CHKING = FALSE;          # NO DIGIT CHECKING                 #
          END 
        ELSE
          BEGIN 
          CHKING = TRUE;           # CHECK WHEN NUMERIC                #
          DIGITCT = 0;             # INITIALIZE COUNT OF DIGITS        #
          END 
  
        P<DESATT1> = ATOADDR[0];
        PICSIZE = DPICSIZ[0] - 1;  # LOOP LIMIT                        #
        FOR STEPPER = 0 STEP 1
          UNTIL PICSIZE 
        DO
          BEGIN 
          STORIT;                  # STORE ONE CHARACTER               #
          IF ERRCODE GR 0          # IF ERROR ON STORE                 #
          THEN
            BEGIN 
            RETURN;                # EXIT *ITMSIZE*                    #
            END 
  
          INCSAVE;                 # AND GET ANOTHER                   #
          END 
  
        CVT;                       # STORE FIELD AND GET NEXT ENTRY    #
        IF ERRCODE GQ 0            # IF ERROR ON CONVERT OR END OF INP #
        THEN
          BEGIN 
          RETURN;                  # EXIT *ITMSIZE*                    #
          END 
        END                        # END LOOPER LOOP                   #
  
      ERRCODE = 0;                 # SUCCESSFUL READ OF INPUT RECORD   #
      RETURN; 
      END                          # END ITMSIZE                       #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     N U M B E R S                                                    #
#                                                                      #
#     THIS PROCEDURE GATHERS ALL THE NUMBERS FOR ONE FIELD             #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC NUMBERS; 
      BEGIN 
                                   # FIRST SEE IF CONVERTCODE VALID    #
      IF CONVERTCODE[0] EQ 1       # CHAR TYPES NOT ALLOWED            #
        OR CONVERTCODE[0] EQ 8
      THEN
        BEGIN 
        ERRCODE = 814;
        RETURN; 
        END 
  
      FINIS = FALSE;
      CHKING = TRUE;               # COUNT DIGITS                      #
      DIGITCT = 0;
  
      FOR STEPPER = STEPPER        # LOOP THROUGH INPUT                #
        WHILE NOT FINIS 
      DO
        BEGIN 
        STORIT;                    # STORE CURRENT DIGIT               #
        IF ERRCODE GR 0            # IF ERROR ON STORE                 #
        THEN
          BEGIN 
          FINIS = TRUE; 
          TEST STEPPER;            # EXIT *NUMBERS*                    #
          END 
  
        INCSAVE;                   # GET NEXT ONE                      #
  
        IF ERRCODE EQ 0            # SEE IF END OF FIELD               #
          OR CHAR EQ " "
          OR CHAR EQ ","
        THEN
          BEGIN 
          FINIS = TRUE; 
          CVT;                     # PROCESS FIELD AND GET NEXTENTRY   #
          END 
        END                        # END STEPPER LOOP                  #
  
      RETURN; 
      END                          # END PROC NUMBERS                  #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     R C T E S T                                                      #
#                                                                      #
#     THIS PROCEDURE TESTS THE RETURN CODE FROM PROC CONVERT.          #
#     IF A ROUNDING ERROR IS FOUND THE DIAGNOSTIC IS ISSUED IMMEDIATELY#
#     AND PROCESSING CONTINUES. FOR OTHER ERRORS, ERRCODE IS SET.      #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC RCTEST;
      BEGIN 
      IF RC EQ 360                 # ROUNDING ERROR                    #
      THEN
        BEGIN 
        RC = 0;                    # CLEAR ERROR TO CONTINUE PROCESSING#
        DIAG(360);                 # WRITE THE DIAGNOSTIC              #
        END 
  
      IF RC NQ 0
      THEN
        BEGIN 
        IF RC EQ 51                # CURWORD AND NEXTWORD REQUIRED     #
        THEN
          BEGIN 
          ERRCODE = 808;           # USE THIS DIAGNOSTIC INSTEAD       #
          END 
        ELSE
          BEGIN 
          ERRCODE = RC;            # USE DIAGNOSTIC SET BY CONVERT     #
          END 
        END 
  
      RETURN; 
      END                          # END PROC RCTEST                   #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E P S T E P                                                    #
#                                                                      #
#     A SEPARATOR WAS RECOGNIZED WHICH INDICATES A LITERAL IS          #
#     TO BE STORED.  IF TWO CONSECUTIVE SEPARATORS ARE FOUND,          #
#     ONE OF THEM IS STORED IN THE WORD, OTHERWISE ALL CHARACTERS      #
#     ARE STORED UNTIL A SINGLE SEPARATOR IS FOUND.                    #
#     UPON EXIT, THE NEXT CHARACTER TO BE PROCESSED IS IN *CHAR*       #
#     AND *NEXTENTRY* IS SET.                                          #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC SEPSTEP; 
      BEGIN 
      FINIS = FALSE;
      CHKING = FALSE;              # NO DIGIT COUNT NEEDED             #
      FOR STEPPER = STEPPER        # LOOP THRU ALL CHARS FOR           #
        WHILE NOT FINIS            # ONE FIELD                         #
      DO
        BEGIN 
        INCSAVE;                   # GET NEXT CHARACTER                #
        IF ERRCODE EQ 0            # INPUT SHOULD NOT END WITHOUT      #
        THEN                       # A SEPARATOR                       #
          BEGIN 
          FINIS = TRUE; 
          ERRCODE = 811;
          TEST STEPPER; 
          END 
  
        IF CHAR NQ SEPARATOR
        THEN
          BEGIN 
          STORIT;                  # STORE CHARACTER                   #
          IF ERRCODE GR 0          # IF ERROR ON STORE                 #
          THEN
            BEGIN 
            FINIS = TRUE;          # EXIT *SEPSTEP*                    #
            END 
          TEST STEPPER;            # GO BACK AND DO IT AGAIN           #
          END 
                                   # A SEPARATOR IS FOUND - MUST DO    #
                                   # A LOOK AHEAD AND SEE IF THERE IS  #
                                   # ANOTHER ONE OR WHETHER THIS IS    #
                                   # THE END OF THE FIELD              #
        INCSAVE;                   # GET NEXT CHARACTER                #
        IF CHAR EQ SEPARATOR       #  SEP FOLLOWING SEP                #
        THEN
          BEGIN 
          STORIT;                  # STORE ONE OF THEM                 #
          IF ERRCODE GR 0          # IF ERROR ON STORE                 #
          THEN
            BEGIN 
            FINIS = TRUE;          # EXIT *SEPSTEP*                    #
            END 
          TEST STEPPER;            # GO BACK AND GET NEW CHAR          #
          END                      # END CHAR EQ SEP                   #
  
                                   # A NEW NON-SEP ITEM FOUND          #
                                   # FINISH UP THIS FIELD              #
        FINIS = TRUE; 
        IF CHARCNT EQ 0            # WAS IT A NULL SCAN                #
          AND WORDCNT EQ 0
        THEN
          BEGIN 
          IF ERRCODE LS 0          # IF NOT END OF INPUT               #
          THEN
            BEGIN 
            SKIP;                  # SET UP FOR NEXT ENTRY             #
            END 
          TEST STEPPER;            # AND EXIT LOOP                     #
          END 
  
        ELSE                       # IF NOT A NULL SCAN                #
          BEGIN                    # NUMERIC ITEM NOT ALLOWED          #
          IF CONVERTCODE[0] NQ 1   # BETWEEN SEPARATORS                #
            AND CONVERTCODE[0] NQ 8 
          THEN
            BEGIN 
            ERRCODE = 813;
            FINIS = TRUE; 
            TEST STEPPER;          # EXIT *SEPSTEP*                    #
            END 
  
          CVT;                     # EVERYTHING IS OK.  CVT PROCESSES  #
                                   # FIELD AND GETS NEXT ENTRY         #
          END                      # END NOT A NULL SCAN               #
        END                        # END STEPPER LOOP                  #
  
      RETURN; 
      END                          # END SEPSTEP                       #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S K I P                                                          #
#                                                                      #
#     THIS PROCEDURE CHECKS TO SEE IF THERE IS ANOTHER ENTRY IN THE    #
#     USETABLE AND IF SO, CALLS CHARWD TO INCREMENT POSITIONS          #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC SKIP;
      BEGIN 
      IF FIGSUBF                   # IF FIGSUB SHOULD BE CALLED        #
      THEN
        BEGIN 
        FIGSUB2 (CVTPARAM, RC); 
        IF RC NQ 0
        THEN
          BEGIN 
          ERRCODE = RC; 
          RETURN; 
          END 
  
        FLDLNG = AATTRIB[0];
        FIGSUB3 (CVTPARAM, DD, FLDLNG, CHARPOS);
        FIGSUBF = FALSE;           # DO NOT CALL FIGSUBX AGAIN         #
        END 
  
      IF ATTRIB[0] EQ 0 
      THEN
        BEGIN 
        ERRCODE = 809;
        END 
      ELSE
        BEGIN 
        CHARWD;                    # INCREMENT PTRS                    #
        END 
  
      RETURN; 
      END                          # END PROC SKIP                     #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S T O R I T                                                      #
#                                                                      #
#     THIS PROCEDURE STORES THE TEMPORARY *CHAR* IN *CHSTRING*         #
#     IF *CHKING* IS IN EFFECT, THE CHARACTER IS ANALYZED AND          #
#     *DIGITCT* IS SET.                                                #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC STORIT;
      BEGIN 
      IF WORDCNT GQ 25             # TOO MUCH INPUT                    #
        AND CHARCNT GQ 6
      THEN
        BEGIN 
        ERRCODE = 810;
        RETURN; 
        END 
  
      C<CHARCNT,1>CHSTORE[WORDCNT] = CHAR;  # STORE CHAR IN STRING     #
      CHARCNT = CHARCNT + 1;
      IF CHARCNT GR 9              # AT END OF WORD                    #
      THEN
        BEGIN 
        CHARCNT = 0;
        WORDCNT = WORDCNT + 1;
        END 
  
      IF CHKING                    # IF TO CHECK FOR MORE THAN 15      #
      THEN                         # DIGITS                            #
        BEGIN 
        IF DIGITCT EQ 0            # IF LOOKING AT FIRST CHAR          #
        THEN                       # OR FIRST AFTER SIGN               #
          BEGIN 
          IF CHAR NQ "+"           # IF FIRST CHAR NOT SIGN            #
            AND CHAR NQ "-"        # OR BLANK                          #
            AND CHAR NQ " "        # BLANK POSSIBLE ON SEP ITEMSIZE    #
          THEN
            BEGIN 
            IF CHAR GQ "0"         # IF NUMERIC                        #
              AND CHAR LQ "9" 
            THEN
              BEGIN 
              DIGITCT = 1;         # ADVANCE DIGITCT                   #
              END 
            ELSE
              BEGIN 
              CHKING = FALSE;      # NO CHECKING ON NON-NUMERICS       #
              END 
            END 
          END                      # END IF FIRST CHAR                 #
  
        ELSE
          BEGIN                    # NOT FIRST CHAR                    #
          IF CHAR GQ "0"           # TEST NUMERIC                      #
            AND CHAR LQ "9" 
          THEN
            BEGIN 
            DIGITCT = DIGITCT + 1;  # ADVANCE COUNT                    #
            END 
  
          ELSE                     # IF NON-NUMERIC CHAR               #
            BEGIN 
            IF CHAR NQ " "         # IF NOT BLANK (I.E. AT END WHEN    #
                                   # ITEMSIZE IN EFFECT)               #
            THEN
              BEGIN 
              CHKING = FALSE;      # SET FOR NO CHECKING               #
              END                  # END CHAR NQ SPACE                 #
            END                    # END CHAR NOT NUMERIC              #
          END                      # END NOT FIRST CHAR                #
        END                        # END CHKING                        #
  
      RETURN; 
      END                          # END PROC STORIT                   #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#                       MAIN BODY OF PROC USINGEX                      #
#                                                                      #
#----------------------------------------------------------------------#
  
  
                                   # INITIALIZE                        #
      USECONVERT = TRUE;           # CONVERT SHOULD CHECK FOR SEPARATOR#
                                   # ITEM-SIZE TO SCALE FIELDS         #
      P<BASICTABLE> = BASCPTR;
      ANUMBER = 0;
      CURTABLE = BASCADDR[BASTABIND]; 
      P<ATTRIBTABLE> = CURTABLE - EESIZE;  # COPYATT INCREMENTS PTR    #
  
      IF NOT IMFDBM                # IMF DOES NOT HAVE AREATABLE       #
      THEN
        BEGIN 
        P<AREA$TABLE> = TARGETAREA;  # AREA TO BE UPDATED IF CRM/CDCS  #
        P<KEY$TBL> = AT$PKEYDPTR;    # POSITION TO KEY DESC TABLE      #
        END 
  
      COPYATT;                     # COPY USE ENTRY TO CVTPARAM        #
  
      IF BASCTEMP[BASTABIND]
      THEN
        BEGIN 
        FOUNDKEY = TRUE;           # TEMP ITEMS HAVE NO KEY SO         #
                                   # PRETEND IT WAS FOUND              #
        END 
      ELSE
        BEGIN 
        FOUNDKEY = FALSE; 
        END 
      ERRCODE = -1; 
                                   # SET UP FOR INPUT                  #
      IF BASCFROM[BASTABIND]       # IF UPDATE FROM                    #
      THEN
        BEGIN 
        P<FIT> = BASFITFROM[BASTABIND]; 
        P<USINGWSA> = FITWSA;      # USE FILES WSA                     #
        USINGWSALEN = ((FITMRL + 9) / 10) - 1;
        END 
      ELSE
        BEGIN 
        P<USINGWSA> = P<QUIWSA>;   # USE QUIWSA                        #
        USINGWSALEN = QUIWLGW;
        END 
  
*IF -DEF,NOS
      IF FITDV6 EQ O"61"           # IF DEVICE TYPE IS REMOTE TERMINAL #
      THEN
        BEGIN 
        CONCTED = TRUE;            # INDICATE CONNECTED FILE INPUT     #
        END 
      ELSE
        BEGIN 
        CONCTED = FALSE;           # INDICATE NOT CONNECTED FILE INPUT #
        END 
*ENDIF
*IF DEF,NOS 
      IF FITDV6 EQ O"24"           # IF DEVICE TYPE IS REMOTE TERMINAL #
      THEN
        BEGIN 
        CONCTED = TRUE;            # INDICATE CONNECTED FILE INPUT     #
        END 
      ELSE
        BEGIN 
        CONCTED = FALSE;           # INDICATE NOT CONNECTED FILE INPUT #
        END 
*ENDIF
                                   # GET A LINE OF INPUT IF NEEDED     #
      IF GETKEY 
        OR NOT NEWDATA
        OR FOUNDKEY 
      THEN
        BEGIN 
GETDATA:  
        NEWDATA = TRUE; 
        FOR LOOPER = 0 STEP 1      # CLEAR INPUT AREA                  #
          UNTIL USINGWSALEN 
        DO
          BEGIN 
          CHSTRING[LOOPER] = "          ";
          END 
  
        IF BASCFROM[BASTABIND]     # IF READING *FROM* FILE            #
        THEN
          BEGIN 
          IF CONCTED               # IF FILE CONNECTED TO TERMINAL     #
  
            AND NOT OPROCESSED     # AND NO *O* PARAMETER USED         #
          THEN
            BEGIN 
            PROMTYPE = 30;         # INSERT OCTAL 13 AT BIT 30 FOR NOS #
                                   # TO ACCEPT INPUT ON SAME LINE.     #
            WRITE(NEXTDATA,10,RC); # PROMPT USER FOR INPUT             #
            END 
          FINIS = FALSE;
          FOR LOOPER = LOOPER 
            WHILE NOT FINIS 
          DO
            BEGIN 
            GET (FIT, USINGWSA, RA0);     # READ A LINE                #
            IF FITES NQ 0                 # ERROR RETURN               #
            THEN
              BEGIN 
              FINIS = TRUE; 
              DIAG(903, FITES, FITLFNC);  # DIAGNOSE ERROR             #
              FITES = 0;                  # RESET ERROR STATUS         #
              ERRCODE = 99999;            # INDICATE NO MORE PROCESSING#
              END 
  
            ELSE
              BEGIN 
              IF FITFP EQ O"100"   # REACHED EOF/EOI                   #
              THEN
                BEGIN 
                FINIS = TRUE; 
                ERRCODE = 99999;
                END 
  
              ELSE
                BEGIN 
                IF FITFP EQ O"20"  # EOR BOUNDARY MEANS FINISH         #
                THEN
                  BEGIN 
                  FINIS = TRUE; 
                  NCHBUF = FITRL;  # SET BUFFER LENGTH                 #
                  END 
                END                # END FITFP NQ  100                 #
              END                  # END FITES EQ  0                   #
            END                    # END LOOPER LOOP                   #
          END                      # END READING *FROM* FILE           #
  
        ELSE                       # GET TERMINAL INPUT                #
          BEGIN 
          PROMTYPE = 30;           # INSERT OCTAL 13 AT BIT 30 FOR NOS #
          WRITE(NEXTDATA, 10, RC); # PROMPT USER FOR INPUT             #
          READ(USINGWSA, NCHBUF, MXTRNLG, RC);  # READ INPUT           #
          IF RC NQ 0               # ERROR RETURN                      #
          THEN
            BEGIN 
            ERRCODE = 99999;       # INDICATE NO MORE PROCESSING       #
            END 
          END                      # END TERMINAL INPUT                #
        END                        # END GET DATA                      #
  
      IF CHEND[0] EQ "*END"        # IF USER ENDED INPUT               #
      THEN
        BEGIN 
        ERRCODE = 99999;           # CODE FOR END OF INPUT             #
        END 
  
      IF ERRCODE GR 0              # IF ERROR OR EOF/EOI               #
      THEN
        BEGIN 
        GOTO WINDUP;               # EXIT *USINGEX*                    #
        END 
  
      CHARCNT = 0;                 # INITIALIZE ALL THE POINTERS       #
      WORDCNT = 0;
      CHARPTR = 0;
      WORDPTR = 0;
  
      IF ITEMSIZE                  # IF SEP ITEM-SIZE IN EFFECT        #
      THEN
        BEGIN 
        ITMSIZE;                   # PROCESS ALL INPUT DATA            #
        END 
  
      ELSE                         # IF SEP ITEM-SIZE NOT IN EFFECT    #
        BEGIN 
        INCSAVE;                   # GET FIRST CHARACTER               #
  
        FOR LOOPER = LOOPER        # LOOP THRU INPUT                   #
          WHILE ERRCODE LS 0
        DO
          BEGIN 
          IF CHAR EQ " "           # SPACE AND COMMA IGNORED           #
            OR CHAR EQ ","
          THEN
            BEGIN 
            INCSAVE;               # GET ANOTHER CHARACTER             #
            TEST LOOPER;           # GO BACK AND SEE WHAT IT IS        #
            END 
  
          IF CHAR EQ SEPARATOR     # IF NEXT CHARACTER IS SEPARATOR    #
          THEN
            BEGIN 
            SEPSTEP;               # GO PROCESS CHARACTER ITEM         #
            END 
          ELSE
            BEGIN 
            NUMBERS;               # GO PROCESS NUMERIC ITEM           #
            END 
          END                      # END LOOPER LOOP                   #
        END                        # END NOT ITEMSIZE                  #
  
                                   # ALL INPUT PROCESSED               #
                                   # SEE WHAT HAPPENED                 #
WINDUP: 
      USECONVERT = FALSE; 
      CONCTED = FALSE;             # RESET CONNECTED FILE FLAG         #
                                   # TO ACCEPT INPUT ON SAME LINE      #
      IF ERRCODE EQ 0              # ALL OK                            #
      THEN
        BEGIN 
        XRC = 0;
        NEWDATA = FALSE;
  
        IF NOT FOUNDKEY            # CHECK IF KEY NOT FOUND            #
          AND NOT (AT$FITFO EQ FOSQ  # AND NOT UNSORTED SEQUENTIAL     #
            AND NOT AT$SORTSEQ) 
          AND (AT$FITFO NQ FOAK)   # NOR ACTUAL KEY                    #
          AND (BASCODE[BASTABIND] LS STORCODE) # STORE,MODIFY OR REMOVE#
                                             # IS OK - KEY NOT ALWAYS  #
                                             # IN SETTING/USING        #
        THEN
          BEGIN 
          ERRCODE = 817;           # KEY MISSING                       #
          END 
        END                        # END ERRCODE EQ 0                  #
  
      IF ERRCODE GR 0              # IF ACTUAL ERROR                   #
        AND ERRCODE LS 88888
      THEN
        BEGIN 
        NEWDATA = FALSE;
        XRC = 2;
        IF BASCFROM[BASTABIND]     # IF UPDATE FROM                    #
        THEN
          BEGIN 
          FROMERR(RC);             # WRITE LINE IN ERROR               #
          IF RC NQ 0
          THEN
            BEGIN 
            XRC = 1;               # TREAT AS *END OR EOI              #
            END 
          END 
        DIAG(ERRCODE, ANUMBER);    # WRITE ERROR MESSAGE               #
        END 
  
      ELSE
        BEGIN 
        IF ERRCODE EQ 88888        # KEY EXIT                          #
        THEN
          BEGIN 
          XRC = 0;                 # OK NO NEED TO CHECK FOR KEY       #
          END 
  
        ELSE
          BEGIN 
          IF ERRCODE EQ 99999      # *END OR EOI ENCOUNTERED           #
          THEN
            BEGIN 
            XRC = 1;
            END 
          END 
        END 
  
      RETURN; 
      END                          # END USINGEX                       #
      TERM
