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
