       IDENTIFICATION DIVISION.
       PROGRAM-ID.   RMCTRM.
      *                  Ver. 2.0B
      *              For CP/M, CP/M-86 and MS-DOS OpSys Environments
      *              Date Revised  19 July 1984
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.  RMCOBOL.
       OBJECT-COMPUTER.  RMCOBOL.
       SPECIAL-NAMES.
           SWITCH-1 ON STATUS IS NUL-RUNTIME.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       SELECT TERM-FILE ASSIGN TO RANDOM "RMCTRM.DAT"
           ORGANIZATION IS INDEXED
           ACCESS MODE IS DYNAMIC
           RECORD KEY IS TERM-TYPE
           FILE STATUS IS FILE-STATUS.
       DATA DIVISION.
       FILE SECTION.
       FD  TERM-FILE.
       01  TERM-REC.
           03  TERM-TYPE                          PIC X(8).
           03  CRT-DATA                           PIC X(248).
           03  FILLER                             PIC X(18).
       WORKING-STORAGE SECTION.
       77  A                                      PIC 9.
       77  E                                      PIC 99.
       77  O                                      PIC 99.
       77  FILE-STATUS                            PIC XX.
       77  STATUS-IND                             PIC 9.
       01  RUN-NAMES.
           03  RUN-NAME   OCCURS 4 TIMES          PIC X(74).
       77  FILE-NAME                              PIC X(74).
       01  CRT-128.
           03  CRT-1                              PIC X(128).
           03  CRT-2                              PIC X(120).
       01  PATCH-REC.
           03  PATCH-BYTE    OCCURS 128 TIMES     PIC X.
       77  ADDR                                   PIC 9(10).
       77  LNGTH                                  PIC 999.
       77  RTN                                    PIC 9.
       01  COMP-WORD         COMP-1               PIC 9(5).
       01  COMP-BYTES REDEFINES COMP-WORD.
           03  C1                                 PIC X.
           03  C2                                 PIC X.
       01  ERR-LITERALS.
           03  ERR-LIT       OCCURS 10 TIMES      PIC X(40).
       77  DATA-BUF                               PIC X(512).
       01  SPLIT-FIELD.
           03  NUM-DAT                            PIC 9(10).
           03  FILLER                             PIC X(502).
       77  FUNC                                   PIC 99.
       77  SYS-RTN                                PIC 99.
      /
       PROCEDURE DIVISION.
       DECLARATIVES.
       TERM-FILE-ERROR SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON TERM-FILE.
       FILE-ERROR.
           IF FILE-STATUS = "94" MOVE 1 TO STATUS-IND
             ELSE MOVE 2 TO STATUS-IND.
       END DECLARATIVES.
       MAIN SECTION.
       INIT-PARA.
           MOVE SPACES TO RUN-NAME (1) RUN-NAME (2)
                          RUN-NAME (3) RUN-NAME (4)
           MOVE "RUNCOBOL.COM" TO RUN-NAME (1).
           MOVE "RUNCOBOL.CMD" TO RUN-NAME (2).
           MOVE "RUNCOBOL.COM" TO RUN-NAME (3).
           MOVE "RUNCOBOL.68K" TO RUN-NAME (4).
           MOVE LOW-VALUE TO C1 MOVE 0 TO STATUS-IND MOVE 0 TO A.
           MOVE "Incorrect value" TO ERR-LIT (1).
           MOVE "Entry left blank" TO ERR-LIT (2).
           MOVE "Operating System not yet available" TO ERR-LIT (3).
           MOVE "OpSys - Runtime Incompatibility" TO ERR-LIT (4).
           MOVE "Runtime not found" TO ERR-LIT (5).
           MOVE "Terminal not found" TO ERR-LIT (6).
           MOVE "RMCTRM.DAT not found" TO ERR-LIT (7).
           MOVE "Error on RMCTRM.DAT" TO ERR-LIT (8).
           MOVE "Runtime is R/O - Patch Failed" TO ERR-LIT (9).
           MOVE "Patch complete" TO ERR-LIT (10).
       NUL-RUNTIME-PARA.
           IF NUL-RUNTIME MOVE 0 TO SYS-RTN PERFORM SYS-CALL
               PERFORM GET-ADDR ADD 14 TO ADDR
               MOVE LOW-VALUES TO PATCH-REC MOVE 16 TO LNGTH
               PERFORM CALL-PARA ADD 40 TO ADDR MOVE 12 TO LNGTH
               PERFORM CALL-PARA ADD 96 TO ADDR MOVE 36 TO LNGTH
               PERFORM CALL-PARA MOVE 10 TO E GO TO EXIT-PARA.
       DISP-PARA.
           PERFORM DISP-BLANK-LINE 12 TIMES.
           DISPLAY "Runtime Terminal Configuration Utility"
                   "  (Ver. 2.0B 19 July 84)"
               SPACE SIZE 18 SPACE SIZE 80 
               "1. CP/M, MP/M-II and TurboDOS Operating Systems"
               SPACE SIZE 23 SPACE SIZE 10
               "2. CP/M-86 and MP/M-86 Operating Systems"
               SPACE SIZE 30 SPACE SIZE 10
               "3. MS-DOS and PC-DOS Operating Systems"
               SPACE SIZE 32 SPACE SIZE 10
               "4. CP/M-68K Operating System" SPACE SIZE 53.
       ACPT-1.
           DISPLAY SPACE SIZE 1 "Enter Desired OpSys Number   ".
           ACCEPT O POSITION 0 CONVERT TAB.
           MOVE 1 TO A   DISPLAY SPACE SIZE 49.
           IF O = 0 OR O > 4 MOVE 1 TO E PERFORM ERROR-PARA.
           IF O = 4 MOVE 3 TO E PERFORM ERROR-PARA.
       ACPT-2.
           DISPLAY SPACE SIZE 1 "Update Runtime Name   ".
           ACCEPT RUN-NAME (O) POSITION 0 TAB UPDATE SIZE 76.
           MOVE 2 TO A   DISPLAY SPACE SIZE 30.
           IF RUN-NAME (O) = SPACES MOVE 2 TO E PERFORM ERROR-PARA.
           MOVE O TO SYS-RTN PERFORM GET-ADDR.
      /
       ACPT-3.
           DISPLAY SPACE SIZE 1 "Enter Terminal Type   ".
           ACCEPT TERM-TYPE POSITION 0 TAB.
           MOVE 3 TO A   DISPLAY SPACE SIZE 20.
           IF TERM-TYPE = SPACES MOVE 2 TO E PERFORM ERROR-PARA.
           OPEN INPUT TERM-FILE   PERFORM IO-CHECK.
           READ TERM-FILE INVALID KEY CLOSE TERM-FILE
               PERFORM IO-CHECK MOVE 6 TO E PERFORM ERROR-PARA.
           CLOSE TERM-FILE.
       IO-CHECK.
           IF STATUS-IND NOT = 0 ADD STATUS-IND 6 GIVING E
               GO TO EXIT-PARA.
       PATCH-PARA.
           MOVE CRT-DATA TO CRT-128   MOVE 128 TO LNGTH.
           MOVE CRT-1 TO PATCH-REC   PERFORM CALL-PARA-SEQ.
           MOVE CRT-2 TO PATCH-REC   MOVE 120 TO LNGTH.
           PERFORM CALL-PARA-SEQ   MOVE 10 TO E.
       EXIT-PARA.
           DISPLAY SPACE SIZE 40 ERR-LIT (E).
       STOP-PARA.
           STOP RUN.
      *
       ERROR-PARA.
           DISPLAY SPACE SIZE 40 ERR-LIT (E) SPACE SIZE 40
               "Hit any key to try again ".
           ACCEPT E POSITION 0   DISPLAY SPACE SIZE 14.
           GO TO ACPT-1 ACPT-2 ACPT-3 DEPENDING ON A.
       DISP-BLANK-LINE.
           DISPLAY SPACES SIZE 80.
       GET-ADDR.
           MOVE 1 TO FUNC MOVE RUN-NAME (SYS-RTN) TO FILE-NAME.
           MOVE LOW-VALUES TO DATA-BUF.
           PERFORM SYS-CALL MOVE DATA-BUF TO SPLIT-FIELD.
           ADD NUM-DAT 22 GIVING ADDR.
       SYS-CALL.
           CALL "RMCSYS.COB" USING FILE-NAME DATA-BUF FUNC SYS-RTN.
           IF SYS-RTN = 0 PERFORM E-TYPE 
               IF A = 0 GO TO EXIT-PARA ELSE PERFORM ERROR-PARA.
       E-TYPE.
           IF DATA-BUF = SPACES MOVE 5 TO E ELSE MOVE 4 TO E.
       CALL-PARA.
           MOVE 0 TO RTN   CALL "RMPSUB.COB"
               USING FILE-NAME PATCH-REC LNGTH ADDR RTN.
           IF RTN = 0 MOVE 9 TO E GO TO EXIT-PARA.
       CALL-PARA-SEQ.
           PERFORM CALL-PARA   ADD 128 TO ADDR.
      *
       END PROGRAM.
