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.