0010   IDENTIFICATION DIVISION.
0020   PROGRAM-ID.   RMCCNV.
0025  *                  Ver. 2.0B
0030  *              (ISAMFILE CONVERSION PROGRAM
0040  *              (FOR RM/COBOL VERSION 2 LIO
      *     Date Revised    12 July 1984
0050  *     Prev Revised    09 Mar 1984
0100   ENVIRONMENT DIVISION.
0110   CONFIGURATION SECTION.
0120   SOURCE-COMPUTER.  RMC.
0130   OBJECT-COMPUTER.  RMC.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       SELECT DUMMY-FILE ASSIGN TO RANDOM DUMMY-NAME
           ORGANIZATION IS BINARY SEQUENTIAL.
       COPY "COPYFC.CNV".
      *
0140   DATA DIVISION.
0150   FILE SECTION.
       FD  DUMMY-FILE.
       01  DUMMY-REC                    PIC X(256).
       COPY "COPYFS.CNV".
      /
0160   WORKING-STORAGE SECTION.
0190   77  FORMAT-TYPE             PIC 9.
0200   77  DUP-FLAG                PIC 9       VALUE 0.
0210   77  RETURN-KEY              PIC X.
0210   77  CURRENT-AU              PIC 9(10)   VALUE 0.
0220   77  LAST-AU                 PIC 9(10)   COMP.
0230   77  SECTOR-AU               PIC 9       VALUE 8.
0270   77  FOUND-DISP              PIC Z(8)9.
0280   77  FOUND                   PIC 9(9)    VALUE 0.
0290   77  REMAINING-AUS-IN-RECORD PIC 99999   COMP-1.
0300   77  DUP-OPEN-FLAG           PIC X       VALUE "N".  
           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  DROP-COUNT              PIC 9(9)    VALUE 0.
       77  DROP-DISP               PIC Z(8)9.
       77  OUT-COUNT               PIC 9(9)    VALUE 0.
       77  OUT-DISP                PIC Z(8)9.
       77  EOF-IND                 PIC X       VALUE "N".
       77  FIRST-REC-FLAG          PIC 9.
       77  DISPLAY-REC-LEN         PIC 9(5).
       77  X-REC                   PIC X.
       01  X-REC-LEN-1.
           03  A-REC               PIC X.
           03  B-REC               PIC X.
       01  X-REC-LEN               REDEFINES X-REC-LEN-1
                                   PIC 9(5)    COMP-1.
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  DUMMY-NAME              PIC X(23).
0490   01  OUT-NAME                PIC X(23).
      /
       77  I                       PIC 99      COMP.
       77  J                       PIC 9       COMP.
       77  K                       PIC 99      COMP.
       77  L                       PIC 9       COMP.
       77  R                       PIC 9(5)    COMP.
       77  TEMP-WORD               PIC S9(5).
       01  BIT-VALUES.
           03  FILLER              PIC 9(16)
                   VALUE 4096025600160001.
       01  BIT-VALUE-TABLE REDEFINES BIT-VALUES.
           03  BIT-VALUE           PIC 9(4)
                                   OCCURS 4 TIMES.
       01  HEX-VALUES.
           03  FILLER              PIC X(16)
                   VALUE "0123456789ABCDEF".
       01  HEX-VALUE-TABLE REDEFINES HEX-VALUES.
           03  HEX-VALUE           PIC X
                                   OCCURS 16 TIMES.
       01  WORD-DISP.
           03  HEX-DIGIT           PIC X
                                   OCCURS 6 TIMES.
       01  ASCII-VALUES.
           03  FILLER              PIC X(48)     VALUE
           "................................ !""#$%&'()*+,-./".
           03  FILLER              PIC X(49)     VALUE
           "0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ(\)^_`".
           03  FILLER              PIC X(31)     VALUE
           "abcdefghijklmnopqrstuvwxyz{|}~.".
       01  ASCII-VALUE-TABLE REDEFINES ASCII-VALUES.
           03  ASCII-VALUE         PIC X
                                   OCCURS 128 TIMES.
0520  /
0530   01  IN-REC.
0540       03  IN-AU-MAP           PIC X(32)   OCCURS 8 TIMES.
0550   01  HEADER-MAP.
0560       02  HEADER-AU           PIC X(32)   OCCURS 8 TIMES.
0570   01  HEADER-RECORD                       REDEFINES HEADER-MAP.
0580       03  GLOBAL-INFO.
0590           05  FILLER          PIC XX.
0600           05  AUS-IN-HEADER   PIC 99999   COMP-1.
0610           05  AUS-IN-RECORD   PIC 99999   COMP-1.
0620           05  FILLER          PIC X(18).
0630           05  FIRST-FREE-AUH  PIC 99999   COMP-1.
0640           05  FIRST-FREE-AUL  PIC 99999   COMP-1.
0650           05  FILLER          PIC XX.
0660           05  NUMBER-OF-KEYS  PIC 99999   COMP-1.
0670       03  KEY-INFO                        OCCURS 34 TIMES.
0680           05  KEY-LENGTH      PIC 99999   COMP-1.
0690           05  KEY-OFFSET      PIC 99999   COMP-1.
0700           05  FILLER          PIC X(10).
0710       03  FILLER              PIC X(4).
0720  *
0730  * HEADER-BYTES maps the header record into individual bytes.
0740  * that can be flipped in order for processors that store 16
0750  * bit values in a reversed-byte manner.
0760  *
0770   01  HEADER-BYTES                        REDEFINES HEADER-MAP.
0780       03  GLOBAL-INFO-BYTES.
0790           05  FILLER          PIC XX.
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(18).
0850           05  FFAHL           PIC X.
0860           05  FFAHH           PIC X.
0870           05  FFALL           PIC X.
0880           05  FFALH           PIC X.
0890           05  FILLER          PIC XX.
0900           05  NKL             PIC X.
0910           05  NKH             PIC X.
0920       03  KEY-INFO-BYTES                  OCCURS 34 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(10).
0980       03  FILLER              PIC X(4).
0990   01  OUT-REC.
1000       03  OUT-AU              PIC X(32)   OCCURS 128 TIMES.
       01  DUMMY-AREA              REDEFINES OUT-REC.
           03  OVERHEAD            PIC XX.
           03  ACTUAL-DATA         PIC X(4094).
1010  /
1020  * The flag values are twos-complement 16-bit numbers,
1030  * one entry each for flipped or non-flipped bytes.
1040  *
       01  IN-AU                   PIC X(32).
       01  IN-AU-WORDS REDEFINES IN-AU.
           03  IN-AU-WORD          PIC 9(5)    COMP-1
                                   OCCURS 16 TIMES.
1060   01  LOOK-AU REDEFINES IN-AU.
1070       03  FLAG                PIC 99999   COMP-1.
1080           88  TYPE-DEL-RECORD             VALUE 0.
1090           88  TYPE-DUP                    VALUE -2.
1100           88  TYPE-DUP-F                  VALUE -257.
1110           88  TYPE-NODE                   VALUE -3.
1120           88  TYPE-NODE-F                 VALUE -513.
1130           88  TYPE-DEL-NODE               VALUE -4.
1140           88  TYPE-DEL-NODE-F             VALUE -769.
1150           88  TYPE-GAP                    VALUE -5.
1160           88  TYPE-GAP-F                  VALUE -1025.
1170       03  FILLER              PIC X(30).
1175   77  FLAG-SAVE               PIC 9(5)    COMP-1.
1180  *
1190  *  By doing a MOVE CORRESPONDING of the GLOBAL-INFO-BYTES and
1200  *  KEY-INFO-BYTES to FLIPPED-, high and low order bytes
1210  *  of COMP-1 fields in GLOBAL-INFO and KEY-INFO are flipped.
1220  *
1230   01  FLIPPED-GLOBAL.
1240       03  FILLER              PIC XX.
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(18).
1300       03  FFAHH               PIC X.
1310       03  FFAHL               PIC X.
1320       03  FFALH               PIC X.
1330       03  FFALL               PIC X.
1340       03  FILLER              PIC XX.
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(10).
1430  /
1440   PROCEDURE DIVISION.
1450  *
1460  * Information storage in an RM/COBOL indexed file:
1470  *
1480  *  - the smallest unit of storage is a 32-byte AU
1490  *  - all information is stored in different kinds of data
1500  *    structures, where the first two bytes of the first AU of
1510  *    the structure contains a twos-complement value indicator:
1520  *
1530  *    value = structure type = length of structure in AUs
1540  *       -5 = gap to mod 8AU = variable
1550  *       -4 = deleted node   = 16
1560  *       -3 = node           = 16
1570  *       -2 = dup            = 1
1580  *       -1 = header         = AUS-IN-HEADER
1590  *        0 = deleted record = AUS-IN-RECORD
1600  *    other = record         = AUS-IN-RECORD
1610  *
1620  *  - the first structure in the file is assumed to be the header,
1630  *    and the header contains the values AUS-IN-HEADER and AUS-IN-
1640  *    RECORD in the first AU
1650  *
       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.
      *       "Y" = Duplicate Key being Written (No Error)
      *       "D" = Duplicate Key Error on Indexed File Output
      *       "E" = Other Indexed File Output Error
       INPUT-OUTPUT-EXIT.
           EXIT.
       END DECLARATIVES.
      /
       MAIN SECTION.
1690   START-UP.
           DISPLAY "Indexed File Conversion Program (Ver. 2.0 12Jul84)"
               LINE 1 POSITION 19 ERASE.
1720       DISPLAY "For RM/COBOL Indexed Files" POSITION 27.
1740       DISPLAY "Original Indexed File Name? " LINE 5.
1750       ACCEPT DUMMY-NAME POSITION 0 TAB.
           MOVE 0 TO FIRST-REC-FLAG.
           MOVE SPACES TO WORD-DISP.
1760       OPEN INPUT DUMMY-FILE.
1770       MOVE 1 TO I.
1780       PERFORM GET-HEADER.
1790       IF AUS-IN-HEADER > 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       PERFORM GET-HEADER VARYING I FROM 2 BY 1
1840           UNTIL I GREATER THAN AUS-IN-HEADER.
1850       DISPLAY "Key Structure of Indexed File:" LINE 7.
1860       PERFORM SHOW-KEY VARYING I FROM 1 BY 1
1870           UNTIL I GREATER THAN NUMBER-OF-KEYS.
1880       DISPLAY "Hit any key to continue" LINE 22 POSITION 40.
1890       ACCEPT RETURN-KEY POSITION 0.
1900  *
1910   ACCEPT-FORMAT.
           DISPLAY "Indexed File Conversion Program (Ver. 2.0 12Jul84)"
               LINE 1 ERASE.
1920       DISPLAY "Which format do you desire on output? " LINE 3.
1930       DISPLAY "(Enter 1 for single-file, 2 for dual-file)"
1935           LINE 4 POSITION 5.
1940       ACCEPT FORMAT-TYPE LINE 3 POSITION 40 TAB.
1950       IF FORMAT-TYPE NOT = 1 AND FORMAT-TYPE NOT = 2
1955           PERFORM ACCEPT-FORMAT.
      *
       ENTER-OUT-NAME.
           IF FORMAT-TYPE = 1
               DISPLAY "Output Indexed File Name? "
                   LINE 6 ERASE EOL
               DISPLAY "(with required index extension)" LINE 7
               ACCEPT OUT-NAME LINE 6 POSITION 27 TAB.
           IF FORMAT-TYPE = 2
               DISPLAY "Output Data File Name? "
                   LINE 6 ERASE EOL
               DISPLAY "(with data file extension)" LINE 7
               ACCEPT OUT-NAME LINE 6 POSITION 24 TAB.
           IF OUT-NAME = SPACES GO TO ENTER-OUT-NAME.
1960  /
1965   CON-TINUE.
1970       IF FORMAT-TYPE = 1 
               OPEN I-O OUT-FILE
               IF OTHER-ERROR
                   DISPLAY "OPEN ERROR" LINE 21
                   DISPLAY FILE-STATUS LINE 21 POSITION 20
                   GO TO DONE.
1975       IF FORMAT-TYPE = 2
               OPEN OUTPUT OUT-FILE
               IF OTHER-ERROR
                   DISPLAY "OPEN ERROR" LINE 21
                   DISPLAY FILE-STATUS LINE 21 POSITION 20
                   GO TO DONE.
1980       SUBTRACT 1 FROM AUS-IN-RECORD GIVING REMAINING-AUS-IN-RECORD.
1990       MOVE 0 TO LAST-AU.
2000       IF FIRST-FREE-AUL IS LESS THAN 0
2010           MOVE 65536 TO LAST-AU.
2020       COMPUTE LAST-AU = LAST-AU + (FIRST-FREE-AUH * 65536) +
2030                           FIRST-FREE-AUL - 1.
2100       DISPLAY "Records in      : " LINE 12 POSITION 30.
2110       DISPLAY "Records dropped : " LINE 14 POSITION 30.
2120       DISPLAY "Records out     : " LINE 16 POSITION 30.
2130       PERFORM SCAN-AUS UNTIL CURRENT-AU NOT LESS THAN LAST-AU.
2140       DISPLAY "Conversion Successful" LINE 23 POSITION 40.
2160   DONE.
2170       CLOSE DUMMY-FILE.
2180       CLOSE OUT-FILE.
2190       IF DUP-OPEN CLOSE SCRATCH-FILE.
2200   EXIT-PARA.
2210       EXIT PROGRAM.
2220   STOP-PARA.
2230       STOP RUN.
2240  *
2270   GET-HEADER.
2280       PERFORM GET-AU.
2290       MOVE IN-AU TO HEADER-AU (I).
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.
2420  /
2430   SCAN-AUS.
2440       PERFORM GET-AU.
2450       IF TYPE-NODE AND NOT FLIPPED
2460         PERFORM IGNORE-NODE,
2470       ELSE
2480         IF TYPE-NODE-F AND FLIPPED
2490           PERFORM IGNORE-NODE,
2500         ELSE
2510           IF TYPE-DEL-NODE AND NOT FLIPPED
2520             PERFORM IGNORE-NODE,
2530           ELSE
2540             IF TYPE-DEL-NODE-F AND FLIPPED
2550               PERFORM IGNORE-NODE,
2560             ELSE
2570               IF TYPE-DUP AND NOT FLIPPED
2580                 PERFORM IGNORE-DUP,
2590               ELSE
2600                 IF TYPE-DUP-F AND FLIPPED
2610                   PERFORM IGNORE-DUP,
2620                 ELSE
2630                   IF TYPE-GAP AND NOT FLIPPED
2640                     PERFORM IGNORE-GAP,
2650                   ELSE
2660                     IF TYPE-GAP-F AND FLIPPED
2670                       PERFORM IGNORE-GAP,
2680                     ELSE
2690                       IF NOT TYPE-DEL-RECORD
2700                         ADD 1 TO FOUND,
2710                         PERFORM DISPLAY-FOUND,
2750                         PERFORM PROCESS-RECORD,
2760                       ELSE
2770                         PERFORM IGNORE-RECORD.
      *
2800   IGNORE-NODE.
2810       PERFORM GET-AU 15 TIMES.
2820  *
2830   IGNORE-DUP.
2840       EXIT.
2850  *
2860   IGNORE-GAP.
2870       COMPUTE CURRENT-AU = CURRENT-AU + 8 - SECTOR-AU.
2880       MOVE 8 TO SECTOR-AU.
2890  *
2900   IGNORE-RECORD.
2910       PERFORM GET-AU REMAINING-AUS-IN-RECORD TIMES.
2920  *
2930   PROCESS-RECORD.
           MOVE FLAG TO X-REC-LEN   PERFORM FLIP-BYTES.
           IF X-REC-LEN > DISPLAY-REC-LEN OR X-REC-LEN < 0
               PERFORM NO-HIT.
2940       MOVE IN-AU TO OUT-AU (1).
2950       PERFORM GET-REC-AU VARYING I FROM 2 BY 1
2960           UNTIL I GREATER THAN AUS-IN-RECORD.
2970       PERFORM WRITE-RECORD.
      /
2990   DISPLAY-FOUND.
           IF FIRST-REC-FLAG = 0
               MOVE 1 TO FIRST-REC-FLAG
               DISPLAY "Record Length ? " LINE 6 POSITION 51
               ACCEPT DISPLAY-REC-LEN POSITION 0 CONVERT ECHO TAB
               MOVE DISPLAY-REC-LEN TO X-REC-LEN
               PERFORM FLIP-BYTES
               MOVE X-REC-LEN TO FLAG-SAVE.
3000       MOVE FOUND TO FOUND-DISP.
3010       DISPLAY FOUND-DISP LINE 12 POSITION 48.
3020  *
       FLIP-BYTES.
           IF FLIPPED
               MOVE B-REC TO X-REC
               MOVE A-REC TO B-REC
               MOVE X-REC TO A-REC.
      *
3030   GET-REC-AU.
3040       PERFORM GET-AU.
3050       MOVE IN-AU TO OUT-AU (I).
3060  *
3130   GET-AU.
3140       IF SECTOR-AU EQUAL 8
3150           MOVE 0 TO SECTOR-AU
               READ DUMMY-FILE RECORD INTO IN-REC.
3180       ADD 1 TO SECTOR-AU.
3190       ADD 1 TO CURRENT-AU.
3200       MOVE IN-AU-MAP (SECTOR-AU) TO IN-AU.
3240  *
3290   WRITE-RECORD.
3300       PERFORM WRITE-OUTPUT-RECORD THRU WRITE-END.
3310       IF EOF-IND = "Y" GO TO DONE.
3320  *
3330   NO-HIT.
           DISPLAY "Fatal Error Encountered!" LINE 20.
           DISPLAY "Do you wish to exit? " LINE 21.
           ACCEPT RETURN-KEY POSITION 0 TAB.
           IF RETURN-KEY = "Y" OR RETURN-KEY = "y"
               GO TO DONE.
           IF RETURN-KEY = "N" OR RETURN-KEY = "n" 
               GO TO VIEW-DATA.
           PERFORM NO-HIT.
      /
       VIEW-DATA.
           MOVE 0 TO I.
           DISPLAY " " LINE 20 ERASE EOS.
           PERFORM HEX-DISPLAY 8 TIMES.
           MOVE 0 TO I.
           DISPLAY QUOTE LINE 20 POSITION 53.
           PERFORM ASCII-DISPLAY 8 TIMES.
           DISPLAY QUOTE POSITION 0.
           DISPLAY " " LINE 21.
           PERFORM HEX-DISPLAY 8 TIMES.
           MOVE 8 TO I.
           DISPLAY QUOTE LINE 21 POSITION 53.
           PERFORM ASCII-DISPLAY 8 TIMES.
           DISPLAY QUOTE POSITION 0.
       CHECK-DATA.
           DISPLAY "Is this the beginning of a Data Record? "
               LINE 23 POSITION 30.
           ACCEPT RETURN-KEY POSITION 0 TAB.
           IF RETURN-KEY = "Y" OR RETURN-KEY = "y"
               DISPLAY " " LINE 20 ERASE EOS
               MOVE FLAG-SAVE TO FLAG
               GO TO PROCESS-RECORD.
           IF RETURN-KEY = "N" OR RETURN-KEY = "n"
               PERFORM GET-AU
               GO TO VIEW-DATA.
           GO TO CHECK-DATA.
       HEX-DISPLAY.
           ADD 1 TO I.
           MOVE IN-AU-WORD (I) TO TEMP-WORD.
           IF TEMP-WORD < 0 ADD 65536 TO TEMP-WORD.
           MOVE 0 TO J.
           MOVE 0 TO L.
           PERFORM HEX-CONVERT 4 TIMES.
           DISPLAY WORD-DISP POSITION 0.
       HEX-CONVERT.
           ADD 1 TO J.
           ADD 1 TO L.
           IF L = 3 ADD 1 TO L.
           DIVIDE TEMP-WORD BY BIT-VALUE (J)
               GIVING K REMAINDER R.
           MOVE R TO TEMP-WORD.
           ADD 1 TO K.
           MOVE HEX-VALUE (K) TO HEX-DIGIT (L).
       ASCII-DISPLAY.
           ADD 1 TO I.
           MOVE IN-AU-WORD (I) TO TEMP-WORD.
           IF TEMP-WORD < 0 ADD 65536 TO TEMP-WORD.
           DIVIDE TEMP-WORD BY 256 GIVING K REMAINDER R.
           ADD 1 TO K.
           ADD 1 TO R.
           DISPLAY ASCII-VALUE (K) POSITION 0.
           DISPLAY ASCII-VALUE (R) POSITION 0.
3360  /
3830   WRITE-OUTPUT-RECORD.
           WRITE OUT-RECORD FROM ACTUAL-DATA.
           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-COUNT.
           MOVE OUT-COUNT TO OUT-DISP.
           DISPLAY OUT-DISP LINE 16 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 14 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.
