MP Batchs, copybooks, jcls, Procs
This commit is contained in:
612
Batch/DTSBZ249.cob
Normal file
612
Batch/DTSBZ249.cob
Normal file
@ -0,0 +1,612 @@
|
||||
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
|
||||
Reference in New Issue
Block a user