DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
121
Batch/DTSBU052.cob
Normal file
121
Batch/DTSBU052.cob
Normal file
@ -0,0 +1,121 @@
|
||||
00001 IDENTIFICATION DIVISION. 02/26/08
|
||||
00002 PROGRAM-ID. DTSBU052. DTSBU052
|
||||
00003 AUTHOR. NGC. LV001
|
||||
00004 DATE-WRITTEN. JANUARY 2006. DTSBU052
|
||||
00005 DATE-COMPILED. DTSBU052
|
||||
00006 SKIP3 DTSBU052
|
||||
00007 ***** DTSBU052
|
||||
00008 * DTSBU052
|
||||
00009 * FUNCTION: UI RATE EDIT. DTSBU052
|
||||
00010 * DTSBU052
|
||||
00011 * DTSBU052
|
||||
00012 * MODIFICATION LOG: DTSBU052
|
||||
00013 * DTSBU052
|
||||
00014 * 01/04/2006 INITIAL DEVELOPMENT. DTSBU052
|
||||
00015 * CLONED FROM DTSCU052 FOR WEB REGISTRATION. DTSBU052
|
||||
00016 * WORK ORDER: PROGRAMMER: GD DTSBU052
|
||||
00017 * DTSBU052
|
||||
00018 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU052
|
||||
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU052
|
||||
00020 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU052
|
||||
00021 * DTSBU052
|
||||
00022 * DTSBU052
|
||||
00023 * DESCRIPTION: DTSBU052
|
||||
00024 * DTSBU052
|
||||
00025 * DTSBU052 IS PASSED A EFF-YRQ, A UI-RATE-TYPE AND A UI-RATE. DTSBU052
|
||||
00026 * DTSBU052 DETERMINES IF THE RATE IS A VALID RATE FOR THE DTSBU052
|
||||
00027 * EFF-YRQ AND THE UI-RATE-TYPE SPECIFIED. DTSBU052
|
||||
00028 * DTSBU052
|
||||
00029 * READ THE REFERENCE FILE AT THE FUIR RECORD WITH DTSBU052
|
||||
00030 * FUIR-EFF-YRQ EQUAL TO L052-EFF-YRQ AND FUIR-TYPE EQUAL DTSBU052
|
||||
00031 * TO L052-UI-RATE-TYPE. DTSBU052
|
||||
00032 * DTSBU052
|
||||
00033 * IF FUIR-UI-RATE EQUAL TO L052-UI-RATE WAS FOUND DTSBU052
|
||||
00034 * VALID DTSBU052
|
||||
00035 * ELSE DTSBU052
|
||||
00036 * NOT VALID. DTSBU052
|
||||
00037 * DTSBU052
|
||||
00038 ***** DTSBU052
|
||||
00039 SKIP3 DTSBU052
|
||||
00040 ENVIRONMENT DIVISION. DTSBU052
|
||||
00041 SKIP3 DTSBU052
|
||||
00042 DATA DIVISION. DTSBU052
|
||||
00043 SKIP3 DTSBU052
|
||||
00044 WORKING-STORAGE SECTION. DTSBU052
|
||||
000445 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU052 02/26/08'. DTSBU052
|
||||
00045 SKIP3 DTSBU052
|
||||
00046 01 WRK-AREA. DTSBU052
|
||||
00047 05 WRK-ABEND-CODE PIC X(04) VALUE 'U052'. DTSBU052
|
||||
00048 DTSBU052
|
||||
00049 EJECT DTSBU052
|
||||
00050 01 L931-LINK-AREA. DTSBU052
|
||||
00051 05 L931-CONTROL-BLOCK. DTSBU052
|
||||
00052 ++INCLUDE DTSIL931 DTSBU052
|
||||
00053 SKIP3 DTSBU052
|
||||
00054 01 FSKL-REC. DTSBU052
|
||||
00055 ++INCLUDE DTSIFSKL DTSBU052
|
||||
00056 SKIP3 DTSBU052
|
||||
00057 01 FUIR-REC. DTSBU052
|
||||
00058 ++INCLUDE DTSIFUIR DTSBU052
|
||||
00059 EJECT DTSBU052
|
||||
00060 LINKAGE SECTION. DTSBU052
|
||||
00061 SKIP3 DTSBU052
|
||||
00062 01 L052-LINK-AREA. DTSBU052
|
||||
00063 ++INCLUDE DTSIL052 DTSBU052
|
||||
00064 EJECT DTSBU052
|
||||
00065 PROCEDURE DIVISION USING L052-LINK-AREA. DTSBU052
|
||||
00066 DTSBU052
|
||||
00067 SET L052-NOT-VALID TO TRUE. DTSBU052
|
||||
00068 DTSBU052
|
||||
00069 MOVE SPACE TO L052-MSG-AREA. DTSBU052
|
||||
00070 DTSBU052
|
||||
00071 DTSBU052
|
||||
00072 MOVE LOW-VALUES TO FUIR-KEY-AREA. DTSBU052
|
||||
00073 DTSBU052
|
||||
00074 SET FUIR-UIR-88 TO TRUE. DTSBU052
|
||||
00075 DTSBU052
|
||||
00076 MOVE L052-EFF-YRQ TO FUIR-EFF-YRQ. DTSBU052
|
||||
00077 DTSBU052
|
||||
00078 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSBU052
|
||||
00079 PERFORM S931-READ THRU S931-EXIT. DTSBU052
|
||||
00080 DTSBU052
|
||||
00081 IF L931-OK-88 DTSBU052
|
||||
00082 MOVE FSKL-REC TO FUIR-REC DTSBU052
|
||||
00083 PERFORM P1000-PROCESS-FUIR THRU P1000-EXIT DTSBU052
|
||||
00084 ELSE DTSBU052
|
||||
00085 IF L931-NO-REC-88 DTSBU052
|
||||
00086 SET L052-NOT-VALID TO TRUE. DTSBU052
|
||||
00087 DTSBU052
|
||||
00088 DTSBU052
|
||||
00089 GOBACK. DTSBU052
|
||||
00090 EJECT DTSBU052
|
||||
00091 P1000-PROCESS-FUIR. DTSBU052
|
||||
00092 IF L052-UI-RATE = FUIR-DEFAULT-NEW-EMP-RATE DTSBU052
|
||||
00093 SET L052-VALID TO TRUE DTSBU052
|
||||
00094 GO TO P1000-EXIT. DTSBU052
|
||||
00095 DTSBU052
|
||||
00096 PERFORM DTSBU052
|
||||
00097 VARYING FUIR-RATE-IDX FROM 1 BY 1 DTSBU052
|
||||
00098 UNTIL (FUIR-RATE-IDX > FUIR-RATE-CNT) DTSBU052
|
||||
00099 OR DTSBU052
|
||||
00100 (L052-VALID) DTSBU052
|
||||
00101 IF FUIR-UI-RATE (FUIR-RATE-IDX) = L052-UI-RATE DTSBU052
|
||||
00102 SET L052-VALID TO TRUE DTSBU052
|
||||
00103 END-IF DTSBU052
|
||||
00104 END-PERFORM. DTSBU052
|
||||
00105 P1000-EXIT. DTSBU052
|
||||
00106 EXIT. DTSBU052
|
||||
00107 EJECT DTSBU052
|
||||
00108 S931-READ. DTSBU052
|
||||
00109 SET L931-READ-88 TO TRUE. DTSBU052
|
||||
00110 GO TO S931-REF-FILE. DTSBU052
|
||||
00111 DTSBU052
|
||||
00112 S931-REF-FILE. DTSBU052
|
||||
00113 CALL 'DTSBU931' USING L931-LINK-AREA DTSBU052
|
||||
00114 FSKL-REC. DTSBU052
|
||||
00115 DTSBU052
|
||||
00116 S931-EXIT. DTSBU052
|
||||
00117 EXIT. DTSBU052
|
||||
00118 DTSBU052
|
||||
00119 DTSBU052
|
||||
00120 DTSBU052
|
||||
Reference in New Issue
Block a user