00001 IDENTIFICATION DIVISION. 08/28/02 00002 PROGRAM-ID. DESBR101. DESBR101 00003 AUTHOR. TRW INC. LV003 00004 DATE-WRITTEN. MARCH 2001. DESBR101 00005 DATE-COMPILED. DESBR101 00006 DESBR101 00007 ***** DESBR101 00008 * DESBR101 00009 * CALLING SEQUENCE: DESBE101 CREATES DESIR101 RECORDS. DESBR101 00010 * DTSBD100 CALLS DESBR101 DESBR101 00011 * WHICH PRODUCES THE ELECTRONIC DESBR101 00012 * MEDIA PACKING LIST. DESBR101 00013 * DESBR101 00014 * FUNCTION: ELECTRONIC MEDIA PACKING LIST. DESBR101 00015 * DESBR101 00016 * DESBR101 00017 * MODIFICATION HISTORY: DESBR101 00018 * DESBR101 00019 * 12-20-94 INITIAL DEVELOPMENT DESBR101 00020 * REFERENCE TAPE TRCKING SYSTEM AUTHOR OF CHANGE - RW1 DESBR101 00021 * DESBR101 00022 * 03-29-02 ADD EPRF-FORMAT-CD, EPRF-DATA-TYPE-CD AND DESBR101 00023 * EPRF-MEDIUM-TYPE-CD DESBR101 00024 * TO PACKING LIST REPORT DESBR101 00025 * REFERENCE RFP #**** PROGRAMMER: GB DESBR101 00026 * DESBR101 00027 * DESBR101 00028 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBR101 00029 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBR101 00030 * REFERENCE RFP #**** PROGRAMMER: XXX DESBR101 00031 * DESBR101 00032 * DESBR101 00033 * DESCRIPTION: DESBR101 00034 * DESBR101 00035 * THIS MODULE PRODUCES THE ELECTRONIC MEDIA PACKING LIST. DESBR101 00036 * DESBR101 00037 * DESBR101 00038 * RECORDS READ: DESBR101 00039 * DESBR101 00040 * NONE. DESBR101 00041 * DESBR101 00042 * DESBR101 00043 * PRINTED OUTPUTS: DESBR101 00044 * DESBR101 00045 * 810R1 ELETRONIC MEDIA PACKING LIST. DESBR101 00046 * DESBR101 00047 * DESBR101 00048 * RECORDS WRITTEN: DESBR101 00049 * DESBR101 00050 * NONE. DESBR101 00051 * DESBR101 00052 * DESBR101 00053 * MODULES CALLED: DESBR101 00054 * DESBR101 00055 * DTSBU001 DATE CONVERT. DESBR101 00056 * DESBR101 00057 ***** DESBR101 00058 EJECT DESBR101 00059 ENVIRONMENT DIVISION. DESBR101 00060 DESBR101 00061 CONFIGURATION SECTION. DESBR101 00062 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DESBR101 00063 DESBR101 00064 INPUT-OUTPUT SECTION. DESBR101 00065 FILE-CONTROL. DESBR101 00066 SELECT PRT-FILE ASSIGN TO RPT101R1. DESBR101 00067 DESBR101 00068 DATA DIVISION. DESBR101 00069 FILE SECTION. DESBR101 00070 DESBR101 00071 FD PRT-FILE DESBR101 00072 RECORDING MODE IS F. DESBR101 00073 01 REPORT-LISTING PIC X(133). DESBR101 00074 DESBR101 00075 WORKING-STORAGE SECTION. DESBR101 000755 77 PAN-VALET PICTURE X(24) VALUE '003DESBR101 08/28/02'. DESBR101 00076 DESBR101 00077 01 WRK-AREA. DESBR101 00078 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +101.DESBR101 00079 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DESBR101 00080 DESBR101 00081 05 WS-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DESBR101 00082 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +60.DESBR101 00083 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DESBR101 00084 05 HOLD-BOX-NO PIC X(08) VALUE SPACES. DESBR101 00085 DESBR101 00086 01 PAGE-HEADING. DESBR101 00087 05 HEADER-1. DESBR101 00088 10 FILLER PIC X(01) VALUE SPACE. DESBR101 00089 10 FILLER PIC X(10) DESBR101 00090 VALUE 'EMT101R1'. DESBR101 00091 10 FILLER PIC X(30) VALUE SPACES.DESBR101 00092 10 HDR-AGY-NAME-LINE1 PIC X(50). DESBR101 00093 10 FILLER PIC X(27) VALUE SPACES.DESBR101 00094 10 FILLER PIC X(05) DESBR101 00095 VALUE 'DATE:'. DESBR101 00096 10 FILLER PIC X(01) VALUE SPACE. DESBR101 00097 10 HDR-SYS-DATE PIC X(08). DESBR101 00098 05 HEADER-2. DESBR101 00099 10 FILLER PIC X(41) VALUE SPACES.DESBR101 00100 10 HDR-AGY-NAME-LINE2 PIC X(50). DESBR101 00101 10 FILLER PIC X(27) VALUE SPACES.DESBR101 00102 10 FILLER PIC X(05) DESBR101 00103 VALUE 'TIME:'. DESBR101 00104 10 FILLER PIC X(01) VALUE SPACE. DESBR101 00105 10 HDR-SYS-TIME PIC X(08). DESBR101 00106 05 HEADER-3. DESBR101 00107 10 FILLER PIC X(01) VALUE SPACE. DESBR101 00108 10 FILLER PIC X(35) VALUE SPACES.DESBR101 00109 10 FILLER PIC X(82) VALUE SPACES.DESBR101 00110 10 FILLER PIC X(05) DESBR101 00111 VALUE 'PAGE:'. DESBR101 00112 10 FILLER PIC X(03) VALUE SPACES.DESBR101 00113 10 HDR-PAGE-CNT PIC ZZ,ZZ9. DESBR101 00114 05 HEADER-4. DESBR101 00115 10 FILLER PIC X(51) VALUE SPACES.DESBR101 00116 10 FILLER PIC X(29) DESBR101 00117 VALUE 'ELECTRONIC MEDIA PACKING LIST'. DESBR101 00118 05 HEADER-5 PIC X(133). DESBR101 00119 05 HEADER-6. DESBR101 00120 10 FILLER PIC X(01) VALUE SPACE. DESBR101 00121 10 FILLER PIC X(04) DESBR101 00122 VALUE 'BOX:'. DESBR101 00123 10 FILLER PIC X(01) VALUE SPACE. DESBR101 00124 10 HDR-BOX-NO PIC X(08). DESBR101 00125 10 FILLER PIC X(10) VALUE SPACE. DESBR101 00126 10 FILLER PIC X(09) DESBR101 00127 VALUE 'OPERATOR:'. DESBR101 00128 10 FILLER PIC X(01) VALUE SPACE. DESBR101 00129 10 HDR-OPID PIC X(08). DESBR101 00130 10 FILLER PIC X(89) VALUE SPACES.DESBR101 00131 05 HEADER-7 PIC X(133). DESBR101 00132 05 HEADER-8. DESBR101 00133 10 FILLER PIC X(02) VALUE SPACES.DESBR101 00134 10 FILLER PIC X(06) DESBR101 00135 VALUE 'VOLUME'. DESBR101 00136 10 FILLER PIC X(10) VALUE SPACES.DESBR101 00137 10 FILLER PIC X(06) DESBR101 00138 VALUE 'ELF ID'. DESBR101 00139 10 FILLER PIC X(10) VALUE SPACES.DESBR101 00140 10 FILLER PIC X(26) DESBR101 00141 VALUE ' NAME '. DESBR101 00142 10 FILLER PIC X(16) VALUE SPACES.DESBR101 00143 10 FILLER PIC X(06) DESBR101 00144 VALUE 'FORMAT'. DESBR101 00145 10 FILLER PIC X(08) VALUE SPACES.DESBR101 00146 10 FILLER PIC X(11) DESBR101 00147 VALUE 'MEDIUM TYPE'. DESBR101 00148 10 FILLER PIC X(08) VALUE SPACES.DESBR101 00149 10 FILLER PIC X(09) DESBR101 00150 VALUE 'DATA TYPE'. DESBR101 00151 10 FILLER PIC X(07) VALUE SPACES.DESBR101 00152 10 FILLER PIC X(08) DESBR101 00153 VALUE 'JOB NAME'. DESBR101 00154 10 FILLER PIC X(23) VALUE SPACES.DESBR101 00155 05 HEADER-9 PIC X(133). DESBR101 00156 DESBR101 00157 01 DETAIL-LINE. DESBR101 00158 05 DTL-LINE-1. DESBR101 00159 10 FILLER PIC X(02) VALUE SPACE. DESBR101 00160 10 DTL-LOG-NO PIC X(06). DESBR101 00161 10 FILLER PIC X(10) VALUE SPACES.DESBR101 00162 10 DTL-ELF-ID PIC 999B999. DESBR101 00163 10 FILLER PIC X(09) VALUE SPACES.DESBR101 00164 10 DTL-ENTITY-NAME PIC X(40). DESBR101 00165 10 FILLER PIC X(02) VALUE SPACE. DESBR101 00166 10 DTL-FORMAT-CODE PIC X(03). DESBR101 00167 10 FILLER PIC X(15) VALUE SPACE. DESBR101 00168 10 DTL-MEDIUM-TYPE PIC X(02). DESBR101 00169 10 FILLER PIC X(17) VALUE SPACE. DESBR101 00170 10 DTL-DATA-TYPE PIC X(02). DESBR101 00171 10 FILLER PIC X(10) VALUE SPACE. DESBR101 00172 10 DTL-JOB-NAME PIC X(08). DESBR101 00173 10 FILLER PIC X(23) VALUE SPACES.DESBR101 00174 DESBR101 00175 EJECT DESBR101 00176 LINKAGE SECTION. DESBR101 00177 DESBR101 00178 01 LRCM-LINK-AREA. DESBR101 00179 ++INCLUDE DTSILRCM DESBR101 00180 EJECT DESBR101 00181 01 R101-REC. DESBR101 00182 ++INCLUDE DESIR101 DESBR101 00183 EJECT DESBR101 00184 PROCEDURE DIVISION USING LRCM-LINK-AREA DESBR101 00185 R101-REC. DESBR101 00186 DESBR101 00187 IF FIRST-TIME-IND = 'Y' DESBR101 00188 PERFORM I1000-INITIATE THRU I1000-EXIT DESBR101 00189 MOVE 'N' TO FIRST-TIME-IND. DESBR101 00190 DESBR101 00191 IF LRCM-EOR-88 DESBR101 00192 PERFORM T1000-TERMINATE THRU T1000-EXIT DESBR101 00193 ELSE DESBR101 00194 PERFORM P1000-PROCESS THRU P1000-EXIT. DESBR101 00195 DESBR101 00196 GOBACK. DESBR101 00197 DESBR101 00198 I1000-INITIATE. DESBR101 00199 DESBR101 00200 OPEN OUTPUT PRT-FILE. DESBR101 00201 MOVE LRCM-SYS-DATE TO HDR-SYS-DATE. DESBR101 00202 MOVE LRCM-SYS-TIME TO HDR-SYS-TIME. DESBR101 00203 MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1. DESBR101 00204 MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2. DESBR101 00205 MOVE SPACES TO REPORT-LISTING. DESBR101 00206 DESBR101 00207 I1000-EXIT. DESBR101 00208 EXIT. DESBR101 00209 DESBR101 00210 P1000-PROCESS. DESBR101 00211 DESBR101 00212 IF R101-BOX-NO NOT = HOLD-BOX-NO DESBR101 00213 MOVE R101-BOX-NO TO HOLD-BOX-NO DESBR101 00214 HDR-BOX-NO DESBR101 00215 MOVE R101-OPID TO HDR-OPID DESBR101 00216 MOVE +0 TO WS-PAGE-CNT DESBR101 00217 DESBR101 00218 IF WS-NUMBER-ONE = +0 DESBR101 00219 MOVE +99 TO WS-NUMBER-ONE DESBR101 00220 ELSE DESBR101 00221 MOVE +60 TO WS-LINE-CNT2 DESBR101 00222 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT DESBR101 00223 END-IF DESBR101 00224 END-IF. DESBR101 00225 DESBR101 00226 MOVE R101-LOG-NO TO DTL-LOG-NO. DESBR101 00227 MOVE R101-ELF-ID TO DTL-ELF-ID. DESBR101 00228 MOVE R101-ELF-NAME TO DTL-ENTITY-NAME. DESBR101 00229 MOVE R101-FORMAT-CD TO DTL-FORMAT-CODE. DESBR101 00230 MOVE R101-MEDIUM-TYPE-CD TO DTL-MEDIUM-TYPE. DESBR101 00231 MOVE R101-DATA-TYPE-CD TO DTL-DATA-TYPE. DESBR101 00232 MOVE R101-JOBNAME TO DTL-JOB-NAME. DESBR101 00233 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DESBR101 00234 WRITE REPORT-LISTING FROM DTL-LINE-1 AFTER 1. DESBR101 00235 ADD +1 TO WS-LINE-CNT2. DESBR101 00236 DESBR101 00237 P1000-EXIT. DESBR101 00238 EXIT. DESBR101 00239 DESBR101 00240 P2000-PRINT-HEADER. DESBR101 00241 DESBR101 00242 IF WS-LINE-CNT2 GREATER 58 DESBR101 00243 MOVE +0 TO WS-LINE-CNT2 DESBR101 00244 ADD +1 TO WS-PAGE-CNT DESBR101 00245 MOVE WS-PAGE-CNT TO HDR-PAGE-CNT DESBR101 00246 WRITE REPORT-LISTING FROM HEADER-1 AFTER TOP-OF-PAGE DESBR101 00247 WRITE REPORT-LISTING FROM HEADER-2 AFTER 1 DESBR101 00248 WRITE REPORT-LISTING FROM HEADER-3 AFTER 1 DESBR101 00249 WRITE REPORT-LISTING FROM HEADER-4 AFTER 1 DESBR101 00250 WRITE REPORT-LISTING FROM HEADER-5 AFTER 1 DESBR101 00251 WRITE REPORT-LISTING FROM HEADER-6 AFTER 1 DESBR101 00252 WRITE REPORT-LISTING FROM HEADER-7 AFTER 1 DESBR101 00253 WRITE REPORT-LISTING FROM HEADER-8 AFTER 1 DESBR101 00254 WRITE REPORT-LISTING FROM HEADER-9 AFTER 1 DESBR101 00255 ADD +9 TO WS-LINE-CNT2. DESBR101 00256 DESBR101 00257 P2000-EXIT. DESBR101 00258 EXIT. DESBR101 00259 DESBR101 00260 T1000-TERMINATE. DESBR101 00261 DESBR101 00262 CLOSE PRT-FILE. DESBR101 00263 DESBR101 00264 T1000-EXIT. DESBR101 00265 EXIT. DESBR101 00266 DESBR101 00267 *S999-ABEND. DESBR101 00268 * DESBR101 00269 * CALL 'DTSBU999' USING WRK-ABEND-CD. DESBR101 00270 * DESBR101 00271 *S999-EXIT. DESBR101 00272 * EXIT. DESBR101 00273 DESBR101