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