00001  IDENTIFICATION DIVISION.                                         09/10/98
00002  PROGRAM-ID.             DTSCU331.                                DTSCU331
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV006
00004  DATE-WRITTEN.           DECEMBER 1991.                           DTSCU331
00005  DATE-COMPILED.                                                   DTSCU331
00006      SKIP3                                                        DTSCU331
00007 *****                                                             DTSCU331
00008 *                                                                 DTSCU331
00009 *    FUNCTION:  WRITE MAINTENANCE LIST REPORT RECORDS.            DTSCU331
00010 *                                                                 DTSCU331
00011 *                                                                 DTSCU331
00012 *    MODIFICATION LOG:                                            DTSCU331
00013 *                                                                 DTSCU331
00014 *    12/01/91  INITIAL DEVELOPMENT.                               DTSCU331
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU331
00016 *                                                                 DTSCU331
00017 *    04/18/94  MODIFIED FOR MONTANA.                              DTSCU331
00018 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU331
00019 *                                                                 DTSCU331
00020 *    05/23/96  PARAGRAPH P5000-CONSTRUCT-R738 ADDED TO GENERATE   DTSCU331
00021 *              REPORT REC FOR ELF MAINTENANCE LIST                DTSCU331
00022 *              WORK ORDER: NONE                 PROGRAMMER: SFW   DTSCU331
00023 *                                                                 DTSCU331
00024 *    09/09/1998  MODULE REWRITTEN FOR DC - IN DC, MLOG RECORDS       CL**2
00025 *                REPLACE THE MONTANA "MAINTENANCE LIST" REPORT       CL**2
00026 *                RECORDS.                                            CL**2
00027 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00028 *                                                                    CL**2
00029 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00030 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00031 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00032 *                                                                 DTSCU331
00033 *                                                                 DTSCU331
00034 *  DESCRIPTION:                                                   DTSCU331
00035 *                                                                 DTSCU331
00036 *    CONSTRUCT AND WRITE AN MLOG RECORD OCCURRENCE.                  CL**5
00037 *                                                                 DTSCU331
00038 *****                                                             DTSCU331
00039      SKIP3                                                        DTSCU331
00040  ENVIRONMENT DIVISION.                                            DTSCU331
00041      SKIP3                                                        DTSCU331
00042  DATA DIVISION.                                                   DTSCU331
00043      SKIP3                                                        DTSCU331
00044  WORKING-STORAGE SECTION.                                         DTSCU331
000445 77  PAN-VALET PICTURE X(24) VALUE '006DTSCU331  09/10/98'.       DTSCU331
00045      SKIP3                                                        DTSCU331
00046  01  WRK-AREA.                                                    DTSCU331
00047      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U331'.    DTSCU331
00048                                                                      CL**3
00049      05  WRK-SUB                     PIC S9(04)  COMP.               CL**3
00050                                                                      CL**3
00051      05  WRK-FIRST-NOT-SPACE         PIC S9(04)  COMP.               CL**3
00052                                                                      CL**3
00053      05  WRK-LENGTH                  PIC S9(04)  COMP.               CL**3
00054      EJECT                                                        DTSCU331
00055  01  L810-COMM-AREA.                                                 CL**3
00056      05  L810-CONTROL-BLOCK.                                         CL**3
00057  ++INCLUDE DTSIL810                                                  CL**3
00058      SKIP3                                                           CL**3
00059      05  MSKL-REC.                                                   CL**3
00060  ++INCLUDE DTSIMSKL                                                  CL**3
00061      EJECT                                                           CL**3
00062  01  MLOG-REC.                                                       CL**3
00063  ++INCLUDE DTSIMLOG                                                  CL**3
00064      EJECT                                                           CL**3
00065  LINKAGE SECTION.                                                 DTSCU331
00066      SKIP3                                                        DTSCU331
00067  01  DFHCOMMAREA.                                                 DTSCU331
00068  ++INCLUDE DTSIL331                                                  CL**2
00069      EJECT                                                        DTSCU331
00070  PROCEDURE DIVISION.                                              DTSCU331
00071                                                                      CL**3
00072      MOVE SPACES TO L331-MSG-AREA.                                DTSCU331
00073                                                                      CL**3
00074      SET L331-OK TO TRUE.                                            CL**3
00075                                                                      CL**3
00076      ADD +1 TO L331-UPDATE-ABSTIME.                                  CL**3
00077                                                                      CL**3
00078                                                                      CL**5
00079      PERFORM P1000-CONSTRUCT-MLOG THRU P1000-EXIT.                   CL**3
00080                                                                      CL**3
00081                                                                      CL**5
00082      MOVE MLOG-REC TO MSKL-REC.                                      CL**3
00083                                                                      CL**3
00084      PERFORM S810-WRITE THRU S810-EXIT.                              CL**3
00085                                                                      CL**3
00086      IF L810-FILE-CLOSED-88                                          CL**3
00087          MOVE L810-MSG-AREA TO L331-MSG-AREA                         CL**3
00088          SET L331-FILE-CLOSED TO TRUE                             DTSCU331
00089      ELSE                                                         DTSCU331
00090          SET L331-OK TO TRUE.                                     DTSCU331
00091                                                                      CL**3
00092                                                                      CL**3
00093      EXEC CICS                                                    DTSCU331
00094          RETURN                                                   DTSCU331
00095      END-EXEC.                                                    DTSCU331
00096                                                                      CL**3
00097                                                                      CL**3
00098                                                                      CL**3
00099      GOBACK.                                                      DTSCU331
00100      EJECT                                                        DTSCU331
00101  P1000-CONSTRUCT-MLOG.                                               CL**3
00102      MOVE LOW-VALUES TO MLOG-REC.                                    CL**6
00103                                                                      CL**3
00104      MOVE L331-EMP-NO TO MLOG-EMP-NO.                                CL**3
00105                                                                      CL**3
00106      SET MLOG-LOG-88 TO TRUE.                                        CL**3
00107                                                                      CL**3
00108      MOVE L331-UPDATE-ABSTIME TO MLOG-ESTB-ABSTIME.                  CL**3
00109                                                                      CL**3
00110                                                                      CL**4
00111      MOVE +0 TO MLOG-PURGE-DATE.                                     CL**3
00112                                                                      CL**3
00113                                                                      CL**4
00114      MOVE L331-REC-OCC-ID TO MLOG-REC-OCC-ID.                        CL**3
00115                                                                      CL**3
00116      MOVE L331-FIELD-NAME TO MLOG-DATA-ELEMENT-NAME.                 CL**3
00117                                                                      CL**3
00118      PERFORM P1100-FROM-VALUE THRU P1100-EXIT.                       CL**5
00119                                                                      CL**5
00120      PERFORM P1200-TO-VALUE THRU P1200-EXIT.                         CL**5
00121                                                                      CL**5
00122      MOVE L331-OP-ID TO MLOG-OP-ID.                                  CL**5
00123                                                                      CL**5
00124      SET MLOG-NOT-CONVERTED-88 TO TRUE.                              CL**5
00125                                                                      CL**5
00126      MOVE L331-CURR-RUN-DATE TO MLOG-ESTB-DATE.                      CL**5
00127  P1000-EXIT.                                                         CL**4
00128      EXIT.                                                           CL**4
00129      EJECT                                                           CL**4
00130  P1100-FROM-VALUE.                                                   CL**4
00131      MOVE SPACES TO MLOG-PRE-MODIFICATION-VALUE.                     CL**6
00132                                                                      CL**6
00133      IF L331-FROM-VALUE = SPACES                                     CL**4
00134          GO TO P1100-EXIT.                                           CL**4
00135                                                                      CL**4
00136      MOVE +0 TO WRK-FIRST-NOT-SPACE.                                 CL**4
00137                                                                      CL**3
00138      MOVE LENGTH OF L331-FROM-VALUE TO WRK-LENGTH.                   CL**4
00139                                                                      CL**4
00140      PERFORM                                                         CL**3
00141        VARYING WRK-SUB FROM 1 BY 1                                   CL**4
00142        UNTIL (WRK-FIRST-NOT-SPACE NOT = +0)                          CL**4
00143                 OR                                                   CL**4
00144              (WRK-SUB > WRK-LENGTH)                                  CL**4
00145          IF L331-FROM-VALUE (WRK-SUB:1) NOT = SPACE                  CL**4
00146              MOVE WRK-SUB TO WRK-FIRST-NOT-SPACE                     CL**4
00147          END-IF                                                      CL**4
00148      END-PERFORM.                                                    CL**4
00149                                                                      CL**4
00150      IF WRK-FIRST-NOT-SPACE = +0                                     CL**4
00151          MOVE L331-FROM-VALUE TO MLOG-PRE-MODIFICATION-VALUE         CL**4
00152      ELSE                                                            CL**4
00153          SUBTRACT WRK-FIRST-NOT-SPACE FROM WRK-LENGTH                CL**4
00154          ADD +1 TO WRK-LENGTH                                        CL**4
00155          MOVE L331-FROM-VALUE (WRK-FIRST-NOT-SPACE:WRK-LENGTH)       CL**4
00156            TO MLOG-PRE-MODIFICATION-VALUE.                           CL**4
00157  P1100-EXIT.                                                         CL**4
00158      EXIT.                                                        DTSCU331
00159      EJECT                                                        DTSCU331
00160  P1200-TO-VALUE.                                                     CL**4
00161      MOVE SPACES TO MLOG-POST-MODIFICATION-VALUE.                    CL**6
00162                                                                      CL**6
00163      IF L331-TO-VALUE = SPACES                                       CL**4
00164          GO TO P1200-EXIT.                                           CL**4
00165                                                                      CL**4
00166      MOVE +0 TO WRK-FIRST-NOT-SPACE.                                 CL**4
00167                                                                      CL**4
00168      MOVE LENGTH OF L331-TO-VALUE TO WRK-LENGTH.                     CL**4
00169                                                                      CL**4
00170      PERFORM                                                         CL**4
00171        VARYING WRK-SUB FROM 1 BY 1                                   CL**4
00172        UNTIL (WRK-FIRST-NOT-SPACE NOT = +0)                          CL**4
00173                 OR                                                   CL**4
00174              (WRK-SUB > WRK-LENGTH)                                  CL**4
00175          IF L331-TO-VALUE (WRK-SUB:1) NOT = SPACE                    CL**4
00176              MOVE WRK-SUB TO WRK-FIRST-NOT-SPACE                     CL**4
00177          END-IF                                                      CL**4
00178      END-PERFORM.                                                    CL**4
00179                                                                      CL**4
00180      IF WRK-FIRST-NOT-SPACE = +0                                     CL**4
00181          MOVE L331-TO-VALUE TO MLOG-POST-MODIFICATION-VALUE          CL**5
00182      ELSE                                                            CL**4
00183          SUBTRACT WRK-FIRST-NOT-SPACE FROM WRK-LENGTH                CL**4
00184          ADD +1 TO WRK-LENGTH                                        CL**4
00185          MOVE L331-TO-VALUE (WRK-FIRST-NOT-SPACE:WRK-LENGTH)         CL**5
00186            TO MLOG-POST-MODIFICATION-VALUE.                          CL**5
00187  P1200-EXIT.                                                         CL**4
00188      EXIT.                                                           CL**4
00189      EJECT                                                           CL**4
00190  S810-WRITE.                                                         CL**3
00191      SET L810-WRITE-88 TO TRUE.                                      CL**3
00192      GO TO S810-MSTR-IO.                                             CL**3
00193                                                                      CL**3
00194  S810-MSTR-IO.                                                       CL**3
00195      EXEC CICS                                                    DTSCU331
00196          LINK                                                     DTSCU331
00197              PROGRAM('DTSCU810')                                     CL**3
00198              COMMAREA(L810-COMM-AREA)                                CL**3
00199      END-EXEC.                                                    DTSCU331
00200  S810-EXIT.                                                          CL**3
00201      EXIT.                                                        DTSCU331
00202      EJECT                                                        DTSCU331
00203 *S899-ABEND.                                                         CL**3
00204                                                                      CL**3
00205 *****EXEC CICS                                                       CL**3
00206 *********ABEND                                                       CL**3
00207 *************ABCODE (WRK-ABEND-CD)                                   CL**3
00208 *****END-EXEC.                                                       CL**3
00209                                                                      CL**3
00210 *S899-EXIT.                                                          CL**3
00211 *****EXIT.                                                           CL**3
