-ADD COB0COPY,PSWD=40EF,ARC,SEQ=/1,6,100,100/
-DESC SET RC FOR LIB -SEL OR NOT
-PGMR STEVE RYDER, JSR SYSTEMS
-LANG COB
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.     COB0COPY.
000300 AUTHOR.         STEVE RYDER/JSR SYSTEMS.
000400 DATE-WRITTEN.   FEB 1999.
000500 DATE-COMPILED.
000600*
000700*----COPY CARDS (SYSIN) FILE TO OSJOB OR LIBIN FILE.
000800*    IF INPUT = -SEL, BASIS, OR CREATE
000900*       RC = 00 AND DATA IS ON LIBIN FILE
001000*    ELSE RC=04 AND DATA IS ON OSJOB FILE.
001100*----
001200 ENVIRONMENT DIVISION.
001300 CONFIGURATION SECTION.
001400 INPUT-OUTPUT SECTION.
001500 FILE-CONTROL.
001600     SELECT  CARD-FILE     ASSIGN TO   UT-S-CARDS.
001700     SELECT  OSJOB-FILE    ASSIGN TO   UT-S-OSJOB.
001800     SELECT  LIBIN-FILE    ASSIGN TO   UT-S-LIBIN.
001900 DATA DIVISION.
002000 FILE SECTION.
002100 FD  CARD-FILE
002200     RECORDING MODE IS F
002300     RECORD CONTAINS 0  CHARACTERS
002400     LABEL RECORDS ARE STANDARD
002500     BLOCK CONTAINS  0  RECORDS
002600     DATA RECORD IS  CARD-RECORD.
002700 01  CARD-RECORD.
002800     05  CARD-01-04              PIC X(04).
002900     05  FILLER                  PIC X(76).
003000 FD  OSJOB-FILE
003100     RECORDING MODE IS F
003200     RECORD CONTAINS 80 CHARACTERS
003300     LABEL RECORDS ARE  STANDARD
003400     DATA RECORD IS  OSJOB-RECORD.
003500 01  OSJOB-RECORD                PIC X(80).
003600 FD  LIBIN-FILE
003700     RECORDING MODE IS F
003800     RECORD CONTAINS 80 CHARACTERS
003900     LABEL RECORDS ARE  STANDARD
004000     DATA RECORD IS  LIBIN-RECORD.
004100 01  LIBIN-RECORD                PIC X(80).
004200 WORKING-STORAGE SECTION.
004300 01  MY-PROGRAM-ID               PIC X(08) VALUE 'COB0COPY'.
004400 01  WHICH-FILE                  PIC X(08) VALUE SPACES.
004500 01  CARD-EOF-SW                 PIC X(01) VALUE SPACE.
004600     88 CARD-EOF                           VALUE 'E'.
004700 LINKAGE SECTION.
004800 01  PARM-FIELDS.
004900     05  PARM-LENGTH             PIC S9(4) COMP SYNC.
005000     05  PARM-DATA.
005100         10  PARM-CHAR           PIC X(01) OCCURS 0 TO 100 TIMES
005200                                 DEPENDING ON PARM-LENGTH.
005300 PROCEDURE DIVISION  USING   PARM-FIELDS.
005400 0000-BEGIN.
005500     OPEN  INPUT CARD-FILE
005600          OUTPUT OSJOB-FILE LIBIN-FILE
005700     PERFORM 900-READ
005800     IF  CARD-EOF
005900         MOVE 16 TO RETURN-CODE
006000     ELSE
006100     IF  CARD-01-04 = '-SEL'
006200     OR  CARD-01-04 = 'BASI'
006300     OR  CARD-01-04 = 'CREA'
006400         MOVE 'LIBIN   ' TO WHICH-FILE
006500         PERFORM 100-COPY
006600             UNTIL CARD-EOF
006700         MOVE 00 TO RETURN-CODE
006800     ELSE
006900         MOVE 'OSJOB   ' TO WHICH-FILE
007000         PERFORM 100-COPY
007100             UNTIL CARD-EOF
007200         MOVE 04 TO RETURN-CODE
007300     .
007400     CLOSE CARD-FILE  OSJOB-FILE  LIBIN-FILE
007500     .
007600     STOP RUN
007700     .
007800 100-COPY.
007900     IF  WHICH-FILE = 'OSJOB   '
008000         WRITE OSJOB-RECORD FROM CARD-RECORD
008100     ELSE
008200         WRITE LIBIN-RECORD FROM CARD-RECORD
008300     .
008400     PERFORM 900-READ
008500     .
008600 900-READ.
008700     READ CARD-FILE
008800         AT END MOVE 'E' TO CARD-EOF-SW
008900     .
009000 END PROGRAM COB0COPY.
-END
