Files
DUTAS/Copybook/DTSIP012.cpy
2025-07-21 11:20:11 -04:00

86 lines
6.7 KiB
COBOL

00001 ***** 05/22/01
00002 * DTSIP012
00003 * DTSIP012 ALTERNATE INDEX RECORD CONSTRUCTION LV001
00004 * ELECTRONIC MEDIA SYSTEM DTSIP012
00005 * PROCEDURE DIVISION CODE. S3200 PARAGRAPH. DTSIP012
00006 * DTSIP012
00007 * IF THIS CODE IS MODIFIED, THEN DTSCU835, DTSIP012
00008 * DTSBU935, AND DTSBE992 MUST BE RECOMPILED. DTSIP012
00009 * DTSIP012
00010 * DTSIP012
00011 * 01/17/2001 INITIAL DEVELOPMENT. GD. DTSIP012
00012 * DTSIP012
00013 ***** DTSIP012
00014 DTSIP012
00015 S3200-CONSTRUCT-IPOST. DTSIP012
00016 MOVE LOW-VALUES TO POST-UPDATE-AIX-RECS. DTSIP012
00017 DTSIP012
00018 MOVE +0 TO AIX-REC-SUB. DTSIP012
00019 DTSIP012
00020 IF ELEN-AIX-YES-88 (REC-TYPE-SUB) DTSIP012
00021 NEXT SENTENCE DTSIP012
00022 ELSE DTSIP012
00023 GO TO S3200-EXIT. DTSIP012
00024 DTSIP012
00025 IF ESKL-PRF-88 OF WRK-REC DTSIP012
00026 PERFORM S3210-PRF THRU S3210-EXIT DTSIP012
00027 ELSE DTSIP012
00028 IF ESKL-LOG-88 OF WRK-REC DTSIP012
00029 PERFORM S3220-LOG THRU S3220-EXIT DTSIP012
00030 ELSE DTSIP012
00031 IF ESKL-EMH-88 OF WRK-REC DTSIP012
00032 PERFORM S3230-EMH THRU S3230-EXIT DTSIP012
00033 ELSE DTSIP012
00034 PERFORM S999-ABEND THRU S999-EXIT. DTSIP012
00035 S3200-EXIT. DTSIP012
00036 EXIT. DTSIP012
00037 SKIP3 DTSIP012
00038 S3210-PRF. DTSIP012
00039 PERFORM S3911-IENM-FROM-NAME THRU S3911-EXIT. DTSIP012
00040 ADD +1 TO AIX-REC-SUB. DTSIP012
00041 MOVE IENM-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP012
00042 DTSIP012
00043 PERFORM S3912-IEPR-FROM-ELF-ID THRU S3912-EXIT. DTSIP012
00044 ADD +1 TO AIX-REC-SUB. DTSIP012
00045 MOVE IEPR-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP012
00046 DTSIP012
00047 S3210-EXIT. DTSIP012
00048 EXIT. DTSIP012
00049 SKIP3 DTSIP012
00050 S3220-LOG. DTSIP012
00051 PERFORM S3921-IEAL-FROM-LOG THRU S3921-EXIT. DTSIP012
00052 ADD +1 TO AIX-REC-SUB. DTSIP012
00053 MOVE IEAL-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP012
00054 DTSIP012
00055 PERFORM S3922-IEAE-FROM-LOG THRU S3922-EXIT. DTSIP012
00056 ADD +1 TO AIX-REC-SUB. DTSIP012
00057 MOVE IEAE-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP012
00058 DTSIP012
00059 PERFORM S3923-IEBX-FROM-LOG THRU S3923-EXIT. DTSIP012
00060 ADD +1 TO AIX-REC-SUB. DTSIP012
00061 MOVE IEBX-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP012
00062 DTSIP012
00063 PERFORM S3924-IEOP-FROM-LOG THRU S3924-EXIT. DTSIP012
00064 ADD +1 TO AIX-REC-SUB. DTSIP012
00065 MOVE IEOP-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP012
00066 DTSIP012
00067 PERFORM S3925-IESR-FROM-LOG THRU S3925-EXIT. DTSIP012
00068 ADD +1 TO AIX-REC-SUB. DTSIP012
00069 MOVE IESR-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP012
00070 DTSIP012
00071 S3220-EXIT. DTSIP012
00072 EXIT. DTSIP012
00073 SKIP3 DTSIP012
00074 S3230-EMH. DTSIP012
00075 PERFORM S3931-IEER-FROM-EMH THRU S3931-EXIT. DTSIP012
00076 ADD +1 TO AIX-REC-SUB. DTSIP012
00077 MOVE IEER-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP012
00078 DTSIP012
00079 PERFORM S3932-IEET-FROM-EMH THRU S3932-EXIT. DTSIP012
00080 ADD +1 TO AIX-REC-SUB. DTSIP012
00081 MOVE IEET-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP012
00082 DTSIP012
00083 S3230-EXIT. DTSIP012
00084 EXIT. DTSIP012
00085 SKIP3 DTSIP012