*DECK,NRODIS
*CALL COMUSETXT 
PROC NRO$IS;
      BEGIN 
                                                                         ISNRO
     XREF BEGIN                                                          ISNRO
          PROC UNFX$AA ;                                                 ISNRO
          PROC LKEY$AA ;
          PROC MOVC$AA ;                                                 ISNRO
          PROC MOVW$AA ;                                                 ISNRO
          PROC MERR ;                                                    ISNRO
          FUNC QUMP$AA ;                                                 ISNRO
          PROC ADRC$AA ;                                                 ISNRO
          PROC STOV$AA ;                                                 ISNRO
          PROC BACK$AA ;                                                 ISNRO
          PROC STUP$IS ;                                                 ISNRO
          PROC DELL$AA ;                                                 ISNRO
          PROC SEBL$AA ;                                                 ISNRO
          PROC CPCH$AA ;                                                 CREATEM
          PROC NUBL$AA ;                                                 ISNRO
          PROC RCKN$AA ;                                                 ISNRO
          PROC DLT$MP;                                                   JJJ0724
          PROC REPL$MP;                                                  JJJ0916
          PROC PUT$MP;                                                   JJJ0916
          PROC EZKY$IS ;                                                 ISNRO
          PROC STMD$AA ;                                                 ISNRO
          PROC CMRC$AA ;                                                 AFB0528
          PROC LOCR$AA ;                                                 AFB0528
          PROC GOKY$IS ;                                                 ISNRO
          FUNC SIKH$IS ;                                                 ISNRO
          PROC CCAL$AA;      #USED TO CALL WNOW$IS,AWAY$IS,VANB$IS,    # JJJ0923
                             #                              AND SPLT$IS# JJJ0923
          PROC BCK1$AA ;                                                 ISNRO
          FUNC UUCC$AA ;                                                 ISNRO
          PROC ALTR$AA ;                                                 ISNRO
          PROC SLOG$AA ;                                                014500
          PROC TROW$AA ;                                                 ISNRO
          PROC HAWK$AA ;                                                 ISNRO
          PROC STPF$AA ;                                                 AFB1213
          PROC MSGZ$AA;                                                  JJJ1204
          PROC KPTR$IS; 
          PROC VOKM$AA; 
          PROC DUPK$AA ;
          END                                                            ISNRO
                                                                         ISNRO
CONTROL WEAK DLT$MP,PUT$MP,REPL$MP;                                      JJJ0724
                                                                         JJJ0724
     XDEF BEGIN                                                          ISNRO
          PROC PTRP$IS ;                                                 ISNRO
          PROC DLTE$IS ;                                                 ISNRO
          PROC KYSV$IS ;                                                 ISNRO
          PROC DLT$IS;                                                   JJJ0724
          PROC PURE$IS; 
          PROC PUT$IS;
          PROC REPL$IS; 
          END                                                            ISNRO
                                                                         ISNRO
          ITEM IX;           #ITEM USED AS AN INDUCTION VARIABLE#        ISNROMO
          ITEM RNOX;         #SAVE CURRENT RECORD NUMBER# 
PROC DLT$IS;                                                             JJJ0724
 #                                                                       ID0913 
* *   DLT$IS                                     PAGE  1                 JJJ0724
* *   VB GODDARD                                 DATE  76/09/10          ID0913 
* 1DC DLT$IS                                                             JJJ0724
* DC  FUNCTION                                                           ID0913 
*     PROCESS DELETE REQUESTS FOR IS FILES.                              ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*     FIT$AA,FSTT$AA,FIAT$AA,PTRE$AA, AND FINF$AA CONTAIN THE            VBG1005
*     ADDRESSES OF THEIR RESPECTIVE TABLES.                              VBG1005
* DC  EXIT CONDITIONS                                                    ID0913 
*     THE REC HAS BEEN DELETED.                                          JJJ0925
* DC  ERROR CONDITIONS                                                   ID0913 
*     EC445 - RECORD NOT FOUND, DELETE REJECTED.                         ID0913 
*     EC503 - DUPLICATE ALTERNATE KEY.                                   ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*     PURE$IS - TO CHECK REQUEST AND POSITION THE FILE.                  ID0913 
*     DLTE$IS - TO DO THE ACTUAL DELETE.                                 ID0913 
*     DEL$MP  - TO GENERATE MIP FILE UPDATES.                            ID0913 
*     DCMR$AA - TO DECOMPRESS A RECORD.                                  ID0913 
*     MSGZ$AA - TO ISSUE DIAGNOSTIC MESSAGES.                            ID0913 
*     QUMP$AA - TO LOAD MIP CAPSULES.                                    VBG1104
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        JJJ0221
*     QMF IS THE RESULT VARIABLE FOR PURE$IS.                            JJJ0221
*                                                                        JJJ0221
*     (IN FSTT)                                                          ID0913 
*     FSDELCNT - INCREMENTED BY 1.                                       ID0913 
* DC  DESCRIPTION:                                                       ID0913 
*     PURE$IS IS CALLED TO:                                              ID0913 
*         SET ITEMS FOR IS/MIP SUB-PROCS.                                ID0913 
*         DO REQUEST ERROR CHECKING.                                     ID0913 
*         TRANSLATE SYMBOLIC KEYS.                                       ID0913 
*         POSITION THE FILE.                                             ID0913 
*     IF A MIP FILE EXISTS, DEL$MP IS CALLED TO GENERATE MIP FILE        ID0913 
*     UPDATES. BEFORE CALLING, THE RECORD IS DECOMPRESSED INTO THE       ID0913 
*     COMPRESSION BUFFER, IF NECESSARY.                                  ID0913 
*     DLTE$IS IS CALLED TO PERFORM THE ACTUAL DELETE PROCESS.            ID0913 
*     THE FSTT MOD-IN-PROGRESS FLAG IS RESET.                            ID0913 
*     THE FSTT DELETE COUNT IS INCREMENTED BY 1.                         ID0913 
 #                                                                       ID0913 
CONTROL EJECT;                                                           ID0913 
      BEGIN                                                              ID0913 
                                                                         ID0913 
                                                                         ID0913 
      PURE$IS;               #PRELIMINARIES TO ACTUAL PUT#               ID0913 
      IF QMF[0] EQ 0         #ERROR IF KEY NOT FOUND#                    ID0913 
      THEN                                                               ID0913 
          BEGIN                                                          ID0913 
          MSGZ$AA(EC445);                                                ID0913 
          RETURN;                                                        ID0913 
          END                                                            ID0913 
      RNOX=RNO[0];           #SAVE CURRENT RECORD NUMBER#                ID0913 
      IF QUMP$AA(1) NQ 0     #UPDATE MIP FILE IF IT EXISTS#              VBG1104
      THEN                                                               ID0913 
          BEGIN                                                          ID0913 
          DLT$MP;                                                        JJJ0724
          END                                                            ID0913 
      RNO[0]=RNOX;           #RESTORE CURRENT NUMBER#                    ID0913 
      DLTE$IS;                                                           ID0913 
      FSDELCNT[0]=FSDELCNT[0]+1;                                         ID0913 
      RETURN;                                                            ID0913 
      END                                                                ID0913 
