*DECK DB$RUPD 
USETEXT JLDEFTX 
USETEXT CDCSCTX 
      PROC DB$RUPD; 
      BEGIN 
 #
* *   DB$RUPD - RECOVERY/RESTORE UPDATE ROUTINE  PAGE  1
* *   J E ESLER                                  DATE  08/30/76 
* *   A W ALLEN - DATABASE VERSIONS              DATE  09/19/80 
* 
* DC  PURPOSE 
* 
*     APPLY BEFORE/AFTER IMAGES SELECTED FROM A LOG FILE TO A DATABASE. 
*     OPTIONALLY, THE UPDATE PROCESS IS RECORDED ON JOURNAL AND QUICK 
*     RECOVERY LOGS.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL - THE DATABASE HAS BEEN UPDATED TO REFLECT THE SELECTED
*              LOG FILE RECORDS.
*     ABNORMAL-IF ANY ERROR CONDITION IS DETECTED, THE RUN IS TERMINATED
*              TO PREVENT FURTHER DAMAGE TO THE DATABASE. 
* 
* DC  CALLING ROUTINES
* 
*     DB$RVRS - RECOVERY/RESTORE CONTROL ROUTINE
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ABRT;           #ABORT THE PROGRAM#
      XREF PROC DB$ARAT;           #ATTACH A DB AREA# 
      XREF PROC DB$ARRN;           #RETURN A DB AREA# 
      XREF FUNC DB$CBIN;           #CONVERT DISPLAY CODE TO BINARY# 
      XREF FUNC DB$CDIS C(10);     #CONVERT TO DISPLAY CODE#
      XREF PROC DB$CLOG;           #CLOSE JOURNAL LOG FILES#
      XREF PROC DB$EPRT;           #PRINT A LINE# 
      XREF PROC DB$JLBA;           #WRITE BEFORE/AFTER JOURNAL LOG REC# 
      XREF PROC DB$JLCL;           #WRITE CLOSE JOURNAL LOG RECORD# 
      XREF PROC DB$JLIN;           #WRITE INVOKE JOURNAL LOG RECORD#
      XREF PROC DB$JLOP;           #WRITE OPEN JOURNAL LOG RECORD#
      XREF PROC DB$JLST;           #LIST A JOURNAL LOG RECORD#
      XREF PROC DB$JLTM;           #WRITE TERMINATE JOURNAL LOG RECORD# 
      XREF PROC DB$LNIF;           #INITIALIZE JOURNAL LOG FILES# 
      XREF PROC DB$MDER;           #MD ERROR PROCESSOR# 
      XREF PROC DB$MFA;            #ALLOCATE MM BLOCK#
      XREF PROC DB$MFF;            #RELEASE MM BLOCK# 
      XREF PROC DB$MSG;            #ISSUE DAYFILE MESSAGE#
      XREF PROC DB$RPV;            #SET REPRIEVE ADDRESS# 
      XREF PROC DB$STA;            #PRINT AREA UPDATE STATISTICS# 
      XREF PROC DB$STT;            #PRINT RUN UPDATE STATISTICS#
      XREF PROC DB$UCLF;           #CLOSE I/O FILES#
      XREF PROC DB$UQIN;           #INITIALIZE QRF FILE#
      XREF PROC DB$UQRP;           #FLUSH QRF AND GENERATE RECOVERY PT# 
      XREF PROC DB$URFP;           #WRITE BLOCKS TO QRF#
      XREF PROC DB$VEPN;           # FIND PRIMARY VERSION NAME         #
      XREF PROC DB$VERL;           # VERSION NAME LOOK-UP IN MD        #
      XREF PROC DB$WGET;           #WORD ADDRESSABLE READ INTERFACE#
      XREF PROC CLOSEM;            #CRM CLOSE MODULE# 
      XREF PROC DLTE;              #CRM DELETE MODULE#
      XREF PROC GET;               #CRM READ MODULE#
      XREF PROC OPENM;             #CRM OPEN MODULE#
      XREF PROC PUT;               #CRM WRITE MODULE# 
      XREF PROC REPLC;             #CRM REPLACE MODULE# 
# 
* DC  NON-LOCAL VARIABLES 
# 
      XREF ITEM DB$FLRQ B;         #FLAG REQUESTING FLUSH OF QRF FILE  #
      XREF ARRAY DB$FTMD;;         #FIT FOR MASTER DIRECTORY           #
      XREF ARRAY DB$RA0;;          #ARRAY BASED AT RA+0#
      XREF ARRAY DB$JFIT;          #MODEL FIT FOR JOURNAL LOG#
        BEGIN 
        ITEM LOGFITWD;
        END 
