364 lines
11 KiB
COBOL
364 lines
11 KiB
COBOL
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.
|