CONTROL EJECT;                                                           ID0913 
PROC DLTE$IS;                                                            ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   DLTE$IS - DELETE A DATA RECORD FROM A FILE         PAGE  1         JJJ0916
* *   A.F.R.BROWN                                                        ID0913 
* 1DC DLTE$IS                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO DELETE THE CURRENT DATA RECORD FROM A FILE OR SUBFILE,          ID0913 
*     LEAVING THE PTREE TO SHOW A POSITION AT THE NEXT RECORD, OR        ID0913 
*     AT EOI, AND MAKING ANY NECESSARY CHANGES TO THE INDEX BLOCKS.      ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     THE PTREE MUST SHOW US VALIDLY POSITIONED AT A DATA RECORD, AND    ID0913 
*     NOT AT EOI.                                                        ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     NOTHING FURTHER NEEDS TO BE DONE, AND THE PTREE SHOWS US AT THE    ID0913 
*     NEXT DATA RECORD OR AT EOI IF THE LAST RECORD WAS DELETED.         ID0913 
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     AWAY$IS - TO MOVE THE ONE AND ONLY BLOCK TO THE EMPTY CHAIN IF     ID0913 
*       THE ONLY RECORD IN THE FILE IS BEING DELETED.                    ID0913 
*     BCK1$AA - TO TEST WHETHER THE CURRENT RECORD, WHICH IS TO BE       ID0913 
*       DELETED, IS THE FIRST LIVE RECORD IN ITS BLOCK. (THIS IS A       ID0913 
*       KIND OF ACCIDENTAL USE OF BCK1$AA.)                              ID0913 
*     DELL$AA - TO SQUEEZE THE CURRENT RECORD OUT OF THE CURRENT BLOCK.  ID0913 
*     KYSV$IS - TO CONSTRUCT A NEW INDEX RECORD FOR THE CURRENT BLOCK,   ID0913 
*       AND SAVE IT IN ARRAY KEYHOLE, IF THE FIRST RECORD OF THE         ID0913 
*       CURRENT BLOCK IS BEING DELETED.                                  ID0913 
*     STUP$IS - IF KYSV$IS WAS USED, TO MOVE UP TO THE PARENT INDEX      ID0913 
*       RECORD THAT HAS TO BE REPLACED.                                  ID0913 
*     ALTR$AA - IN THE SAME CASE, TO DO THE NECESSARY COURTESIES         ID0913 
*       BEFORE ALTERING THE BLOCK THAT CONTAINS THE PARENT INDEX RECORD  ID0913 
*     MOVW$AA - IN THE SAME CASE, TO MOVE IN THE NEW INDEX RECORD,       ID0913 
*       REPLACING THE OLD ONE WITHOUT CHANGING ANYTHING ELSE ABOUT       ID0913 
*       ITS BLOCK.                                                       ID0913 
*     VANB$AA - WHEN THE DATA RECORD BEING DELETED IS THE ONLY ONE       ID0913 
*       IN ITS BLOCK, THIS IS CALLED TO MOVE THE BLOCK OUT TO THE        ID0913 
*       EMPTY CHAIN AND MAKE NECESSARY CHANGES IN THE INDEX.             ID0913 
*     SLOG$AA - TO DO SOME SPECIAL LOGGING ACTIVITY IF FLAG SFLG        014700
*       IS SET IN THE FIT, IN ORDER TO SHOW THAT AN UPDATE              014800
*       INVOLVING MORE THAN ONE BLOCK IS BEGINNING.                     014900
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     BACKREC IS USED BY SUBROUTINE BCK1$AA TO RETURN ITS RESULT.        ID0913 
*     INDXLNG IS THE LENGTH IN WORDS OF AN INDEX RECORD IN THE           ID0913 
*       FILE, SET BY STMD$AA.                                            ID0913 
*     RECFWA IS THE FWA OF THE CURRENT RECORD IN ITS BLOCK --            ID0913 
*       SET BY SUBROUTINE STUP$IS IN THIS CASE.                          ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
          ITEM DL;           #LOCAL FLAG#                                ID0913 
                                                                         ID0913 
                             #START OF DLTE$IS CODE#                     ID0913 
          IF QLR NQ 0                                                    ISNRO
            THEN BEGIN                                                   ISNRO
              QEI = 1 ;                                                  ISNRO
              QLR = 0 ;                                                  ISNRO
            END                                                          ISNRO
          RECCNT = RECCNT - 1 ;                                          ISNRO
          IF RECCNT EQ 0                                                 ISNRO
            THEN BEGIN #VANISH FILE#                                     ISNRO
              AWAYCHN;                                                   JJJ0209
              PRBK = 0 ;                                                 ISNRO
              FIRDAT = 0 ;                                               ISNRO
            END                                                          ISNRO
            ELSE BEGIN                                                   ISNRO
              IF RC NQ 1 AND EC + 2 * RECLNG + 1 NQ MAXMT                JJJ0908
                THEN BEGIN #BLOCK REMAINS#                               ISNRO
                      BACKREC = 1;                                       ISNROMO
                  IF NLEV NQ 0 THEN BCK1$AA ;                            ISNRO
                      DL = BACKREC;  #0 IF ALREADY ON 1ST LIVE RECORD#   ISNROMO
                  IF DL EQ 0                                            015100
                    THEN BEGIN                                          015200
                      SLOG$AA ;                                         015300
                    END                                                 015400
                  DELL$AA ;                                              ISNRO
                  IF ORG EQ FO"FIFO" THEN RETURN ;
                  IF DL EQ 0                                             ISNRO
                    THEN BEGIN                                           ISNRO
                      KYSV$IS ( 0 ) ;                                    ISNRO
                                                                         JJJ1001
DLTEISA:              STUP$IS;                                           JJJ1001
                      ALTR$AA ;                                          ISNRO
                      MOVW$AA ( LOC(KEYHOLE[0]) , INDXLNG , RECFWA ) ;   ISNRO
                      BLCIP[0] = 0 ;
                      IF CURPTR NQ 0 AND RNO EQ 1                        JJJ1001
                      THEN                                               JJJ1001
                          BEGIN                                          JJJ1001
                          B<36,24>KEYHOLE[INDXLNG-1] = BLOCKID[0];       JJJ1001
                          GOTO DLTEISA;                                  JJJ1001
                          END                                            JJJ1001
                      CURPTR = NLEV ;                                    ISNRO
                    END                                                  ISNRO
                END                                                      ISNRO
                ELSE                                                     JJJ0923
                  BEGIN                                                  JJJ0923
                  SLOG$AA ;                                             015600
                 VANBLK;     #BLOCK VANISHES#                            JJJ0209
                  END                                                    JJJ0923
            END                                                          ISNRO
          END                                                            ISNRO
CONTROL EJECT;                                                           ID0913 
PROC KYSV$IS ( N );                                                      ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   KYSV$IS - MAKE + SAVE INDEX REC FOR CURRENT BLOCK  PAGE  1         JJJ0916
* *   A.F.R.BROWN                                                        ID0913 
* 1DC KYSV$IS                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO CONSTRUCT THE INDEX RECORD FOR THE CURRENT BLOCK, AND SAVE IT   ID0913 
*     IN THE ARRAY CALLED KEYHOLE.                                       ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     ONE PARAMETER IS RECEIVED IN THE STANDARD SYMPL WAY. THIS IS       ID0913 
*     0, 1, OR 2, INDICATING THE 1ST, 2ND OR 3RD POSITION IN A GROUP     ID0913 
*     OF INDEX RECORDS THAT WILL REPLACE THE INDEX RECORD THAT IS NOW    ID0913 
*     THE PARENT OF THE CURRENT BLOCK.                                   ID0913 
*                                                                        ID0913 
*     THE CURRENT BLOCK IS LOCATED BY P<BLOK$AA> AND BLOCLWA.            ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     RECFWA, RNO, TEMPLOC AND TEMPOS HAVE BEEN SAVED AND RESTORED.      CY211
*     THIS SEEMS TO BE NECESSARY ONLY BECAUSE OF THE CALL TO             CY211
*     KYSV$IS IN VANB$IS, WHERE THE CALL TO KYSV$IS IS FOLLOWED          CY211
*     IMMEDIATELY BY A CALL TO STUP$IS. STUP$IS ASSUMES THESE            CY211
*     VARIABLES STILL REFER TO THE RECORD IT HAS TO STEP UP FROM,        CY211
*     WHILE KYSV$IS USES THEM OTHERWISE.                                 CY211
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     UUCC$AA - TO FETCH THE UNUSED CHARACTER COUNT OF A RECORD          CY211
*       IDENTIFIED BY NUMBER. WE NEED THE KEY OF THE FIRST LIVE          CY211
*       RECORD IN THE BLOCK, AND A DEAD RECORD IS KNOWN BY               CY211
*       UNUSED CHARACTER COUNT = 15.                                     CY211
*     LOCR$AA - TO LOCATE A RECORD IN THE BLOCK, IDENTIFIED BY           CY211
*       NUMBER. WE GO UP FROM NUMBER 1 UNTIL WE FIND A LIVE ONE.         CY211
*     MOVW$AA -- TO COPY A KEY THAT BEGINS ON A WORD BOUNDARY.           ID0913 
*     MOVC$AA -- TO COPY A KEY THAT DOES NOT.                            ID0913 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     ARRAY KEYHOLE IS USED ONLY IN CONNECTION WITH KYSV$IS.             ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
          ITEM N;            #WHICH INDEX REPLACES PARENT#               ID0913 
          ITEM KP;           #TEMP RECORD POINTER#                       ID0913 
          ITEM SA , SB , SC; #SAVE AREAS FOR FECFWA,TEMPLOC AND TEMPOS#  AFB0531
          ITEM SD;           #SAVE FOR RNO# 
                                                                         ID0913 
                             #START OF KYSV$IS CODE#                     ID0913 
                                                                         AFB0531
#     SAVE RECFWA TEMPLOC AND TEMPOS FOR LATER USE#                      AFB0531
                                                                         AFB0531
          SA = RECFWA;                                                   AFB0531
          SB = TEMPLOC;                                                  AFB0531
          SC = TEMPOS;                                                   AFB0531
          SD = RNO; 
          FOR KP = 1 WHILE UUCC$AA ( KP ) EQ DEAD DO KP = KP+1 ;         ISNRO
          LOCR$AA ( KP ) ;                                               AFB0528
          IF TEMPOS EQ 0                                                 AFB0528
            THEN BEGIN                                                   AFB0528
              MOVW$AA(TEMPLOC,INDXLNG,LOC(KEYHOLE[INDXLNG*N]) ) ;        AFB0528
            END                                                          AFB0528
            ELSE BEGIN                                                   AFB0528
              MOVC$AA(TEMPLOC,TEMPOS,LOC(KEYHOLE[INDXLNG*N]),0,          AFB0528
                10*INDXLNG);                                             AFB0528
            END                                                          AFB0528
          B<36,24>KEYHOLE[INDXLNG*N+INDXLNG-1] = BLOCKID[0] ;            ISNRO
          RECFWA = SA;                                                   AFB0531
          TEMPLOC = SB;                                                  AFB0531
          TEMPOS = SC;                                                   AFB0531
          RNO = SD; 
          END                                                            ISNRO
CONTROL EJECT;                                                           ISNROMO
PROC PTRP$IS ( N ) ;                                                     ISNROMO
          BEGIN                                                          ISNROMO
                                                                         ID0913 
 #                                                                       ID0913 
