00001  IDENTIFICATION DIVISION.                                         12/18/08
00002  PROGRAM-ID.             DTSBE718.                                DTSBE718
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV016
00004                          MODIFIED BY TRW/BDM OCT. 1998.           DTSBE718
00005  DATE-WRITTEN.           SEPTEMBER 1994.                          DTSBE718
00006  DATE-COMPILED.                                                   DTSBE718
00007      SKIP3                                                        DTSBE718
00008 *****                                                             DTSBE718
00009 *                                                                 DTSBE718
00010 *    CALLING SEQUENCE:  DTSBD400 CALLS                            DTSBE718
00011 *                       DTSBE718 WHICH UPDATES DTSIR718           DTSBE718
00012 *                       DTSBR718 READS DTSIR718 RECORDS.          DTSBE718
00013 *                                                                 DTSBE718
00014 *    FUNCTION:  RQC FIELD AUDIT UNIVERSE RECORDS EXTRACT.         DTSBE718
00015 *                                                                 DTSBE718
00016 *                                                                 DTSBE718
00017 *    MODIFICATION LOG:                                            DTSBE718
00018 *                                                                 DTSBE718
00019 *    12/18/2008  REMOVED TEST AT THE TOP OF P0000 TO BYPASS       DTSBE718
00020 *                THE EMPLOYER IS MPRF-MFAS-NO88 IS TRUE.          DTSBE718
00021 *                THIS TESTS WORKS ONLY IF THERE IS A CURRENTLY    DTSBE718
00022 *                ACTIVE FIELD ASSIGNMENT.                         DTSBE718
00023 *                WORK ORDER:                    PROGRAMMER: GD    DTSBE718
00024 *                                                                 DTSBE718
00025 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE718
00026 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE718
00027 *                WORK ORDER:                    PROGRAMMER: XXX   DTSBE718
00028 *                                                                 DTSBE718
00029 *                                                                 DTSBE718
00030 *  DESCRIPTION:                                                   DTSBE718
00031 *                                                                 DTSBE718
00032 *                                                                 DTSBE718
00033 *    INITIATION:                                                  DTSBE718
00034 *                                                                 DTSBE718
00035 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE718
00036 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE718
00037 *                                                                 DTSBE718
00038 *      EDIT AND DEFAULT PARAMETERS.                               DTSBE718
00039 *                                                                 DTSBE718
00040 *                                                                 DTSBE718
00041 *    PROCESSING:                                                  DTSBE718
00042 *                                                                 DTSBE718
00043 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (718R1).       DTSBE718
00044 *                                                                 DTSBE718
00045 *                                                                 DTSBE718
00046 *    TERMINATION:                                                 DTSBE718
00047 *                                                                 DTSBE718
00048 *      NONE.                                                      DTSBE718
00049 *                                                                 DTSBE718
00050 *                                                                 DTSBE718
00051 *    RECORDS READ:                                                DTSBE718
00052 *                                                                 DTSBE718
00053 *      MASTER:                                                    DTSBE718
00054 *                                                                 DTSBE718
00055 *        MHDR                                                     DTSBE718
00056 *        MFAS                                                     DTSBE718
00057 *                                                                 DTSBE718
00058 *                                                                 DTSBE718
00059 *      ALTERNATE INDEX:                                           DTSBE718
00060 *                                                                 DTSBE718
00061 *        NONE.                                                    DTSBE718
00062 *                                                                 DTSBE718
00063 *                                                                 DTSBE718
00064 *      REFERENCE:                                                 DTSBE718
00065 *                                                                 DTSBE718
00066 *        NONE.                                                    DTSBE718
00067 *                                                                 DTSBE718
00068 *                                                                 DTSBE718
00069 *    RECORDS UPDATED:                                             DTSBE718
00070 *                                                                 DTSBE718
00071 *        NONE.                                                    DTSBE718
00072 *                                                                 DTSBE718
00073 *                                                                 DTSBE718
00074 *    REPORT RECORDS WRITTEN:                                      DTSBE718
00075 *                                                                 DTSBE718
00076 *        R718 RQC FIELD AUDIT UNIVERSE RECORDS.                   DTSBE718
00077 *                                                                 DTSBE718
00078 *                                                                 DTSBE718
00079 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE718
00080 *                                                                 DTSBE718
00081 *        NONE.                                                    DTSBE718
00082 *                                                                 DTSBE718
00083 *                                                                 DTSBE718
00084 *    MODULES CALLED:                                              DTSBE718
00085 *                                                                 DTSBE718
00086 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBE718
00087 *        DTSBU910  MASTER FILE I/O.                               DTSBE718
00088 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBE718
00089 *                                                                 DTSBE718
00090 *                                                                 DTSBE718
00091 *    VERMONT REFERENCE:                                           DTSBE718
00092 *                                                                 DTSBE718
00093 *        NONE.                                                    DTSBE718
00094 *                                                                 DTSBE718
00095 *****                                                             DTSBE718
00096      SKIP3                                                        DTSBE718
00097  ENVIRONMENT DIVISION.                                            DTSBE718
00098      EJECT                                                        DTSBE718
00099  DATA DIVISION.                                                   DTSBE718
00100      SKIP3                                                        DTSBE718
00101  WORKING-STORAGE SECTION.                                         DTSBE718
001015 77  PAN-VALET PICTURE X(24) VALUE '016DTSBE718  12/18/08'.       DTSBE718
00102      SKIP3                                                        DTSBE718
00103  01  WRK-AREA.                                                    DTSBE718
00104      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +718.DTSBE718
00105      SKIP1                                                        DTSBE718
00106      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE718'.DTSBE718
00107      SKIP3                                                        DTSBE718
00108      05  ABEND-MSG                       PIC  X(60).              DTSBE718
00109      SKIP3                                                        DTSBE718
00110      05  WRK-PARM-PERIOD-START-DATE  PIC S9(09)  COMP-3.          DTSBE718
00111                                                                   DTSBE718
00112      05  WRK-PARM-PERIOD-END-DATE    PIC S9(09)  COMP-3.          DTSBE718
00113      EJECT                                                        DTSBE718
00114  01  L001-LINK-AREA.                                              DTSBE718
00115  ++INCLUDE DTSIL001                                               DTSBE718
00116      EJECT                                                        DTSBE718
00117  01  L910-LINK-AREA.                                              DTSBE718
00118  ++INCLUDE DTSIL910                                               DTSBE718
00119      SKIP3                                                        DTSBE718
00120  01  MSKL-REC.                                                    DTSBE718
00121  ++INCLUDE DTSIMSKL                                               DTSBE718
00122      SKIP3                                                        DTSBE718
00123  01  MHDR-REC.                                                    DTSBE718
00124  ++INCLUDE DTSIMHDR                                               DTSBE718
00125      SKIP3                                                        DTSBE718
00126  01  MFAS-REC.                                                    DTSBE718
00127  ++INCLUDE DTSIMFAS                                               DTSBE718
00128      EJECT                                                        DTSBE718
00129  01  R718-REC.                                                    DTSBE718
00130  ++INCLUDE DTSIR718                                               DTSBE718
00131      EJECT                                                        DTSBE718
00132  LINKAGE SECTION.                                                 DTSBE718
00133      SKIP3                                                        DTSBE718
00134  01  LECM-LINK-AREA.                                              DTSBE718
00135  ++INCLUDE DTSILECM                                               DTSBE718
00136      SKIP3                                                        DTSBE718
00137          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE718
00138              15  LECM-PARM-PERIOD-START-DATE  PIC  X(06).         DTSBE718
00139              15  FILLER                       PIC  X(01).         DTSBE718
00140              15  LECM-PARM-PERIOD-END-DATE    PIC  X(06).         DTSBE718
00141              15  FILLER                       PIC  X(55).         DTSBE718
00142      EJECT                                                        DTSBE718
00143  01  MPRF-LINK-REC.                                               DTSBE718
00144  ++INCLUDE DTSIMPRF                                               DTSBE718
00145      EJECT                                                        DTSBE718
00146  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE718
00147                           MPRF-LINK-REC.                          DTSBE718
00148      SKIP2                                                        DTSBE718
00149      SKIP2                                                        DTSBE718
00150      IF LECM-PROCESS-88                                           DTSBE718
00151          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE718
00152      ELSE                                                         DTSBE718
00153      IF LECM-INITIALIZE-88                                        DTSBE718
00154          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE718
00155      ELSE                                                         DTSBE718
00156      IF LECM-TERMINATE-88                                         DTSBE718
00157          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE718
00158      ELSE                                                         DTSBE718
00159          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE718
00160            TO ABEND-MSG                                           DTSBE718
00161          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE718
00162      SKIP2                                                        DTSBE718
00163      GOBACK.                                                      DTSBE718
00164      EJECT                                                        DTSBE718
00165  I0000-INITIALIZE.                                                DTSBE718
00166      SKIP2                                                        DTSBE718
00167      MOVE LENGTH OF R718-REC TO R718-LENGTH.                      DTSBE718
00168      MOVE '718'              TO R718-REC-TYPE.                    DTSBE718
00169      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE718
00170      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE718
00171                                                                   DTSBE718
00172      PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT.        DTSBE718
00173                                                                   DTSBE718
00174      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE718
00175      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE718
00176      SKIP2                                                        DTSBE718
00177  I0000-EXIT.                                                      DTSBE718
00178      EXIT.                                                        DTSBE718
00179      SKIP3                                                        DTSBE718
00180  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE718
00181      MOVE LOW-VALUES TO MHDR-KEY-AREA.                            DTSBE718
00182      MOVE +0 TO MHDR-EMP-NO.                                      DTSBE718
00183      SET MHDR-HDR-88 TO TRUE.                                     DTSBE718
00184      MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE718
00185      PERFORM S910-READ THRU S910-EXIT.                            DTSBE718
00186      IF L910-NO-REC-88                                            DTSBE718
00187          MOVE 'MHDR RECORD NOT FOUND' TO ABEND-MSG                DTSBE718
00188          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE718
00189                                                                   DTSBE718
00190      MOVE MSKL-REC TO MHDR-REC.                                   DTSBE718
00191                                                                   DTSBE718
00192      PERFORM I1100-PERIOD-START-DATE THRU I1100-EXIT.             DTSBE718
00193                                                                   DTSBE718
00194      PERFORM I1200-PERIOD-END-DATE THRU I1200-EXIT.               DTSBE718
00195  I1000-EXIT.                                                      DTSBE718
00196      EXIT.                                                        DTSBE718
00197      SKIP3                                                        DTSBE718
00198  I1100-PERIOD-START-DATE.                                         DTSBE718
00199      IF LECM-PARM-PERIOD-START-DATE = SPACES                      DTSBE718
00200          MOVE MHDR-CMPL-YEAR-BEGIN-DATE                           DTSBE718
00201            TO WRK-PARM-PERIOD-START-DATE                          DTSBE718
00202      ELSE                                                         DTSBE718
00203          MOVE LECM-PARM-PERIOD-START-DATE TO L001-CAL-6-DATE-X    DTSBE718
00204          PERFORM S001-FROM-CAL-6 THRU S001-EXIT                   DTSBE718
00205          IF L001-VALID-DATE                                       DTSBE718
00206              MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-START-DATE DTSBE718
00207          ELSE                                                     DTSBE718
00208              MOVE 'LECM-PARM-PERIOD-START-DATE NOT VALID'         DTSBE718
00209                TO ABEND-MSG                                       DTSBE718
00210              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBE718
00211  I1100-EXIT.                                                      DTSBE718
00212      EXIT.                                                        DTSBE718
00213      SKIP3                                                        DTSBE718
00214  I1200-PERIOD-END-DATE.                                           DTSBE718
00215      IF LECM-PARM-PERIOD-END-DATE = SPACES                        DTSBE718
00216          MOVE MHDR-CMPL-YEAR-END-DATE                             DTSBE718
00217            TO WRK-PARM-PERIOD-END-DATE                            DTSBE718
00218      ELSE                                                         DTSBE718
00219          MOVE LECM-PARM-PERIOD-END-DATE TO L001-CAL-6-DATE-X      DTSBE718
00220          PERFORM S001-FROM-CAL-6 THRU S001-EXIT                   DTSBE718
00221          IF L001-VALID-DATE                                       DTSBE718
00222              MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-END-DATE   DTSBE718
00223          ELSE                                                     DTSBE718
00224              MOVE 'LECM-PARM-PERIOD-END-DATE NOT VALID'           DTSBE718
00225                TO ABEND-MSG                                       DTSBE718
00226              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBE718
00227                                                                   DTSBE718
00228      IF WRK-PARM-PERIOD-END-DATE < WRK-PARM-PERIOD-START-DATE     DTSBE718
00229          MOVE 'PERIOD-END-DATE LESS THAN PERIOD-START-DATE'       DTSBE718
00230            TO ABEND-MSG                                           DTSBE718
00231          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE718
00232  I1200-EXIT.                                                      DTSBE718
00233      EXIT.                                                        DTSBE718
00234      EJECT                                                        DTSBE718
00235  P0000-PROCESS.                                                   DTSBE718
00236 **   IF MPRF-NO-MFAS-88                                           DTSBE718
00237 **       GO TO P0000-EXIT.                                        DTSBE718
00238                                                                   DTSBE718
00239      IF MPRF-CLASS-SELF-INS-88                                    DTSBE718
00240          GO TO P0000-EXIT.                                        DTSBE718
00241                                                                   DTSBE718
00242      MOVE LOW-VALUES TO MFAS-KEY-AREA.                            DTSBE718
00243      MOVE MPRF-EMP-NO TO MFAS-EMP-NO.                             DTSBE718
00244      SET MFAS-FAS-88 TO TRUE.                                     DTSBE718
00245      MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE718
00246      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE718
00247      PERFORM P1000-SCAN-MFAS THRU P1000-EXIT                      DTSBE718
00248          UNTIL L910-NO-REC-88.                                    DTSBE718
00249  P0000-EXIT.                                                      DTSBE718
00250      EXIT.                                                        DTSBE718
00251      SKIP3                                                        DTSBE718
00252  P1000-SCAN-MFAS.                                                 DTSBE718
00253      MOVE MSKL-REC TO MFAS-REC.                                   DTSBE718
00254                                                                   DTSBE718
00255      IF (MFAS-PROCESSED-DATE < WRK-PARM-PERIOD-START-DATE)        DTSBE718
00256              OR                                                   DTSBE718
00257         (MFAS-PROCESSED-DATE > WRK-PARM-PERIOD-END-DATE)          DTSBE718
00258          NEXT SENTENCE                                            DTSBE718
00259      ELSE                                                         DTSBE718
00260          PERFORM P1100-GENERATE-R718 THRU P1100-EXIT.             DTSBE718
00261                                                                   DTSBE718
00262      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE718
00263  P1000-EXIT.                                                      DTSBE718
00264      EXIT.                                                        DTSBE718
00265      SKIP3                                                        DTSBE718
00266  P1100-GENERATE-R718.                                             DTSBE718
00267      MOVE MPRF-EMP-NO       TO R718-EMP-NO.                       DTSBE718
00268                                                                   DTSBE718
00269      SET R718-TRANS-TYPE-OTHER-88 TO TRUE.                        DTSBE718
00270                                                                   DTSBE718
00271      PERFORM                                                      DTSBE718
00272        VARYING MFAS-SEL-IDX FROM 1 BY 1                           DTSBE718
00273        UNTIL MFAS-SEL-IDX > MFAS-SEL-CNT                          DTSBE718
00274          IF MFAS-AUDIT-SEL-RANDOM-88 (MFAS-SEL-IDX)               DTSBE718
00275              SET R718-TRANS-TYPE-RANDOM-88 TO TRUE                DTSBE718
00276          END-IF                                                   DTSBE718
00277      END-PERFORM.                                                 DTSBE718
00278                                                                   DTSBE718
00279      MOVE MFAS-PROCESSED-DATE TO R718-PROCESSED-DATE.             DTSBE718
00280                                                                   DTSBE718
00281      PERFORM S946-WRITE-R718 THRU S946-EXIT.                      DTSBE718
00282  P1100-EXIT.                                                      DTSBE718
00283      EXIT.                                                        DTSBE718
00284      EJECT                                                        DTSBE718
00285  T0000-TERMINATE.                                                 DTSBE718
00286      SKIP2                                                        DTSBE718
00287      SKIP2                                                        DTSBE718
00288  T0000-EXIT.                                                      DTSBE718
00289      EXIT.                                                        DTSBE718
00290      EJECT                                                        DTSBE718
00291  S001-FROM-FED-8.                                                 DTSBE718
00292      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE718
00293      GO TO S001-DATE.                                             DTSBE718
00294      SKIP1                                                        DTSBE718
00295  S001-FROM-ABS-DAY.                                               DTSBE718
00296      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE718
00297      GO TO S001-DATE.                                             DTSBE718
00298      SKIP1                                                        DTSBE718
00299  S001-FROM-CAL-6.                                                 DTSBE718
00300      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE718
00301      GO TO S001-DATE.                                             DTSBE718
00302      SKIP1                                                        DTSBE718
00303  S001-DATE.                                                       DTSBE718
00304      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE718
00305  S001-EXIT.                                                       DTSBE718
00306      EXIT.                                                        DTSBE718
00307      SKIP3                                                        DTSBE718
00308  S910-READ.                                                       DTSBE718
00309      SET L910-READ-88 TO TRUE.                                    DTSBE718
00310      GO TO S910-MSTR-IO.                                          DTSBE718
00311      SKIP1                                                        DTSBE718
00312  S910-START-BROWSE.                                               DTSBE718
00313      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE718
00314      GO TO S910-MSTR-IO.                                          DTSBE718
00315      SKIP1                                                        DTSBE718
00316  S910-READ-NEXT.                                                  DTSBE718
00317      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE718
00318      GO TO S910-MSTR-IO.                                          DTSBE718
00319      SKIP1                                                        DTSBE718
00320  S910-COUNT.                                                      DTSBE718
00321      SET L910-COUNT-88 TO TRUE.                                   DTSBE718
00322      GO TO S910-MSTR-IO.                                          DTSBE718
00323      SKIP1                                                        DTSBE718
00324  S910-MSTR-IO.                                                    DTSBE718
00325      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE718
00326                            MSKL-REC.                              DTSBE718
00327  S910-EXIT.                                                       DTSBE718
00328      EXIT.                                                        DTSBE718
00329      SKIP3                                                        DTSBE718
00330  S946-WRITE-R718.                                                 DTSBE718
00331      CALL 'DTSBU946' USING R718-REC.                              DTSBE718
00332      GO TO S946-EXIT.                                             DTSBE718
00333      SKIP1                                                        DTSBE718
00334  S946-EXIT.                                                       DTSBE718
00335      EXIT.                                                        DTSBE718
00336      SKIP3                                                        DTSBE718
00337  S999-ABEND.                                                      DTSBE718
00338      DISPLAY '*** DTSBE718 ABENDING.  '                           DTSBE718
00339              ABEND-MSG.                                           DTSBE718
00340      SKIP1                                                        DTSBE718
00341      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE718
00342  S999-EXIT.                                                       DTSBE718
00343      EXIT.                                                        DTSBE718
