613 lines
48 KiB
COBOL
613 lines
48 KiB
COBOL
000010 IDENTIFICATION DIVISION. 07/02/03
|
|
000020 PROGRAM-ID. DTSBZ249. DTSBZ249
|
|
000030 AUTHOR. TRW. LV036
|
|
000040 DATE-WRITTEN. MARCH 2003. CL**4
|
|
000050 DATE-COMPILED. CL**4
|
|
000060 SKIP3 CL**4
|
|
000070***** CL**4
|
|
000080* CL**4
|
|
000090* MODIFICATION LOG: CL**4
|
|
000100* CL**4
|
|
000110* 03/05/2003 INITIAL DEVELOPMENT. CL**4
|
|
000120* WORK ORDER: PROGRAMMER: GD CL**4
|
|
000130* CL**4
|
|
000140* MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**4
|
|
000150* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**4
|
|
000160* REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**4
|
|
000170* CL**4
|
|
000180* CL**4
|
|
000190* DESCRIPTION: CL**4
|
|
000200* CL**5
|
|
000210* DESCRIPTION: CREATE W2 AND W4 TRANSACTIONS FOR THE FOLLOWING CL**5
|
|
000220* INVALID ACCOUNT NUMBERS. CL**5
|
|
000230* 087353 INVALID 120536 VALID CL**5
|
|
000240* 123827 INVALID 127369 VALID CL**5
|
|
000250* 123828 INVALID 127270 VALID CL**5
|
|
000260* 120865 INVALID 129491 VALID CL**5
|
|
000270* FROM THE SEGO4 OF THE CLAIM. CL**5
|
|
000280* CL**5
|
|
000290* USE THE PARAMETER CARD TO PROCESS CL*36
|
|
000300* ONE ACCOUNT NUMBER AT A TIME. CL*36
|
|
000310 CL*36
|
|
000320* MODULES CALLED: CL**4
|
|
000330* CL**4
|
|
000340* CL**4
|
|
000350* CL**4
|
|
000360***** CL**4
|
|
000370 SKIP3 CL**4
|
|
000380 ENVIRONMENT DIVISION. CL**4
|
|
000390 INPUT-OUTPUT SECTION. CL**4
|
|
000400 CL**4
|
|
000410 FILE-CONTROL. CL**4
|
|
000420 CL**4
|
|
000430 CL**4
|
|
000440 SELECT W4-OUT-FILE ASSIGN TO W4FILE CL**4
|
|
000450 FILE STATUS IS W4-STATUS. CL**4
|
|
000460 CL**4
|
|
000470 CL**4
|
|
000480 SELECT W2-OUT-FILE ASSIGN TO W2FILE CL**4
|
|
000490 FILE STATUS IS W2-STATUS. CL**4
|
|
000500 CL**4
|
|
000510 SKIP3 CL**4
|
|
000520 DATA DIVISION. CL**4
|
|
000530 FILE SECTION. CL**4
|
|
000540 CL**4
|
|
000550 CL**4
|
|
000560 CL**4
|
|
000570 FD W4-OUT-FILE CL**4
|
|
000580 RECORDING MODE IS F CL**4
|
|
000590 BLOCK CONTAINS 0 RECORDS CL**4
|
|
000600 LABEL RECORDS ARE OMITTED. CL**4
|
|
000610 CL**4
|
|
000620 01 W4-OUT-REC PIC X(80). CL**4
|
|
000630 CL**4
|
|
000640 CL**4
|
|
000650 FD W2-OUT-FILE CL**4
|
|
000660 RECORDING MODE IS F CL**4
|
|
000670 BLOCK CONTAINS 0 RECORDS CL**4
|
|
000680 LABEL RECORDS ARE OMITTED. CL**4
|
|
000690 CL**4
|
|
000700 01 W2-OUT-REC PIC X(80). CL**4
|
|
000710 CL**4
|
|
000720 WORKING-STORAGE SECTION. CL**4
|
|
000725 77 PAN-VALET PICTURE X(24) VALUE '001DTSBZ249 04/19/07'. CL**4
|
|
000730 CL*17
|
|
000740 01 WRK-PARM-IN. CL*16
|
|
000750 05 PGM-NAME PIC X(8). CL*34
|
|
000760 05 WRK-PARM-FIL PIC X. CL*34
|
|
000770 05 WRK-PARM-ACCT-OLD PIC 9(6). CL*34
|
|
000780 05 WRK-PARM-FIL PIC X. CL*34
|
|
000790 05 WRK-PARM-ACCT-NEW PIC 9(6). CL*34
|
|
000800 05 WRK-PARM-FIL PIC X. CL*35
|
|
000810 05 WRK-PARM-EMPL-NAME PIC X(4). CL*35
|
|
000820 CL*34
|
|
000830 01 WRK-AREA. CL**4
|
|
000840 CL**4
|
|
000850 05 WRK-DTSBU005-IND PIC X(01). CL*16
|
|
000860 88 WRK-DTSBU005-YES VALUE 'Y'. CL**4
|
|
000870 88 WRK-DTSBU005-NO VALUE 'N'. CL**4
|
|
000880 CL**4
|
|
000890 05 WRK-CURR-DATE PIC S9(15) COMP-3 VALUE 0. CL**4
|
|
000900 05 WRK-CURR-TIME PIC S9(09) COMP-3 VALUE 0. CL**4
|
|
000910 CL**4
|
|
000920 05 WRK-CORRECT-EMPLOYER. CL**4
|
|
000930 10 WRK-LEADING-ZERO PIC 9. CL**4
|
|
000940 10 WRK-EMP-ACCT5 PIC 9(5). CL**4
|
|
000950 CL**4
|
|
000960 05 WRK-ABEND-CODE PIC X(04) VALUE 'Z240'. CL**4
|
|
000970 CL**4
|
|
000980 05 IN-STATUS PIC X(02). CL**4
|
|
000990 88 IN-STATUS-OK-88 VALUE '00'. CL**4
|
|
001000 88 IN-STATUS-EOF-88 VALUE '10'. CL**4
|
|
001010 CL**4
|
|
001020 05 OUT-STATUS PIC X(02). CL**4
|
|
001030 88 OUT-STATUS-OK-88 VALUE '00'. CL**4
|
|
001040 CL**4
|
|
001050 05 W4-STATUS PIC X(02). CL**4
|
|
001060 88 W4-STATUS-OK-88 VALUE '00'. CL**4
|
|
001070 CL**4
|
|
001080 05 W2-STATUS PIC X(02). CL**4
|
|
001090 88 W2-STATUS-OK-88 VALUE '00'. CL**4
|
|
001100 CL**4
|
|
001110 05 WRK-ERROR-IND PIC X(01). CL**4
|
|
001120 88 WRK-ERROR-YES-88 VALUE 'Y'. CL**4
|
|
001130 CL**4
|
|
001140 05 WRK-CURR-SSN PIC 9(09) VALUE ZERO. CL**4
|
|
001150 05 WRK-SSN-IN-COUNT PIC 9(09) VALUE ZERO. CL**4
|
|
001160 05 WRK-SSN-OUT-COUNT PIC 9(09) VALUE ZERO. CL**4
|
|
001170 05 WRK-CLAIM-OUT-COUNT PIC 9(09) VALUE ZERO. CL**4
|
|
001180 05 WRK-W2-COUNT PIC 9(09) VALUE ZERO. CL**4
|
|
001190 05 WRK-CLAIM-OUT-COUNT-W4 PIC 9(09) VALUE ZERO. CL**4
|
|
001200 CL**4
|
|
001210 05 WRK-SSN-IN. CL**4
|
|
001220 10 WRK-SSN1-IN PIC 9(03). CL**4
|
|
001230 10 FILLER PIC X(01). CL**4
|
|
001240 10 WRK-SSN2-IN PIC 9(02). CL**4
|
|
001250 10 FILLER PIC X(01). CL**4
|
|
001260 10 WRK-SSN3-IN PIC 9(04). CL**4
|
|
001270 CL**4
|
|
001280 05 WRK-SSN. CL**4
|
|
001290 10 WRK-SSN1 PIC 9(03). CL**4
|
|
001300 10 WRK-SSN2 PIC 9(02). CL**4
|
|
001310 10 WRK-SSN3 PIC 9(04). CL**4
|
|
001320 05 WRK-SSN9 PIC 9(09). CL**4
|
|
001330 CL**4
|
|
001340 05 WRK-OLD-EMP PIC 9(06) VALUE 085350. CL**4
|
|
001350 CL**4
|
|
001360 05 WRK-OUT-REC. CL**4
|
|
001370 10 WRK-OUT-SSN PIC 9(09). CL**4
|
|
001380 10 WRK-OUT-SEQ PIC 9(01). CL**4
|
|
001390 10 WRK-OUT-NAME-CHK PIC X(03). CL**4
|
|
001400 10 WRK-OUT-B-PERIOD-1ST-YRQTR PIC 9(5). CL**4
|
|
001410 10 WRK-OUT-B-PERIOD-2ND-YRQTR. CL**4
|
|
001420 15 WRK-OUT-B-PERIOD-2ND-CENYR PIC 9(04). CL**4
|
|
001430 15 WRK-OUT-B-PERIOD-2ND-QTR PIC 9(01). CL**4
|
|
001440 10 WRK-OUT-B-PERIOD-3RD-YRQTR. CL**4
|
|
001450 15 WRK-OUT-B-PERIOD-3RD-CENYR PIC 9(04). CL**4
|
|
001460 15 WRK-OUT-B-PERIOD-3RD-QTR PIC 9(01). CL**4
|
|
001470 10 WRK-OUT-B-PERIOD-4TH-YRQTR. CL**4
|
|
001480 15 WRK-OUT-B-PERIOD-4TH-CENYR PIC 9(04). CL**4
|
|
001490 15 WRK-OUT-B-PERIOD-4TH-QTR PIC 9(01). CL**4
|
|
001500 10 WRK-OUT-TOT-WAGE PIC 9(07)V99. CL**4
|
|
001510 10 WRK-OUT-CORRECT-EMPLOYER PIC 9(6). CL**4
|
|
001520 CL**4
|
|
001530 01 WRK-AREA-QTR-CODE. CL**4
|
|
001540 CL**4
|
|
001550 05 WS-QTR-CODE PIC 9(5). CL**4
|
|
001560 05 WS-QTR-BRK REDEFINES WS-QTR-CODE. CL**4
|
|
001570 10 WS-QTR-YR PIC 9(4). CL**4
|
|
001580 10 WS-QTR-NUM PIC 9(1). CL**4
|
|
001590 CL**4
|
|
001600 05 WS-YEAR. CL**4
|
|
001610 10 WS-CENTURY PIC 9(2). CL**4
|
|
001620 10 WS-YEAR-BRK PIC 9(2). CL**4
|
|
001630 CL**4
|
|
001640 CL**4
|
|
001650 01 WRK-IN-REC. CL**4
|
|
001660 05 SSN-IN-SSN PIC X(11). CL**4
|
|
001670 05 FILLER PIC X(01). CL**4
|
|
001680 05 SSN-IN-NEW-EMP PIC 9(05). CL**4
|
|
001690 CL**4
|
|
001700 01 EMSG-LITERALS. CL**4
|
|
001710 05 EMSG-NO-REC. CL**4
|
|
001720 10 FILLER PIC X(31) CL**4
|
|
001730 VALUE 'NO BENEFITS RECORD FOUND '. CL**4
|
|
001740 10 FILLER PIC X(16) CL**4
|
|
001750 VALUE SPACES. CL**4
|
|
001760 05 EMSG-EOF. CL**4
|
|
001770 10 FILLER PIC X(31) CL**4
|
|
001780 VALUE 'END OF FILE '. CL**4
|
|
001790 10 FILLER PIC X(16) CL**4
|
|
001800 VALUE SPACES. CL**4
|
|
001810 CL**4
|
|
001820 01 COMMON-LINKAGE-SECTION. CL**4
|
|
001830 CL**4
|
|
001840 ++INCLUDE ESPLINKB CL**4
|
|
001850 CL**4
|
|
001860 ++INCLUDE EWGLINKB CL**4
|
|
001870 CL**4
|
|
001880 ++INCLUDE EWGTRNB0 CL**4
|
|
001890 CL**4
|
|
001900 01 TRANSACTION-WORK-AREA. CL**4
|
|
001910 CL**4
|
|
001920 ++INCLUDE ESPTRAND CL**4
|
|
001930 CL**4
|
|
001940 ++INCLUDE EWGTRNW2 CL**4
|
|
001950 CL**4
|
|
001960 ++INCLUDE EWGTRNW4 CL**4
|
|
001970 CL**4
|
|
001980 CL**4
|
|
001990 01 L005-LINK-AREA. CL**4
|
|
002000 ++INCLUDE DTSIL005 CL**4
|
|
002010 CL**4
|
|
002020 PROCEDURE DIVISION. CL**4
|
|
002030 CL*16
|
|
002040 ACCEPT WRK-PARM-IN. CL*16
|
|
002050 DISPLAY 'WRK-PARM-IN ' WRK-PARM-IN. CL*28
|
|
002060 CL*16
|
|
002070* DISPLAY ' 1311 BEFORE INIT '. CL**4
|
|
002080 PERFORM I0000-INIT THRU I0000-EXIT. CL**4
|
|
002090 CL**4
|
|
002100* DISPLAY '1340 AFTER I0000-INIT HERE ' CL**4
|
|
002110 CL**4
|
|
002120 PERFORM P0000-PROCESS THRU P0000-EXIT. CL**4
|
|
002130 CL**4
|
|
002140 GOBACK. CL**4
|
|
002150 EJECT CL**4
|
|
002160 I0000-INIT. CL**4
|
|
002170 CL**4
|
|
002180 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. CL**4
|
|
002190 CL**4
|
|
002200 MOVE ZEROS TO WRK-AREA-QTR-CODE. CL**4
|
|
002210 CL**4
|
|
002220 CL**4
|
|
002230 PERFORM S005-FROM-SYS THRU S005-EXIT. CL**4
|
|
002240 CL**4
|
|
002250 MOVE L005-DATE TO WRK-CURR-DATE. CL**4
|
|
002260 MOVE L005-TIME TO WRK-CURR-TIME. CL**4
|
|
002270 CL**4
|
|
002280 I0000-EXIT. CL**4
|
|
002290 EXIT. CL**4
|
|
002300 CL**4
|
|
002310 I1000-OPEN-FILES. CL**4
|
|
002320 CL**4
|
|
002330 CL**4
|
|
002340 OPEN OUTPUT W4-OUT-FILE. CL**4
|
|
002350 OPEN OUTPUT W2-OUT-FILE. CL**4
|
|
002360 CL**4
|
|
002370 MOVE 'DTSBZ240' TO DB-PROGRAM-NAME. CL**4
|
|
002380 SET DB-HEADER-RECORD TO TRUE. CL**4
|
|
002390 SET DB-RANDOM-PROCESSING TO TRUE. CL**4
|
|
002400 SET DB-OPEN-INPUT TO TRUE. CL**4
|
|
002410 MOVE ZEROS TO DB-KEY. CL**4
|
|
002420 CL**4
|
|
002430 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4
|
|
002440 IF DB-SUCCESSFUL-COMPLETION CL**4
|
|
002450 NEXT SENTENCE CL**4
|
|
002460 ELSE CL**4
|
|
002470 DISPLAY 'CANNOT OPEN BENEFITS FILE' CL**4
|
|
002480 PERFORM S9999-ABEND THRU S9999-EXIT. CL**4
|
|
002490 CL**4
|
|
002500 I1000-EXIT. CL**4
|
|
002510 EXIT. CL**4
|
|
002520 CL**4
|
|
002530 P0000-PROCESS. CL**4
|
|
002540 CL**4
|
|
002550 PERFORM S1000-RESET-ALL THRU S1000-EXIT. CL**4
|
|
002560 CL**4
|
|
002570 PERFORM P1000-SCAN-CLAIMS THRU P1000-EXIT CL**4
|
|
002580 UNTIL DB-END-OF-FILE. CL**7
|
|
002590 CL**4
|
|
002600 PERFORM S3000-TERMINATE THRU S3000-EXIT. CL**4
|
|
002610 CL**4
|
|
002620 P0000-EXIT. CL**4
|
|
002630 EXIT. CL**4
|
|
002640 CL**4
|
|
002650 P1000-SCAN-CLAIMS. CL**4
|
|
002660* DISPLAY 'P1000 SCAN CLAIM HERE ' CL**4
|
|
002670*& CL**4
|
|
002680** DISPLAY 'P1000 CPD ' CPD-SSN ' IN ' WRK-SSN9. CL*23
|
|
002690 CL**7
|
|
002700 PERFORM S1100-READ-SEG01 THRU S1100-EXIT CL**7
|
|
002710 CL*29
|
|
002720** DISPLAY '2660 CPD-SSN ' CPD-SSN. CL*31
|
|
002730 CL*29
|
|
002740 IF DB-END-OF-FILE CL*23
|
|
002750 GO TO P1000-EXIT. CL*23
|
|
002760 CL*23
|
|
002770 PERFORM P2000-PROCESS-CLAIM THRU P2000-EXIT. CL*24
|
|
002780 CL**4
|
|
002790 P1000-EXIT. CL**4
|
|
002800 EXIT. CL**4
|
|
002810 CL**4
|
|
002820 P2000-PROCESS-CLAIM. CL**4
|
|
002830 CL*23
|
|
002840** DISPLAY '2781 CPD-SSN ' CPD-SSN. CL*33
|
|
002850 IF CPD-LIABLE-STATE-DC CL**4
|
|
002860 PERFORM P2100-FIND-EMPLOYERS THRU P2100-EXIT CL**4
|
|
002870 END-IF. CL**4
|
|
002880 CL**4
|
|
002890 P2000-EXIT. CL**4
|
|
002900 EXIT. CL**4
|
|
002910 CL**4
|
|
002920 P2100-FIND-EMPLOYERS. CL**4
|
|
002930*& CL**4
|
|
002940*& CL**4
|
|
002950 CL**4
|
|
002960** DISPLAY '2891 CPD-SSN ' CPD-SSN. CL*31
|
|
002970 PERFORM S1200-RESET-SEG04 THRU S1200-EXIT. CL**4
|
|
002980 CL**4
|
|
002990 PERFORM P2110-SCAN-SEG04 THRU P2110-EXIT CL**4
|
|
003000 UNTIL DB-NO-RECORD-FOUND. CL**4
|
|
003010 CL**4
|
|
003020 P2100-EXIT. CL**4
|
|
003030 EXIT. CL**4
|
|
003040 CL**4
|
|
003050 P2110-SCAN-SEG04. CL**4
|
|
003060 CL**4
|
|
003070 PERFORM S1300-READ-SEG04 THRU S1300-EXIT. CL**4
|
|
003080 CL**4
|
|
003090 IF DB-NO-RECORD-FOUND CL**4
|
|
003100 GO TO P2110-EXIT. CL**4
|
|
003110 CL**4
|
|
003120** DISPLAY '3061 CPD-SSN ' CPD-SSN. CL*32
|
|
003130** DISPLAY '3062 BPE-ACCT ' BPE-EMPLOYER-ACCT. CL*32
|
|
003140** DISPLAY '3063 WRK-PARM ' WRK-PARM-ACCT. CL*32
|
|
003150 CL*31
|
|
003160 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34
|
|
003170 CL**7
|
|
003180 PERFORM P2111-BPE-QTR-CODE THRU P2111-EXIT CL*14
|
|
003190 CL**8
|
|
003200 PERFORM P2112-CAPTURE-PURGED-WAGES THRU P2112-EXIT. CL*14
|
|
003210 CL**4
|
|
003220 P2110-EXIT. CL**4
|
|
003230 EXIT. CL**4
|
|
003240 CL**4
|
|
003250 CL**8
|
|
003260 P2111-BPE-QTR-CODE. CL**8
|
|
003270 CL**8
|
|
003280* DISPLAY 'P2111 BPE-QTR-CODE ' BPE-QTR-CODE. CL*23
|
|
003290* DISPLAY 'P2111 CPD-SSN ' CPD-SSN. CL*33
|
|
003300 CL**8
|
|
003310 CL**8
|
|
003320 CL**8
|
|
003330 MOVE BPE-QTR-CODE TO WRK-OUT-B-PERIOD-1ST-YRQTR CL**8
|
|
003340 WS-QTR-CODE. CL**8
|
|
003350** DISPLAY '3071 WRK-OUT-B-PERIOD-1ST-YRQTR' CL*23
|
|
003360** WRK-OUT-B-PERIOD-1ST-YRQTR. CL*23
|
|
003370** DISPLAY '3073 BPE-QTR-CODE ' WS-QTR-CODE. CL*23
|
|
003380 CL**8
|
|
003390 MOVE WS-QTR-YR TO WS-YEAR. CL**8
|
|
003400 ADD +1 TO WS-QTR-NUM. CL**8
|
|
003410*** DISPLAY '3171 WS-QTR-NUM ' WS-QTR-NUM CL*23
|
|
003420 CL**8
|
|
003430 IF WS-QTR-NUM < +5 CL**8
|
|
003440 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-2ND-CENYR CL**8
|
|
003450 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-2ND-QTR CL**8
|
|
003460** DISPLAY '3140WS-QTR-YR ' WS-QTR-YR CL*23
|
|
003470 ELSE CL**8
|
|
003480 MOVE +1 TO WS-QTR-NUM CL**8
|
|
003490 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-2ND-QTR CL**8
|
|
003500** DISPLAY '3241 WS-QTR-NUM ' WS-QTR-NUM CL*23
|
|
003510 ADD +1 TO WS-QTR-YR CL**8
|
|
003520 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-2ND-CENYR. CL**8
|
|
003530 CL**8
|
|
003540** DISPLAY '3271 WS-QTR-YR ' WS-QTR-YR CL*23
|
|
003550 CL**8
|
|
003560 ADD +1 TO WS-QTR-NUM. CL**8
|
|
003570** DISPLAY '3301 WS-QTR-NUM ' WS-QTR-NUM. CL*23
|
|
003580 CL**8
|
|
003590 IF WS-QTR-NUM < +5 CL**8
|
|
003600 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-3RD-CENYR CL**8
|
|
003610 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-3RD-QTR CL**8
|
|
003620 DISPLAY '3270WS-QTR-YR ' WS-QTR-YR CL**8
|
|
003630 ELSE CL**8
|
|
003640 MOVE +1 TO WS-QTR-NUM CL**8
|
|
003650 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-3RD-QTR CL**8
|
|
003660** DISPLAY '3381 WS-QTR-NUM ' WS-QTR-NUM CL*23
|
|
003670 ADD +1 TO WS-QTR-YR CL**8
|
|
003680 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-3RD-CENYR. CL**8
|
|
003690 CL**8
|
|
003700 CL**8
|
|
003710 ADD +1 TO WS-QTR-NUM. CL**8
|
|
003720** DISPLAY '3441 WS-QTR-NUM ' WS-QTR-NUM CL*23
|
|
003730 CL**8
|
|
003740 IF WS-QTR-NUM < +5 CL**8
|
|
003750** DISPLAY '3410WS-QTR-YR ' WS-QTR-YR CL*23
|
|
003760 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-4TH-CENYR CL**8
|
|
003770 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-4TH-QTR CL**8
|
|
003780 ELSE CL**8
|
|
003790 MOVE +1 TO WS-QTR-NUM CL**8
|
|
003800 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-4TH-QTR CL**8
|
|
003810** DISPLAY '3531 WS-QTR-NUM ' WS-QTR-NUM CL*23
|
|
003820 DISPLAY '3500WS-QTR-YR ' WS-QTR-YR CL**8
|
|
003830 ADD +1 TO WS-QTR-YR CL**8
|
|
003840 DISPLAY '3571WS-QTR-YR ' WS-QTR-YR CL**8
|
|
003850 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-4TH-CENYR. CL**8
|
|
003860 CL**8
|
|
003870** DISPLAY '4451 P2111-EXIT HERE '. CL*23
|
|
003880 P2111-EXIT. CL**8
|
|
003890 EXIT. CL**8
|
|
003900 CL**4
|
|
003910 P2112-CAPTURE-PURGED-WAGES. CL**4
|
|
003920 DISPLAY '3790 P2112-HERE '. CL*27
|
|
003930 CL**4
|
|
003940 PERFORM P2113-LOAD-W2-EARNINGS THRU P2113-EXIT. CL*14
|
|
003950 CL**4
|
|
003960 PERFORM P2114-LOAD-W4-EARNINGS THRU P2114-EXIT. CL*24
|
|
003970 CL**4
|
|
003980 CL**4
|
|
003990 P2112-EXIT. CL**4
|
|
004000 EXIT. CL**4
|
|
004010 CL**4
|
|
004020 CL*13
|
|
004030 P2113-LOAD-W2-EARNINGS. CL*13
|
|
004040 CL*13
|
|
004050 DISPLAY '4671 P2113-HERE '. CL*27
|
|
004060 CL*13
|
|
004070 IF BPE-WAGES-QTR1 > ZERO CL*13
|
|
004080 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34
|
|
004090 MOVE CPD-SSN TO W2-SSN CL*13
|
|
004100 MOVE 'W2' TO W2-TRAN-ID CL*13
|
|
004110 MOVE '00044405' TO W2-OPER-ID CL*13
|
|
004120 MOVE WRK-CURR-DATE TO W2-DATE-ENTERED CL*13
|
|
004130 MOVE WRK-CURR-TIME TO W2-TIME-ENTERED CL*13
|
|
004140 MOVE CPD-NAME TO W2-NAME CL*13
|
|
004150 MOVE WRK-OUT-B-PERIOD-1ST-YRQTR TO W2-QTR CL*13
|
|
004160 MOVE WRK-PARM-ACCT-OLD TO W2-ACCOUNT-NUMBER CL*34
|
|
004170 CL*13
|
|
004180 WRITE W2-OUT-REC FROM W2-TRAN-AREA CL*13
|
|
004190 CL*13
|
|
004200 ADD 1 TO WRK-W2-COUNT. CL*13
|
|
004210 CL*13
|
|
004220 IF BPE-WAGES-QTR2 > ZERO CL*13
|
|
004230 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34
|
|
004240 CL*13
|
|
004250 MOVE CPD-SSN TO W2-SSN CL*13
|
|
004260 MOVE 'W2' TO W2-TRAN-ID CL*13
|
|
004270 MOVE '00044405' TO W2-OPER-ID CL*13
|
|
004280 MOVE WRK-CURR-DATE TO W2-DATE-ENTERED CL*13
|
|
004290 MOVE WRK-CURR-TIME TO W2-TIME-ENTERED CL*13
|
|
004300 MOVE CPD-NAME TO W2-NAME CL*13
|
|
004310 MOVE WRK-OUT-B-PERIOD-2ND-YRQTR TO W2-QTR CL*13
|
|
004320 MOVE WRK-PARM-ACCT-OLD TO W2-ACCOUNT-NUMBER CL*34
|
|
004330 CL*13
|
|
004340 WRITE W2-OUT-REC FROM W2-TRAN-AREA CL*13
|
|
004350 CL*13
|
|
004360 ADD 1 TO WRK-W2-COUNT. CL*13
|
|
004370 CL*13
|
|
004380 IF BPE-WAGES-QTR3 > ZERO CL*13
|
|
004390 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34
|
|
004400 CL*13
|
|
004410 MOVE CPD-SSN TO W2-SSN CL*13
|
|
004420 MOVE 'W2' TO W2-TRAN-ID CL*13
|
|
004430 MOVE '00044405' TO W2-OPER-ID CL*13
|
|
004440 MOVE WRK-CURR-DATE TO W2-DATE-ENTERED CL*13
|
|
004450 MOVE WRK-CURR-TIME TO W2-TIME-ENTERED CL*13
|
|
004460 MOVE CPD-NAME TO W2-NAME CL*13
|
|
004470 MOVE WRK-OUT-B-PERIOD-3RD-YRQTR TO W2-QTR CL*13
|
|
004480 MOVE WRK-PARM-ACCT-OLD TO W2-ACCOUNT-NUMBER CL*34
|
|
004490 CL*13
|
|
004500 WRITE W2-OUT-REC FROM W2-TRAN-AREA CL*13
|
|
004510 CL*13
|
|
004520 ADD 1 TO WRK-W2-COUNT. CL*13
|
|
004530 CL*13
|
|
004540 IF BPE-WAGES-QTR4 > ZERO CL*13
|
|
004550 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34
|
|
004560 CL*13
|
|
004570 MOVE CPD-SSN TO W2-SSN CL*13
|
|
004580 MOVE 'W2' TO W2-TRAN-ID CL*13
|
|
004590 MOVE '00044405' TO W2-OPER-ID CL*13
|
|
004600 MOVE WRK-CURR-DATE TO W2-DATE-ENTERED CL*13
|
|
004610 MOVE WRK-CURR-TIME TO W2-TIME-ENTERED CL*13
|
|
004620 MOVE CPD-NAME TO W2-NAME CL*13
|
|
004630 MOVE WRK-OUT-B-PERIOD-4TH-YRQTR TO W2-QTR CL*13
|
|
004640 MOVE WRK-PARM-ACCT-OLD TO W2-ACCOUNT-NUMBER CL*34
|
|
004650 CL*13
|
|
004660 WRITE W2-OUT-REC FROM W2-TRAN-AREA CL*13
|
|
004670 CL*13
|
|
004680 ADD 1 TO WRK-W2-COUNT. CL*13
|
|
004690 CL*13
|
|
004700 P2113-EXIT. CL*24
|
|
004710 EXIT. CL*13
|
|
004720 CL*13
|
|
004730 P2114-LOAD-W4-EARNINGS. CL**4
|
|
004740 CL**4
|
|
004750 IF BPE-WAGES-QTR1 > ZERO CL**4
|
|
004760 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34
|
|
004770 MOVE WRK-OUT-B-PERIOD-1ST-YRQTR TO W4-QUARTER CL**4
|
|
004780 MOVE BPE-WAGES-QTR1 TO W4-QUARTER-EARNINGS CL**4
|
|
004790 PERFORM P2115-LOAD-W4 THRU P2115-EXIT. CL**4
|
|
004800 CL**4
|
|
004810 IF BPE-WAGES-QTR2 > ZERO CL**4
|
|
004820 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34
|
|
004830 MOVE WRK-OUT-B-PERIOD-2ND-YRQTR TO W4-QUARTER CL**4
|
|
004840 MOVE BPE-WAGES-QTR2 TO W4-QUARTER-EARNINGS CL**4
|
|
004850 PERFORM P2115-LOAD-W4 THRU P2115-EXIT. CL**4
|
|
004860 CL**4
|
|
004870 CL**4
|
|
004880 IF BPE-WAGES-QTR3 > ZERO CL**4
|
|
004890 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34
|
|
004900 MOVE WRK-OUT-B-PERIOD-3RD-YRQTR TO W4-QUARTER CL**4
|
|
004910 MOVE BPE-WAGES-QTR3 TO W4-QUARTER-EARNINGS CL**4
|
|
004920 PERFORM P2115-LOAD-W4 THRU P2115-EXIT. CL**4
|
|
004930 CL**4
|
|
004940 CL**4
|
|
004950 IF BPE-WAGES-QTR4 > ZERO CL**4
|
|
004960 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34
|
|
004970 MOVE WRK-OUT-B-PERIOD-4TH-YRQTR TO W4-QUARTER CL**4
|
|
004980 MOVE BPE-WAGES-QTR4 TO W4-QUARTER-EARNINGS CL**4
|
|
004990 PERFORM P2115-LOAD-W4 THRU P2115-EXIT. CL**4
|
|
005000 CL**4
|
|
005010 P2114-EXIT. CL**4
|
|
005020 EXIT. CL**4
|
|
005030 CL**4
|
|
005040 P2115-LOAD-W4. CL**4
|
|
005050 CL**4
|
|
005060 MOVE CPD-SSN TO W4-SSN. CL**4
|
|
005070 MOVE 'W4' TO W4-TRAN-ID. CL**4
|
|
005080 MOVE '00044405' TO W4-TRAN-OPER-ID. CL**4
|
|
005090 MOVE WRK-CURR-DATE TO W4-DATE-ENTERED. CL**4
|
|
005100 MOVE WRK-CURR-TIME TO W4-TIME-ENTERED. CL**4
|
|
005110 MOVE CPD-NAME TO W4-NAME-CHECK. CL**4
|
|
005120 MOVE 'N' TO W4-AFFI-CODE CL**4
|
|
005130 MOVE WRK-PARM-ACCT-NEW TO W4-ACCOUNT. CL*34
|
|
005140 MOVE WRK-PARM-EMPL-NAME TO W4-EMP-NAME. CL*35
|
|
005150 WRITE W4-OUT-REC FROM W4-TRAN-AREA. CL**4
|
|
005160 CL**4
|
|
005170 ADD 1 TO WRK-CLAIM-OUT-COUNT-W4. CL**4
|
|
005180 CL**4
|
|
005190 P2115-EXIT. CL**4
|
|
005200 EXIT. CL**4
|
|
005210 CL**4
|
|
005220 CL**4
|
|
005230 S1000-RESET-ALL. CL**4
|
|
005240 SET DB-RESET-POINTERS TO TRUE. CL**4
|
|
005250 SET DB-RANDOM-PROCESSING TO TRUE. CL**4
|
|
005260 SET DB-BENEFIT-PAYMENTS TO TRUE. CL**4
|
|
005270 SET DB-ALL-SEGMENTS TO TRUE. CL**4
|
|
005280 CL**4
|
|
005290 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4
|
|
005300 CL**4
|
|
005310 S1000-EXIT. CL**4
|
|
005320 EXIT. CL**4
|
|
005330 CL**4
|
|
005340 S1100-READ-SEG01. CL**4
|
|
005350 SET DB-SEQUENTIAL-PROCESSING TO TRUE. CL**4
|
|
005360 SET DB-CLAIMANT-PROFILE TO TRUE. CL**4
|
|
005370 SET DB-READ-SEGMENT TO TRUE. CL**4
|
|
005380 CL**4
|
|
005390 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4
|
|
005400 CL**4
|
|
005410 IF DB-SUCCESSFUL-COMPLETION CL**4
|
|
005420 OR DB-END-OF-FILE CL**4
|
|
005430 NEXT SENTENCE CL**4
|
|
005440 ELSE CL**4
|
|
005450 DISPLAY 'BAD READ ON SEG01 ' DB-COMPLETION-CODE CL**4
|
|
005460 SET DB-END-OF-FILE TO TRUE. CL**4
|
|
005470 CL**4
|
|
005480 S1100-EXIT. CL**4
|
|
005490 EXIT. CL**4
|
|
005500 CL**4
|
|
005510 S1200-RESET-SEG04. CL**4
|
|
005520 SET DB-RESET-POINTERS TO TRUE. CL**4
|
|
005530 SET DB-RANDOM-PROCESSING TO TRUE. CL**4
|
|
005540 SET DB-BASE-PERIOD-EMP TO TRUE. CL**4
|
|
005550 CL**4
|
|
005560 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4
|
|
005570 CL**4
|
|
005580 S1200-EXIT. CL**4
|
|
005590 EXIT. CL**4
|
|
005600 CL**4
|
|
005610 S1300-READ-SEG04. CL**4
|
|
005620 SET DB-RANDOM-PROCESSING TO TRUE. CL**4
|
|
005630 SET DB-BASE-PERIOD-EMP TO TRUE. CL**4
|
|
005640 SET DB-READ-SEGMENT TO TRUE. CL**4
|
|
005650 CL**4
|
|
005660 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4
|
|
005670 IF DB-SUCCESSFUL-COMPLETION CL**4
|
|
005680 OR DB-NO-RECORD-FOUND CL**4
|
|
005690 NEXT SENTENCE CL**4
|
|
005700 ELSE CL**4
|
|
005710 DISPLAY 'BAD READ ON SEG04 ' DB-COMPLETION-CODE CL**4
|
|
005720 SET DB-END-OF-FILE TO TRUE. CL**4
|
|
005730 CL**4
|
|
005740 S1300-EXIT. CL**4
|
|
005750 EXIT. CL**4
|
|
005760 CL**4
|
|
005770 CL**4
|
|
005780 CL**4
|
|
005790 S3000-TERMINATE. CL**4
|
|
005800 CL**4
|
|
005810 CLOSE W4-OUT-FILE, W2-OUT-FILE. CL*25
|
|
005820 CL**4
|
|
005830 MOVE 'C' TO DB-COMMAND-CODE. CL**4
|
|
005840 CL**4
|
|
005850 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4
|
|
005860 CL**4
|
|
005870 DISPLAY 'WRK W4 COUNT ' WRK-CLAIM-OUT-COUNT-W4. CL**4
|
|
005880 DISPLAY 'WRK W2 COUNT ' WRK-W2-COUNT. CL**4
|
|
005890 CL**4
|
|
005900 S3000-EXIT. CL**4
|
|
005910 EXIT. CL**4
|
|
005920 CL**4
|
|
005930 CL**4
|
|
005940 S005-FROM-SYS. CL**4
|
|
005950 CL**4
|
|
005960 SET L005-FROM-SYS TO TRUE. CL**4
|
|
005970 GO TO S005-ABSTIME. CL**4
|
|
005980 CL**4
|
|
005990 S005-ABSTIME. CL**4
|
|
006000 CL**4
|
|
006010 CALL 'DTSBU005' USING L005-LINK-AREA. CL**4
|
|
006020 CL**4
|
|
006030 S005-EXIT. CL**4
|
|
006040 EXIT. CL**4
|
|
006050 CL**4
|
|
006060 S9999-ABEND. CL**4
|
|
006070 SKIP1 CL**4
|
|
006080 CALL 'DTSBU999' USING WRK-ABEND-CODE. CL**4
|
|
006090 SKIP1 CL**4
|
|
006100 S9999-EXIT. CL**4
|
|
006110 EXIT. CL**4
|