* *   PTRP$IS - PUT OR REPLACE RECORD AT CURRENT POSITION   PAGE  1      JJJ0916
* *   A.F.R.BROWN                                                        ID0913 
* 1DC PTRP$IS                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO INSERT OR REPLACE A RECORD AT THE CURRENT POSITION IN AN        ID0913 
*     I-S FILE OR SUBFILE. THE RECORD THAT THE PTREE DEFINES AS          ID0913 
*     CURRENT MUST BE IN CORE, BUT IT IS NOT KNOWN WHETHER THERE IS      ID0913 
*     ROOM IN THE BLOCK FOR THE INSERTION OR REPLACEMENT. IF THE         ID0913 
*     INSERTION OR REPLACEMENT MAKES A CHANGE IN AN INDEX RECORD         ID0913 
*     NECESSARY, PTRP$IS MAKES THE CHANGE, AND CHANGES MAY CASCADE       ID0913 
*     UP TO THE PRIMARY INDEX BLOCK -- AN ADDITIONAL LEVEL OF INDEXING   ID0913 
*     MAY BE CREATED.                                                    ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     ONE PARAMETER IS RECEIVED IN THE ORDINARY WAY -- IT IS 0 FOR       ID0913 
*     A REPLACE OR 1 FOR A PUT. NOTE THAT IT IS THE NUMBER BY WHICH      ID0913 
*     THE COUNT OF RECORDS IN THE FILE OR SUBFILE WILL BE INCREASED.     ID0913 
*                                                                        ID0913 
*     THE VARIABLE CALLED BARREN WILL BE 0 EXCEPT WHEN THE FILE IS PART  ID0913 
*     OF A MIP FILE, AND THE NEW RECORD IS TO CONTAIN A POINTER TO A     ID0913 
*     DAUGHTER SUB-FILE. IF BARREN IS NOT 0, THEN THE BLOCK INTO WHICH   ID0913 
*     THE NEW RECORD IS GOING MAY NO LONGER BE TREATED AS HAVING         ID0913 
*     ((UNIFORM RECORDS)) EVEN IF THE NEW RECORD APPEARS TO CONFORM.     ID0913 
*                                                                        ID0913 
*     THE PTREE MUST MARK A RECORD AS CURRENT, AND THIS RECORD MUST      ID0913 
*     BE IN CORE NOW. FOR A PUT-AT-EOI, THE LAST RECORD IS CURRENT,      ID0913 
*     BUT THE QEI FLAG IS 1 AND THE QLR FLAG IS 0 IN THE PTREE.          ID0913 
*                                                                        CY211
*     RNO IS THE CURRENT RECORD NUMBER, WITHIN THE BLOCK. BUT IF         CY211
*     RNO IS NEGATIVE, IT MEANS A NEW RECORD IS TO BE INSERTED AFTER     CY211
*     THE LAST RECORD IN THE BLOCK -- IF THERE IS ROOM, OTHERWISE        CY211
*     IT MUST GO TO THE BEGINNING OF THE NEXT BLOCK, OR INTO A           CY211
*     NEW BLOCK.                                                         CY211
*                                                                        ID0913 
*     IF THE PARAMETER IS 0, THE CURRENT RECORD IS TO BE REPLACED.       ID0913 
*     IF THE PARAMETER IS 1, THE NEW RECORD IS TO BE INSERTED BEFORE     ID0913 
*     THE CURRENT RECORD, OR AT EOI.                                     CY211
*                                                                        ID0913 
*     NEWFWA IS THE FWA OF THE NEW RECORD, WHICH BEGINS AT THE           ID0913 
*     WORD BOUNDARY.                                                     ID0913 
*                                                                        ID0913 
*     NEWLG IS THE LENGTH OF THE NEW RECORD IN CHARACTERS.               ID0913 
*                                                                        ID0913 
*     HOWEVER, IF NEWLG IS NEGATIVE, THE CALL TO PTRP$IS IS INTENDED     ID0913 
*     TO SPLIT THE BLOCK WITHOUT REPLACING OR INSERTING A RECORD.        ID0913 
*     SUBROUTINE RCKN$AA IS ALSO ABLE TO RECOGNIZE THIS. IT IS ONLY      ID0913 
*     NEEDED FOR MIP FILES.                                              ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     THE PTREE WILL SHOW THE NEW DATA RECORD AS CURRENT, THOUGH ITS     ID0913 
*     BLOCK MAY OR MAY NOT BE IN CORE. ALL NEEDED ADJUSTMENTS TO         ID0913 
*     THE INDEX AND THE FSTT WILL HAVE BEEN MADE.                        ID0913 
*                                                                        CY211
*     FSEXCEDPT[0] HAS BEEN SET TO 1 IF THIS PUT OR REPLACE CAUSED A     CY211
*     BLOCK SPLIT AND AN INCREASE IN THE NUMBER OF INDEX LEVELS, AND     CY211
*     THE ROOM THAT WAS ALLOCATED AT OPEN TIME FOR THE PTREE IS NOW      CY211
*     FULL. THE EFFECT IS THAT ALL UPDATE OPERATIONS TO THE FILE WILL    CY211
*     BE REFUSED AND WILL GIVE NON-FATAL ERRORS. THIS IS TO PREVENT THE  CY211
*     OCCURRENCE OF A PUT OR REPLACE THAT WOULD TRY TO ADD YET ANOTHER   CY211
*     INDEX LEVEL, FOR WHICH THERE WOULD BE NO ROOM -- BY THE TIME THE   CY211
*     NEED FOR ANOTHER INDEX LEVEL IS REALIZED, DURING A PUT OR          CY211
*     REPLACE, THE FILE HAS ALREADY BEEN MODIFIED TOO FAR TO ALLOW       CY211
*     A SUCCESSFUL BACKUP.                                               CY211
*                                                                        CY211
*     TO GET PAST THIS OBSTRUCTION, THE USER NEED ONLY CLOSE THE FILE    CY211
*     AND OPEN IT AGAIN. AT OPEN-OLD TIME, THE PTREE IS ALWAYS SET UP    CY211
*     TO ALLOW FOR EXPANSION BY TWO MORE INDEX LEVELS.                   CY211
*                                                                        CY211
*     FSINXFUL[0] IS SET TO 1 AT A MORE SERIOUS TIME, WHEN THE FINAL     CY211
*     MAXIMUM NUMBER OF INDEX LEVELS (15) HAS BEEN REACHED, AND AN       CY211
*     UPDATE IS INCREASING THE NUMBER OF RECORDS IN THE PRIMARY          CY211
*     INDEX BLOCK BY 1 OR 2, AND THIS LEAVES ROOM FOR LESS THAN 2 MORE   CY211
*     RECORDS IN THE INDEX BLOCK. THIS FLAG PREVENTS ALL FUTURE UPDATES  CY211
*     TO THE FILE, BECAUSE OF THE CHANCE THAT EVENTUALLY AN UPDATE WILL  CY211
*     OCCUR THAT RESULTS IN 2 MORE RECORDS HAVING TO BE ADDED TO THE     CY211
*     PRIMARY INDEX BLOCK. IT IS TRUE THAT AN ENORMOUS NUMBER OF RECORDS CY211
*     WOULD HAVE TO BE ADDED TO THE FILE BEFORE THAT HAPPENED, BUT THIS  CY211
*     IS THE LAST MOMENT AT WHICH IT IS EASY TO MAKE A RULING.           CY211
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     NUBL$AA -- TO GET A NEW BLOCK, EITHER WHEN PUTTING THE FIRST       ID0913 
*       RECORD INTO AN EMPTY FILE, OR WHEN ADDING A NEW LEVEL OF         ID0913 
*       INDEXING. (NOT FOR BLOCK SPLITTING.)                             ID0913 
*     UNFX$AA -- TO PUT THE BLOCK CREATED BY NUBL$AA INTO THE            ID0913 
*       KICKOUT CHAIN.                                                   ID0913 
*     SEBL$AA -- TO LOCATE, READING IF NECESSARY, THE BLOCK POINTED      ID0913 
*       TO BY A GIVEN WORD OF THE PTREE.                                 ID0913 
*     BACK$AA -- TO BACKSPACE A RECORD, WHEN DECIDING WHETHER TO PUT     ID0913 
*       A RECORD AT THE END OF ONE BLOCK OR THE BEGINNING OF THE NEXT.   ID0913 
*     RCKN$AA  -- TO DECIDE WHETHER, IN THE CURRENT BLOCK,               ID0913 
*       1. THERE IS ROOM FOR THE INSERTION/REPLACEMENT.                  ID0913 
*       2. IF NOT, THE SPLIT MUST BE 3-WAY OR 2-WAY.                     ID0913 
*       3. IF 2-WAY, WHICH HALF WILL BE SHORTER.                         ID0913 
*     STOV$AA -- TO SKIP FORWARD FROM THE END OF ONE BLOCK TO THE FIRST  ID0913 
*       RECORD OF THE NEXT. SKPF$AA COULD BE USED IN THESE CASES, BUT    ID0913 
*       WE KNOW IN ADVANCE THAT IT WILL CALL STOV$AA IN THE END, AND     ID0913 
*       AVOID THE MIDDLEMAN.                                             ID0913 
*     STPF$AA - TO MOVE FORWARD ONE RECORD WITHIN A BLOCK. THIS IS DONE  CY211
*       AFTER A RECORD HAS BEEN INSERTED AT THE BEGINNING OF A BLOCK,    CY211
*       IN ORDER TO REGAIN CURRENCY FOR WHAT USED TO BE RECORD 1 AND     CY211
*       IS NOW RECORD 2. STUP$IS IS ABOUT TO BE CALLED, AND IT NEEDS     CY211
*       TO START ITS ASCENT FROM THE OLD RECORD, NOT THE NEW ONE.        CY211
*     SPLT$IS ALIAS SPLITBLK - TO SPLIT THE CURRENT BLOCK.               CY211
*     WNOW$IS ALIAS WRITNOW - TO WRITE OUT IMMEDIATELY THE NEW BLOCK     CY211
*       RESULTING FROM THE SPLIT, WHICH CONTAINS THE SECOND              CY211
*       PART OF THE ORIGINAL                                             CY211
*       BLOCK. THIS IS DONE FOR THE SAKE OF RELIABILITY. THIS ROUTINE    ID0913 
*       ALSO CALLS OTHERS TO PREPARE THE INDEX RECORD CORRESPONDING TO   ID0913 
*       THE NEW BLOCK, AND TO INSERT THE BLOCK IN THE KICKOUT CHAIN.     ID0913 
*     ADRC$AA -- TO INSERT OR REPLACE A RECORD IN THE CURRENT BLOCK      ID0913 
*       WHEN IT IS KNOWN THAT THERE IS ROOM IN THE BLOCK TO DO IT        ID0913 
*     KYSV$IS -- TO PREPARE THE INDEX RECORD CORRESPONDING TO THE        ID0913 
*       CURRENT BLOCK WHEN NECESSARY. (FOR THE NEW BLOCKS THAT MAY HAVE  ID0913 
*       TO BE SPLIT OFF THIS ONE, KYSV$IS IS CALLED BY WNOW$IS.)         ID0913 
*     HAWK$AA -- TO MAKE P<BLOK$AA> AND BLOCLWA POINT TO A BLOCK AT A    ID0913 
*       GIVEN ADDRESS (USED FOR TEMPORARY DEPARTURES FROM AND RETURNS    ID0913 
*       TO THE CURRENT BLOCK)                                            ID0913 
*     TROW$AA -- LIKE HAWK$AA, BUT CALLED WITH A CHEAPER PARAMETER,      ID0913 
*       RESTRICTED TO ADDRESSES STORED IN THE FIXHOLD AREA BY THE        ID0913 
*       ROUTINE THAT FREEZES BLOCKS OUT OF THE KICKOUT CHAIN.            ID0913 
*     STUP$IS -- TO MOVE UP A LEVEL IN THE PTREE, WHEN A CHANGE IS       ID0913 
*       PROPAGATED UP THE INDEX TREE.                                    ID0913 
*     MOVW$AA -- TO PUT RECORDS INTO A NEWLY-CREATED PRIMARY             ID0913 
*       INDEX BLOCK.                                                     ID0913 
*     SLOG$AA -- TO DO SOME SPECIAL LOGGING ACTIVITY IF FLAG            015800
*       SFLG IS SET IN THE FIT, IN ORDER TO SHOW THAT AN                015900
*       UPDATE INVOLVING MORE THAN ONE BLOCK IS BEGINNING.              016000
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     FUNCT - THE INCOMING PARAMETER IS COPIED INTO FUNCT BEFORE         ID0913 
*       USE. A SINGLE CALL TO PTRP$IS MAY CAUSE MOST OF THE ROUTINE      ID0913 
*       TO BE CYCLED THROUGH MORE THAN ONCE, AND A PUT AT THE DATA       ID0913 
*       BLOCK LEVEL MAY LEAD TO A REPLACE AT THE INDEX BLOCK LEVEL.      CY211
*       SO IT IS BETTER TO HAVE FUNCT, WHICH CAN BE                      CY211
*       CHANGED ACCORDINGLY, RATHER THAN AN INCOMING PARAMETER, WHICH    ID0913 
*       COULD NOT.                                                       ID0913 
*     BSFLG - A FLAG THAT IS 0 USUALLY, BUT SET TO 1 WHEN A BLOCK        ID0913 
*       SPLIT TAKES PLACE AND WE WANT TO END UP POSITIONED ON THE        ID0913 
*       SECOND RESULTING BLOCK RATHER THAN THE FIRST.                    ID0913 
*     DBSFLG - A FLAG THAT IS 0 USUALLY, BUT SET TO 1 IF BSFLG AT THE    ID0913 
*       NEXT LOWER LEVEL OF INDEXING WAS 1. IT TELLS US TO POSITION      ID0913 
*       FORWARD ONE INDEX RECORD, CORRESPONDING TO THE STEP OF A BLOCK   ID0913 
*       AT THE DAUGHTER LEVEL.                                           ID0913 
*     NRECINS - THE NUMBER OF NEW RECORDS TO BE INSERTED OR TO           ID0913 
*       REPLACE AN OLD ONE. INITIALLY SET TO 1, FOR PTRP$AA IS ALWAYS    ID0913 
*       CALLED FOR A SINGLE NEW RECORD (OR, VERY OCCASIONALLY IN MIP,    ID0913 
*       FOR ZERO RECORDS, SIGNALLED BY NEWLG<0 .) BUT BECAUSE OF ONE     ID0913 
*       NEW DATA RECORD, A GROUP OF 1, 2, OR 3 INDEX RECORDS MAY HAVE    ID0913 
*       TO BE PUT AT THE NEXT LEVEL UP, REPLACING THE 1 EXISTING         CY211
*       RECORD. SO NRECINS MAY CHANGE WITH EACH CYCLE OF THIS TRIP       CY211
*       THROUGH PTRP$AA.                                                 CY211
*     NEWBNUM - THE NEW BLOCK PRU NUMBER, SET BY NUBL$AA .               ID0913 
*     SPLTFLG - THE RESULT RETURNED BY RCKN$AA.                          ID0913 
*     NMINDX - A NUMBER SET TO 0 WHEN THE CHANGE AT THE CURRENT LEVEL OF ID0913 
*       THE FILE WILL REQUIRE NO CHANGE AT THE NEXT LEVEL UP IN THE      ID0913 
*       INDEX, AND OTHERWISE TO THE NUMBER OF RECORDS (1, 2, OR 3        ID0913 
*       IS POSSIBLE) THAT WILL HAVE TO REPLACE THE PARENT RECORD         ID0913 
*       A LEVEL ABOVE THE CURRENT BLOCK.                                 ID0913 
*     INDXLNG - THE LENGTH IN WORDS OF AN INDEX RECORD IN THIS FILE      ID0913 
*       SET BY ROUTINE STMD$AA.                                          ID0913 
*     IX IS USED FOR AN INDUCTION VARIABLE.                              CY211
*     ARRAY KEYHOLE IS SET UP BY SUBROUTINE KYSV$IS.                     CY211
*                                                                        ID0913 
 #                                                                       ID0913 
