0010   IDENTIFICATION DIVISION.
0020   PROGRAM-ID.   RMCRV2.
0025  *                  Ver. 2.0B
0030  *              (ISMFILE DATA RECOVERY PROGRAM
0040  *              (FOR RM/COBOL VERSION 2 LIO
0045  *              (DUAL-FILE FORMAT INDEXED FILES
      *     Date Revised    22 August 1984
0050  *     Prev Revised    19 Dec 1983
0100   ENVIRONMENT DIVISION.
0110   CONFIGURATION SECTION.
0120   SOURCE-COMPUTER.  RMC.
0130   OBJECT-COMPUTER.  RMC.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       SELECT INX-FILE ASSIGN TO RANDOM INX-NAME
           ORGANIZATION IS BINARY SEQUENTIAL.
       COPY "COPYFC.RV2".
      *
0140   DATA DIVISION.
0150   FILE SECTION.
       FD  INX-FILE.
       01  INX-RECORD                   PIC X(512).
       COPY "COPYFS.RV2".
      /
0160   WORKING-STORAGE SECTION.
0220   77  RETURN-KEY              PIC X.
0225   77  DUP-FLAG                PIC 9       VALUE 0.
0230   77  IN-RECORD-NUM           PIC 9(9)    VALUE 0.
       77  IN-DISP                 PIC Z(8)9.
0250   77  OUT-RECORD-NUM          PIC 9(9)    VALUE 0.
       77  OUT-DISP                PIC Z(8)9.
       77  DROP-COUNT              PIC 9(9)    VALUE 0.
       77  DROP-DISP               PIC Z(8)9.
0260   77  RECORD-SIZE             PIC 9(4).
0270   77  RECORD-COUNT            PIC 9(9)    COMP.
0280   77  I                       PIC 99      COMP.
0320   77  DUP-OPEN-FLAG           PIC X       VALUE "N".
0330       88  DUP-OPEN                        VALUE "Y".
0340   77  FLIPPED-FLAG            PIC X       VALUE "N".
0350       88  FLIPPED                         VALUE "Y".
       77  ERROR-IND               PIC X       VALUE "N".
           88  DUPLICATE-02                    VALUE "Y".
           88  DUPLICATE-22                    VALUE "D".
           88  OTHER-ERROR                     VALUE "E".
       77  FILE-STATUS             PIC XX.
       77  EOF-IND                 PIC X       VALUE "N".
       77  DISP-COUNT              PIC 9(9)    VALUE 0.
0360   01  KEY-SUMMARY.
0370       03  FILLER              PIC X(5)    VALUE SPACES.
0380       03  KEY-TYPE            PIC X(9)    VALUE "Primary  ".
0390       03  FILLER              PIC X(10)   VALUE " key size ".
0400       03  KEY-LENGTH          PIC ZZZ9.
0410       03  FILLER              PIC X(12)   VALUE ", at offset ".
0420       03  KEY-OFFSET          PIC ZZZ9.
0430       03  DUP-TYPE            PIC X(17).
0460   01  IN-NAME                 PIC X(23).
0490   01  OUT-NAME                PIC X(23).
0530   01  INX-NAME                PIC X(23).
0560  *
0570   01  HEADER-RECORD.
0580       03  GLOBAL-INFO.
0590           05  HEADER-CODE     PIC 9(5)    COMP-1.
0600           05  AUS-IN-HEADER   PIC 9(5)    COMP-1.
0610           05  AUS-IN-RECORD   PIC 9(5)    COMP-1.
0620           05  FILLER          PIC X(12).
0622           05  NODE-SIZE-1     PIC 9(5)    COMP-1.
0624           05  NODE-SIZE-2     PIC 9(5)    COMP-1.
0626           05  FILLER          PIC X(12).
0630           05  RECORD-COUNT-1  PIC 9(5)    COMP-1.
0640           05  RECORD-COUNT-2  PIC 9(5)    COMP-1.
0650           05  FILLER          PIC X(6).
0660           05  NUMBER-OF-KEYS  PIC 9(5)    COMP-1.
0670       03  KEY-INFO                        OCCURS 15 TIMES.
0680           05  KEY-LENGTH      PIC 9(5)    COMP-1.
0690           05  KEY-OFFSET      PIC 9(5)    COMP-1.
0700           05  FILLER          PIC X(6).
0710       03  FILLER              PIC X(316).
0720  /
0770   01  HEADER-BYTES                    REDEFINES HEADER-RECORD.
0780       03  GLOBAL-INFO-BYTES.
0790           05  HCL             PIC X.
0795           05  HCH             PIC X.
0800           05  AHL             PIC X.
0810           05  AHH             PIC X.
0820           05  ARL             PIC X.
0830           05  ARH             PIC X.
0840           05  FILLER          PIC X(12).
0842           05  NS1L            PIC X.
0844           05  NS1H            PIC X.
0846           05  NS2L            PIC X.
0848           05  NS2H            PIC X.
0849           05  FILLER          PIC X(12).
0850           05  RC1L            PIC X.
0860           05  RC1H            PIC X.
0870           05  RC2L            PIC X.
0880           05  RC2H            PIC X.
0890           05  FILLER          PIC X(6).
0900           05  NKL             PIC X.
0910           05  NKH             PIC X.
0920       03  KEY-INFO-BYTES                  OCCURS 15 TIMES.
0930           05  KLL             PIC X.
0940           05  KLH             PIC X.
0950           05  KOL             PIC X.
0960           05  KOH             PIC X.
0970           05  FILLER          PIC X(6).
0980       03  FILLER              PIC X(316).
1220  *
1230   01  FLIPPED-GLOBAL.
1240       03  HCH                 PIC X.
1245       03  HCL                 PIC X.
1250       03  AHH                 PIC X.
1260       03  AHL                 PIC X.
1270       03  ARH                 PIC X.
1280       03  ARL                 PIC X.
1290       03  FILLER              PIC X(12).
1292       03  NS1H                PIC X.
1294       03  NS1L                PIC X.
1295       03  NS2H                PIC X.
1296       03  NS2L                PIC X.
1298       03  FILLER              PIC X(12).
1300       03  RC1H                PIC X.
1310       03  RC1L                PIC X.
1320       03  RC2H                PIC X.
1330       03  RC2L                PIC X.
1340       03  FILLER              PIC X(6).
1350       03  NKH                 PIC X.
1360       03  NKL                 PIC X.
1370   01  FLIPPED-KEY.
1380       03  KLH                 PIC X.
1390       03  KLL                 PIC X.
1400       03  KOH                 PIC X.
1410       03  KOL                 PIC X.
1420       03  FILLER              PIC X(6).
1430  /
1440   PROCEDURE DIVISION.
       DECLARATIVES.
       OUTPUT-ERROR SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON OUT-FILE.
       INPUT-OUTPUT-PAR.
           IF FILE-STATUS = "02"
               MOVE "Y" TO ERROR-IND
           ELSE
               IF FILE-STATUS = "22"
                   MOVE "D" TO ERROR-IND
               ELSE
                   MOVE "E" TO ERROR-IND.
       INPUT-OUTPUT-EXIT.
           EXIT.
       END DECLARATIVES.
      *
       MAIN SECTION.
1690   START-UP.
1700       DISPLAY "Data Reclamation Program (Ver. 2.0B 22Aug84)"
               LINE 1 POSITION 22 ERASE.
1720       DISPLAY "For RM/COBOL Indexed Files" POSITION 27.
1740       DISPLAY "Original Indexed File Name? " LINE 5.
1745       DISPLAY "(with required index extension)" LINE 6.
1750       ACCEPT INX-NAME LINE 5 POSITION 29 TAB.
1760       OPEN INPUT INX-FILE.
1780       READ INX-FILE RECORD INTO HEADER-RECORD.
1790       IF AUS-IN-HEADER GREATER THAN 255 OR AUS-IN-HEADER < 0
1800           MOVE "Y" TO FLIPPED-FLAG,
1810           MOVE CORRESPONDING GLOBAL-INFO-BYTES TO FLIPPED-GLOBAL,
1820           MOVE FLIPPED-GLOBAL TO GLOBAL-INFO-BYTES.
1830       DISPLAY "Key Structure of Indexed File:" LINE 8.
1840       PERFORM SHOW-KEY VARYING I FROM 1 BY 1
1850           UNTIL I GREATER THAN NUMBER-OF-KEYS.
1860       MOVE AUS-IN-RECORD TO RECORD-SIZE.
           DISPLAY "Hit any key to continue" LINE 22 POSITION 40.
           ACCEPT RETURN-KEY POSITION 0.
1890   ENTER-IN-NAME.
1893       DISPLAY "Data Reclamation Program (Ver 2.0 22Aug84)"
                LINE 1 ERASE.
1895       DISPLAY "Dual-File Format" LINE 1 POSITION 59.
1900       DISPLAY "Original Data File Name? " LINE 5.
1910       DISPLAY "(with data file extension)" LINE 6.
1920       ACCEPT IN-NAME LINE 5 POSITION 26 TAB.
1925       IF IN-NAME = SPACES GO TO ENTER-IN-NAME.
1930       OPEN INPUT IN-FILE.
           DISPLAY "Record Length = " LINE 5 POSITION 51.
           DISPLAY RECORD-SIZE LINE 5 POSITION 67.
1935   ENTER-OUT-NAME.
1940       DISPLAY "Output Data File Name? " LINE 8.
1945       DISPLAY "(with data file extension)" LINE 9.
1950       ACCEPT OUT-NAME LINE 8 POSITION 24 TAB.
1960       IF OUT-NAME = SPACES GO TO ENTER-OUT-NAME.
1970       OPEN OUTPUT OUT-FILE.
           IF OTHER-ERROR
               DISPLAY "OPEN ERROR" LINE 21
               DISPLAY FILE-STATUS LINE 21 POSITION 20
               GO TO DONE.
1980  /
1990   CALC-RECORD-COUNT.
2000       IF RECORD-COUNT-1 < 0
2010           ADD 65536 TO RECORD-COUNT-1.
2020       IF RECORD-COUNT-2 < 0
2030           ADD 65536 TO RECORD-COUNT-2.
2040       COMPUTE RECORD-COUNT =
2050           (RECORD-COUNT-1 * 65536) + RECORD-COUNT-2 .
2060   CON-TINUE.
2070       DISPLAY "Records in      : " LINE 16 POSITION 30.
2080       DISPLAY "Records dropped : " LINE 18 POSITION 30.
2090       DISPLAY "Records out     : " LINE 20 POSITION 30.
2100       PERFORM PROCESS-RECORD THRU PROCESS-RECORD-END
2110           UNTIL IN-RECORD-NUM = RECORD-COUNT.
2120       DISPLAY "Recovery Successful" LINE 23 POSITION 40.
2170   DONE.
2180       CLOSE IN-FILE.
2190       CLOSE OUT-FILE.
2195       IF DUP-OPEN CLOSE SCRATCH-FILE.
2200   EXIT-PARA.
2210       EXIT PROGRAM.
2220   STOP-PARA.
2230       STOP RUN.
2240  *
2300   SHOW-KEY.
2310       IF FLIPPED,
2320           MOVE CORRESPONDING KEY-INFO-BYTES (I) TO FLIPPED-KEY,
2330           MOVE FLIPPED-KEY TO KEY-INFO-BYTES (I).
2340       IF KEY-LENGTH IN KEY-INFO (I) GREATER THAN 4096
2350           SUBTRACT 4096 FROM KEY-LENGTH IN KEY-INFO (I),
2360           MOVE ", with duplicates" TO DUP-TYPE,
2370       ELSE
2380           MOVE SPACES TO DUP-TYPE.
2390       MOVE CORRESPONDING KEY-INFO (I) TO KEY-SUMMARY.
2400       DISPLAY KEY-SUMMARY.
2410       MOVE "Alternate" TO KEY-TYPE.
2500  /
2930   PROCESS-RECORD.
3000       READ IN-FILE RECORD INTO OUT-RECORD.
           IF OUT-RECORD = LOW-VALUES
               ADD 1 TO IN-RECORD-NUM
               ADD 1 TO RECORD-COUNT
               GO TO PROCESS-RECORD-END.
           ADD 1 TO DISP-COUNT.
           MOVE DISP-COUNT TO IN-DISP.
           ADD 1 TO IN-RECORD-NUM.
           DISPLAY IN-DISP LINE 16 POSITION 48.
3020       PERFORM WRITE-RECORD THRU WRITE-END.
       PROCESS-RECORD-END.
3030       IF EOF-IND = "Y" GO TO DONE.
      *
       WRITE-RECORD.
           WRITE OUT-RECORD.
           IF DUPLICATE-02
               MOVE "N" TO ERROR-IND.
           IF DUPLICATE-22
               PERFORM DUP-WRITE-ERROR.
           IF OTHER-ERROR
               MOVE "Y" TO EOF-IND
               DISPLAY "INPUT-OUTPUT ERROR" LINE 21
               DISPLAY FILE-STATUS LINE 21 POSITION 20
               MOVE "N" TO ERROR-IND
               GO TO WRITE-END.
           ADD 1 TO OUT-RECORD-NUM.
           MOVE OUT-RECORD-NUM TO OUT-DISP.
           DISPLAY OUT-DISP LINE 20 POSITION 48.
       WRITE-END.
           EXIT.
      *
       DUP-WRITE-ERROR.
           IF DUP-FLAG = 0
               OPEN OUTPUT SCRATCH-FILE
               MOVE "Y" TO DUP-OPEN-FLAG
               ADD 1 TO DUP-FLAG.
           ADD 1 TO DROP-COUNT.
           MOVE DROP-COUNT TO DROP-DISP.
           DISPLAY DROP-DISP LINE 18 POSITION 48.
           MOVE "N" TO ERROR-IND.
           MOVE SPACES TO SCRATCH-REC.
           MOVE OUT-RECORD TO SCRATCH-REC.
           WRITE SCRATCH-REC.
           GO TO WRITE-END.
      *
       END PROGRAM.
