giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

DUTAS re-platformed to Raincode - Initial Source Code

Browse Source
This commit is contained in:
Neeraj Kumar
2025-07-21 07:44:09 -04:00
commit ca3572c5df
2773 changed files with 798221 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

363
Batch/DESBU193.cob Normal file
View File

@ -0,0 +1,363 @@
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.