CONTROL EJECT;            #START OF PTRP$IS CODE#                        ID0913 
          ITEM N;            #FORMAL PARAMETER#                          ISNROMO
          ITEM TILE;         #LOCAL, STORES BLOK$AA#                     ISNROMO
          ITEM BSFLG;        #BLOCK SPLIT FLAG#                          ISNROMO
          ITEM DBSFLG;       #DAUGHTER BLOCK SPLIT FLAG#                 ISNROMO
          ITEM NMINDX;       #NUM OF INDEX RECORDS TO INSERT#            ISNROMO
                                                                         ID0913 
                                                                         ID0913 
          FUNCT = N ;                                                    ISNRO
             #FUNCT=0 FOR REPLACE, 1 FOR PUT#                            ISNRO
          DBSFLG = 0;                                                    ISNROMO
          NRECINS = 1 ;                                                  ISNRO
          IF NEWLNG LS 0 THEN GOTO PUTRAP;                               JJJ0908
            # THIS COULD ONLY BE A KLUGE FROM MIPNRO INTENDED            ISNRO
              TO CAUSE A BLOCK SPLIT BEFORE ENLARGING A SUBBLOCK #       ISNRO
          IF PRBK EQ 0                                                   ISNRO
            THEN BEGIN                                                   ISNRO
              NUBL$AA ( 0 ) ;                                            ISNRO
              UNFX$AA ( 0 ) ;                                            ISNRO
              PRBK = NEWBNUM ;                                           ISNRO
              FIRDAT = NEWBNUM ; LASTBNO = NEWBNUM ;                     ISNRO
              PTCURBLK[0] = NEWBNUM ;                                    ISNRO
              SEBL$AA ( 0 , 1 ) ;                                        ISNRO
            END                                                          ISNRO
          IF FUNCT NQ 0                                                  ISNRO
            THEN BEGIN                                                   ISNRO
              IF RNO LS 0                                                ISNRO
                THEN BEGIN #POSTION ON NEXT LOWER#                       ISNRO
                  GOTO PUTRUP ; #INSERT BETWEEN BLOCKS#                  ISNRO
                END                                                      ISNRO
              IF RNO EQ 1 AND QFR EQ 0 AND QEI EQ 0                      ISNRO
                THEN BEGIN                                               ISNRO
                  BACK$AA ;                                              ISNRO
