00001  IDENTIFICATION DIVISION.                                         07/16/04
00002  PROGRAM-ID.             DTSBD331.                                DTSBD331
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV034
00004  DATE-WRITTEN.           NOVEMBER 1998.                           DTSBD331
00005  DATE-COMPILED.                                                   DTSBD331
00006      SKIP2                                                        DTSBD331
00007 *****                                                             DTSBD331
00008 *                                                                 DTSBD331
00009 *    FUNCTION:  TAX DOWNLOAD AND WAGE DOWNLOAD PROCESSING.        DTSBD331
00010 *                                                                 DTSBD331
00011 *                                                                 DTSBD331
00012 *    MODIFICATION LOG:                                            DTSBD331
00013 *                                                                 DTSBD331
00014 *    10/23/2000  CORRECTED A PROBLEM WITH 'LEFT-OVER' DATA IN SOMEDTSBD331
00015 *                R603- & R604-  FIELDS.           PROGRAMMER: JHP DTSBD331
00016 *                                                                 DTSBD331
00017 *    11/18/1998  INITIAL DEVELOPMENT. MODIFIED FROM MACBD331.     DTSBD331
00018 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD331
00019 *                                                                 DTSBD331
00020 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD331
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD331
00022 *                WORK ORDER:                      PROGRAMMER: XXX DTSBD331
00023 *                                                                 DTSBD331
00024 *                                                                 DTSBD331
00025 *  DESCRIPTION:                                                   DTSBD331
00026 *                                                                 DTSBD331
00027 *      IF T021-DOWNLOAD-TAX:                                      DTSBD331
00028 *                                                                 DTSBD331
00029 *        READ THE INDICATED FIELD ASSIGNMENT.                     DTSBD331
00030 *                                                                 DTSBD331
00031 *        IF THE FIELD ASSIGNMENT IS FOUND                         DTSBD331
00032 *                                                                 DTSBD331
00033 *            CONSTRUCT AND WRITE ONE R603 RECORD (SEE THE         DTSBD331
00034 *              EXTERNAL DESIGN FOR DETAILS)                       DTSBD331
00035 *                                                                 DTSBD331
00036 *        ELSE                                                     DTSBD331
00037 *                                                                 DTSBD331
00038 *            FAIL THE TRANSACTION.                                DTSBD331
00039 *                                                                 DTSBD331
00040 *                                                                 DTSBD331
00041 *        DO ONLY ONE TAX DOWNLOAD FOR ANY GIVEN ASSIGNMENT.       DTSBD331
00042 *        YOU CAN DEPEND ON THE T021 TRANSACTIONS TO ARRIVE        DTSBD331
00043 *        IN ASSIGN-NO (WITHIN EMP-NO) SEQUENCE.  IGNORE TAX       DTSBD331
00044 *        DOWNLOAD REQUESTS TWO THRU N FOR A GIVEN                 DTSBD331
00045 *        EMP-NO+ASSIGN-NO.                                        DTSBD331
00046 *                                                                 DTSBD331
00047 *                                                                 DTSBD331
00048 *                                                                 DTSBD331
00049 *      IF T021-DOWNLOAD-WAGE:                                     DTSBD331
00050 *                                                                 DTSBD331
00051 *        READ THE INDICATED FIELD ASSIGNMENT.                     DTSBD331
00052 *                                                                 DTSBD331
00053 *        IF THE FIELD ASSIGNMENT IS FOUND                         DTSBD331
00054 *                                                                 DTSBD331
00055 *            CONSTRUCT AND WRITE ONE R604 RECORD (SEE THE         DTSBD331
00056 *              EXTERNAL DESIGN FOR DETAILS)                       DTSBD331
00057 *                                                                 DTSBD331
00058 *        ELSE                                                     DTSBD331
00059 *                                                                 DTSBD331
00060 *            FAIL THE TRANSACTION.                                DTSBD331
00061 *                                                                 DTSBD331
00062 *                                                                 DTSBD331
00063 *        DO ONLY ONE WAGE DOWNLOAD FOR ANY GIVEN ASSIGNMENT.      DTSBD331
00064 *        YOU CAN DEPEND ON THE T021 TRANSACTIONS TO ARRIVE        DTSBD331
00065 *        IN ASSIGN-NO (WITHIN EMP-NO) SEQUENCE.  IGNORE WAGE      DTSBD331
00066 *        DOWNLOAD REQUESTS TWO THRU N FOR A GIVEN                 DTSBD331
00067 *        EMP-NO+ASSIGN-NO.                                        DTSBD331
00068 *                                                                 DTSBD331
00069 *                                                                 DTSBD331
00070 *      MASTER FILE RECORDS READ:                                  DTSBD331
00071 *                                                                 DTSBD331
00072 *        MFAS                                                     DTSBD331
00073 *        MOPO                                                     DTSBD331
00074 *        MTAD                                                     DTSBD331
00075 *        MQTR                                                     DTSBD331
00076 *                                                                 DTSBD331
00077 *                                                                 DTSBD331
00078 *      MASTER FILE RECORDS UPDATED:                               DTSBD331
00079 *                                                                 DTSBD331
00080 *        NONE.                                                    DTSBD331
00081 *                                                                 DTSBD331
00082 *                                                                 DTSBD331
00083 *      REPORT RECORDS WRITTEN:                                    DTSBD331
00084 *                                                                 DTSBD331
00085 *        R603  FIELD ASSIGNMENT EXPORT (TAX).                     DTSBD331
00086 *        R604  FIELD ASSIGNMENT EXPORT (WAGE).                    DTSBD331
00087 *                                                                 DTSBD331
00088 *                                                                 DTSBD331
00089 *      MODULES CALLED:                                            DTSBD331
00090 *                                                                 DTSBD331
00091 *        DTSBU004  ABSOLUTE QUARTER.                              DTSBD331
00092 *        DTSBU062  FIELD REP ID EDIT/DESCRIPTION.                 DTSBD331
00093 *        DTSBU112  FORMAT ADDRESS.                                DTSBD331
00094 *        DTSBU910  MASTER FILE I/O.                               DTSBD331
00095 *        DTSBU946  VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.    DTSBD331
00096 *                                                                 DTSBD331
00097 *                                                                 DTSBD331
00098 *****                                                             DTSBD331
00099      SKIP2                                                        DTSBD331
00100  ENVIRONMENT DIVISION.                                            DTSBD331
00101      EJECT                                                        DTSBD331
00102  DATA DIVISION.                                                   DTSBD331
00103  WORKING-STORAGE SECTION.                                         DTSBD331
001035 77  PAN-VALET PICTURE X(24) VALUE '034DTSBD331  07/16/04'.       DTSBD331
00104                                                                   DTSBD331
00105  01  WRK-AREA.                                                    DTSBD331
00106      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +331.DTSBD331
00107      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD331'.DTSBD331
00108                                                                   DTSBD331
00109      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBD331
00110                                                                   DTSBD331
00111      05  LAST-R603-EMP-NO            PIC S9(07)  COMP-3.          DTSBD331
00112      05  LAST-R604-EMP-NO            PIC S9(07)  COMP-3.          DTSBD331
00113      05  LAST-R603-ASSIGN-NO         PIC S9(09)  COMP-3.          DTSBD331
00114      05  LAST-R604-ASSIGN-NO         PIC S9(09)  COMP-3.          DTSBD331
00115                                                                   DTSBD331
00116      05  WRK-QTR-SUB                 PIC S9(04)  COMP.            DTSBD331
00117      05  WRK-ACCT-SUB                PIC S9(04)  COMP.            DTSBD331
00118      05  WRK-CNT                     PIC S9(04)  COMP.            DTSBD331
00119      05  WRK-YRQ                     PIC  9(05).                  DTSBD331
00120      05  FILLER   REDEFINES   WRK-YRQ.                            DTSBD331
00121          10  WRK-YR                  PIC  9(04).                  DTSBD331
00122          10  WRK-Q                   PIC  9(01).                  DTSBD331
00123      05  WRK-ABS-START-QTR           PIC S9(04) COMP.             DTSBD331
00124      05  WRK-ABS-END-QTR             PIC S9(04) COMP.             DTSBD331
00125      05  WRK-START-QTR               PIC S9(05) COMP-3.           DTSBD331
00126      05  WRK-END-QTR                 PIC S9(05) COMP-3.           DTSBD331
00127      05  WRK-MAIL-ADDR               PIC  X(200).                 DTSBD331
00128      05  WRK-MAIL-PHONE              PIC  X(15).                  DTSBD331
00129      05  WRK-PHYS-ADDR               PIC  X(200).                 DTSBD331
00130      05  WRK-PHYS-PHONE              PIC  X(15).                  DTSBD331
00131      SKIP2                                                        DTSBD331
00132  01  MSG-TABLE.                                                   DTSBD331
00133                                                                   DTSBD331
00134      05  MSG1-ASSIGN-NO-NOT-FOUND.                                DTSBD331
00135          10  MSG1-ID         PIC  X(11)  VALUE 'DTSBD331601'.     DTSBD331
00136          10  MSG1-SHORT-TEXT PIC  X(20)  VALUE 'ASSIGN NO ERR '.  DTSBD331
00137          10  MSG1-LONG-TEXT.                                      DTSBD331
00138              15  FILLER      PIC  X(31)                           DTSBD331
00139                    VALUE 'TRANSACTION FAILED - ASSIGN NO '.       DTSBD331
00140              15  MSG1-ASSIGN-NO                                   DTSBD331
00141                              PIC 99B99999.                        DTSBD331
00142              15  FILLER      PIC  X(15)                           DTSBD331
00143                    VALUE ' DOES NOT EXIST'.                       DTSBD331
00144                                                                   DTSBD331
00145      05  MSG2-FIELD-REP-OPID-INVALID.                             DTSBD331
00146          10  MSG2-ID         PIC  X(11)  VALUE 'DTSBD331611'.     DTSBD331
00147          10  MSG2-SHORT-TEXT PIC  X(20)                           DTSBD331
00148                    VALUE 'INVALID FLD REP OPID'.                  DTSBD331
00149          10  MSG2-LONG-TEXT.                                      DTSBD331
00150              15  FILLER      PIC  X(30)                           DTSBD331
00151                    VALUE 'TRANSACTION FAILED - FIELD REP'.        DTSBD331
00152              15  FILLER      PIC  X(22)                           DTSBD331
00153                    VALUE ' OPID ERR - ASSIGN NO '.                DTSBD331
00154              15  MSG2-ASSIGN-NO                                   DTSBD331
00155                              PIC 99B99999.                        DTSBD331
00156                                                                   DTSBD331
00157      05  MSG3-INVALID-TRN-CD.                                     DTSBD331
00158          10  MSG3-ID         PIC  X(11)  VALUE 'DTSBD331905'.     DTSBD331
00159          10  MSG3-SHORT-TEXT PIC  X(20)  VALUE 'INVALID TRN CD'.  DTSBD331
00160          10  MSG3-LONG-TEXT.                                      DTSBD331
00161              15  FILLER      PIC  X(30)                           DTSBD331
00162                    VALUE 'TRANSACTION FAILED - TRANSACTI'.        DTSBD331
00163              15  FILLER      PIC  X(30)                           DTSBD331
00164                    VALUE 'ON CODE NOT VALID             '.        DTSBD331
00165      EJECT                                                        DTSBD331
00166  01  L004-LINK-AREA.                                              DTSBD331
00167  ++INCLUDE DTSIL004                                               DTSBD331
00168      EJECT                                                        DTSBD331
00169  01  L062-LINK-AREA.                                              DTSBD331
00170  ++INCLUDE DTSIL062                                               DTSBD331
00171      EJECT                                                        DTSBD331
00172  01  L112-LINK-AREA.                                              DTSBD331
00173  ++INCLUDE DTSIL112                                               DTSBD331
00174      EJECT                                                        DTSBD331
00175  01  L910-LINK-AREA.                                              DTSBD331
00176  ++INCLUDE DTSIL910                                               DTSBD331
00177      EJECT                                                        DTSBD331
00178  01  MSKL-REC.                                                    DTSBD331
00179  ++INCLUDE DTSIMSKL                                               DTSBD331
00180      EJECT                                                        DTSBD331
00181  01  MFAS-REC.                                                    DTSBD331
00182  ++INCLUDE DTSIMFAS                                               DTSBD331
00183      EJECT                                                        DTSBD331
00184  01  MTAD-REC.                                                    DTSBD331
00185  ++INCLUDE DTSIMTAD                                               DTSBD331
00186      EJECT                                                        DTSBD331
00187  01  MOPO-REC.                                                    DTSBD331
00188  ++INCLUDE DTSIMOPO                                               DTSBD331
00189      EJECT                                                        DTSBD331
00190  01  MQTR-REC.                                                    DTSBD331
00191  ++INCLUDE DTSIMQTR                                               DTSBD331
00192      EJECT                                                        DTSBD331
00193  01  L931-LINK-AREA.                                              DTSBD331
00194  ++INCLUDE DTSIL931                                               DTSBD331
00195      EJECT                                                        DTSBD331
00196  01  FSKL-REC.                                                    DTSBD331
00197  ++INCLUDE DTSIFSKL                                               DTSBD331
00198      EJECT                                                        DTSBD331
00199  01  FCYR-REC.                                                    DTSBD331
00200  ++INCLUDE DTSIFCYR                                               DTSBD331
00201      EJECT                                                        DTSBD331
00202  01  RSKL-REC.                                                    DTSBD331
00203  ++INCLUDE DTSIRSK3                                               DTSBD331
00204      EJECT                                                        DTSBD331
00205  01  R603-REC.                                                    DTSBD331
00206  ++INCLUDE DTSIR603                                               DTSBD331
00207      EJECT                                                        DTSBD331
00208  01  R604-REC.                                                    DTSBD331
00209  ++INCLUDE DTSIR604                                               DTSBD331
00210      EJECT                                                        DTSBD331
00211  LINKAGE SECTION.                                                 DTSBD331
00212      SKIP2                                                        DTSBD331
00213  01  LBCM-LINK-AREA.                                              DTSBD331
00214  ++INCLUDE DTSILBCM                                               DTSBD331
00215      EJECT                                                        DTSBD331
00216  01  MPRF-REC.                                                    DTSBD331
00217  ++INCLUDE DTSIMPRF                                               DTSBD331
00218      EJECT                                                        DTSBD331
00219  01  T021-REC.                                                    DTSBD331
00220  ++INCLUDE DTSIT021                                               DTSBD331
00221      EJECT                                                        DTSBD331
00222  PROCEDURE DIVISION USING LBCM-LINK-AREA                          DTSBD331
00223                           MPRF-REC                                DTSBD331
00224                           T021-REC.                               DTSBD331
00225                                                                   DTSBD331
00226      IF FIRST-TIME-IND = 'Y'                                      DTSBD331
00227          PERFORM I0000-INITIATE THRU I0000-EXIT                   DTSBD331
00228          MOVE 'N' TO FIRST-TIME-IND.                              DTSBD331
00229      SKIP2                                                        DTSBD331
00230      IF T021-DOWNLOAD-TAX                                         DTSBD331
00231          PERFORM P1000-DL-TAX THRU P1000-EXIT                     DTSBD331
00232      ELSE                                                         DTSBD331
00233      IF T021-DOWNLOAD-WAGE                                        DTSBD331
00234          PERFORM P2000-DL-WAGE THRU P2000-EXIT                    DTSBD331
00235      ELSE                                                         DTSBD331
00236          MOVE MSG3-INVALID-TRN-CD TO LBCM-TRN-MSG-AREA            DTSBD331
00237          SET LBCM-TRN-NOT-OK-88 TO TRUE.                          DTSBD331
00238      SKIP2                                                        DTSBD331
00239      GOBACK.                                                      DTSBD331
00240      SKIP2                                                        DTSBD331
00241      SKIP2                                                        DTSBD331
00242  I0000-INITIATE.                                                  DTSBD331
00243      MOVE LBCM-TRACE-IND TO L910-TRACE-IND                        DTSBD331
00244                             L931-TRACE-IND.                       DTSBD331
00245      MOVE WRK-MOD-NAME   TO L910-MOD-NAME                         DTSBD331
00246                             L931-MOD-NAME.                        DTSBD331
00247                                                                   DTSBD331
00248      MOVE LENGTH OF R603-REC TO R603-LENGTH.                      DTSBD331
00249      MOVE LENGTH OF R604-REC TO R604-LENGTH.                      DTSBD331
00250      MOVE '603'              TO R603-REC-TYPE.                    DTSBD331
00251      MOVE '604'              TO R604-REC-TYPE.                    DTSBD331
00252                                                                   DTSBD331
00253      MOVE +0 TO LAST-R603-EMP-NO                                  DTSBD331
00254                 LAST-R604-EMP-NO                                  DTSBD331
00255                 LAST-R603-ASSIGN-NO                               DTSBD331
00256                 LAST-R604-ASSIGN-NO.                              DTSBD331
00257  I0000-EXIT. EXIT.                                                DTSBD331
00258      EJECT                                                        DTSBD331
00259  P1000-DL-TAX.                                                    DTSBD331
00260                                                                   DTSBD331
00261      IF  MPRF-EMP-NO = LAST-R603-EMP-NO                           DTSBD331
00262      AND T021-ASSIGN-NO = LAST-R603-ASSIGN-NO                     DTSBD331
00263          GO TO P1000-EXIT                                         DTSBD331
00264      ELSE                                                         DTSBD331
00265          MOVE MPRF-EMP-NO TO LAST-R603-EMP-NO                     DTSBD331
00266          MOVE T021-ASSIGN-NO TO LAST-R603-ASSIGN-NO.              DTSBD331
00267                                                                   DTSBD331
00268      MOVE LOW-VALUE         TO MFAS-KEY-AREA.                     DTSBD331
00269      MOVE MPRF-EMP-NO       TO MFAS-EMP-NO.                       DTSBD331
00270      SET MFAS-FAS-88 TO TRUE.                                     DTSBD331
00271      MOVE T021-ASSIGN-NO    TO MFAS-ASSIGN-NO.                    DTSBD331
00272      MOVE MFAS-KEY-AREA     TO MSKL-KEY-AREA.                     DTSBD331
00273      PERFORM S910-READ THRU S910-EXIT.                            DTSBD331
00274      IF L910-NO-REC-88                                            DTSBD331
00275          MOVE T021-ASSIGN-NO TO MSG1-ASSIGN-NO                    DTSBD331
00276          MOVE MSG1-ASSIGN-NO-NOT-FOUND TO LBCM-TRN-MSG-AREA       DTSBD331
00277          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD331
00278          GO TO P1000-EXIT.                                        DTSBD331
00279      MOVE MSKL-REC TO MFAS-REC.                                   DTSBD331
00280      SKIP2                                                        DTSBD331
00281      MOVE MFAS-FLD-REP-ID        TO R603-FIELD-REP-ID.            DTSBD331
00282      MOVE MFAS-ASSIGN-NO         TO R603-ASSIGN-NO.               DTSBD331
00283      INITIALIZE R603-DATA-AREA.                                   DTSBD331
00284 *-------------------------------------------                      DTSBD331
00285 *  E - EMPLOYER INFO                                              DTSBD331
00286 *-------------------------------------------                      DTSBD331
00287      MOVE MPRF-EMP-NO            TO R603-EMP-NO.                  DTSBD331
00288      MOVE MPRF-PRIMARY-NAME      TO R603-PRIMARY-NAME.            DTSBD331
00289      MOVE MPRF-FEIN              TO R603-FEIN.                    DTSBD331
00290      MOVE MPRF-ORG-TYPE          TO R603-ORG-TYPE.                DTSBD331
00291      MOVE MPRF-SIC-CD            TO R603-SIC-CD.                  DTSBD331
00292      MOVE MPRF-NAICS-CD          TO R603-NAICS-CD.                DTSBD331
00293                                                                   DTSBD331
00294      PERFORM P3000-RETRIEVE-TAX-ADDRESSES THRU P3000-EXIT.        DTSBD331
00295      MOVE WRK-MAIL-ADDR        TO R603-MAIL-ADDR.                 DTSBD331
00296      MOVE WRK-MAIL-PHONE       TO R603-MAIL-VOICE-1.              DTSBD331
00297      MOVE WRK-PHYS-ADDR        TO R603-PHYS-ADDR.                 DTSBD331
00298      MOVE WRK-PHYS-PHONE       TO R603-PHYS-VOICE-1.              DTSBD331
00299 *&   IF LBCM-TRN-NOT-OK-88                                        DTSBD331
00300 *&       GO TO P1000-EXIT.                                        DTSBD331
00301                                                                   DTSBD331
00302      IF MPRF-TOT-CREDIT-AMT > 0                                   DTSBD331
00303          MOVE 'Y' TO R603-CREDIT-IND                              DTSBD331
00304      ELSE                                                         DTSBD331
00305          MOVE 'N' TO R603-CREDIT-IND.                             DTSBD331
00306      IF MPRF-TOT-BALANCE-AMT > 0                                  DTSBD331
00307      OR MPRF-PURSUED-RPT-CNT > 0                                  DTSBD331
00308          MOVE 'Y' TO R603-DEBIT-IND                               DTSBD331
00309      ELSE                                                         DTSBD331
00310          MOVE 'N' TO R603-DEBIT-IND.                              DTSBD331
00311      MOVE MFAS-START-DATE        TO R603-START-DATE.              DTSBD331
00312      MOVE MFAS-START-YRQ         TO R603-AUDIT-START-YRQ.         DTSBD331
00313      MOVE MFAS-END-YRQ           TO R603-AUDIT-END-YRQ.           DTSBD331
00314      MOVE MFAS-AUDIT-IND         TO R603-AUDIT-IND.               DTSBD331
00315                                                                   DTSBD331
00316      MOVE MFAS-FLD-REP-ID TO L062-FLD-REP-ID.                     DTSBD331
00317      PERFORM S062-OPID THRU S062-EXIT.                            DTSBD331
00318      IF L062-VALID                                                DTSBD331
00319          MOVE L062-OP-ID         TO R603-FIELD-REP-OPID           DTSBD331
00320      ELSE                                                         DTSBD331
00321          MOVE T021-ASSIGN-NO TO MSG2-ASSIGN-NO                    DTSBD331
00322          MOVE MSG2-FIELD-REP-OPID-INVALID TO LBCM-TRN-MSG-AREA    DTSBD331
00323          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD331
00324          GO TO P1000-EXIT.                                        DTSBD331
00325 *-------------------------------------------                      DTSBD331
00326 *  Q - QUARTER INFO                                               DTSBD331
00327 *-------------------------------------------                      DTSBD331
00328      IF MFAS-START-YRQ = +0                                       DTSBD331
00329          NEXT SENTENCE                                            DTSBD331
00330      ELSE                                                         DTSBD331
00331          MOVE MFAS-START-YRQ TO L004-QTR-5-9                      DTSBD331
00332          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSBD331
00333                                                                   DTSBD331
00334          MOVE LOW-VALUE TO MQTR-KEY-AREA                          DTSBD331
00335          MOVE MPRF-EMP-NO TO MQTR-EMP-NO                          DTSBD331
00336          SET MQTR-QTR-88 TO TRUE                                  DTSBD331
00337          PERFORM P1200-LOAD-QUARTER-INFO THRU P1200-EXIT          DTSBD331
00338                  VARYING WRK-QTR-SUB FROM +1 BY +1                DTSBD331
00339                  UNTIL   WRK-QTR-SUB > +12                        DTSBD331
00340                  OR L004-QTR-5-9 > MFAS-END-YRQ.                  DTSBD331
00341 *-------------------------------------------                      DTSBD331
00342 *  O - OWNER/PARTNER/OFFICER INFO                                 DTSBD331
00343 *-------------------------------------------                      DTSBD331
00344      MOVE +0 TO R603-OPO-CNT.                                     DTSBD331
00345      MOVE LOW-VALUE   TO MSKL-KEY-AREA.                           DTSBD331
00346      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBD331
00347      SET MSKL-OPO-88 TO TRUE.                                     DTSBD331
00348      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD331
00349      PERFORM UNTIL L910-NO-REC-88                                 DTSBD331
00350              OR    R603-OPO-CNT = +5                              DTSBD331
00351          MOVE MSKL-REC TO MOPO-REC                                DTSBD331
00352          ADD +1 TO R603-OPO-CNT                                   DTSBD331
00353          MOVE MOPO-NAME          TO R603-OPO-NAME  (R603-OPO-CNT) DTSBD331
00354          MOVE MOPO-TITLE         TO R603-OPO-TITLE (R603-OPO-CNT) DTSBD331
00355          MOVE MOPO-SSN           TO R603-OPO-SSN   (R603-OPO-CNT) DTSBD331
00356          PERFORM S910-READ-NEXT THRU S910-EXIT                    DTSBD331
00357      END-PERFORM.                                                 DTSBD331
00358      SKIP2                                                        DTSBD331
00359      MOVE R603-REC TO RSKL-REC.                                   DTSBD331
00360      PERFORM S946-RPT-REC THRU S946-EXIT.                         DTSBD331
00361                                                                   DTSBD331
00362  P1000-EXIT. EXIT.                                                DTSBD331
00363      EJECT                                                        DTSBD331
00364  P1200-LOAD-QUARTER-INFO.                                         DTSBD331
00365                                                                   DTSBD331
00366      MOVE L004-QTR-5-9 TO R603-QTR-YRQ (WRK-QTR-SUB)              DTSBD331
00367                           MQTR-YRQ.                               DTSBD331
00368      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD331
00369      PERFORM S910-READ THRU S910-EXIT.                            DTSBD331
00370      IF L910-OK-88                                                DTSBD331
00371          ADD +1                    TO R603-QTR-CNT                DTSBD331
00372          MOVE MSKL-REC TO MQTR-REC                                DTSBD331
00373          MOVE MQTR-CURR-RPT-TYPE   TO R603-QTR-CURR-RPT-TYPE      DTSBD331
00374                                                      (WRK-QTR-SUB)DTSBD331
00375          MOVE MQTR-UI-RATE         TO R603-QTR-UI-RATE            DTSBD331
00376                                                      (WRK-QTR-SUB)DTSBD331
00377          MOVE MQTR-WAGE-CHNG-DATE  TO R603-QTR-WAGE-CHNG-DATE     DTSBD331
00378                                                      (WRK-QTR-SUB)DTSBD331
00379          MOVE MQTR-TOT-WAGE        TO R603-QTR-TOT-WAGE           DTSBD331
00380                                                      (WRK-QTR-SUB)DTSBD331
00381          MOVE MQTR-EXCESS-WAGE     TO R603-QTR-EXCESS-WAGE        DTSBD331
00382                                                      (WRK-QTR-SUB)DTSBD331
00383          MOVE MQTR-TAX-WAGE        TO R603-QTR-TAX-WAGE           DTSBD331
00384                                                      (WRK-QTR-SUB)DTSBD331
00385          PERFORM P1205-INIT-INDS THRU P1205-EXIT                  DTSBD331
00386              VARYING WRK-CNT FROM 1 BY 1                          DTSBD331
00387                  UNTIL   WRK-CNT > +12                            DTSBD331
00388          PERFORM P1210-ACCOUNT-DATA THRU P1210-EXIT               DTSBD331
00389              VARYING WRK-ACCT-SUB FROM 1 BY 1                     DTSBD331
00390                  UNTIL   WRK-ACCT-SUB > MQTR-ACCT-CNT.            DTSBD331
00391      SKIP2                                                        DTSBD331
00392      ADD +1 TO L004-ABS-QTR.                                      DTSBD331
00393      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBD331
00394                                                                   DTSBD331
00395  P1200-EXIT. EXIT.                                                DTSBD331
00396                                                                   DTSBD331
00397  P1205-INIT-INDS.                                                 DTSBD331
00398      SET R603-QTR-TAX-TOLERATED-NO-88 (WRK-CNT) TO TRUE.          DTSBD331
00399      SET R603-QTR-PEN-TOLERATED-NO-88 (WRK-CNT) TO TRUE.          DTSBD331
00400      SET R603-QTR-PEN-WAIVED-NO-88    (WRK-CNT) TO TRUE.          DTSBD331
00401      SET R603-QTR-INT-TOLERATED-NO-88 (WRK-CNT) TO TRUE.          DTSBD331
00402      SET R603-QTR-INT-WAIVED-NO-88    (WRK-CNT) TO TRUE.          DTSBD331
00403  P1205-EXIT. EXIT.                                                DTSBD331
00404                                                                   DTSBD331
00405  P1210-ACCOUNT-DATA.                                              DTSBD331
00406      IF MQTR-ACCT-TAX-88 (WRK-ACCT-SUB)                           DTSBD331
00407          PERFORM P1211-TAX THRU P1211-EXIT.                       DTSBD331
00408                                                                   DTSBD331
00409      IF MQTR-ACCT-LATE-PEN-88 (WRK-ACCT-SUB)                      DTSBD331
00410      OR MQTR-ACCT-NSF-PEN-88 (WRK-ACCT-SUB)                       DTSBD331
00411      OR MQTR-ACCT-MISC-PEN-88 (WRK-ACCT-SUB)                      DTSBD331
00412          PERFORM P1212-PENALTY THRU P1212-EXIT.                   DTSBD331
00413                                                                   DTSBD331
00414      IF MQTR-ACCT-INT-88 (WRK-ACCT-SUB)                           DTSBD331
00415          PERFORM P1213-INTEREST THRU P1213-EXIT.                  DTSBD331
00416  P1210-EXIT. EXIT.                                                DTSBD331
00417                                                                   DTSBD331
00418  P1211-TAX.                                                       DTSBD331
00419      ADD MQTR-CHARGED-AMT (WRK-ACCT-SUB)                          DTSBD331
00420                      TO R603-QTR-TAX-CHARGED-AMT (WRK-QTR-SUB).   DTSBD331
00421      ADD MQTR-PAID-AMT (WRK-ACCT-SUB)                             DTSBD331
00422                      TO R603-QTR-TAX-PAID-AMT (WRK-QTR-SUB).      DTSBD331
00423      IF MQTR-TOLER-AMT (WRK-ACCT-SUB) > 0                         DTSBD331
00424          SUBTRACT MQTR-TOLER-AMT (WRK-ACCT-SUB)                   DTSBD331
00425              FROM R603-QTR-TAX-CHARGED-AMT (WRK-QTR-SUB)          DTSBD331
00426          SET R603-QTR-TAX-TOLERATED-YES-88 (WRK-QTR-SUB) TO TRUE. DTSBD331
00427                                                                   DTSBD331
00428  P1211-EXIT. EXIT.                                                DTSBD331
00429                                                                   DTSBD331
00430  P1212-PENALTY.                                                   DTSBD331
00431      ADD MQTR-CHARGED-AMT (WRK-ACCT-SUB)                          DTSBD331
00432                      TO R603-QTR-PEN-CHARGED-AMT (WRK-QTR-SUB).   DTSBD331
00433      ADD MQTR-PAID-AMT (WRK-ACCT-SUB)                             DTSBD331
00434                      TO R603-QTR-PEN-PAID-AMT (WRK-QTR-SUB).      DTSBD331
00435                                                                   DTSBD331
00436      IF MQTR-TOLER-AMT (WRK-ACCT-SUB) > 0                         DTSBD331
00437          SUBTRACT MQTR-TOLER-AMT (WRK-ACCT-SUB)                   DTSBD331
00438              FROM R603-QTR-PEN-CHARGED-AMT (WRK-QTR-SUB)          DTSBD331
00439          SET R603-QTR-PEN-TOLERATED-YES-88 (WRK-QTR-SUB) TO TRUE. DTSBD331
00440      IF MQTR-WAIVED-AMT (WRK-ACCT-SUB) > 0                        DTSBD331
00441          SUBTRACT MQTR-WAIVED-AMT (WRK-ACCT-SUB)                  DTSBD331
00442              FROM R603-QTR-PEN-CHARGED-AMT (WRK-QTR-SUB)          DTSBD331
00443          SET R603-QTR-PEN-WAIVED-YES-88 (WRK-QTR-SUB) TO TRUE.    DTSBD331
00444  P1212-EXIT. EXIT.                                                DTSBD331
00445                                                                   DTSBD331
00446  P1213-INTEREST.                                                  DTSBD331
00447      MOVE MQTR-CHARGED-AMT (WRK-ACCT-SUB)                         DTSBD331
00448                      TO R603-QTR-INT-CHARGED-AMT (WRK-QTR-SUB).   DTSBD331
00449      MOVE MQTR-PAID-AMT (WRK-ACCT-SUB)                            DTSBD331
00450                      TO R603-QTR-INT-PAID-AMT (WRK-QTR-SUB).      DTSBD331
00451                                                                   DTSBD331
00452      IF MQTR-TOLER-AMT (WRK-ACCT-SUB) > 0                         DTSBD331
00453          SUBTRACT MQTR-TOLER-AMT (WRK-ACCT-SUB)                   DTSBD331
00454              FROM R603-QTR-INT-CHARGED-AMT (WRK-QTR-SUB)          DTSBD331
00455          SET R603-QTR-INT-TOLERATED-YES-88 (WRK-QTR-SUB) TO TRUE. DTSBD331
00456      IF MQTR-WAIVED-AMT (WRK-ACCT-SUB) > 0                        DTSBD331
00457          SUBTRACT MQTR-WAIVED-AMT (WRK-ACCT-SUB)                  DTSBD331
00458              FROM R603-QTR-INT-CHARGED-AMT (WRK-QTR-SUB)          DTSBD331
00459              SET R603-QTR-INT-WAIVED-YES-88 (WRK-QTR-SUB)TO TRUE. DTSBD331
00460  P1213-EXIT. EXIT.                                                DTSBD331
00461                                                                   DTSBD331
00462      EJECT                                                        DTSBD331
00463  P2000-DL-WAGE.                                                   DTSBD331
00464                                                                   DTSBD331
00465      IF  MPRF-EMP-NO = LAST-R604-EMP-NO                           DTSBD331
00466      AND T021-ASSIGN-NO = LAST-R604-ASSIGN-NO                     DTSBD331
00467          GO TO P2000-EXIT                                         DTSBD331
00468      ELSE                                                         DTSBD331
00469          MOVE MPRF-EMP-NO TO LAST-R604-EMP-NO                     DTSBD331
00470          MOVE T021-ASSIGN-NO TO LAST-R604-ASSIGN-NO.              DTSBD331
00471                                                                   DTSBD331
00472      MOVE LOW-VALUE         TO MFAS-KEY-AREA.                     DTSBD331
00473      MOVE MPRF-EMP-NO       TO MFAS-EMP-NO.                       DTSBD331
00474      SET MFAS-FAS-88 TO TRUE.                                     DTSBD331
00475      MOVE T021-ASSIGN-NO    TO MFAS-ASSIGN-NO.                    DTSBD331
00476      MOVE MFAS-KEY-AREA     TO MSKL-KEY-AREA.                     DTSBD331
00477      PERFORM S910-READ THRU S910-EXIT.                            DTSBD331
00478      IF L910-NO-REC-88                                            DTSBD331
00479          MOVE T021-ASSIGN-NO TO MSG1-ASSIGN-NO                    DTSBD331
00480          MOVE MSG1-ASSIGN-NO-NOT-FOUND TO LBCM-TRN-MSG-AREA       DTSBD331
00481          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD331
00482          GO TO P2000-EXIT.                                        DTSBD331
00483      MOVE MSKL-REC TO MFAS-REC.                                   DTSBD331
00484      INITIALIZE R604-DATA-AREA.                                   DTSBD331
00485                                                                   DTSBD331
00486      MOVE MPRF-EMP-NO            TO R604-EMP-NO.                  DTSBD331
00487      MOVE MPRF-PRIMARY-NAME      TO R604-PRIMARY-NAME.            DTSBD331
00488      MOVE MFAS-ASSIGN-NO         TO R604-ASSIGN-NO.               DTSBD331
00489      MOVE MFAS-FLD-REP-ID        TO R604-FIELD-REP-ID             DTSBD331
00490                                     L062-FLD-REP-ID.              DTSBD331
00491      PERFORM S062-OPID THRU S062-EXIT.                            DTSBD331
00492      IF L062-VALID                                                DTSBD331
00493          MOVE L062-OP-ID         TO R604-FIELD-REP-OPID           DTSBD331
00494      ELSE                                                         DTSBD331
00495          MOVE T021-ASSIGN-NO TO MSG2-ASSIGN-NO                    DTSBD331
00496          MOVE MSG2-FIELD-REP-OPID-INVALID TO LBCM-TRN-MSG-AREA    DTSBD331
00497          SET LBCM-TRN-NOT-OK-88  TO TRUE                          DTSBD331
00498          GO TO P2000-EXIT.                                        DTSBD331
00499      SKIP2                                                        DTSBD331
00500      PERFORM P2010-EDIT-QTRS THRU P2010-EXIT.                     DTSBD331
00501      SKIP2                                                        DTSBD331
00502 *-------------------------------------------                      DTSBD331
00503 *  Q - QUARTER INFO                                               DTSBD331
00504 *-------------------------------------------                      DTSBD331
00505      IF MFAS-START-YRQ = +0                                       DTSBD331
00506          NEXT SENTENCE                                            DTSBD331
00507      ELSE                                                         DTSBD331
00508          MOVE WRK-START-QTR TO L004-QTR-5-9                       DTSBD331
00509          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSBD331
00510                                                                   DTSBD331
00511          MOVE LOW-VALUE TO MQTR-KEY-AREA                          DTSBD331
00512          MOVE MPRF-EMP-NO TO MQTR-EMP-NO                          DTSBD331
00513          SET MQTR-QTR-88 TO TRUE                                  DTSBD331
00514          PERFORM P2100-LOAD-QUARTER-INFO THRU P2100-EXIT          DTSBD331
00515                  VARYING WRK-QTR-SUB FROM +1 BY +1                DTSBD331
00516                  UNTIL   WRK-QTR-SUB > +4                         DTSBD331
00517                  OR L004-QTR-5-9 > WRK-END-QTR.                   DTSBD331
00518      SKIP2                                                        DTSBD331
00519 *    MOVE MPRF-FEIN              TO R604-FEIN.                    DTSBD331
00520 *    MOVE MPRF-ORG-TYPE          TO R604-ORG-TYPE.                DTSBD331
00521 *    MOVE MPRF-SIC-CD            TO R604-SIC-CD.                  DTSBD331
00522 *    MOVE MPRF-NAICS-CD          TO R604-NAICS-CD.                DTSBD331
00523                                                                   DTSBD331
00524      PERFORM P3000-RETRIEVE-TAX-ADDRESSES THRU P3000-EXIT.        DTSBD331
00525      MOVE WRK-MAIL-ADDR        TO R604-MAIL-ADDR.                 DTSBD331
00526      MOVE WRK-MAIL-PHONE       TO R604-MAIL-VOICE-1.              DTSBD331
00527      MOVE WRK-PHYS-ADDR        TO R604-PHYS-ADDR.                 DTSBD331
00528      MOVE WRK-PHYS-PHONE       TO R604-PHYS-VOICE-1.              DTSBD331
00529                                                                   DTSBD331
00530 *-------------------------------------------                      DTSBD331
00531 *  O - OWNER/PARTNER/OFFICER INFO                                 DTSBD331
00532 *-------------------------------------------                      DTSBD331
00533      MOVE +0 TO R604-OPO-CNT.                                     DTSBD331
00534      MOVE LOW-VALUE   TO MSKL-KEY-AREA.                           DTSBD331
00535      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBD331
00536      SET MSKL-OPO-88 TO TRUE.                                     DTSBD331
00537      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD331
00538      PERFORM UNTIL L910-NO-REC-88                                 DTSBD331
00539              OR    R604-OPO-CNT = +5                              DTSBD331
00540          MOVE MSKL-REC TO MOPO-REC                                DTSBD331
00541          ADD +1 TO R604-OPO-CNT                                   DTSBD331
00542          MOVE MOPO-NAME          TO R604-OPO-NAME  (R604-OPO-CNT) DTSBD331
00543          MOVE MOPO-TITLE         TO R604-OPO-TITLE (R604-OPO-CNT) DTSBD331
00544          MOVE MOPO-SSN           TO R604-OPO-SSN   (R604-OPO-CNT) DTSBD331
00545          PERFORM S910-READ-NEXT THRU S910-EXIT                    DTSBD331
00546      END-PERFORM.                                                 DTSBD331
00547                                                                   DTSBD331
00548      PERFORM P2200-TAX-WAGE-BASE THRU P2200-EXIT.                 DTSBD331
00549      MOVE R604-REC TO RSKL-REC.                                   DTSBD331
00550      PERFORM S946-RPT-REC THRU S946-EXIT.                         DTSBD331
00551                                                                   DTSBD331
00552  P2000-EXIT. EXIT.                                                DTSBD331
00553                                                                   DTSBD331
00554 ***********************************************************       DTSBD331
00555 *    THE WAGE EXTRACT WILL PROVIDE NO MORE THAN 4 QUARTERS,       DTSBD331
00556 *    ALTHOUGH THE USER MAY ENTER A RANGE OF UP TO 20.             DTSBD331
00557 *    THIS PARAGRAPH LIMITS THE RANGE ON THE R604 REQUEST          DTSBD331
00558 *    RECORD TO 4 QUARTERS BEGINNING WITH MFAS-START-YRQ.          DTSBD331
00559 ***********************************************************       DTSBD331
00560  P2010-EDIT-QTRS.                                                 DTSBD331
00561      IF MFAS-START-YRQ = +0                                       DTSBD331
00562         MOVE ZERO TO R604-START-YRQ                               DTSBD331
00563                      R604-LAST-YRQ                                DTSBD331
00564                      WRK-START-QTR                                DTSBD331
00565                      WRK-END-QTR                                  DTSBD331
00566         GO TO P2010-EXIT.                                         DTSBD331
00567                                                                   DTSBD331
00568      MOVE MFAS-START-YRQ TO L004-QTR-5-9.                         DTSBD331
00569      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD331
00570      MOVE L004-ABS-QTR TO WRK-ABS-START-QTR.                      DTSBD331
00571                                                                   DTSBD331
00572      MOVE MFAS-END-YRQ TO L004-QTR-5-9.                           DTSBD331
00573      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD331
00574      MOVE L004-ABS-QTR TO WRK-ABS-END-QTR.                        DTSBD331
00575                                                                   DTSBD331
00576      MOVE MFAS-START-YRQ         TO R604-START-YRQ                DTSBD331
00577                                     WRK-START-QTR.                DTSBD331
00578                                                                   DTSBD331
00579      IF (WRK-ABS-END-QTR - WRK-ABS-START-QTR) > +3                DTSBD331
00580         ADD +3 TO WRK-ABS-START-QTR                               DTSBD331
00581         MOVE WRK-ABS-START-QTR TO L004-ABS-QTR                    DTSBD331
00582         PERFORM S004-FROM-ABS THRU S004-EXIT                      DTSBD331
00583         MOVE L004-QTR-5-9        TO R604-LAST-YRQ                 DTSBD331
00584                                     WRK-END-QTR                   DTSBD331
00585      ELSE                                                         DTSBD331
00586         MOVE MFAS-END-YRQ        TO R604-LAST-YRQ                 DTSBD331
00587                                     WRK-END-QTR.                  DTSBD331
00588  P2010-EXIT. EXIT.                                                DTSBD331
00589                                                                   DTSBD331
00590  P2100-LOAD-QUARTER-INFO.                                         DTSBD331
00591                                                                   DTSBD331
00592      MOVE L004-QTR-5-9 TO R604-QTR-YRQ (WRK-QTR-SUB)              DTSBD331
00593                           MQTR-YRQ.                               DTSBD331
00594      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD331
00595      PERFORM S910-READ THRU S910-EXIT.                            DTSBD331
00596      IF L910-OK-88                                                DTSBD331
00597          MOVE MSKL-REC TO MQTR-REC                                DTSBD331
00598          MOVE MQTR-CURR-RPT-TYPE   TO R604-QTR-CURR-RPT-TYPE      DTSBD331
00599                                                      (WRK-QTR-SUB)DTSBD331
00600          MOVE MQTR-UI-RATE         TO R604-QTR-UI-RATE            DTSBD331
00601                                                      (WRK-QTR-SUB)DTSBD331
00602          MOVE MQTR-WAGE-CHNG-DATE  TO R604-QTR-WAGE-CHNG-DATE     DTSBD331
00603                                                      (WRK-QTR-SUB)DTSBD331
00604          MOVE MQTR-TOT-WAGE        TO R604-QTR-TOT-WAGE           DTSBD331
00605                                                      (WRK-QTR-SUB)DTSBD331
00606          MOVE MQTR-EXCESS-WAGE     TO R604-QTR-EXCESS-WAGE        DTSBD331
00607                                                      (WRK-QTR-SUB)DTSBD331
00608          MOVE MQTR-TAX-WAGE        TO R604-QTR-TAX-WAGE           DTSBD331
00609                                                      (WRK-QTR-SUB)DTSBD331
00610      SKIP2                                                        DTSBD331
00611      ADD +1 TO L004-ABS-QTR.                                      DTSBD331
00612      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBD331
00613                                                                   DTSBD331
00614  P2100-EXIT. EXIT.                                                DTSBD331
00615                                                                   DTSBD331
00616  P2200-TAX-WAGE-BASE.                                             DTSBD331
00617      MOVE LOW-VALUES TO FCYR-KEY-AREA.                            DTSBD331
00618      SET FCYR-CYR-88 TO TRUE.                                     DTSBD331
00619      MOVE MFAS-START-YRQ TO L004-QTR-5-9.                         DTSBD331
00620      MOVE L004-QTR-5-YR TO FCYR-YR.                               DTSBD331
00621      MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA.                         DTSBD331
00622                                                                   DTSBD331
00623      PERFORM S931-READ THRU S931-EXIT.                            DTSBD331
00624      IF L931-NO-REC-88                                            DTSBD331
00625         NEXT SENTENCE                                             DTSBD331
00626      ELSE                                                         DTSBD331
00627         MOVE FSKL-REC TO FCYR-REC                                 DTSBD331
00628         MOVE FCYR-TAXABLE-WAGE-BASE TO R604-TAXABLE-WAGE-BASE.    DTSBD331
00629                                                                   DTSBD331
00630  P2200-EXIT. EXIT.                                                DTSBD331
00631      EJECT                                                        DTSBD331
00632  P3000-RETRIEVE-TAX-ADDRESSES.                                    DTSBD331
00633                                                                   DTSBD331
00634      SET L112-TAD-ADDR-88 TO TRUE.                                DTSBD331
00635      SET L112-ANCHOR-FIRST-88 TO TRUE.                            DTSBD331
00636      MOVE SPACE TO L112-PRIMARY-NAME                              DTSBD331
00637                    L112-NAME                                      DTSBD331
00638                    L112-TITLE.                                    DTSBD331
00639 **        MAKE SURE PRIOR MAIL/PHYS DATA ARE CLEARED              DTSBD331
00640      MOVE SPACE TO WRK-MAIL-ADDR                                  DTSBD331
00641                    WRK-MAIL-PHONE                                 DTSBD331
00642                    WRK-PHYS-ADDR                                  DTSBD331
00643                    WRK-PHYS-PHONE.                                DTSBD331
00644                                                                   DTSBD331
00645      MOVE LOW-VALUE         TO MTAD-KEY-AREA.                     DTSBD331
00646      MOVE MPRF-EMP-NO       TO MTAD-EMP-NO.                       DTSBD331
00647      SET MTAD-TAD-88 TO TRUE.                                     DTSBD331
00648      SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE.                     DTSBD331
00649      MOVE MTAD-KEY-AREA     TO MSKL-KEY-AREA.                     DTSBD331
00650      PERFORM S910-READ THRU S910-EXIT.                            DTSBD331
00651                                                                   DTSBD331
00652      IF L910-NO-REC-88                                            DTSBD331
00653          NEXT SENTENCE                                            DTSBD331
00654      ELSE                                                         DTSBD331
00655          MOVE MSKL-REC TO MTAD-REC                                DTSBD331
00656          MOVE MTAD-ADDRESS TO L112-ADDRESS                        DTSBD331
00657          PERFORM S112-ADDRESS THRU S112-EXIT                      DTSBD331
00658          MOVE L112-MAILING-ADDRESS TO WRK-MAIL-ADDR               DTSBD331
00659          MOVE MTAD-VOICE-1         TO WRK-MAIL-PHONE.             DTSBD331
00660                                                                   DTSBD331
00661                                                                   DTSBD331
00662      IF MPRF-TAX-REC-ADDR-NO-88                                   DTSBD331
00663          GO TO P3000-EXIT.                                        DTSBD331
00664                                                                   DTSBD331
00665      MOVE LOW-VALUE         TO MTAD-KEY-AREA.                     DTSBD331
00666      MOVE MPRF-EMP-NO       TO MTAD-EMP-NO.                       DTSBD331
00667      SET MTAD-TAD-88 TO TRUE.                                     DTSBD331
00668      SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE.                     DTSBD331
00669      MOVE MTAD-KEY-AREA     TO MSKL-KEY-AREA.                     DTSBD331
00670      PERFORM S910-READ THRU S910-EXIT.                            DTSBD331
00671                                                                   DTSBD331
00672      IF L910-NO-REC-88                                            DTSBD331
00673          NEXT SENTENCE                                            DTSBD331
00674      ELSE                                                         DTSBD331
00675          MOVE MSKL-REC TO MTAD-REC                                DTSBD331
00676          MOVE MTAD-ADDRESS TO L112-ADDRESS                        DTSBD331
00677          PERFORM S112-ADDRESS THRU S112-EXIT                      DTSBD331
00678          MOVE L112-MAILING-ADDRESS TO WRK-PHYS-ADDR               DTSBD331
00679          MOVE MTAD-VOICE-1         TO WRK-PHYS-PHONE.             DTSBD331
00680                                                                   DTSBD331
00681  P3000-EXIT. EXIT.                                                DTSBD331
00682      EJECT                                                        DTSBD331
00683  S004-FROM-5.                                                     DTSBD331
00684      SET L004-FROM-5 TO TRUE.                                     DTSBD331
00685      GO TO S004-QTR.                                              DTSBD331
00686                                                                   DTSBD331
00687  S004-FROM-ABS.                                                   DTSBD331
00688      SET L004-FROM-ABS TO TRUE.                                   DTSBD331
00689      GO TO S004-QTR.                                              DTSBD331
00690                                                                   DTSBD331
00691  S004-QTR.                                                        DTSBD331
00692      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD331
00693  S004-EXIT. EXIT.                                                 DTSBD331
00694      SKIP2                                                        DTSBD331
00695  S062-OPID.                                                       DTSBD331
00696      CALL 'DTSBU062' USING L062-LINK-AREA.                        DTSBD331
00697  S062-EXIT. EXIT.                                                 DTSBD331
00698      SKIP2                                                        DTSBD331
00699  S112-ADDRESS.                                                    DTSBD331
00700      CALL 'DTSBU112' USING L112-LINK-AREA.                        DTSBD331
00701  S112-EXIT. EXIT.                                                 DTSBD331
00702      SKIP2                                                        DTSBD331
00703  S910-READ.                                                       DTSBD331
00704      SET L910-READ-88 TO TRUE.                                    DTSBD331
00705      GO TO S910-MSTR-IO.                                          DTSBD331
00706                                                                   DTSBD331
00707  S910-START-BROWSE.                                               DTSBD331
00708      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD331
00709      GO TO S910-MSTR-IO.                                          DTSBD331
00710                                                                   DTSBD331
00711  S910-READ-NEXT.                                                  DTSBD331
00712      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD331
00713      GO TO S910-MSTR-IO.                                          DTSBD331
00714                                                                   DTSBD331
00715 *S910-COUNT.                                                      DTSBD331
00716 *    SET L910-COUNT-88 TO TRUE.                                   DTSBD331
00717 *    GO TO S910-MSTR-IO.                                          DTSBD331
00718 *                                                                 DTSBD331
00719 *S910-WRITE.                                                      DTSBD331
00720 *    SET L910-WRITE-88 TO TRUE.                                   DTSBD331
00721 *    GO TO S910-MSTR-IO.                                          DTSBD331
00722 *                                                                 DTSBD331
00723 *S910-REWRITE.                                                    DTSBD331
00724 *    SET L910-REWRITE-88 TO TRUE.                                 DTSBD331
00725 *    GO TO S910-MSTR-IO.                                          DTSBD331
00726 *                                                                 DTSBD331
00727 *S910-DELETE.                                                     DTSBD331
00728 *    SET L910-DELETE-88 TO TRUE.                                  DTSBD331
00729 *    GO TO S910-MSTR-IO.                                          DTSBD331
00730                                                                   DTSBD331
00731  S910-MSTR-IO.                                                    DTSBD331
00732      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD331
00733                            MSKL-REC.                              DTSBD331
00734  S910-EXIT. EXIT.                                                 DTSBD331
00735      SKIP2                                                        DTSBD331
00736  S931-READ.                                                       DTSBD331
00737      SET L931-READ-88 TO TRUE.                                    DTSBD331
00738      GO TO S931-REF-IO.                                           DTSBD331
00739                                                                   DTSBD331
00740  S931-REF-IO.                                                     DTSBD331
00741      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD331
00742                            FSKL-REC.                              DTSBD331
00743  S931-EXIT. EXIT.                                                 DTSBD331
00744      SKIP2                                                        DTSBD331
00745  S946-RPT-REC.                                                    DTSBD331
00746      CALL 'DTSBU946' USING RSKL-REC.                              DTSBD331
00747  S946-EXIT. EXIT.                                                 DTSBD331
00748 *                                                                 DTSBD331