# 
*     CDCS COMMON,RECOVERY/RESTORE COMMON,
 #
      CONTROL NOLIST;              # RVRSCOMMN                         #
*CALL RVRSCOMMN 
      CONTROL LIST; 
# 
*     LOCAL VARIABLES 
# 
      ITEM AREAMSG1 C(45) = "0  AREA NAME ="; 
      ITEM AREAMSG2 C(61) = 
      "   SCHEMA ID = XXXX   AREA ID = XXXX   VERSION NAME = XXXXXXX";
      ITEM BADRECTYPE C(44) = " ERROR - ILLEGAL RECORD TYPE ON SELECT FI
LE:"; 
      ITEM DCAREAORD C(4) = " ";   #AREA ORDINAL IN DISPLAY CODE# 
      ITEM INDEX;                  #LOOP INDEX# 
      ITEM KL;                     #KEY LENGTH# 
      ITEM ARID;                   #AREA ID, INTEGER# 
      ITEM JOBNAME C(7) = " ";     #JOB NAME FOR JOURNAL LOGGING# 
      ITEM LOGERR = 0;             #LOGGING ERROR CODE# 
      ITEM PROGNAME C(10);         #PROGRAM NAME FOR JOURNAL LOGGING# 
      ITEM KLW;                    #KEY LENGTH IN WORDS#
      ITEM TLEN I;                 #TRAILER LENGTH IN CHARS#
      ITEM PAD I;                  #UNUSED CHAR COUNT#
      ITEM PFOFF U;                # OFFSET TO PRIMARY VERSION PF INFO #
                                   # IN THE MD.                        #
      ITEM PVENAME C(07);          # PRIMARY VERSION NAME OF CURRENT   #
                                   # DATABASE FILE.                    #
      ITEM RVENAME C(07);          # REQUESTED VERSION NAME OF CURRENT #
                                   # SELECT FILE RECORD.               #
      ITEM BADRECL C(52) =
          " ERROR - INCORRECT RECORD LENGTH DATA IN LOG RECORD:"; 
      ARRAY MDSCINFO S(DFMDSCINSZ); 
        BEGIN 
*CALL MDSCIDCLS 
        END 
      BASED ARRAY RECORD;;         #LOGGED RECORD#
      BASED ARRAY RECKEY;;         #KEY OF LOGGED RECORD# 
      ITEM QRFLFN C(07) = O"21220614170700";
                                   # QRF LFN - QRFLOG                  #
      ITEM RECLEN;                 #LOGGED RECORD LENGTH# 
      ITEM SELOPNERR C(34) = " CRM ERROR ON OPEN OF SELECT FILE:";
      ITEM SELCRMERR C(26) = " CRM ERROR ON SELECT FILE:";
      ITEM SELVERRF B;             # TRUE IF VERSION ERROR             #
      ITEM SELVERERR C(42)=" VERSION ON SELECT FILE DOES NOT MATCH MD:";
      ITEM SELRECTYPE C(1);        #LOG RECORD TYPE FOR THIS RUN# 
      ITEM WRTDIRCODE C(1);        #LOG DIRECTIVE CODE FOR DB WRITE#
      ITEM REWDIRCODE C(1);        #LOG DIRECTIVE CODE FOR DB REWRITE#
      ITEM DELDIRCODE C(1);        #LOG DIRECTIVE CODE FOR DB DELETE# 
      ITEM VERSUB U;               # VERSION SUBSCRIPT                 #
      ITEM WSARL;                  #LENGTH OF "BEFORE" IMAGE RECORD#
      BASED ARRAY WSA;;            #WORKING STORAGE FOR "BEFORE " IMAGE#
      ARRAY SFIT [DFFITSIZE] S;    #SELECTION FILE FIT# 
        BEGIN 
        ITEM SFITWD (0,0,60); 
        ITEM SFITLFN C(0,0,7);     #FILE NAME#
        ITEM SFITFP  U(10,26,7);   #FILE POSITION#
        ITEM SFITRL  U(11,0,24);   #RECORD LENGTH#
        ITEM SFITMRL U(12,0,24);   #MAXIMUM RECORD LENGTH#
        ITEM SFITES  U(13,33,9);   #ERROR STATUS# 
        ITEM SFITHL  U(15,0,24);   #HEADER LENGTH OF A T TYPE RECORD   #
                                   #IN CHARACTERS.                     #
        ITEM SFITWSA U(15,42,18);  #WORKING STORAGE AREA# 
        ITEM SFITCP  U(17,15,24);  #TRAILER COUNT BEGINNING CHARACTER  #
                                   #POSITION OF A T TYPE RECORD.       #
        END 
 #