PUTRUP:           RNO = RC + 1;                                          AFB1202
                  RCKN$AA (1 , BARREN);                                  AFB1202
                  IF SPLTFLG EQ 0                                        ISNRO
                    THEN BEGIN                                           ISNRO
                        NMINDX = 0;                                      ISNROMO
                        GOTO PUTRIP ;                                    ISNRO
                    END                                                  ISNRO
                  IF FACREATE[0] NQ 0                                    CREATEM
                   OR ( FALPBLNO[0] EQ BLOCKID[0] AND FALPRCNO[0] EQ RC) CREATEM
                    THEN BEGIN #SEQUENTIAL PUTS#                         ISNRO
                      GOTO PATRAP ;                                      ISNRO
                    END                                                  ISNRO
                  STOV$AA ;                                              JJJ0916
                END                                                      ISNRO
            END                                                          ISNRO
          IF QEI NQ 0 THEN RNO = RC + 1 ;                                ISNRO
PUTRAP:   RCKN$AA (FUNCT , BARREN);                                      JJJ0924
          IF FUNCT NQ 0                                                  VBG1208
          THEN                                                           VBG1208
              BEGIN                                                      VBG1208
              IF SPLTFLG EQ 2                                            VBG1208
              THEN                                                       VBG1208
                  BEGIN                                                  VBG1208
                  SPLTFLG = 1;                                           VBG1208
                  END                                                    VBG1208
              ELSE                                                       VBG1208
                  BEGIN                                                  VBG1208
                  IF SPLTFLG EQ 3 AND RNO LQ RC AND FALPBLNO EQ BLOCKID  VBG1208
                                  AND FALPRCNO EQ RNO-1                  VBG1208
                  THEN                                                   VBG1208
                      BEGIN                                              VBG1208
                      SPLTFLG = -2;  #FORCE 3-WAY SPLIT#                 VBG1208
                      END                                                VBG1208
                  END                                                    VBG1208
              END                                                        VBG1208
PATRAP:   BSFLG = 0;                                                     JJJ0924
          NMINDX = 0;                                                    JJJ0924
          IF SPLTFLG NQ 0 OR (FUNCT NQ 0 AND RNO EQ 1)                  016200
            THEN BEGIN                                                  016300
              SLOG$AA ;                                                 016400
            END                                                         016500
          IF SPLTFLG NQ 0                                                ISNRO
            THEN BEGIN                                                   ISNRO
              IF SPLTFLG LS 0                                            ISNRO
                THEN BEGIN #3BLOCKS#                                     ISNRO
                  NMINDX = 3;                                            ISNROMO
                  SPLITBLK (RNO + 1 - N);                                JJJ0209
                  WRITNOW (2);                                           JJJ0209
                  UNFX$AA (0);                                           AFB0405
                  SPLITBLK (RNO);                                        JJJ0209
                  BSFLG = 1;                                             ISNROMO
                END                                                      ISNRO
                ELSE BEGIN #2 BLOCKS#                                    ISNRO
                  NMINDX = 2;                                            ISNROMO
                  IF SPLTFLG EQ 1 AND FUNCT EQ 0                         ISNRO
                  THEN                                                   JJJ0923
                    BEGIN                                                JJJ0923
                    SPLITBLK (RNO + 1);                                  JJJ0209
                    END                                                  JJJ0923
                  ELSE                                                   JJJ0923
                    BEGIN                                                JJJ0923
                    SPLITBLK (RNO);                                      JJJ0209
                    END                                                  JJJ0923
                  IF SPLTFLG GQ 2                                        VBG1208
                    THEN BSFLG = 1;                                      ISNROMO
                    ELSE PTCUREC[CURPTR] = RNO ;                         ISNRO
                END                                                      ISNRO
              IF BSFLG NQ 0  THEN STOV$AA;                               ISNROMO
            END                                                          ISNRO
PUTRIP:         IF NEWLNG GQ 0                                           JJJ0908
              # NEWLG = -1 IS A KLUGE IN MIPNRO TO GET                   ISNRO
              A BLOCK SPLIT BEFORE ENLARGING A SUBBLOCK #                ISNRO
            THEN BEGIN                                                   ISNRO
              ADRC$AA ;                                                  ISNRO
              IF INDEXFLAG EQ 0 AND N NQ 0                               ISNRO
                THEN BEGIN                                               ISNRO
                  RECCNT = RECCNT + 1 ;                                  ISNRO
                  IF MIPMODE EQ 0                                        JJJ1116
                    THEN BEGIN                                           JJJ1116
                      FALPBLNO[0] = BLOCKID[0] ;                         JJJ1116
                      FALPRCNO[0] = RNO ;                                JJJ1116
                    END                                                  JJJ1116
                  IF SPLTFLG EQ 1 AND RC EQ 1 AND PTCUREC[0] EQ 0        CREATEM
                  THEN                                                   JJJ1211
                      BEGIN                                              JJJ1211
                      STOV$AA;                                           JJJ1211
                      BSFLG = 1;                                         JJJ1211
                      END                                                JJJ1211
                END                                                      ISNRO
            END                                                          ISNRO
          IF NMINDX EQ 0                                                 ISNROMO
            THEN BEGIN                                                   ISNRO
              IF RNO EQ 1 AND (FUNCT NQ 0 OR INDEXFLAG NQ 0)             AFB1208
                THEN BEGIN                                               ISNRO
                  NMINDX = 1;                                            ISNROMO
                  KYSV$IS ( 0 ) ;                                        ISNRO
                  IF PTCUREC[0] EQ 0 AND INDEXFLAG EQ 0 THEN STPF$AA ;   CREATEM
                END                                                      ISNRO
            END                                                          ISNRO
            ELSE BEGIN                                                   ISNRO
              WRITNOW (1);                                               JJJ0209
              TILE = P<BLOK$AA> ;                                        ISNRO
              TROW$AA ( 0 ) ; #FIXHOLD[0]#                               ISNRO
              KYSV$IS ( 0 ) ;                                            ISNRO
              HAWK$AA ( TILE ) ; #RESTORE P<BLOK$AA>#                    ISNRO
              UNFX$AA ( 0 ) ;                                            ISNRO
            END                                                          ISNRO
                                                                         ISNRO
          IF DBSFLG NQ 0  THEN PTCUREC[CURPTR] = PTCUREC[CURPTR]+DBSFLG; ISNROMO
                                                                         ISNROMO
          DBSFLG = BSFLG;                                                ISNROMO
          BSFLG = 0;                                                     ISNROMO
          IF NMINDX NQ 0                                                 ISNROMO
          THEN                                                           ISNROMO
              BEGIN                                                      ISNROMO
              NRECINS = NMINDX;                                          ISNROMO
              NEWFWA = LOC(KEYHOLE[0]) ;                                 ISNRO
              NEWLNG = 10 * INDXLNG * NRECINS;                           JJJ0908
              IF CURPTR NQ 0                                             ISNRO
                THEN BEGIN                                               ISNRO
                  STUP$IS ;                                              ISNRO
                  IF CURPTR EQ 0 AND NLEV EQ MXFTNL                      RPN1209
                  THEN                                                   JJJ1204
                      BEGIN                                              JJJ1204
                      IF 2 * (NRECINS+1) * INDXLNG GR EC                 CY211
                      THEN                                               JJJ1204
                          BEGIN  #PRIM INDEX BLK LV 15 IS FULL#          JJJ1204
                          FSINXFUL = 1;                                  JJJ1204
                          END                                            JJJ1204
                      END                                                JJJ1204
                  FUNCT = 0 ;                                            ISNRO
                  GOTO PUTRAP ;                                          ISNRO
                END                                                      ISNRO
                ELSE BEGIN                                               ISNRO
                  IF NRECINS GR 1 AND ORG EQ FO"IS"                      ISNRO
                    THEN BEGIN                                           ISNRO
                      FOR IX = NLEV STEP -1 UNTIL 0                      ISNROMO
                        DO BEGIN #NEW INDEX LEVEL#                       ISNRO
                        IF PTBLKIN[IX] NQ 0                              ISNROMO
                        THEN                                             ISNROMO
                          BEGIN                                          ISNROMO
                          P<BLOK$AA> = PTCURBADR[IX];                    ISNROMO
                          BLPTRADR[0] = P<PTRE$AA> + IX + 1;             ISNROMO
                          END                                            ISNROMO
                        PTREEWRD[IX+1] = PTREEWRD[IX] ;                  ISNROMO
                        END                                              ISNRO
                      NLEV = NLEV + 1 ;                                  ISNRO
                      IF MIPMODE NQ 0 
                      THEN
                          BEGIN 
                          IF CURLEV EQ 2 AND NLEV+1 GR FSPT2SZ[0] 
                          THEN
                              BEGIN 
                              FSPT2SZ[0] = NLEV+1 ; 
                              END 
                          IF CURLEV EQ 3 AND NLEV+1 GR FSPT3SZ[0] 
                          THEN
                              BEGIN 
                              FSPT3SZ[0] = NLEV+1 ; 
                              END 
                          END 
                      IF NLEV EQ PTREESIZE - 1                           CY211
                      THEN                                               JJJ1204
                          BEGIN  #FILE GREW MORE THAN 2 INDEX LEVELS#    JJJ1204
                          FSEXCEDPT = 1;                                 JJJ1204
                          IF MIPMODE NQ 0 
                          THEN
                              BEGIN 
                              FSEXCEDPT [FTFSTT[0]-P<FSTT$AA>] = 1; 
                              END 
                          END                                            JJJ1204
                      NUBL$AA ( 0 ) ;                                    ISNRO
                      UNFX$AA ( 0 ) ;                                    ISNRO
                      FWD = PRBK ;                                       ISNRO
                      PRBK = NEWBNUM ;                                   ISNRO
                      PTCURBLK[0] = NEWBNUM ;                            ISNRO
                      PTCUREC[0] = DBSFLG + 1 ;                          CREATEM
                      SEBL$AA ( 0 , 1 ) ;                                ISNRO
                      RC = NRECINS ;                                     ISNRO
                      EC = EC - 1 - 2*NRECINS*INDXLNG ;                  ISNRO
                      UR = 1 ;                                           ISNRO
                      INDEXFLAG = 1 ;                                    ISNRO
                      MOVW$AA ( LOC(KEYHOLE[0]) ,                        ISNRO
                          NRECINS*INDXLNG , P<BLOK$AA>+DBLKOVHED ) ;     ISNRO
                      W[BLOCLWA-1] = INDXLNG; #RECORD POINTER,LWA FIELD# ISNRO
                    END                                                  ISNRO
                END                                                      ISNRO
            END                                                          ISNRO
          CURPTR = NLEV ;                                                ISNRO
          END                                                            ISNRO
