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