000010 IDENTIFICATION DIVISION.                                         04/05/04
000020 PROGRAM-ID.             DESBU193.                                DESBU193
000030 AUTHOR.                 TRW                                         LV007
000040 DATE-WRITTEN.           JANUARY 2003
000050 DATE-COMPILED.
000060
000070*****
000080*
000090*    FUNCTION:  WAGE TRANSACTION I-O FOR WAGE UPDATE PROCESS
000100*
000110*
000120*    MODIFICATION LOG:
000130*
000140*    01/23/2003  INITIAL DEVELOPMENT
000150*                REFERENCE:                     PROGRAMMER: GD
000160*
000170*    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
000180*                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
000190*                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX
000200*
000210*
000220*    DESCRIPTION:
000230*
000240*        DESBU193 READS 80 BYTE WAGE TRANSACTION RECORDS             CL**2
000250*        FROM AN INPUT GDG, MERGES THE RECORDS FROM
000260*        ALL GENERATIONS, AND WRITES THEM TO AN OUTPUT
000270*        FILE.
000280*
000290*        IT WILL WRITE TO EITHER A FIXED LENGTH OR VARIABLE
000300*        LENGTH OUTPUT FILE BASED ON A PARAMETER.
000310*        PARM VALUES:
000320*           FB: FIXED LENGTH    - OUTFILE1
000330*           VB: VARIABLE LENGTH - OUTFILE2
000340*
000350*        WHEN WRITING TO THE FIXED LENGTH FILE, THE PROGRAM
000360*        ISSUES A RETURN CODE OF 1 IF THE INPUT FILE IS EMPTY.
000370*
000380*        THIS PROGRAM IS PART OF THE DAILY WAGE UPDATE
000390*        PROCESS.
000400*
000410*****
000420
000430 ENVIRONMENT DIVISION.
000440
000450 INPUT-OUTPUT SECTION.
000460
000470 FILE-CONTROL.
000480     SELECT INFILE ASSIGN TO INFILE
000490         FILE STATUS IS INFILE-STATUS.
000500
000510     SELECT OUTFILE1 ASSIGN TO OUTFILE1
000520         FILE STATUS IS OUTFILE1-STATUS.
000530
000540     SELECT OUTFILE2 ASSIGN TO OUTFILE2
000550         FILE STATUS IS OUTFILE2-STATUS.
000560
000570 DATA DIVISION.
000580
000590 FILE SECTION.
000600
000610 FD  INFILE
000620     RECORDING MODE IS F
000630     BLOCK CONTAINS 0 RECORDS.
000640
000650 01  INFILE-REC                      PIC  X(80).
000660
000670 FD  OUTFILE1
000680     RECORDING MODE IS F
000690     BLOCK CONTAINS 0 RECORDS.
000700
000710 01  OUTFILE1-REC                     PIC  X(80).
000720
000730 FD  OUTFILE2
000740     RECORDING MODE IS S
000750     BLOCK CONTAINS 0 RECORDS.
000760
000770 01  OUTFILE2-REC.
000780     05  OUTFILE2-CHAR OCCURS 1 TO 19061 TIMES                       CL**7
000790           DEPENDING ON WRK-LEN     PIC  X(01).
000800
000810 WORKING-STORAGE SECTION.
000815 77  PAN-VALET PICTURE X(24) VALUE '001DESBU193  12/12/05'.
000820
000830 01  WRK-AREA.
000840     05  WRK-ABEND-CD             PIC S9(04)  COMP VALUE +190.
000850
000860     05  WRK-LEN                  PIC S9(04)  COMP   VALUE +80.
000870     05  INFILE-CNT               PIC S9(07)  COMP-3 VALUE +0.
000880     05  OUTFILE-CNT              PIC S9(07)  COMP-3 VALUE +0.
000890
000900     05  INFILE-STATUS            PIC  X(02).
000910         88  INFILE-OK-88             VALUE '00'.
000920         88  INFILE-EOF-88            VALUE '10'.
000930
000940     05  OUTFILE1-STATUS           PIC  X(02).
000950         88  OUTFILE1-OK-88            VALUE '00'.
000960
000970     05  OUTFILE2-STATUS           PIC  X(02).
000980         88  OUTFILE2-OK-88            VALUE '00'.
000990
001000     05  WRK-OUTPUT-FILE-TYPE      PIC  X(02).
001010         88  WRK-OUTPUT-FILE-FB-88     VALUE 'FB'.
001020         88  WRK-OUTPUT-FILE-VB-88     VALUE 'VB'.
001030
001040     05  WRK-RETURN-CD-IND    PIC  X(01).
001050         88  WRK-RETURN-CD-YES-88    VALUE 'Y'.
001060         88  WRK-RETURN-CD-NO-88     VALUE 'N'.
001070
001080 LINKAGE SECTION.
001090
001100 01  PARM-AREA.
001110     05  PARM-LENGTH                PIC S9(04)  COMP.
001120     05  PARM-DATA.
001130         10  PARM-OUTPUT-FILE      PIC  X(02).
001140             88  PARM-OUTPUT-FILE-VALID-88
001150                                   VALUE 'FB' 'VB'.
001160         10  PARM-FILLER           PIC  X(01).
001170         10  PARM-RETURN-CD-IND    PIC  X(01).
001180             88  PARM-RETURN-CD-YES-88    VALUE 'Y'.
001190             88  PARM-RETURN-CD-NO-88     VALUE 'N'.
001200             88  PARM-RETURN-CD-VALID-88  VALUE 'Y' 'N'.
001210
001220 PROCEDURE DIVISION USING PARM-AREA.
001230     DISPLAY '*******STARTT DESBU193 HERE*******************'.       CL**6
001240 DESBU193-MAINLINE.                                                  CL**2
001250     PERFORM I0000-INITIATE                 THRU I0000-EXIT.
001260
001270     PERFORM P1000-COPY-DATA                THRU P1000-EXIT.
001280
001290     PERFORM T0000-TERMINATE                THRU T0000-EXIT.
001300
001310 DESBU193-MAINLINE-EXIT.                                             CL**2
001320     GOBACK.
001330
001340 I0000-INITIATE.
001350     MOVE ZERO                TO INFILE-CNT
001360                                 OUTFILE-CNT.
001370
001380     PERFORM I1000-EDIT-PARMS THRU I1000-EXIT.
001390
001400     PERFORM I2000-OPEN-FILES THRU I2000-EXIT.
001410
001420 I0000-EXIT.
001430     EXIT.
001440
001450 I1000-EDIT-PARMS.
001460     IF PARM-LENGTH = +4
001470         NEXT SENTENCE
001480     ELSE
001490         DISPLAY 'PARM-LENGTH NOT EQUAL TO 4 ' PARM-LENGTH
001500         PERFORM S999-ABEND    THRU S999-EXIT.
001510
001520     IF PARM-OUTPUT-FILE-VALID-88
001530        MOVE PARM-OUTPUT-FILE  TO WRK-OUTPUT-FILE-TYPE
001540     ELSE
001550         DISPLAY 'PARM OUTPUT FILE TYPE INVALID '
001560            PARM-OUTPUT-FILE
001570         PERFORM S999-ABEND    THRU S999-EXIT.
001580
001590     IF PARM-RETURN-CD-VALID-88
001600        MOVE PARM-RETURN-CD-IND TO WRK-RETURN-CD-IND
001610     ELSE
001620         DISPLAY 'PARM RETURN CODE IND INVALID '
001630            PARM-RETURN-CD-IND
001640         PERFORM S999-ABEND    THRU S999-EXIT.
001650
001660     DISPLAY '*********** DESBU193 ******************'               CL**2
001670
001680     IF WRK-OUTPUT-FILE-FB-88
001690        DISPLAY 'DESBU193 WRITING TO FIXED-LENGTH FILE'              CL**2
001700     ELSE
001710        DISPLAY 'DESBU193 WRITING TO VARIABLE-LENGTH FILE'.          CL**2
001720
001730     DISPLAY SPACE.
001740
001750     IF WRK-RETURN-CD-YES-88
001760        DISPLAY
001770        'DESBU193 ISSUES RETURN CODE OF 1 IF INFILE IS EMPTY'        CL**2
001780     ELSE
001790        DISPLAY 'DESBU193 WILL NOT ISSUE RETURN CODE'.               CL**2
001800
001810     DISPLAY SPACE.
001820
001830 I1000-EXIT.
001840     EXIT.
001850
001860 I2000-OPEN-FILES.
001870     PERFORM S1000-OPEN-INFILE        THRU S1000-EXIT.
001880     PERFORM S2000-OPEN-OUTFILE       THRU S2000-EXIT.
001890
001900 I2000-EXIT.
001910     EXIT.
001920
001930 P1000-COPY-DATA.
001940     PERFORM S1100-READ-INFILE        THRU S1100-EXIT.
001950     IF NOT INFILE-OK-88
001960        DISPLAY 'INPUT FILE IS EMPTY '
001970           INFILE-STATUS
001980        DISPLAY '***************************************'
001990        IF WRK-RETURN-CD-YES-88
002000           MOVE +1   TO RETURN-CODE
002010           GO TO P1000-EXIT
002020        ELSE
002030           GO TO P1000-EXIT.
002040
002050     PERFORM P1100-COPY    THRU P1100-EXIT
002060        UNTIL INFILE-EOF-88.
002070
002080 P1000-EXIT.
002090     EXIT.
002100
002110 P1100-COPY.
002120     PERFORM S2100-WRITE-OUTFILE       THRU S2100-EXIT.
002130
002140     PERFORM S1100-READ-INFILE         THRU S1100-EXIT.
002150
002160 P1100-EXIT.
002170     EXIT.
002180
002190 T0000-TERMINATE.
002200     DISPLAY 'DESBU193 TERMINATION STATISTICS'                       CL**2
002210     DISPLAY SPACE.
002220     DISPLAY '   INPUT RECORDS READ     ' INFILE-CNT.
002230     DISPLAY SPACE.
002240     DISPLAY '   OUTPUT RECORDS WRITTEN ' OUTFILE-CNT.
002250
002260     PERFORM S1400-CLOSE-INFILE        THRU S1400-EXIT.
002270
002280     PERFORM S2200-CLOSE-OUTFILE       THRU S2200-EXIT.
002290
002300
002310 T0000-EXIT.
002320     EXIT.
002330     EJECT
002340 S1000-OPEN-INFILE.
002350     OPEN INPUT  INFILE.
002360     IF NOT INFILE-OK-88
002370        DISPLAY 'CANNOT OPEN INPUT FILE '
002380           INFILE-STATUS
002390        PERFORM S999-ABEND THRU S999-EXIT.
002400
002410 S1000-EXIT.
002420     EXIT.
002430
002440 S1100-READ-INFILE.
002450     READ INFILE.
002460     IF INFILE-EOF-88
002470        GO TO S1100-EXIT
002480     ELSE
002490        IF NOT INFILE-OK-88
002500           DISPLAY 'INPUT FILE READ ERROR '
002510              INFILE-STATUS
002520           PERFORM S999-ABEND THRU S999-EXIT
002530        ELSE
002540           ADD +1 TO INFILE-CNT.
002550
002560 S1100-EXIT.
002570     EXIT.
002580
002590 S1400-CLOSE-INFILE.
002600     CLOSE INFILE.
002610     IF NOT INFILE-OK-88
002620        DISPLAY 'INPUT FILE CLOSE ERROR '
002630           INFILE-STATUS.
002640
002650 S1400-EXIT.
002660     EXIT.
002670
002680 S2000-OPEN-OUTFILE.
002690     IF WRK-OUTPUT-FILE-FB-88
002700        PERFORM S2010-OPEN-OUTFILE1  THRU S2010-EXIT
002710     ELSE
002720        PERFORM S2020-OPEN-OUTFILE2  THRU S2020-EXIT.
002730
002740 S2000-EXIT.
002750     EXIT.
002760
002770 S2010-OPEN-OUTFILE1.
002780     OPEN OUTPUT OUTFILE1.
002790     IF NOT OUTFILE1-OK-88
002800        DISPLAY 'CANNOT OPEN OUTPUT FILE 1 '
002810           OUTFILE1-STATUS
002820        PERFORM S999-ABEND THRU S999-EXIT.
002830
002840 S2010-EXIT.
002850     EXIT.
002860
002870 S2020-OPEN-OUTFILE2.
002880     OPEN OUTPUT OUTFILE2.
002890     IF NOT OUTFILE2-OK-88
002900        DISPLAY 'CANNOT OPEN OUTPUT FILE 2 '
002910           OUTFILE2-STATUS
002920        PERFORM S999-ABEND THRU S999-EXIT.
002930
002940 S2020-EXIT.
002950     EXIT.
002960
002970 S2100-WRITE-OUTFILE.
002980     IF WRK-OUTPUT-FILE-FB-88
002990        PERFORM S2110-WRITE-OUTFILE1  THRU S2110-EXIT
003000     ELSE
003010        PERFORM S2120-WRITE-OUTFILE2  THRU S2120-EXIT.
003020
003030 S2100-EXIT.
003040     EXIT.
003050
003060 S2110-WRITE-OUTFILE1.
003070     WRITE OUTFILE1-REC  FROM INFILE-REC.
003080     IF NOT OUTFILE1-OK-88
003090        DISPLAY 'CANNOT WRITE TO OUTPUT FILE 1 '
003100           OUTFILE1-STATUS
003110        PERFORM S999-ABEND THRU S999-EXIT
003120     ELSE
003130        ADD +1 TO OUTFILE-CNT.
003140
003150 S2110-EXIT.
003160     EXIT.
003170
003180 S2120-WRITE-OUTFILE2.
003190     WRITE OUTFILE2-REC  FROM INFILE-REC.
003200     IF NOT OUTFILE2-OK-88
003210        DISPLAY 'CANNOT WRITE TO OUTPUT FILE 2 '
003220           OUTFILE2-STATUS
003230        PERFORM S999-ABEND THRU S999-EXIT
003240     ELSE
003250        ADD +1 TO OUTFILE-CNT.
003260
003270 S2120-EXIT.
003280     EXIT.
003290
003300 S2200-CLOSE-OUTFILE.
003310     IF WRK-OUTPUT-FILE-FB-88
003320        PERFORM S2210-CLOSE-OUTFILE1   THRU S2210-EXIT
003330     ELSE
003340        PERFORM S2220-CLOSE-OUTFILE2   THRU S2220-EXIT.
003350
003360 S2200-EXIT.
003370     EXIT.
003380
003390 S2210-CLOSE-OUTFILE1.
003400     CLOSE OUTFILE1
003410     IF NOT OUTFILE1-OK-88
003420        DISPLAY 'OUTPUT FILE 1 CLOSE ERROR '
003430           OUTFILE1-STATUS.
003440
003450 S2210-EXIT.
003460     EXIT.
003470
003480 S2220-CLOSE-OUTFILE2.
003490     CLOSE OUTFILE2
003500     IF NOT OUTFILE2-OK-88
003510        DISPLAY 'OUTPUT FILE 2 CLOSE ERROR '
003520           OUTFILE2-STATUS.
003530
003540 S2220-EXIT.
003550     EXIT.
003560
003570 S999-ABEND.
003580     DISPLAY '*** DESBU193 ABENDING'.                                CL**2
003590
003600     CALL 'DTSBU999' USING WRK-ABEND-CD.
003610 S999-EXIT.
003620     EXIT.