CONTROL EJECT;
PROC PURE$IS;      #CODE COMMON TO PUT$IS AND REP$IS#                    JJJ0908
 #                                                                       JJJ0908
* *   PURE$IS                                    PAGE  1                 JJJ0908
* *   VB GODDARD                                 DATE  76/09/07          JJJ0908
* DC   PURE$IS                                                           JJJ0908
* DC   FUNCTION                                                          JJJ0908
*     PERFORMS COMMON FUNCTIONS TO THE PUT$IS AND REP$IS PROCEDURES      JJJ0908
*     PREPARATORY TO THE ACTUAL FILE UPDATE. THESE COMMON FUNCTIONS      JJJ0908
*     INCLUDE:                                                           JJJ0908
*         ERROR CHECKING.                                                JJJ0908
*         SETTING PARAMETERS IN GCOM$AA FOR IS/MIP SUB-PROCS.            JJJ0908
*         TRANSLATING SYMBOLIC KEYS.                                     JJJ0908
*         POSITIONING FILE TO PLACE WHERE PRIMARY KEY BELONGS.           JJJ0908
*     THE CODE ALSO INCLUDES A SPECIAL TEST ENABLING IT TO BE USED       ID0913 
*     FOR THE DELT$IS PROCEDURE.                                         ID0913 
* DC  ENTRY CONDITIONS                                                   JJJ0908
*     FIT$AA,FSTT,AA,FIAT$AA,PTRE$AA, AND FINF$AA CONTAIN THE            VBG1005
*     ADDRESSES OF THEIR RESPECTIVE TABLES.                              VBG1005
*     PURE$IS IS A SYMPL PROC WITH NO PARAMETERS.                        JJJ0908
* DC  EXIT CONDITIONS                                                    JJJ0908
*     TRANSLATED SYMBOLIC KEYS ARE IN COMMON ARRAY TRKY, WITH KEY        JJJ0908
*     DESCRIPTORS SET ACCORDINGLY.                                       JJJ0908
*     FILE POSITIONING IS SET TO OUTCOME OF KEY SEARCH.                  JJJ0908
* DC  ERROR CONDITIONS                                                   JJJ0908
*     EC167 - RECORD SIZE ERROR.                                         JJJ0908
* DC  CALLED ROUTINES                                                    JJJ0908
*     MSGZ$AA - TO OUTPUT ERROR MESSAGES.                                JJJ0908
*     EZKY$IS - TO POSITION THE FILE.                                    JJJ0908
*     TRNK$IS - TO TRANSLATE KEY.                                        JJJ0908
*     KPTR$IS - SET KEY POINTERS AND TRANSLATE KEY                       JJJ1116
*     VOKM$AA - TO VERIFY THAT ITS OK TO MODIFY THE FILE.                JJJ0908
*     GOKY$IS - TO POSITION THE FILE.                                    JJJ0908
*     SIKH$IS - TO DETERMINE IF A SEEK IS IN PROGRESS.                   JJJ0908
*     EXIT$AA - TO RETURN TO AAM CONTROLLER FOLLOWING ERROR DETECTION.   JJJ0908
* DC  NON-LOCAL VARIABLES                                                JJJ0908
*     (IN GCOM$AA)                                                       JJJ0908
*     INDXLNG                                                            JJJ0908
*     OUTKEY                                                             JJJ0908
*     MIPMODE                                                            JJJ0908
*     KEYFWA                                                             JJJ0908
*     KEYOFF                                                             JJJ0908
*     MAJKEY                                                             JJJ0908
*     QREL                                                               JJJ0908
* DC  DESCRIPTION                                                        JJJ0908
*     VOKM$AA IS CALLED TO VERIFY THE FILE MODIFICATION.                 JJJ0908
*     THE RECORD SIZE IS VALIDATED. (THIS IS BYPASSED FOR DELT$IS.)      ID0913 
*     KEY DESCRIPTOR ITEMS ARE SET AND SYMBOLIC KEYS ARE TRANSLATED.     JJJ0908
*     ONE OF GOKY$IS AND EZKY$IS IS CALLED TO POSITION THE FILE,         JJJ0908
*     DEPENDING ON WHETHER OR NOT A SEEK WAS IN PROGRESS.                JJJ0908
*     AFTER ESTABLISHING FILE POSITION, THE FILE ALTERED FLAG IS SET     VBG1012
*     AND THE SEEK KEY, IF ANY, IS CLEARED IN ALL FIAT TABLES ATTACHED   VBG1012
*     TO THE FSTT.                                                       VBG1012
 #                                                                       JJJ0908
CONTROL EJECT;                                                           JJJ0908
      BEGIN                                                              JJJ0908
      ITEM X;                #PARAMETER TOR KPTR$IS, EZKY$IS, GOKY$IS#   JJJ1118
      ITEM T1,T2;            #TEMPORARIES#                               VBG1005
      ITEM OMICRON;          #TEMP STORE FOR FAPKY#                      CREATEM
                                                                         JJJ0908
                                                                         JJJ0908
      FTRL[0]=FTRRL[0];      #SET RECORD LENGTH IN RL#                   JJJ0925
      VOKM$AA;               #VERIFY OK TO MODIFY FILE#                  JJJ0908
      IF FTCOP EQ OP"DLT"  THEN X = 0;  ELSE  X = 1;                     JJJ0519
      KPTR$IS (X);                                                       JJJ1118
      IF FACREATE NQ 0                                                   JJJ0519
      THEN                                                               JJJ0519
          BEGIN                                                          JJJ0519
          OMICRON = FAPKY3ADR;                                           JJJ0519
          CPCH$AA (KEYFWA,KEYOFF,OMICRON,0,MAJKEY,KTYPE);                JJJ0519
          IF COND GR 0 OR RECCNT EQ 0  #KEYS ASCENDING OR 1ST PUT#       JJJ0519
          THEN                                                           JJJ0519
              BEGIN                                                      JJJ0519
              MOVC$AA (KEYFWA,KEYOFF,OMICRON,0,MAJKEY);                  JJJ0519
              IF RECCNT NQ 0                                             JJJ0519
              THEN           #NOT 1ST PUT#                               JJJ0519
                  BEGIN                                                  JJJ0519
                  IF PTCUREC EQ 0                                        JJJ0519
                  THEN                                                   JJJ0519
                      BEGIN                                              JJJ0519
                      GOKY$IS (1);                                       JJJ0519
                      END                                                JJJ0519
                  ELSE                                                   JJJ0519
                      BEGIN                                              JJJ0519
                      CURPTR = NLEV;                                     JJJ0519
                      IF PTBLKIN[CURPTR] EQ 0                            JJJ0519
                         OR P<BLOK$AA> NQ PTCURBADR[CURPTR]              JJJ0519
                      THEN                                               JJJ0519
                          BEGIN                                          JJJ0519
                          SEBL$AA (CURPTR,1);                            JJJ0519
                          END                                            JJJ0519
                      ELSE                                               JJJ0519
                          BEGIN                                          JJJ0519
                          LKEY$AA ; 
                          END                                            JJJ0519
                      RNO = -1;                                          JJJ0519
                      END                                                JJJ0519
                  RETURN;    #READY TO GO WITH CREATE#                   JJJ0519
                                                                         JJJ0519
                  END        #NOT 1ST PUT#                               JJJ0519
              ELSE  NULLSTMT #DOES NOTHING BUT KEEPS STRUC STRAIGHT#     JJJ0519
              END            #CREATE STILL ON#                           JJJ0519
          ELSE               #KEYS NO LONGER ASCENDING#                  JJJ0519
              BEGIN                                                      JJJ0519
              FACREATE = 0;                                              JJJ0519
              END                                                        JJJ0519
          END                                                            JJJ0519
      IF FTCOP NQ OP"PUT"  THEN X = 0;  #FOR REPLACE OR DELETE#          JJJ0519
      IF SIKH$IS EQ 0                                                    JJJ0519
      THEN                                                               JJJ0908
          BEGIN                                                          JJJ0908
          GOKY$IS(X);                                                    ID0913 
          END                                                            JJJ0908
      ELSE                   #SEEK NOT IN PROGRESS#                      JJJ0908
          BEGIN                                                          JJJ0908
          EZKY$IS(X);                                                    ID0913 
          END                                                            JJJ0908
      X=0;         #SET DATA FSTT INDEX FOR VOID SUB-PROC#               VBG1104
      VOID;        #VOID POSITIONING IN ALL REGULAR FIATS#               VBG1104
      IF FTMIPFS[0] NQ 0     #IF A MIP FILE#                             VBG1104
      THEN                   #ALSO VOID POSITIONING IN NDX-ONLY FIATS#   VBG1104
          BEGIN                                                          VBG1104
          X=FTMIPFS[0]-P<FSTT$AA>;                                       VBG1104
          VOID;                                                          VBG1104
          END                                                            VBG1104
      RETURN;                                                            VBG1104
   PROC VOID;      #VOID SEEK POSITIONING IN ALL FIATS#                  VBG1104
          BEGIN                                                          VBG1104
          FOR T1=FSFTCHN[X] WHILE T1 NQ 0        #TRAVERSE FIT CHAIN#    VBG1104
              DO                                                         VBG1104
              BEGIN                                                      VBG1104
              T1=T1-P<FIT$AA>;         #FIT INDEX#                       VBG1104
              T2=FTFIAT[T1]-P<FIAT$AA>;#FIAT INDEX#                      VBG1104
              FASEEKEY1[T2]=0;         #CLEAR SEEK KEY#                  VBG1104
              FAALTPOS[T2]=1;          #FILE ALTERED SINCE POSITIONED#   VBG1104
              T1=FTFTCH[T1];           #NEXT FIT IN CHAIN#               VBG1104
              END                                                        VBG1104
          END                                                            VBG1104
      END                                                                JJJ0908