* 
* DC  DESCRIPTION 
* 
*     MAIN PROGRAM DOES THE FOLLOWING-- 
*       INITIALIZE FIT FOR SORTED SELECT FILE, UPDATE PARAMETERS AND
*         STATISTICS. 
*       INITIALIZE JOURNAL LOG FILE, IF REQUESTED (THAT IS, IF THE
*         RECOVERY/RESTORE OPERATION IS ITSELF TO BE LOGGED.
*       IF QRF LOGGING IS DEFINED FOR THE SCHEMA
*       THEN
*         INITIALIZE QRF. 
*       SET REPRIEVE ADDRESS. 
*       FOR ALL RECORDS ON THE SELECT FILE
*         BEGIN 
*         READ SELECT FILE RECORD.
*         IF NEW AREA ID OR NEW VERSION NAME
*         THEN
*           RETURN PREVIOUS FILE (RETURNAREA).
*           ATTACH NEW FILE (ATTACHAREA). 
*         IF QRF IS FULL
*         THEN
*           FLUSH IT (DB$UQRP). 
*         APPLY RECORD TO DATABASE AND WRITE JOURNAL LOG RECORD IF
*           NEEDED. 
*         ABORT IF UNRECOGNIZED LOG RECORD. 
*         END 
*       WHEN EOI IS REACHED ON THE SELECT FILE, CLOSE IT, RETURN THE
*         LAST DATABASE FILE, AND OUTPUT THE RUN STATISTICS.
* 
*     INTERNAL PROCEDURES-- 
* 
 #
  
  
  
  
      PROC ABTUPD;
      BEGIN 
 #
*     ABTUPD - ABORT THE PROGRAM WITH ABORT MESSAGE.
*     NOTE...SEE PROCEDURE REPRIEVE FOR REPRIEVE PROCESSING.
 #
      DB$MSG("  **PROGRAM ABORTED**:"); 
      DB$ABRT;
      END 
  
  
  
  
      PROC ATTACHAREA;
      BEGIN 
 #
*     ATTACHAREA - ATTACH A DATABASE FILE (AND INDEX FILE) AND OPEN IT. 
 #
  
#     IF SELECTION FILE IS INPUT FILE ("RCV" PARAMETER) THEN FIND      #
#       VERSION INFORMATION IN MD.                                     #
  
      IF JLHDVENM[0] NQ DFMASTER
        AND NOT SELECTION 
      THEN
        BEGIN 
        SELVERRF = FALSE; 
        DB$VERL(JLHDVENM[0],VERSUB);  # FIND VERSION NAME ON MD.       #
        IF VERSUB EQ 0             # IF INVALID VERSION...             #
        THEN
          SELVERRF = TRUE;         # SET ERROR FLAG.                   #
        ELSE
          BEGIN                    # VERSION OK, FIND PRIMARY VERSION. #
          ARID = DB$CBIN(JLHDARID[0],4,10); 
          DB$VEPN(VERSUB,ARID,PVENAME,PFOFF); 
          SELPFOFF[0] = PFOFF;
          IF PVENAME NQ SELPVENAM[0]
          THEN                     # IF PRIMARY VERSION HAS CHANGED... #
            SELVERRF = TRUE;       # SET ERROR.  SELECT FILE COULD BE  #
          END                      # SORTED WRONG.                     #
        IF SELVERRF                # IF SELECT FILE HAS INCORRECT      #
        THEN                       # VERSION DATA...                   #
          BEGIN                    # PRINT MESSAGES AND ABORT.         #
          DB$EPRT(SELVERERR,42);
          C<15,4>AREAMSG2 = JLHDSCID[0];
          C<32,4>AREAMSG2 = JLHDARID[0];
          C<54,7>AREAMSG2 = JLHDVENM[0];
          DB$EPRT(AREAMSG2,36); 
          ABTUPD; 
  
          END 
        END 
      DB$ARAT(JLHDARID[0],SELPFOFF[0]); 
      IF ATTACHSTATUS NQ 0 THEN 
        ABTUPD;                        #ERROR-TERMINATE RUN#
      DCAREAORD = JLHDARID[0];
#                                                                      #
#     OUTPUT AREA NAME, AREA ID AND SCHEMA ID.                         #
#                                                                      #
      C<15,30>AREAMSG1 = MDADARNM[0]; 
      DB$EPRT(AREAMSG1,45); 
      C<15, 4>AREAMSG2 = JLHDSCID;
      C<32, 4>AREAMSG2 = JLHDARID;
      C<54, 7>AREAMSG2 = SELPVENAM[0];  # PRIMARY VERSION NAME         #
      DB$EPRT(AREAMSG2,36); 
 #
*     IF BLOCK LOGGING IS SPECIFIED, SET REQUIRED FIT FIELDS. 
 #
      IF MDAILGBB[0]
      THEN
        AFITLGX[0] = LOC(DB$URFP);
 #
*     OPEN THE FILE.
 #
      AFITPD[0] = 3;                   #OPEN FOR I/O# 
      AFITKP[0] = 0;         #KEY IS LEFT JUSTIFIED IN LOG RECORD#
# 
*               **** TEMPORARY CODE ****
*     SET A BIT IN THE FIT TO EXEMPT THIS FILE FROM THE CRM ERROR 202 
*     THAT COULD RESULT IF THE FSMODFLG BIT IS SET IN THE FSTT WHEN 
*     THE FILE IS OPENED. 
# 
      B<0,1>AFITWD[29] = 1; 
      OPENM(AFIT,DB$RA0); 
      IF AFITES[0] NQ 0 THEN           #ERROR ON OPEN#
        BEGIN 
        CRMERR("OPEN"); 
        ABTUPD;                        #ABORT THE RUN-FATAL ERROR#
        END 
      ARID = MDADIDNT[0]; 
      PVENAME = SELPVENAM[0]; 
      REQVERS = JLHDVENM[0];       # SAVE REQUESTED VERSION NAME       #
      IF NEWLOG1 NQ 0 THEN
        BEGIN 
        DB$MFA(AFITMRL,P<WSA>);        #RESERVE WSA FOR "BEFORE" IMAGE# 
        DB$JLOP(ARID,MDADARNM[0],DFJLDCB,JOBNAME,PROGNAME,PVENAME); 
        END 
      RETURN; 
      END 
  
  
  
  
  
  
      PROC CRMERR((ERROPR));
      BEGIN 
 #
*     CRMERR - REPORT A CRM ERROR ON A DATABASE (OR INDEX) FILE.
 #
      ITEM CRMERRMSG C(36) = "0CRM ERROR XXX PROCESSING XXXXXXX"; 
      ITEM ERROPR C(7);            #OPERATION ATTEMPTED ON FILE#
  
      C<11,3>CRMERRMSG = DB$CDIS(AFITES[0],3,8,"0");
      C<26,7>CRMERRMSG = ERROPR;
      DB$EPRT(CRMERRMSG,36);
      DB$JLST;
      END 
  
  
  
  
  
  
      PROC REPRIEVE;
      BEGIN 
 #
*     REPRIEVE - CALLED BY SYSTEM IF THE RUN ABORTS.  AN ERROR MESSAGE
*     IS ISSUED, THE DATABASE AREA IS RETURNED, STATISTICS ARE PRINTED, 
*     AND WE RETURN TO THE SYSTEM TO RESET THE ERROR CONDITION. 
 #
      ITEM REPRIEVMSG C(38) = " RECOVER/RESTORE ABORT, JOB REPRIEVED:"; 
  
      DB$MSG(REPRIEVMSG); 
      DB$EPRT(REPRIEVMSG,37); 
 #
*     IF BLOCK LOGGING IS BEING PERFORMED FOR THIS AREA,
*     THE AREA IS NOT CLOSED AND THE QRF IS NOT FLUSHED.
 #
      IF NOT MDAILGBB[0]
      THEN
        RETURNAREA; 
      ELSE
        DB$STA;                    #OUTPUT STATISTICS FOR AREA# 
      DB$STT; 
      DB$UCLF;
      DB$JLTM(0,TOTLWRITES,TOTLREWRITES,TOTLDELETES,SASCNAME[0],
              JOBNAME,PROGNAME,DFCLRVENM);
      DB$CLOG;
      RETURN; 
      END 
  
  
  
  
  
      PROC RETURNAREA;
 #
*     RETURNAREA - RETURN A DATABASE FILE AND OUTPUT ITS UPDATE 
*                  STATISTICS.
                   FLUSH THE QRF IF IT WAS BEING USED.
 #
      BEGIN 
      IF DCAREAORD EQ " " THEN         #NO AREA IS OPEN - RETURN# 
        RETURN; 
      IF NEWLOG1 NQ 0 THEN
        BEGIN 
        DB$MFF(P<WSA>); 
        DB$JLCL(ARID,MDADARNM[0],0,CNTWRITES,CNTREWRITES,CNTDELETES,
              JOBNAME,PROGNAME,PVENAME);
        END 
      DB$STA;                          #OUTPUT AREA STATISTICS# 
      CLOSEM(AFIT,DFDET,DB$RA0);
      IF MDAILGBB[0]               # IF QRF LOGGING ACTIVE...          #
      THEN
        DB$UQRP;                     #FLUSH QRF#
      DB$ARRN(AFIT);
      DCAREAORD = " ";
      END 
  
  
  
  
#     S T A R T   O F   D B $ R U P D   E X E C U T A B L E   C O D E  #
  
  
#     INITIALIZE SELECT FILE FIT, UPDATE PARAMETERS AND STATISTICS.    #
  
      FOR INDEX = DFFITSIZE-1 STEP -1 UNTIL 0 DO
        SFITWD[INDEX] = LOGFITWD[INDEX];
      SFITLFN[0] = C<0,7>SELLFN;
      SFITMRL[0] = SASCMAXLOG[0] + DFSELCHARS;
                                           # MAX. SELECT FILE RECORD   #
                                           # SIZE.                     #
      SFITHL[0] = SFITHL[0] + DFSELCHARS; 
      SFITCP[0] = SFITCP[0] + DFSELCHARS; 
                                   # INCREASE THE HEADER LENGTH AND THE#
                                   # BEGINNING CHARACTER POSITION OF   #
                                   # THE TRAILER COUNT TO ACCOMMODATE  #
                                   # THE ADDED WORD OF THE SELECT FILE #
                                   # RECORD.                           #
      DB$MFA((SASCMAXLOG[0] + 9)/10 + DFSELWORDS,P<SELREC>);
                                           # RESERVE WSA FOR SELECT    #
                                           # FILE.                     #
      SFITWSA[0] = P<SELREC>; 
      P<LOGREC> = P<SELREC> + DFSELWORDS;  # LOG RECORD FORMAT COMES   #
                                           # AFTER SELECT FILE HEADER  #
                                           # WORD.                     #
      P<RECKEY> = LOC(JLBARKEY[0]); 
      OPENM(SFIT,DFINPUT,DB$RA0); 
      IF SFITES[0] NQ 0 THEN           #ERROR ON SELECT FILE# 
        BEGIN 
        DB$MSG(SELOPNERR);
        DB$EPRT(SELOPNERR,33);
        DB$ABRT;
        END 
      IF RECOVRUN THEN                 #SET LOG RECORD TYPES FOR DBRCN# 
        BEGIN 
        SELRECTYPE = DFJLRQAI;
        WRTDIRCODE = DFJLDCD; 
        REWDIRCODE = DFJLDCE; 
        DELDIRCODE = DFJLDCF; 
        PROGNAME = "DBRCN"; 
        END 
      ELSE                             #SET LOG RECORD TYPES FOR DBRST# 
        BEGIN 
        SELRECTYPE = DFJLRQBI;
        WRTDIRCODE = DFJLDCF; 
        REWDIRCODE = DFJLDCE; 
        DELDIRCODE = DFJLDCD; 
        PROGNAME = "DBRST"; 
        END 
      CNTWRITES = 0;
      CNTREWRITES = 0;
      CNTDELETES  = 0;
      TOTLWRITES = 0; 
      TOTLREWRITES = 0; 
      TOTLDELETES = 0;
      ERRWRITES = 0;
      ERRREWRITES = 0;
      ERRDELETES = 0; 
# 
*     INITIALIZE JOURNAL LOG FILE, IF REQUESTED 
# 
      SASCJAFG[0] = FALSE;         # INDICATES NO JOURNAL LOGGING OF   #
      SAJLSWF[0] = FALSE;          # RECOVER/RESTORE OPTION.           #
      IF NEWLOG1 NQ 0              # IF OUTPUT LOG FILE SPECIFIED...   #
      THEN
        BEGIN 
        SASCJAFG[0] = TRUE;        # INDICATES THAT RECOVER/RESTORE    #
        SAJLSWF[0] = TRUE;         # OPERATION IS TO BE LOGGED.        #
        DB$LNIF(NEWLOG1,LOGERR);
        IF LOGERR NQ 0 THEN 
          ABTUPD; 
        DB$JLIN(SASCNAME[0],JOBNAME,PROGNAME,DFCLRVENM);
        END 
# 
*     INITIALIZE QRF LOGGING IF DEFINED FOR SCHEMA. 
# 
      IF SASCQRF[0] 
      THEN
        BEGIN 
        DB$WGET(DB$FTMD,MDSCINFO,DFMDSCINSZ,SASCWASC[0] 
               ,DB$MDER); 
        DB$UQIN(QRFLFN,LOGERR); 
        IF LOGERR NQ 0 THEN 
          ABTUPD; 
        END 
# 
*     SET REPRIEVE ADDRESS. 
# 
      DB$RPV(REPRIEVE); 
      DB$MFA(DFMDADEN,P<MDARDIR>);     #RESERVE AREA DIRECTORY# 
# 
*     READ SELECT FILE AND VALIDATE RECORD. 
# 
      FOR INDEX = INDEX WHILE SFITFP[0] NQ DFEOI DO 
        BEGIN 
        GET(SFIT,DB$RA0); 
        RVENAME = JLHDVENM[0];
        IF SFITES[0] NQ 0 THEN
          BEGIN 
          DB$MSG(SELCRMERR);
          DB$EPRT(SELCRMERR,25);
          DB$JLST;
          ABTUPD; 
          END 
        IF SFITRL[0] EQ 0 THEN
          TEST;                        #NO DATA READ# 
  
        IF JLHDTYPE[0] NQ SELRECTYPE THEN  #UNEXPECTED LOG RECORD TYPE# 
          BEGIN 
          DB$EPRT(BADRECTYPE,43); 
          DB$MSG(BADRECTYPE); 
          DB$JLST;
          ABTUPD;                      #FATAL ERROR - ABORT#
          END 
  
  
        IF JLHDARID[0] NQ DCAREAORD    # IF NEW AREA ID TO PROCESS     #
          OR SELPVENAM[0] NQ PVENAME   # OR NEW PRIMARY VERSION        #
        THEN                           # NEED A NEW DB FILE...         #
          BEGIN 
          RETURNAREA;                      #RETURN PREVIOUS AREA# 
          ATTACHAREA;                      #ATTACH NEW AREA#
          END 
# 
*     IF THE QRF IS FULL, FLUSH IT. 
# 
        IF DB$FLRQ THEN 
          DB$UQRP;
# 
*     APPLY RECORD TO DATABASE. 
# 
        KL = DB$CBIN(JLHDKEYL[0],3,10); 
        KLW = (KL + 9) / 10;
        P<RECORD> = LOC(JLBARKEY[0]) + KLW; 
#                                                                      #
#     COMPUTE RECORD LENGTH. THROW AWAY PADDING ADDED TO MAKE THE      #
#     LOG RECORD LENGTH A MULTIPLE OF 10 CHARACTERS.                   #
#                                                                      #
        TLEN = DB$CBIN( JLHDTRLS [0], 6, 10 );   # TRAILER LENGTH      #
        PAD  = DB$CBIN( JLHDPAD  [0], 1, 10);    # UNUSED CHAR COUNT   #
#                                                                      #
#     IF DB$CBIN RETURNED A NEGATIVE VALUE, AN ERROR OCCURRED          #
#                                                                      #
        IF TLEN LS 0 OR PAD LS 0
        THEN
          BEGIN 
          DB$MSG( BADRECL );            # ERROR MSG ON DAYFILE         #
          DB$EPRT( BADRECL, 51);        # ERROR MSG ON FILE "OUTPUT"   #
          DB$JLST;                      # PRINT LOG REC HEADER         #
          ABTUPD;                       # ABORT DBRCN/DBRST            #
          END 
        RECLEN = TLEN - 10 * KLW - PAD; # COMPUTE REC LEN              #
        IF JLHDDIRC[0] EQ WRTDIRCODE THEN 
          BEGIN 
          PUT(AFIT,RECORD,RECLEN,RECKEY,DB$RA0);
          IF AFITES[0] NQ 0 THEN
            BEGIN 
            ERRWRITES = ERRWRITES + 1;
            CRMERR("WRITE");
            AFITES[0] = 0;
            END 
          ELSE
            BEGIN 
            CNTWRITES = CNTWRITES + 1;
            IF NEWLOG1 NQ 0 THEN
              BEGIN 
              DB$JLBA(DFJLRQBI,P<RECKEY>,KL,0,0,ARID,DFJLDCD, 
                      JOBNAME,PROGNAME,RVENAME);
              DB$JLBA(DFJLRQAI,P<RECKEY>,KL,RECORD,RECLEN,ARID,DFJLDCD, 
                      JOBNAME,PROGNAME,RVENAME);
              END 
            END 
          TEST; 
  
          END 
  
#     IF LOGGING IS REQUESTED, READ THE "BEFORE" IMAGE OF THE RECORD   #
#     BEFORE PERFORMING THE REWRITE OR DELETE.                         #
  
        IF NEWLOG1 NQ 0 THEN
          BEGIN 
          GET(AFIT,WSA,RECKEY,DB$RA0);
          IF AFITES[0] EQ 0 THEN
            WSARL = AFITRL[0];
          ELSE
            WSARL = 0;
          END 
  
        IF JLHDDIRC[0] EQ REWDIRCODE THEN 
          BEGIN 
          REPLC(AFIT,RECORD,RECLEN,RECKEY,DB$RA0);
          IF AFITES[0] NQ 0 THEN
            BEGIN 
            ERRREWRITES = ERRREWRITES + 1;
            CRMERR("REWRITE");
            AFITES[0] = 0;
            END 
          ELSE
            BEGIN 
            CNTREWRITES = CNTREWRITES + 1;
            IF NEWLOG1 NQ 0 THEN
              BEGIN 
              DB$JLBA(DFJLRQBI,P<RECKEY>,KL,WSA,WSARL,ARID,DFJLDCE, 
                      JOBNAME,PROGNAME,RVENAME);
              DB$JLBA(DFJLRQAI,P<RECKEY>,KL,RECORD,RECLEN,ARID,DFJLDCE, 
                      JOBNAME,PROGNAME,RVENAME);
              END 
            END 
          TEST; 
  
          END 
        IF JLHDDIRC[0] EQ DELDIRCODE THEN 
          BEGIN 
          DLTE(AFIT,RECKEY,DB$RA0); 
          IF AFITES[0] NQ 0 THEN
            BEGIN 
            ERRDELETES = ERRDELETES + 1;
            CRMERR("DELETE"); 
            AFITES[0] = 0;
            END 
          ELSE
            BEGIN 
            CNTDELETES = CNTDELETES + 1;
            IF NEWLOG1 NQ 0 THEN
              BEGIN 
              DB$JLBA(DFJLRQBI,P<RECKEY>,KL,WSA,WSARL,ARID,DFJLDCF, 
                      JOBNAME,PROGNAME,RVENAME);
              DB$JLBA(DFJLRQAI,P<RECKEY>,KL,0,0,ARID,DFJLDCF, 
                      JOBNAME,PROGNAME,RVENAME);
              END 
            END 
          TEST; 
  
#     RECORD WAS NOT RECOGNIZED - ABORT RUN.                           #
        DB$MSG(BADRECTYPE); 
        DB$EPRT(BADRECTYPE,43); 
        DB$JLST;
        ABTUPD; 
          END 
        END  #INDEX#
# 
*     WHEN EOI IS REACHED ON THE SELECT FILE, CLOSE IT, RETURN THE LAST 
*     DB AREA, AND OUTPUT THE RUN STATISTICS. 
# 
      RETURNAREA;                          #RETURN LAST AREA# 
      CLOSEM(SFIT,DFDET,DB$RA0);
      DB$MFF(P<SELREC>);
      DB$STT;                          #OUTPUT RUN STATISTICS#
      IF NEWLOG1 NQ 0 THEN
      DB$JLTM(0,TOTLWRITES,TOTLREWRITES,TOTLDELETES,SASCNAME[0],
              JOBNAME,PROGNAME,DFCLRVENM);
      DB$CLOG;
      END 
      TERM
