00001  IDENTIFICATION DIVISION.                                         01/30/99
00002  PROGRAM-ID.             DTSBU331.                                DTSBU331
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV007
00004  DATE-WRITTEN.           JANUARY 1999.                               CL**7
00005  DATE-COMPILED.                                                   DTSBU331
00006      SKIP3                                                        DTSBU331
00007 *****                                                             DTSBU331
00008 *                                                                 DTSBU331
00009 *    FUNCTION:  CONSTRUCT AND WRITE MLOG RECORDS.                    CL**7
00010 *                                                                 DTSBU331
00011 *                                                                 DTSBU331
00012 *    MODIFICATION LOG:                                            DTSBU331
00013 *                                                                 DTSBU331
00014 *                                                                 DTSBU331
00015 *    01/30/1999  CLONED FROM DTSCU331.                               CL**7
00016 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00017 *                                                                    CL**2
00018 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00019 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00020 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00021 *                                                                 DTSBU331
00022 *                                                                 DTSBU331
00023 *  DESCRIPTION:                                                   DTSBU331
00024 *                                                                 DTSBU331
00025 *    CONSTRUCT AND WRITE AN MLOG RECORD OCCURRENCE.                  CL**5
00026 *                                                                 DTSBU331
00027 *****                                                             DTSBU331
00028      SKIP3                                                        DTSBU331
00029  ENVIRONMENT DIVISION.                                            DTSBU331
00030      SKIP3                                                        DTSBU331
00031  DATA DIVISION.                                                   DTSBU331
00032      SKIP3                                                        DTSBU331
00033  WORKING-STORAGE SECTION.                                         DTSBU331
000335 77  PAN-VALET PICTURE X(24) VALUE '007DTSBU331  01/30/99'.       DTSBU331
00034      SKIP3                                                        DTSBU331
00035  01  WRK-AREA.                                                    DTSBU331
00036      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +331.   CL**7
00037                                                                      CL**3
00038      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.          CL**7
00039                                                                      CL**7
00040      05  WRK-SUB                     PIC S9(04)  COMP.               CL**3
00041                                                                      CL**3
00042      05  WRK-FIRST-NOT-SPACE         PIC S9(04)  COMP.               CL**3
00043                                                                      CL**3
00044      05  WRK-LENGTH                  PIC S9(04)  COMP.               CL**3
00045      EJECT                                                        DTSBU331
00046  01  L910-LINK-AREA.                                                 CL**7
00047  ++INCLUDE DTSIL910                                                  CL**7
00048      SKIP3                                                           CL**3
00049  01  MSKL-REC.                                                       CL**7
00050  ++INCLUDE DTSIMSKL                                                  CL**3
00051      EJECT                                                           CL**3
00052  01  MLOG-REC.                                                       CL**3
00053  ++INCLUDE DTSIMLOG                                                  CL**3
00054      EJECT                                                           CL**3
00055  LINKAGE SECTION.                                                 DTSBU331
00056      SKIP3                                                        DTSBU331
00057  01  L331-LINK-AREA.                                                 CL**7
00058  ++INCLUDE DTSIL331                                                  CL**2
00059      EJECT                                                        DTSBU331
00060  PROCEDURE DIVISION USING L331-LINK-AREA.                            CL**7
00061                                                                      CL**3
00062                                                                      CL**7
00063      IF FIRST-TIME-IND = 'Y'                                         CL**7
00064          MOVE 'DTSBU331' TO L910-MOD-NAME                            CL**7
00065          MOVE 'N' TO L910-TRACE-IND                                  CL**7
00066          MOVE 'N' TO FIRST-TIME-IND.                                 CL**7
00067                                                                      CL**7
00068                                                                      CL**7
00069      MOVE SPACES TO L331-MSG-AREA.                                DTSBU331
00070                                                                      CL**3
00071      SET L331-OK TO TRUE.                                            CL**3
00072                                                                      CL**3
00073      ADD +1 TO L331-UPDATE-ABSTIME.                                  CL**3
00074                                                                      CL**3
00075                                                                      CL**5
00076      PERFORM P1000-CONSTRUCT-MLOG THRU P1000-EXIT.                   CL**3
00077                                                                      CL**3
00078                                                                      CL**5
00079      MOVE MLOG-REC TO MSKL-REC.                                      CL**3
00080                                                                      CL**3
00081      PERFORM S910-WRITE THRU S910-EXIT.                              CL**7
00082                                                                      CL**3
00083      SET L331-OK TO TRUE.                                            CL**7
00084                                                                      CL**3
00085                                                                      CL**3
00086      GOBACK.                                                      DTSBU331
00087      EJECT                                                        DTSBU331
00088  P1000-CONSTRUCT-MLOG.                                               CL**3
00089      MOVE LOW-VALUES TO MLOG-REC.                                    CL**6
00090                                                                      CL**3
00091      MOVE L331-EMP-NO TO MLOG-EMP-NO.                                CL**3
00092                                                                      CL**3
00093      SET MLOG-LOG-88 TO TRUE.                                        CL**3
00094                                                                      CL**3
00095      MOVE L331-UPDATE-ABSTIME TO MLOG-ESTB-ABSTIME.                  CL**3
00096                                                                      CL**3
00097                                                                      CL**4
00098      MOVE +0 TO MLOG-PURGE-DATE.                                     CL**3
00099                                                                      CL**3
00100                                                                      CL**4
00101      MOVE L331-REC-OCC-ID TO MLOG-REC-OCC-ID.                        CL**3
00102                                                                      CL**3
00103      MOVE L331-FIELD-NAME TO MLOG-DATA-ELEMENT-NAME.                 CL**3
00104                                                                      CL**3
00105      PERFORM P1100-FROM-VALUE THRU P1100-EXIT.                       CL**5
00106                                                                      CL**5
00107      PERFORM P1200-TO-VALUE THRU P1200-EXIT.                         CL**5
00108                                                                      CL**5
00109      MOVE L331-OP-ID TO MLOG-OP-ID.                                  CL**5
00110                                                                      CL**5
00111      SET MLOG-NOT-CONVERTED-88 TO TRUE.                              CL**5
00112                                                                      CL**5
00113      MOVE L331-CURR-RUN-DATE TO MLOG-ESTB-DATE.                      CL**5
00114  P1000-EXIT.                                                         CL**4
00115      EXIT.                                                           CL**4
00116      EJECT                                                           CL**4
00117  P1100-FROM-VALUE.                                                   CL**4
00118      MOVE SPACES TO MLOG-PRE-MODIFICATION-VALUE.                     CL**6
00119                                                                      CL**6
00120      IF L331-FROM-VALUE = SPACES                                     CL**4
00121          GO TO P1100-EXIT.                                           CL**4
00122                                                                      CL**4
00123      MOVE +0 TO WRK-FIRST-NOT-SPACE.                                 CL**4
00124                                                                      CL**3
00125      MOVE LENGTH OF L331-FROM-VALUE TO WRK-LENGTH.                   CL**4
00126                                                                      CL**4
00127      PERFORM                                                         CL**3
00128        VARYING WRK-SUB FROM 1 BY 1                                   CL**4
00129        UNTIL (WRK-FIRST-NOT-SPACE NOT = +0)                          CL**4
00130                 OR                                                   CL**4
00131              (WRK-SUB > WRK-LENGTH)                                  CL**4
00132          IF L331-FROM-VALUE (WRK-SUB:1) NOT = SPACE                  CL**4
00133              MOVE WRK-SUB TO WRK-FIRST-NOT-SPACE                     CL**4
00134          END-IF                                                      CL**4
00135      END-PERFORM.                                                    CL**4
00136                                                                      CL**4
00137      IF WRK-FIRST-NOT-SPACE = +0                                     CL**4
00138          MOVE L331-FROM-VALUE TO MLOG-PRE-MODIFICATION-VALUE         CL**4
00139      ELSE                                                            CL**4
00140          SUBTRACT WRK-FIRST-NOT-SPACE FROM WRK-LENGTH                CL**4
00141          ADD +1 TO WRK-LENGTH                                        CL**4
00142          MOVE L331-FROM-VALUE (WRK-FIRST-NOT-SPACE:WRK-LENGTH)       CL**4
00143            TO MLOG-PRE-MODIFICATION-VALUE.                           CL**4
00144  P1100-EXIT.                                                         CL**4
00145      EXIT.                                                        DTSBU331
00146      EJECT                                                        DTSBU331
00147  P1200-TO-VALUE.                                                     CL**4
00148      MOVE SPACES TO MLOG-POST-MODIFICATION-VALUE.                    CL**6
00149                                                                      CL**6
00150      IF L331-TO-VALUE = SPACES                                       CL**4
00151          GO TO P1200-EXIT.                                           CL**4
00152                                                                      CL**4
00153      MOVE +0 TO WRK-FIRST-NOT-SPACE.                                 CL**4
00154                                                                      CL**4
00155      MOVE LENGTH OF L331-TO-VALUE TO WRK-LENGTH.                     CL**4
00156                                                                      CL**4
00157      PERFORM                                                         CL**4
00158        VARYING WRK-SUB FROM 1 BY 1                                   CL**4
00159        UNTIL (WRK-FIRST-NOT-SPACE NOT = +0)                          CL**4
00160                 OR                                                   CL**4
00161              (WRK-SUB > WRK-LENGTH)                                  CL**4
00162          IF L331-TO-VALUE (WRK-SUB:1) NOT = SPACE                    CL**4
00163              MOVE WRK-SUB TO WRK-FIRST-NOT-SPACE                     CL**4
00164          END-IF                                                      CL**4
00165      END-PERFORM.                                                    CL**4
00166                                                                      CL**4
00167      IF WRK-FIRST-NOT-SPACE = +0                                     CL**4
00168          MOVE L331-TO-VALUE TO MLOG-POST-MODIFICATION-VALUE          CL**5
00169      ELSE                                                            CL**4
00170          SUBTRACT WRK-FIRST-NOT-SPACE FROM WRK-LENGTH                CL**4
00171          ADD +1 TO WRK-LENGTH                                        CL**4
00172          MOVE L331-TO-VALUE (WRK-FIRST-NOT-SPACE:WRK-LENGTH)         CL**5
00173            TO MLOG-POST-MODIFICATION-VALUE.                          CL**5
00174  P1200-EXIT.                                                         CL**4
00175      EXIT.                                                           CL**4
00176      EJECT                                                           CL**4
00177  S910-WRITE.                                                         CL**7
00178      SET L910-WRITE-88 TO TRUE.                                      CL**7
00179      GO TO S910-MSTR-IO.                                             CL**7
00180                                                                      CL**3
00181  S910-MSTR-IO.                                                       CL**7
00182      CALL 'DTSBU910' USING L910-LINK-AREA                            CL**7
00183                            MSKL-REC.                                 CL**7
00184  S910-EXIT.                                                          CL**7
00185      EXIT.                                                        DTSBU331
00186      EJECT                                                        DTSBU331
00187 *S999-ABEND.                                                         CL**7
00188 *****CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**7
00189 *S999-EXIT.                                                          CL**7
00190 *****EXIT.                                                           CL**3