CONTROL EJECT;
PROC PUT$IS;                                                             JJJ0908
 #                                                                       JJJ0908
* *   PUT$IS                                     PAGE  1                 JJJ0908
* *   VB GODDARD                                 DATE  76/09/07          JJJ0908
* DC  PUT$IS                                                             JJJ0908
* DC  FUNCTION                                                           JJJ0908
*     PROCESSES PUT REQUESTS FOR IS FILES.                               JJJ0908
* DC  ENTRY CONDITIONS                                                   JJJ0908
*     FIT$AA,FSTT,AA,FIAT$AA,PTRE$AA, AND FINF$AA CONTAIN THE            VBG1005
*     ADDRESSES OF THEIR RESPECTIVE TABLES.                              VBG1005
* DC  EXIT CONDITIONS                                                    JJJ0908
*                                                                        JJJ0221
*     THE FILE OR FILES SHOULD HAVE BEEN ALTERED PROPERLY, AND ANY       JJJ0221
*     PENDING SEEK INFORMATION SHOULD HAVE BEEN CANCELLED.               JJJ0221
*     FILE POSITION FROM A GETNEXT/SKIP POINT OF VIEW REMAINS            JJJ0221
*     UNCHANGED.                                                         JJJ0221
*                                                                        JJJ0221
*     IF THE RECORD COULD NOT BE ADDED TO THE MAIN FILE BECAUSE OF       JJJ0221
*     DUPLICATE KEY, THE ASSOCIATED MIP FILE WILL NOT BE ALTERED.        JJJ0221
*     IF THE SAME PROBLEM TURNS UP IN THE MIP FILE, ANY CHANGES          JJJ0221
*     ALREADY MADE IN THE MIP FILE WILL BE UNDONE. THE INSERTION IN      JJJ0221
*     THE MAIN FILE DOES NOT TAKE PLACE UNTIL ALL CHANGES HAVE BEEN      JJJ0221
*     MADE IN THE MIP FILE, SO IF THERE IS TROUBLE IN THE MIP FILE       JJJ0221
*     THE MAIN FILE WILL NOT BE ALTERED.                                 JJJ0221
*                                                                        JJJ0221
* DC  ERROR CONDITIONS                                                   JJJ0908
*     EC446 - RECORD ALREADY IN FILE.                                    CIM0204
*     EC253 - FILE LIMIT REACHED, PUT REJECTED.                          JJJ0908
*     EC503 - DUPLICATE ALTERNATE KEY, PUT REJECTED.                     JJJ0908
* DC  CALLED ROUTINES                                                    JJJ0908
*     PURE$IS - TO CHECK THE PUT AND POSITION FILE.                      JJJ0908
*     PTRP$IS - TO DO ACTUAL PUT.                                        JJJ0908
*     PUT$MP  - TO GENERATE MIP FILE UPDATES.                            JJJ0908
*     CMRC$AA - TO COMPRESS THE RECORD.                                  JJJ0908
*     MSGZ$AA - TO ISSUE DIAGNOSTIC MESSAGES.                            JJJ0908
*     DUPK$AA - TO ISSUE ERROR MESSAGE FOR DUP KEY. 
*     QUMP$AA - TO LOAD MIP CAPSULES.                                    VBG1104
* DC  NON-LOCAL VARIABLES                                                JJJ0908
*     (IN GCOM$AA)                                                       JJJ0908
*                                                                        JJJ0221
*     QMF AND RNO CONTAN THE RESULTS FROM PURE$IS. THE VALUE OF RNO      JJJ0221
*     HAS TO BE SAVED IN RNOX WHILE ANY MIP WORK IS BEING DONE,          JJJ0221
*     BECAUSE RNO IS SIMILARLY USED IN MIP. THE PTREE RETAINS            JJJ0221
*     THE RECORD NUMBER, BUT NOT THE SPECIAL NEGATIVE VALUE OF RNO THAT  JJJ0221
*     INDICATES THAT THE CURRENT POSITION IS ON THE RECORD AFTER WHICH   JJJ0221
*     THE PUT SHOULD TAKE PLACE, THIS BEING AT THE END OF A BLOCK.       JJJ0221
*                                                                        JJJ0221
*     RHO IS SET INITIALLY TO 0 BY ANY MIP UPDATE ROUTINE, AND TO        JJJ0221
*     NON-ZERO IF DUPLICATE ALTERNATE KEY TROUBLE IS FOUND.              JJJ0221
*                                                                        JJJ0221
*     CMPREC,NEWFWA,NEWLNG,AND BARREN DEFINE A REC FOR PTRP$IS           JJJ0221
*                                                                        JJJ0221
*     (IN FSTT)                                                          JJJ0908
*     FSPUTCNT - +1.                                                     JJJ0908
* DC  DESCRIPTION:                                                       JJJ0908
*     PURE$IS IS CALLED TO:                                              JJJ0908
*         SET ITEMS FOR IS SUB-PROCS.                                    JJJ0908
*         DO ALL ERROR CHECKING COMMON TO PUT AND REPLACE.               JJJ0908
*         TRANSLATE SYMBOLIC KEYS.                                       JJJ0908
*         POSITION THE FILE.                                             JJJ0908
*     THE PUT IS REJECTED IF FILE LIMIT IS REACHED OR KEY FOUND IN FILE. JJJ0908
*     IF A MIP FILE EXISTS, PUT$MP IS CALLED TO GENERATE MIP FILE        JJJ0908
*     UPDATES. AFTERWARDS, A DIAGNOSTIC IS GENERATED IF THE KEY WAS      JJJ0908
*     A DUPLICATE.                                                       JJJ0908
*     THE DESCRIPTOR PARAMETERS ARE SET UP FOR PTRP$IS.                  VBG0922
*     IF COMPRESSION IS INDICATED, CMRC$AA IS CALLED TO COMPRESS THE     JJJ0908
*     RECORD AND CHANGE THE RECORD DESCRIPTOR PARAMETERS ACCORDINGLY.    JJJ0908
*     PTRP$IS IS CALLED TO INSERT THE RECORD INTO THE FILE.              VBG0922
*     THE FSTT MOD-IN-PROGRESS FLAG IS RESET.                            JJJ0908
*     THE FSTT PUT COUNT IS INCREMENTED BY 1.                            JJJ0925
 #                                                                       JJJ0908
