00001 IDENTIFICATION DIVISION. 08/28/02 00002 PROGRAM-ID. DESBD199. DESBD199 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. MARCH 2001. DESBD199 00005 DATE-COMPILED. DESBD199 00006 SKIP3 DESBD199 00007 ***** DESBD199 00008 * DESBD199 00009 * FUNCTION: SAVE TAPE TRACKING OLA RECORDS. DESBD199 00010 * ELECTRONIC MEDIA TRACKING SYSTEM DESBD199 00011 * DESBD199 00012 * DESBD199 00013 ***** DESBD199 00014 SKIP3 DESBD199 00015 ENVIRONMENT DIVISION. DESBD199 00016 DATA DIVISION. DESBD199 00017 DESBD199 00018 WORKING-STORAGE SECTION. DESBD199 000185 77 PAN-VALET PICTURE X(24) VALUE '001DESBD199 08/28/02'. DESBD199 00019 SKIP3 DESBD199 00020 01 WRK-AREA. DESBD199 00021 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +199. DESBD199 00022 DESBD199 00023 05 WRK-MOD-NAME PIC X(08) VALUE 'DESBD199'. DESBD199 00024 DESBD199 00025 05 WRK-OLA-IN-CNT PIC 9(05) COMP-3 VALUE 0. DESBD199 00026 05 WRK-OLA-OUT-CNT PIC 9(05) COMP-3 VALUE 0. DESBD199 00027 05 WRK-CNT-DISP PIC Z(04)9. DESBD199 00028 DESBD199 00029 05 WRK-ERROR-IND PIC X(01). DESBD199 00030 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD199 00031 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD199 00032 DESBD199 00033 05 WRK-OLA-FOUND-IND PIC X(01). DESBD199 00034 88 WRK-OLA-FOUND-YES-88 VALUE 'Y'. DESBD199 00035 88 WRK-OLA-FOUND-NO-88 VALUE 'N'. DESBD199 00036 DESBD199 00037 05 WRK-TRACE-IND PIC X(01) VALUE ' '. DESBD199 00038 DESBD199 00039 01 RSK3-REC. DESBD199 00040 ++INCLUDE DTSIRSK3 DESBD199 00041 EJECT DESBD199 00042 01 T061-REC. DESBD199 00043 ++INCLUDE DTSIT061 DESBD199 00044 EJECT DESBD199 00045 01 L924-LINK-AREA. DESBD199 00046 ++INCLUDE DTSIL924 DESBD199 00047 EJECT DESBD199 00048 DESBD199 00049 PROCEDURE DIVISION. DESBD199 00050 DESBD199 00051 DESBD199-MAIN. DESBD199 00052 PERFORM I0000-INITIATE THRU I0000-EXIT. DESBD199 00053 IF WRK-ERROR-YES-88 DESBD199 00054 GO TO DESBD199-MAIN-EXIT. DESBD199 00055 DESBD199 00056 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD199 00057 DESBD199 00058 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD199 00059 DESBD199 00060 DESBD199-MAIN-EXIT. DESBD199 00061 GOBACK. DESBD199 00062 EJECT DESBD199 00063 I0000-INITIATE. DESBD199 00064 SET WRK-ERROR-NO-88 TO TRUE. DESBD199 00065 SET WRK-OLA-FOUND-NO-88 TO TRUE. DESBD199 00066 DESBD199 00067 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DESBD199 00068 IF WRK-ERROR-YES-88 DESBD199 00069 GO TO I0000-EXIT. DESBD199 00070 DESBD199 00071 I0000-EXIT. DESBD199 00072 EXIT. DESBD199 00073 DESBD199 00074 I1000-OPEN-FILES. DESBD199 00075 MOVE WRK-TRACE-IND TO L924-TRACE-IND. DESBD199 00076 DESBD199 00077 MOVE WRK-MOD-NAME TO L924-MOD-NAME. DESBD199 00078 DESBD199 00079 SET L924-OPEN-READ-88 TO TRUE. DESBD199 00080 DESBD199 00081 PERFORM S924-OLA-I THRU S924-EXIT. DESBD199 00082 DESBD199 00083 I1000-EXIT. DESBD199 00084 EXIT. DESBD199 00085 DESBD199 00086 EJECT DESBD199 00087 P0000-PROCESS. DESBD199 00088 SET L924-READ-NEXT-88 TO TRUE. DESBD199 00089 DESBD199 00090 PERFORM S924-OLA-I THRU S924-EXIT. DESBD199 00091 DESBD199 00092 IF L924-OK-88 DESBD199 00093 SET WRK-OLA-FOUND-YES-88 TO TRUE DESBD199 00094 PERFORM P1000-SCAN-OLA THRU P1000-EXIT DESBD199 00095 UNTIL L924-NO-REC-88 DESBD199 00096 ELSE DESBD199 00097 DISPLAY 'NO OLA REC' DESBD199 00098 END-IF. DESBD199 00099 DESBD199 00100 P0000-EXIT. DESBD199 00101 EXIT. DESBD199 00102 EJECT DESBD199 00103 DESBD199 00104 P1000-SCAN-OLA. DESBD199 00105 ADD +1 TO WRK-OLA-IN-CNT. DESBD199 00106 DESBD199 00107 IF RSK3-REC-TYPE = '060' OR '061' DESBD199 00108 ADD +1 TO WRK-OLA-OUT-CNT DESBD199 00109 PERFORM S947-O THRU S947-EXIT. DESBD199 00110 DESBD199 00111 PERFORM S924-OLA-I THRU S924-EXIT. DESBD199 00112 DESBD199 00113 P1000-EXIT. DESBD199 00114 EXIT. DESBD199 00115 DESBD199 00116 T0000-TERMINATE. DESBD199 00117 DESBD199 00118 DISPLAY ' '. DESBD199 00119 DESBD199 00120 DISPLAY '*** DESBD199 TERMINATION STATISTICS ***'. DESBD199 00121 DESBD199 00122 DISPLAY ' '. DESBD199 00123 DESBD199 00124 MOVE WRK-OLA-IN-CNT TO WRK-CNT-DISP. DESBD199 00125 DISPLAY ' TRIGGER RECORDS READ: ' DESBD199 00126 WRK-CNT-DISP. DESBD199 00127 DESBD199 00128 MOVE WRK-OLA-OUT-CNT TO WRK-CNT-DISP. DESBD199 00129 DISPLAY ' TRIGGER RECORDS SELECTED: ' DESBD199 00130 WRK-CNT-DISP. DESBD199 00131 DESBD199 00132 DISPLAY SPACE. DESBD199 00133 DESBD199 00134 T0000-EXIT. DESBD199 00135 EXIT. DESBD199 00136 DESBD199 00137 S924-OLA-I. DESBD199 00138 CALL 'DTSBU924' USING L924-LINK-AREA DESBD199 00139 RSK3-REC. DESBD199 00140 DESBD199 00141 S924-EXIT. DESBD199 00142 EXIT. DESBD199 00143 DESBD199 00144 S947-O. DESBD199 00145 CALL 'DTSBU947' USING RSK3-REC. DESBD199 00146 DESBD199 00147 S947-EXIT. DESBD199 00148 EXIT. DESBD199