192 lines
15 KiB
COBOL
192 lines
15 KiB
COBOL
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
|