CONTROL EJECT;                                                           JJJ0908
      BEGIN                                                              JJJ0908
                                                                         JJJ0908
                                                                         JJJ0908
      PURE$IS;               #PRELIMINARIES TO ACTUAL PUT#               JJJ0908
      IF FTFLM[0] LQ FSRECCNT[0]       #WILL PUT VIOLATE FILE LIMIT#     JJJ0908
      THEN                             #YES, ERROR#                      JJJ0908
          BEGIN                                                          JJJ0908
          MSGZ$AA(EC253);                                                JJJ0908
          RETURN;                                                        JJJ0908
          END                                                            JJJ0908
  IF FACREATE[0] EQ 0                                                    CREATEM
  THEN                                                                   CREATEM
      BEGIN                                                              CREATEM
      IF QMF[0] NQ 0         #IF A MATCH THEN ERROR#                     JJJ0908
      THEN                                                               JJJ0908
          BEGIN                                                          JJJ0908
          DUPK$AA ( EC446 ) ; 
          RETURN;                                                        JJJ0908
          END                                                            JJJ0908
      RNOX=RNO[0];           #SAVE CURRENT RECORD NUMBER#                JJJ0908
      IF QUMP$AA(1) NQ 0     #UPDATE MIP FILE IF IT EXISTS#              VBG1104
      THEN                                                               JJJ0908
          BEGIN                                                          JJJ0908
          PUT$MP;                                                        JJJ0908
          IF RHO[0] NQ 0     #ERROR IF DUPLICATE KEYS#                   JJJ0908
          THEN                                                           JJJ0908
              BEGIN                                                      JJJ0908
              RETURN;                                                    JJJ0908
              END                                                        JJJ0908
          END                                                            JJJ0908
      RNO[0]=RNOX;           #RESTORE CURRENT NUMBER#                    JJJ0908
      END                                                                CREATEM
      CMRC$AA ;                                                          AFB0528
      BARREN[0]=0;           #NON-MIP RECORDS DONT HAVE SUB-FILES#       JJJ0908
      PTRP$IS(1);            #PUT RECORD IN FILE#                        VBG0922
      FSPUTCNT[0]=FSPUTCNT[0]+1;       #UPDATE STATISTICS#               JJJ0908
      RETURN;                                                            JJJ0908
      END                                                                JJJ0908
CONTROL EJECT;
PROC REPL$IS;                                                            ID0913 
 #                                                                       ID0913 
* *   REPL$IS                                    PAGE  1                 ID0913 
* *   VB GODDARD                                 DATE  76/09/08          ID0913 
* DC  REPL$IS                                                            ID0913 
* DC  FUNCTION                                                           ID0913 
*     PROCESS REPLACE REQUESTS FOR IS FILES.                             ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*     FIT$AA,FSTT,AA,FIAT$AA,PTRE$AA, AND FINF$AA CONTAIN THE            VBG1005
*     ADDRESSES OF THEIR RESPECTIVE TABLES.                              VBG1005
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        JJJ0221
*     THE NECESSARY CHANGES HAVE BEEN MADE TO THE DATA FILE, AND TO      JJJ0221
*     THE MIP FILE IF ANY, PROVIDED THERE WERE NO KEY ERRORS.            JJJ0221
*                                                                        JJJ0221
*     ANY PENDING SEEK INFORMATION HAS BEEN CANCELLED, BUT FILE          JJJ0221
*     POSITION FROM A GETNEXT/SKIP POINT OF VIEW REMAINS UNCHANGED.      JJJ0221
*     (IF THE LAST GETNEXT OR SKIP RELATED TO AN ALTERNATE KEY, AND      JJJ0221
*     THE RECORD AT WHICH IT LEFT US POSITIONED IS THE ONE BEING         JJJ0221
*     REPLACED, THIS IS UNTRUE TO AN UNIMPORTANT EXTENT.)                JJJ0221
*                                                                        JJJ0221
* DC  ERROR CONDITIONS                                                   ID0913 
*     EC445 - RECORD NOT FOUND, REPLACE REJECTED.                        ID0913 
*     EC503 - DUPLICATE ALTERNATE KEY.                                   ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*     PURE$IS - TO CHECK REQUEST AND POSITION THE FILE.                  ID0913 
*     PTRP$IS - TO DO ACTUAL REPLACE.                                    ID0913 
*     RPL$MP  - TO GENERATE MIP FILE UPDATES.                            ID0913 
*     CMRC$AA - TO COMPRESS THE RECORD.                                  ID0913 
*     DCMR$AA - TO DECOMPRESS A RECORD.                                  ID0913 
*     MSGZ$AA - TO ISSUE DIAGNOSTIC MESSAGES.                            ID0913 
*     QUMP$AA - TO LOAD MIP CAPSULES.                                    VBG1104
* DC  NON-LOCAL VARIABLES                                                ID0913 
*     (IN GCOM$AA)                                                       ID0913 
*                                                                        JJJ0221
*     QMF GIVES THE RESULT FROM  PURE$IS. NOTE THAT WE DO NOT WORRY      JJJ0221
*       ABOUT RNO HERE, AS  IN PUT$IS, BECAUSE IF THERE IS A TRIP        JJJ0221
*       THROUGH REPL$MP, IT WILL END WITH A REPOSITIONING AT THE RIGHT   JJJ0221
*       RECORD IN THE DATA FILE. IN PUT$IS, THAT WAS NOT QUITE ENOUGH,   JJJ0221
*       FOR THE POSITION WAS REALLY BETWEEN RECORDS, AND PURE$IS         JJJ0221
*       MIGHT HAVE LEFT RNO WITH A SPECIAL NEGATIVE VALUE THAT IS NOT    JJJ0221
*       REFLECTED IN THE PTREE. (THERE COULD BE A SPECIAL BIT IN EACH    JJJ0221
*       WORD OF THE PTREE TO DO THE SAME JOB, BUT AS PUT$IS IS THE ONLY  JJJ0221
*       PLACE WHERE THE DIFFICULTY ARISES, WE KEEP THE PTREE SIMPLER     JJJ0221
*       AND USE AN EXTRA VARIABLE IN PUT$IS.)                            JJJ0221
*                                                                        JJJ0221
*     RHO IS SET INITIALLY TO 0 BY REPL$MP, AND THEN NON-ZERO IF THERE   JJJ0221
*       IS AN IMPROPER DUPLICATION OF SOME ALTERNATE KEY.                JJJ0221
*                                                                        JJJ0221
*     CMPREC,NEWFWA,NEWLNG,AND BARREN DEFINE A NEW REC FOR PTRP$IS       JJJ0221
*                                                                        JJJ0221
*     (IN FSTT)                                                          ID0913 
*     FSREPCNT - +1.                                                     ID0913 
* DC  DESCRIPTION:                                                       ID0913 
*     PURE$IS IS CALLED TO:                                              ID0913 
*         SET ITEMS FOR IS/MIP SUB-PROCS.                                ID0913 
*         DO ALL ERROR CHECKING COMMON TO PUT AND REPLACE.               ID0913 
*         TRANSLATE SYMBOLIC KEYS.                                       ID0913 
*         POSITION THE FILE.                                             ID0913 
*     IF A MIP FILE EXISTS, RPL$MP IS CALLED TO GENERATE MIP FILE        ID0913 
*     UPDATES. AFTERWARDS, A DIAGNOSTIC IS GENERATED IF THE KEY WAS      ID0913 
*     A DUPLICATE. THE PREVIOUS COPY OF THE RECORD IS DECOMPRESSED       ID0913 
*     INTO THE COMPRESSION BUFFER, IF NECESSARY.                         ID0913 
*     THE RECORD DESCRIPTOR PARAMETERS ARE SET UP FOR PTRP$IS.           VBG0922
*     IF COMPRESSION IS INDICATED, CMRC$AA IS CALLED TO COMPRESS THE     ID0913 
*     RECORD AND CHANGE THE RECORD DESCRIPTOR PARAMETERS ACCORDINGLY.    ID0913 
*     PTRP$IS IS CALLED TO REPLACE THE CURRENT RECORD.                   VBG0922
*     THE FSTT MOD-IN-PROGRESS FLAG IS RESET.                            ID0913 
*     THE FSTT REPLACE COUNT IS INCREMENTED BY 1.                        ID0913 
 #                                                                       ID0913 
CONTROL EJECT;                                                           ID0913 
      BEGIN                                                              ID0913 
                                                                         ID0913 
                                                                         ID0913 
      PURE$IS;               #PRELIMINARIES TO ACTUAL PUT#               ID0913 
      IF QMF[0] EQ 0         #ERROR IF KEY NOT FOUND#                    ID0913 
      THEN                                                               ID0913 
          BEGIN                                                          ID0913 
          MSGZ$AA(EC445);                                                ID0913 
          RETURN;                                                        ID0913 
          END                                                            ID0913 
      RNOX=RNO[0];           #SAVE CURRENT RECORD NUMBER#                ID0913 
      IF QUMP$AA(1) NQ 0     #UPDATE MIP FILE IF IT EXISTS#              VBG1104
      THEN                                                               ID0913 
          BEGIN                                                          ID0913 
          REPL$MP;
          IF RHO[0] NQ 0     #ERROR IF DUPLICATE KEYS#                   ID0913 
          THEN                                                           ID0913 
              BEGIN                                                      ID0913 
              RETURN;                                                    ID0913 
              END                                                        ID0913 
          END                                                            ID0913 
      RNO[0]=RNOX;           #RESTORE CURRENT NUMBER#                    ID0913 
      CMRC$AA ;                                                          AFB0528
      BARREN[0]=0;           #NON-MIP RECORDS DONT HAVE SUB-FILES#       ID0913 
      PTRP$IS(0);            #REPLACE CURRENT RECORD#                    VBG0922
      FSREPCNT[0]=FSREPCNT[0]+1;       #UPDATE REPLACE COUNT#            ID0913 
      RETURN;                                                            ID0913 
      END                                                                ID0913 
                                                                         ISNRO
          END   TERM                                                     ISNRO
