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