167 lines
13 KiB
COBOL
167 lines
13 KiB
COBOL
00001 ***** 07/01/08
|
|
00002 * DTSIP002
|
|
00003 * DTSIP002 ALTERNATE INDEX RECORD CONSTRUCTION PROCEDURE LV008
|
|
00004 * DIVISION CODE. S3200 PARAGRAPH. DTSIP002
|
|
00005 * DTSIP002
|
|
00006 * IF THIS CODE IS MODIFIED, THEN DTSCU810 AND DTSIP002
|
|
00007 * DTSBU910 MUST BE RECOMPILED. DTSIP002
|
|
00008 * DTSIP002
|
|
00009 * DTSIP002
|
|
00010 * 08/31/1998 REVIEWED AND MODIFIED FOR DC. EHH DTSIP002
|
|
00011 * 04/17/2003 ADDED MPAY AND MRPT GD DTSIP002
|
|
00012 * 02/08/2008 ADDED MRFD GD DTSIP002
|
|
00013 * DTSIP002
|
|
00014 ***** DTSIP002
|
|
00015 DTSIP002
|
|
00016 S3200-CONSTRUCT-IPOST. DTSIP002
|
|
00017 MOVE LOW-VALUES TO POST-UPDATE-AIX-RECS. DTSIP002
|
|
00018 DTSIP002
|
|
00019 MOVE +0 TO AIX-REC-SUB. DTSIP002
|
|
00020 DTSIP002
|
|
00021 IF MLEN-AIX-YES-88 (REC-TYPE-SUB) DTSIP002
|
|
00022 NEXT SENTENCE DTSIP002
|
|
00023 ELSE DTSIP002
|
|
00024 GO TO S3200-EXIT DTSIP002
|
|
00025 END-IF. DTSIP002
|
|
00026 DTSIP002
|
|
00027 EVALUATE TRUE DTSIP002
|
|
00028 WHEN MSKL-PRF-88 OF WRK-REC DTSIP002
|
|
00029 PERFORM S3210-PRF THRU S3210-EXIT DTSIP002
|
|
00030 DTSIP002
|
|
00031 WHEN MSKL-BAA-88 OF WRK-REC DTSIP002
|
|
00032 PERFORM S3220-BAA THRU S3220-EXIT DTSIP002
|
|
00033 DTSIP002
|
|
00034 WHEN MSKL-FAS-88 OF WRK-REC DTSIP002
|
|
00035 PERFORM S3230-FAS THRU S3230-EXIT DTSIP002
|
|
00036 DTSIP002
|
|
00037 WHEN MSKL-OPO-88 OF WRK-REC DTSIP002
|
|
00038 PERFORM S3240-OPO THRU S3240-EXIT DTSIP002
|
|
00039 DTSIP002
|
|
00040 WHEN MSKL-PAY-88 OF WRK-REC DTSIP002
|
|
00041 PERFORM S3245-PAY THRU S3245-EXIT DTSIP002
|
|
00042 DTSIP002
|
|
00043 WHEN MSKL-REL-88 OF WRK-REC DTSIP002
|
|
00044 PERFORM S3250-REL THRU S3250-EXIT DTSIP002
|
|
00045 DTSIP002
|
|
00046 WHEN MSKL-RPT-88 OF WRK-REC DTSIP002
|
|
00047 PERFORM S3255-RPT THRU S3255-EXIT DTSIP002
|
|
00048 DTSIP002
|
|
00049 WHEN MSKL-TCK-88 OF WRK-REC DTSIP002
|
|
00050 PERFORM S3260-TCK THRU S3260-EXIT DTSIP002
|
|
00051 DTSIP002
|
|
00052 WHEN MSKL-TAA-88 OF WRK-REC DTSIP002
|
|
00053 PERFORM S3270-TAA THRU S3270-EXIT DTSIP002
|
|
00054 DTSIP002
|
|
00055 WHEN MSKL-RFD-88 OF WRK-REC DTSIP002
|
|
00056 PERFORM S3275-RFD THRU S3275-EXIT DTSIP002
|
|
00057 DTSIP002
|
|
00058 WHEN OTHER DTSIP002
|
|
00059 PERFORM S899-ABEND THRU S899-EXIT DTSIP002
|
|
00060 END-EVALUATE. DTSIP002
|
|
00061 DTSIP002
|
|
00062 S3200-EXIT. DTSIP002
|
|
00063 EXIT. DTSIP002
|
|
00064 SKIP3 DTSIP002
|
|
00065 S3210-PRF. DTSIP002
|
|
00066 PERFORM S3911-IBTB-FROM-PRIMARY THRU S3911-EXIT. DTSIP002
|
|
00067 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00068 MOVE IBTB-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00069 DTSIP002
|
|
00070 PERFORM S3912-IBTB-FROM-ENTITY THRU S3912-EXIT. DTSIP002
|
|
00071 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00072 MOVE IBTB-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00073 DTSIP002
|
|
00074 PERFORM S3913-IBTN THRU S3913-EXIT. DTSIP002
|
|
00075 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00076 MOVE IBTN-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00077 DTSIP002
|
|
00078 PERFORM S3914-IEIN THRU S3914-EXIT. DTSIP002
|
|
00079 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00080 MOVE IEIN-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00081 DTSIP002
|
|
00082 PERFORM S3915-IZIP THRU S3915-EXIT. DTSIP002
|
|
00083 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00084 MOVE IZIP-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00085 S3210-EXIT. DTSIP002
|
|
00086 EXIT. DTSIP002
|
|
00087 SKIP3 DTSIP002
|
|
00088 S3220-BAA. DTSIP002
|
|
00089 PERFORM S3921-IBTB-FROM-BAA THRU S3921-EXIT. DTSIP002
|
|
00090 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00091 MOVE IBTB-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00092 S3220-EXIT. DTSIP002
|
|
00093 EXIT. DTSIP002
|
|
00094 SKIP3 DTSIP002
|
|
00095 S3230-FAS. DTSIP002
|
|
00096 PERFORM S3931-IFAN THRU S3931-EXIT. DTSIP002
|
|
00097 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00098 MOVE IFAN-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00099 DTSIP002
|
|
00100 PERFORM S3932-IFID THRU S3932-EXIT. DTSIP002
|
|
00101 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00102 MOVE IFID-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00103 S3230-EXIT. DTSIP002
|
|
00104 EXIT. DTSIP002
|
|
00105 SKIP3 DTSIP002
|
|
00106 S3240-OPO. DTSIP002
|
|
00107 PERFORM S3941-IOPN THRU S3941-EXIT. DTSIP002
|
|
00108 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00109 MOVE IOPN-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00110 DTSIP002
|
|
00111 PERFORM S3942-IOPS THRU S3942-EXIT. DTSIP002
|
|
00112 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00113 MOVE IOPS-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00114 S3240-EXIT. DTSIP002
|
|
00115 EXIT. DTSIP002
|
|
00116 SKIP3 DTSIP002
|
|
00117 S3245-PAY. DTSIP002
|
|
00118 IF MPAY-TRACE-NO NOT = ZERO DTSIP002
|
|
00119 PERFORM S3946-ITRT THRU S3946-EXIT DTSIP002
|
|
00120 ADD +1 TO AIX-REC-SUB DTSIP002
|
|
00121 MOVE ITRT-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB) DTSIP002
|
|
00122 PERFORM S3947-ITRE THRU S3947-EXIT DTSIP002
|
|
00123 ADD +1 TO AIX-REC-SUB DTSIP002
|
|
00124 MOVE ITRE-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00125 S3245-EXIT. DTSIP002
|
|
00126 EXIT. DTSIP002
|
|
00127 SKIP3 DTSIP002
|
|
00128 S3250-REL. DTSIP002
|
|
00129 PERFORM S3951-IPES THRU S3951-EXIT. DTSIP002
|
|
00130 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00131 MOVE IPES-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00132 S3250-EXIT. DTSIP002
|
|
00133 EXIT. DTSIP002
|
|
00134 SKIP3 DTSIP002
|
|
00135 S3255-RPT. DTSIP002
|
|
00136 IF MRPT-TRACE-NO NOT = ZERO DTSIP002
|
|
00137 IF MRPT-REMIT-AMT = ZERO DTSIP002
|
|
00138 PERFORM S3956-ITRT THRU S3956-EXIT DTSIP002
|
|
00139 ADD +1 TO AIX-REC-SUB DTSIP002
|
|
00140 MOVE ITRT-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB) DTSIP002
|
|
00141 PERFORM S3957-ITRE THRU S3957-EXIT DTSIP002
|
|
00142 ADD +1 TO AIX-REC-SUB DTSIP002
|
|
00143 MOVE ITRE-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00144 S3255-EXIT. DTSIP002
|
|
00145 EXIT. DTSIP002
|
|
00146 SKIP3 DTSIP002
|
|
00147 S3260-TCK. DTSIP002
|
|
00148 PERFORM S3961-ITDS THRU S3961-EXIT. DTSIP002
|
|
00149 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00150 MOVE ITDS-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00151 S3260-EXIT. DTSIP002
|
|
00152 EXIT. DTSIP002
|
|
00153 SKIP3 DTSIP002
|
|
00154 S3270-TAA. DTSIP002
|
|
00155 PERFORM S3971-IBTB-FROM-TAA THRU S3971-EXIT. DTSIP002
|
|
00156 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00157 MOVE IBTB-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00158 S3270-EXIT. DTSIP002
|
|
00159 EXIT. DTSIP002
|
|
00160 DTSIP002
|
|
00161 S3275-RFD. DTSIP002
|
|
00162 PERFORM S3975-IRFD-FROM-RFD THRU S3975-EXIT. DTSIP002
|
|
00163 ADD +1 TO AIX-REC-SUB. DTSIP002
|
|
00164 MOVE IRFD-REC TO POST-UPDATE-AIX-REC (AIX-REC-SUB). DTSIP002
|
|
00165 S3275-EXIT. DTSIP002
|
|
00166 EXIT. DTSIP002
|