00001  IDENTIFICATION DIVISION.                                         07/19/00
00002  PROGRAM-ID.             DTSBE762.                                DTSBE762
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV001
00004  DATE-WRITTEN.           AUGUST 1994.                             DTSBE762
00005  DATE-COMPILED.                                                   DTSBE762
00006                                                                   DTSBE762
00007 *****                                                             DTSBE762
00008 *                                                                 DTSBE762
00009 *    FUNCTION:  GENERIC LABEL EXTRACT.                            DTSBE762
00010 *                                                                 DTSBE762
00011 *                                                                 DTSBE762
00012 *    MODIFICATION LOG:                                            DTSBE762
00013 *                                                                 DTSBE762
00014 *    07/17/2000  MODIFIED FROM DTSBE761 FOR SPECIAL LABEL REQUESTSDTSBE762
00015 *                REFERENCE RFP:                   PROGRAMMER:  GD DTSBE762
00016 *                                                                 DTSBE762
00017 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE762
00018 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE762
00019 *                REFERENCE RFP: #XXX              PROGRAMMER: XXX DTSBE762
00020 *                                                                 DTSBE762
00021 *                                                                 DTSBE762
00022 *  DESCRIPTION:                                                   DTSBE762
00023 *                                                                 DTSBE762
00024 *                                                                 DTSBE762
00025 *    INITIATION:                                                  DTSBE762
00026 *                                                                 DTSBE762
00027 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE762
00028 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE762
00029 *                                                                 DTSBE762
00030 *      EDIT PARAMTERS (SEE 901R1).                                DTSBE762
00031 *                                                                 DTSBE762
00032 *                                                                 DTSBE762
00033 *    PROCESSING:                                                  DTSBE762
00034 *                                                                 DTSBE762
00035 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (901R1).       DTSBE762
00036 *                                                                 DTSBE762
00037 *                                                                 DTSBE762
00038 *    TERMINATION:                                                 DTSBE762
00039 *                                                                 DTSBE762
00040 *      NONE.                                                      DTSBE762
00041 *                                                                 DTSBE762
00042 *                                                                 DTSBE762
00043 *    RECORDS READ:                                                DTSBE762
00044 *                                                                 DTSBE762
00045 *      MASTER:                                                    DTSBE762
00046 *                                                                 DTSBE762
00047 *        NONE.                                                    DTSBE762
00048 *                                                                 DTSBE762
00049 *                                                                 DTSBE762
00050 *      ALTERNATE INDEX:                                           DTSBE762
00051 *                                                                 DTSBE762
00052 *        NONE.                                                    DTSBE762
00053 *                                                                 DTSBE762
00054 *                                                                 DTSBE762
00055 *      REFERENCE:                                                 DTSBE762
00056 *                                                                 DTSBE762
00057 *        NONE.                                                    DTSBE762
00058 *                                                                 DTSBE762
00059 *                                                                 DTSBE762
00060 *    RECORDS UPDATED:                                             DTSBE762
00061 *                                                                 DTSBE762
00062 *        NONE.                                                    DTSBE762
00063 *                                                                 DTSBE762
00064 *                                                                 DTSBE762
00065 *    REPORT RECORDS WRITTEN:                                      DTSBE762
00066 *                                                                 DTSBE762
00067 *        R901  LABELS.                                            DTSBE762
00068 *                                                                 DTSBE762
00069 *                                                                 DTSBE762
00070 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE762
00071 *                                                                 DTSBE762
00072 *        NONE.                                                    DTSBE762
00073 *                                                                 DTSBE762
00074 *                                                                 DTSBE762
00075 *    MODULES CALLED:                                              DTSBE762
00076 *                                                                 DTSBE762
00077 *        DTSBU001  DATE CONVERSION/EDIT.                          DTSBE762
00078 *        DTSBU111  ADDRESS LOOKUP.                                DTSBE762
00079 *        DTSBU112  ADDRESS FORMATTING.                            DTSBE762
00080 *        DTSBU910  MASTER FILE I/O.                               DTSBE762
00081 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBE762
00082 *                                                                 DTSBE762
00083 *                                                                 DTSBE762
00084 *    VERMONT REFERENCE:                                           DTSBE762
00085 *                                                                 DTSBE762
00086 *        NONE.                                                    DTSBE762
00087 *                                                                 DTSBE762
00088 *****                                                             DTSBE762
00089                                                                   DTSBE762
00090  ENVIRONMENT DIVISION.                                            DTSBE762
00091                                                                   DTSBE762
00092  DATA DIVISION.                                                   DTSBE762
00093                                                                   DTSBE762
00094  WORKING-STORAGE SECTION.                                         DTSBE762
000945 77  PAN-VALET PICTURE X(24) VALUE '001DTSBE762  07/19/00'.       DTSBE762
00095                                                                   DTSBE762
00096  01  WRK-AREA.                                                    DTSBE762
00097      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +761.DTSBE762
00098                                                                   DTSBE762
00099      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE761'.DTSBE762
00100                                                                   DTSBE762
00101      05  ABEND-MSG                   PIC  X(60).                  DTSBE762
00102                                                                   DTSBE762
00103      05  WRK-PASSED-EDITS-IND            PIC  X(01)  VALUE SPACES.DTSBE762
00104          88  WRK-PASSED-EDITS-YES-88     VALUE 'Y'.               DTSBE762
00105          88  WRK-PASSED-EDITS-NO-88      VALUE 'N'.               DTSBE762
00106                                                                   DTSBE762
00107      05  WRK-R901-ADDRESS.                                        DTSBE762
00108          10  WRK-ATTN-LINE       PIC  X(40).                      DTSBE762
00109          10  WRK-DELIV-LINE-1    PIC  X(40).                      DTSBE762
00110          10  WRK-DELIV-LINE-2    PIC  X(40).                      DTSBE762
00111          10  WRK-CITY            PIC  X(25).                      DTSBE762
00112          10  WRK-ST              PIC  X(02).                      DTSBE762
00113          10  WRK-ZIP             PIC  X(10).                      DTSBE762
00114          10  WRK-ADVANCED-BARCODE                                 DTSBE762
00115                                  PIC  X(14).                      DTSBE762
00116                                                                   DTSBE762
00117      05  WRK-LABEL-IND                   PIC  X(01).              DTSBE762
00118      EJECT                                                        DTSBE762
00119  01  L001-LINK-AREA.                                              DTSBE762
00120  ++INCLUDE DTSIL001                                               DTSBE762
00121      EJECT                                                        DTSBE762
00122  01  L111-LINK-AREA.                                              DTSBE762
00123  ++INCLUDE DTSIL111                                               DTSBE762
00124      EJECT                                                        DTSBE762
00125  01  L112-LINK-AREA.                                              DTSBE762
00126  ++INCLUDE DTSIL112                                               DTSBE762
00127      EJECT                                                        DTSBE762
00128  01  L910-LINK-AREA.                                              DTSBE762
00129  ++INCLUDE DTSIL910                                               DTSBE762
00130                                                                   DTSBE762
00131  01  MSKL-REC.                                                    DTSBE762
00132  ++INCLUDE DTSIMSKL                                               DTSBE762
00133      EJECT                                                        DTSBE762
00134  01  MQTR-REC.                                                    DTSBE762
00135  ++INCLUDE DTSIMQTR                                               DTSBE762
00136      EJECT                                                        DTSBE762
00137  01  MTAA-REC.                                                    DTSBE762
00138  ++INCLUDE DTSIMTAA                                               DTSBE762
00139      EJECT                                                        DTSBE762
00140  01  MTAD-REC.                                                    DTSBE762
00141  ++INCLUDE DTSIMTAD                                               DTSBE762
00142      EJECT                                                        DTSBE762
00143  01  R901-REC.                                                    DTSBE762
00144  ++INCLUDE DTSIR901                                               DTSBE762
00145      EJECT                                                        DTSBE762
00146  LINKAGE SECTION.                                                 DTSBE762
00147                                                                   DTSBE762
00148  01  LECM-LINK-AREA.                                              DTSBE762
00149  ++INCLUDE DTSILECM                                               DTSBE762
00150                                                                   DTSBE762
00151      EJECT                                                        DTSBE762
00152  01  MPRF-LINK-REC.                                               DTSBE762
00153  ++INCLUDE DTSIMPRF                                               DTSBE762
00154      EJECT                                                        DTSBE762
00155                                                                   DTSBE762
00156  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE762
00157                           MPRF-LINK-REC.                          DTSBE762
00158                                                                   DTSBE762
00159      EVALUATE LECM-CALL-TYPE-IND                                  DTSBE762
00160        WHEN 'P'                                                   DTSBE762
00161          PERFORM P0000-PROCESS                                    DTSBE762
00162             THRU P0000-EXIT                                       DTSBE762
00163        WHEN 'I'                                                   DTSBE762
00164          PERFORM I0000-INITIALIZE                                 DTSBE762
00165             THRU I0000-EXIT                                       DTSBE762
00166        WHEN 'T'                                                   DTSBE762
00167          PERFORM T0000-TERMINATE                                  DTSBE762
00168             THRU T0000-EXIT                                       DTSBE762
00169        WHEN OTHER                                                 DTSBE762
00170          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE762
00171            TO ABEND-MSG                                           DTSBE762
00172          PERFORM S999-ABEND                                       DTSBE762
00173             THRU S999-EXIT                                        DTSBE762
00174      END-EVALUATE.                                                DTSBE762
00175                                                                   DTSBE762
00176      GOBACK.                                                      DTSBE762
00177      EJECT                                                        DTSBE762
00178                                                                   DTSBE762
00179  I0000-INITIALIZE.                                                DTSBE762
00180                                                                   DTSBE762
00181      MOVE LENGTH OF R901-REC   TO R901-LENGTH.                    DTSBE762
00182      MOVE '901'                TO R901-REC-TYPE.                  DTSBE762
00183      MOVE +0                   TO R901-LABEL-CNT.                 DTSBE762
00184      MOVE LECM-TRACE-IND       TO L910-TRACE-IND.                 DTSBE762
00185      MOVE WRK-MOD-NAME         TO L910-MOD-NAME.                  DTSBE762
00186      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE762
00187      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE762
00188                                                                   DTSBE762
00189  I0000-EXIT.                                                      DTSBE762
00190      EXIT.                                                        DTSBE762
00191                                                                   DTSBE762
00192                                                                   DTSBE762
00193                                                                   DTSBE762
00194  P0000-PROCESS.                                                   DTSBE762
00195                                                                   DTSBE762
00196      IF MPRF-STATUS-ACT-88                                        DTSBE762
00197          NEXT SENTENCE                                            DTSBE762
00198      ELSE                                                         DTSBE762
00199          GO TO P0000-EXIT.                                        DTSBE762
00200                                                                   DTSBE762
00201      PERFORM P1000-LABEL-PROCESS                                  DTSBE762
00202         THRU P1000-EXIT.                                          DTSBE762
00203                                                                   DTSBE762
00204  P0000-EXIT.                                                      DTSBE762
00205      EXIT.                                                        DTSBE762
00206      EJECT                                                        DTSBE762
00207  P1000-LABEL-PROCESS.                                             DTSBE762
00208      SET WRK-PASSED-EDITS-YES-88 TO TRUE.                         DTSBE762
00209      PERFORM P1100-SPECIAL-EDITS                                  DTSBE762
00210         THRU P1100-EXIT.                                          DTSBE762
00211      IF WRK-PASSED-EDITS-NO-88                                    DTSBE762
00212         MOVE LOW-VALUES TO R901-SORT-VAR-AREA                     DTSBE762
00213         GO TO P1000-EXIT.                                         DTSBE762
00214                                                                   DTSBE762
00215      PERFORM P2000-SETUP-R901-KEY                                 DTSBE762
00216         THRU P2000-EXIT.                                          DTSBE762
00217      PERFORM P3000-LOOKUP-ADDR                                    DTSBE762
00218         THRU P3000-EXIT.                                          DTSBE762
00219                                                                   DTSBE762
00220 *    IF L111-ADDR-FOUND-88                                        DTSBE762
00221 *        PERFORM P1200-VALIDATE-MAIL-CRITERIA                     DTSBE762
00222 *           THRU P1200-EXIT                                       DTSBE762
00223 *        IF WRK-PASSED-EDITS-NO-88                                DTSBE762
00224 *           MOVE LOW-VALUES TO R901-SORT-VAR-AREA                 DTSBE762
00225 *           GO TO P1000-EXIT.                                     DTSBE762
00226                                                                   DTSBE762
00227      PERFORM S946-WRITE-R901                                      DTSBE762
00228         THRU S946-EXIT.                                           DTSBE762
00229                                                                   DTSBE762
00230      MOVE LOW-VALUES TO R901-SORT-VAR-AREA.                       DTSBE762
00231                                                                   DTSBE762
00232  P1000-EXIT.                                                      DTSBE762
00233      EXIT.                                                        DTSBE762
00234                                                                   DTSBE762
00235 ******************************************************************DTSBE762
00236 *  USE THE FOLLOWING PARAGRAPH TO ADD ANY EDITS NEEDED FOR A      DTSBE762
00237 *  PARTICULAR LABEL REQUEST.                                      DTSBE762
00238 ******************************************************************DTSBE762
00239  P1100-SPECIAL-EDITS.                                             DTSBE762
00240      IF MPRF-SIC-PRIV-HOUSEHOLDS-88                               DTSBE762
00241      OR MPRF-NAICS-PRIV-HOUSEHOLDS-88                             DTSBE762
00242         SET WRK-PASSED-EDITS-NO-88 TO TRUE.                       DTSBE762
00243                                                                   DTSBE762
00244  P1100-EXIT.                                                      DTSBE762
00245      EXIT.                                                        DTSBE762
00246 ******************************************************************DTSBE762
00247 *  THIS PARAGRAPH WILL LIMIT LABEL PRINTING TO EMPLOYERS WITH A   DTSBE762
00248 *  DC ADDRESS.  IF THE MAILING ADDRESS IS IN DC, IT WILL BE USED. DTSBE762
00249 *  OTHERWISE, THE PARAGRAPH WILL CHECK THE PHYSICAL ADDRESS.      DTSBE762
00250 *  IF THE PHYSICAL ADDRESS IS IN DC, IT WILL BE USED.  IF NOT     DTSBE762
00251 *  THE PROGRAM WILL NOT GENERATE ANY ADDRESS LABEL FOR THE        DTSBE762
00252 *  EMPLOYER.                                                      DTSBE762
00253 ******************************************************************DTSBE762
00254                                                                   DTSBE762
00255  P1200-VALIDATE-MAIL-CRITERIA.                                    DTSBE762
00256                                                                   DTSBE762
00257      IF L112-ST EQUAL 'DC'                                        DTSBE762
00258          NEXT SENTENCE                                            DTSBE762
00259      ELSE                                                         DTSBE762
00260          PERFORM P3110-LOOKUP-PHYS-ADDR                           DTSBE762
00261             THRU P3110-EXIT                                       DTSBE762
00262          IF L111-ADDR-FOUND-88                                    DTSBE762
00263              PERFORM S946-WRITE-R901                              DTSBE762
00264                 THRU S946-EXIT.                                   DTSBE762
00265                                                                   DTSBE762
00266  P1200-EXIT.                                                      DTSBE762
00267      EXIT.                                                        DTSBE762
00268 **************************************************************    DTSBE762
00269 *  THIS PARAGRAPH SETS UP THE KEY FOR THE R901 EXTRACT RECORD.    DTSBE762
00270 **************************************************************    DTSBE762
00271                                                                   DTSBE762
00272  P2000-SETUP-R901-KEY.                                            DTSBE762
00273      MOVE +1                    TO R901-LABEL-CNT.                DTSBE762
00274                                                                   DTSBE762
00275      SET R901-ON-REQUEST-88     TO TRUE.                          DTSBE762
00276      MOVE MPRF-EMP-NO           TO R901-GRP1-EMP-NO.              DTSBE762
00277                                                                   DTSBE762
00278  P2000-EXIT.                                                      DTSBE762
00279      EXIT.                                                        DTSBE762
00280 **************************************************************    DTSBE762
00281 *  THIS PARAGRAPH LOOKS UP THE ADDRESS (MTAD).                    DTSBE762
00282 **************************************************************    DTSBE762
00283                                                                   DTSBE762
00284  P3000-LOOKUP-ADDR.                                               DTSBE762
00285                                                                   DTSBE762
00286      SET L111-LOOKUP-TAD-88     TO TRUE.                          DTSBE762
00287      SET L111-ID-NO-TAD-MAIL-88 TO TRUE.                          DTSBE762
00288                                                                   DTSBE762
00289      MOVE MPRF-EMP-NO TO L111-EMP-NO.                             DTSBE762
00290 **   MOVE MPRF-EMP-NO TO R901-EMP-NO.                             DTSBE762
00291      MOVE ZERO        TO R901-EMP-NO.                             DTSBE762
00292                                                                   DTSBE762
00293      PERFORM S111-LOOKUP-ADDR                                     DTSBE762
00294         THRU S111-EXIT.                                           DTSBE762
00295                                                                   DTSBE762
00296      IF L111-ADDR-FOUND-88                                        DTSBE762
00297          SET L112-TAD-ADDR-88 TO TRUE                             DTSBE762
00298          PERFORM P3100-FORMAT-ADDR                                DTSBE762
00299             THRU P3100-EXIT                                       DTSBE762
00300      ELSE                                                         DTSBE762
00301          MOVE +1      TO R901-LABEL-CNT                           DTSBE762
00302          MOVE ALL '?' TO R901-FMT-ADDR                            DTSBE762
00303                          R901-ZIP                                 DTSBE762
00304                          R901-ADVANCED-BARCODE.                   DTSBE762
00305                                                                   DTSBE762
00306  P3000-EXIT.                                                      DTSBE762
00307      EXIT.                                                        DTSBE762
00308                                                                   DTSBE762
00309  P3110-LOOKUP-PHYS-ADDR.                                          DTSBE762
00310                                                                   DTSBE762
00311      SET L111-LOOKUP-TAD-88     TO TRUE.                          DTSBE762
00312      SET L111-ID-NO-TAD-PHYS-88 TO TRUE.                          DTSBE762
00313                                                                   DTSBE762
00314      MOVE MPRF-EMP-NO TO L111-EMP-NO.                             DTSBE762
00315      MOVE MPRF-EMP-NO TO R901-EMP-NO.                             DTSBE762
00316                                                                   DTSBE762
00317      PERFORM S111-LOOKUP-ADDR                                     DTSBE762
00318         THRU S111-EXIT.                                           DTSBE762
00319                                                                   DTSBE762
00320      IF L111-ADDR-FOUND-88                                        DTSBE762
00321          SET L112-TAD-ADDR-88 TO TRUE                             DTSBE762
00322          PERFORM P3100-FORMAT-ADDR                                DTSBE762
00323             THRU P3100-EXIT                                       DTSBE762
00324      ELSE                                                         DTSBE762
00325          MOVE +1      TO R901-LABEL-CNT                           DTSBE762
00326          MOVE ALL '?' TO R901-FMT-ADDR                            DTSBE762
00327                          R901-ZIP                                 DTSBE762
00328                          R901-ADVANCED-BARCODE.                   DTSBE762
00329                                                                   DTSBE762
00330  P3110-EXIT.                                                      DTSBE762
00331      EXIT.                                                        DTSBE762
00332                                                                   DTSBE762
00333                                                                   DTSBE762
00334 **************************************************************    DTSBE762
00335 *  THIS PARAGRAPH FORMATS THE ADDRESS (MTAD).                     DTSBE762
00336 **************************************************************    DTSBE762
00337  P3100-FORMAT-ADDR.                                               DTSBE762
00338                                                                   DTSBE762
00339      SET L112-ANCHOR-LAST-88    TO TRUE.                          DTSBE762
00340      MOVE MPRF-PRIMARY-NAME     TO L112-PRIMARY-NAME.             DTSBE762
00341      MOVE L111-RETURN-AREA      TO L112-NAME-ADDRESS-AREA.        DTSBE762
00342                                                                   DTSBE762
00343      PERFORM S112-FORMAT-ADDR                                     DTSBE762
00344         THRU S112-EXIT.                                           DTSBE762
00345                                                                   DTSBE762
00346      MOVE L112-MAILING-ADDRESS  TO R901-FMT-ADDR.                 DTSBE762
00347      MOVE L112-ZIP              TO R901-ZIP.                      DTSBE762
00348      MOVE L112-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE.         DTSBE762
00349      MOVE +1                    TO R901-LABEL-CNT.                DTSBE762
00350                                                                   DTSBE762
00351  P3100-EXIT.                                                      DTSBE762
00352      EXIT.                                                        DTSBE762
00353      EJECT                                                        DTSBE762
00354  T0000-TERMINATE.                                                 DTSBE762
00355                                                                   DTSBE762
00356                                                                   DTSBE762
00357  T0000-EXIT.                                                      DTSBE762
00358      EXIT.                                                        DTSBE762
00359      EJECT                                                        DTSBE762
00360  S001-FROM-FED-8.                                                 DTSBE762
00361      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE762
00362      GO TO S001-DATE.                                             DTSBE762
00363                                                                   DTSBE762
00364  S001-FROM-CAL-6.                                                 DTSBE762
00365      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE762
00366      GO TO S001-DATE.                                             DTSBE762
00367                                                                   DTSBE762
00368  S001-FROM-ABS-DAY.                                               DTSBE762
00369      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE762
00370      GO TO S001-DATE.                                             DTSBE762
00371                                                                   DTSBE762
00372  S001-DATE.                                                       DTSBE762
00373      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE762
00374  S001-EXIT.                                                       DTSBE762
00375      EXIT.                                                        DTSBE762
00376                                                                   DTSBE762
00377  S111-LOOKUP-ADDR.                                                DTSBE762
00378                                                                   DTSBE762
00379      CALL 'DTSBU111' USING L111-LINK-AREA.                        DTSBE762
00380  S111-EXIT.                                                       DTSBE762
00381      EXIT.                                                        DTSBE762
00382                                                                   DTSBE762
00383  S112-FORMAT-ADDR.                                                DTSBE762
00384      CALL 'DTSBU112' USING L112-LINK-AREA.                        DTSBE762
00385  S112-EXIT.                                                       DTSBE762
00386      EXIT.                                                        DTSBE762
00387                                                                   DTSBE762
00388  S910-READ.                                                       DTSBE762
00389      SET L910-READ-88 TO TRUE.                                    DTSBE762
00390      GO TO S910-MSTR-IO.                                          DTSBE762
00391                                                                   DTSBE762
00392  S910-START-BROWSE.                                               DTSBE762
00393      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE762
00394      GO TO S910-MSTR-IO.                                          DTSBE762
00395                                                                   DTSBE762
00396  S910-READ-NEXT.                                                  DTSBE762
00397      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE762
00398      GO TO S910-MSTR-IO.                                          DTSBE762
00399                                                                   DTSBE762
00400  S910-COUNT.                                                      DTSBE762
00401      SET L910-COUNT-88 TO TRUE.                                   DTSBE762
00402      GO TO S910-MSTR-IO.                                          DTSBE762
00403                                                                   DTSBE762
00404  S910-MSTR-IO.                                                    DTSBE762
00405      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE762
00406                            MSKL-REC.                              DTSBE762
00407  S910-EXIT.                                                       DTSBE762
00408      EXIT.                                                        DTSBE762
00409                                                                   DTSBE762
00410  S946-WRITE-R901.                                                 DTSBE762
00411      CALL 'DTSBU946' USING R901-REC.                              DTSBE762
00412      GO TO S946-EXIT.                                             DTSBE762
00413                                                                   DTSBE762
00414  S946-EXIT.                                                       DTSBE762
00415      EXIT.                                                        DTSBE762
00416                                                                   DTSBE762
00417  S999-ABEND.                                                      DTSBE762
00418      DISPLAY '*** DTSBE761 ABENDING.  '                           DTSBE762
00419              ABEND-MSG.                                           DTSBE762
00420                                                                   DTSBE762
00421      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE762
00422  S999-EXIT.                                                       DTSBE762
00423      EXIT.                                                        DTSBE762
