126 lines
9.9 KiB
COBOL
126 lines
9.9 KiB
COBOL
00001 IDENTIFICATION DIVISION. 09/09/25
|
|
00002 PROGRAM-ID. DTSBU203. DTSBU203
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN. SEPTEMBER 1998. DTSBU203
|
|
00005 DATE-COMPILED. DTSBU203
|
|
00006 SKIP3 DTSBU203
|
|
00007 ***** DTSBU203
|
|
00008 * TESTING RAINCODE CL**3
|
|
00009 * FUNCTION: DETERMINE FIELD ZIP CODE AND FIELD STATE CODE DTSBU203
|
|
00010 * DTSBU203
|
|
00011 * DTSBU203
|
|
00012 * MODIFICATION LOG: DTSBU203
|
|
00013 * DTSBU203
|
|
00014 * 09/02/1998 INITIAL DEVELOPMENT. MODIFIED FROM MACCU203. DTSBU203
|
|
00015 * WORK ORDER: PROGRAMMER: GD DTSBU203
|
|
00016 * DTSBU203
|
|
00017 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU203
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU203
|
|
00019 * WORK ORDER: PROGRAMMER: XXX DTSBU203
|
|
00020 * DTSBU203
|
|
00021 * DTSBU203
|
|
00022 * DESCRIPTION: DTSBU203
|
|
00023 * DTSBU203
|
|
00024 * DTSCU203 DETERMINES THE FIELD ZIP CODE AND FIELD STATE CODE. DTSBU203
|
|
00025 * DTSBU203
|
|
00026 * DTSBU203
|
|
00027 * SEE MPRF-FLD-ZIP, MPRF-FLD-STATE, MPRF-TAX-REC-ADDR-EXISTS-IN CL**2
|
|
00028 * IN THE DATA ELEMENT DEFINITIONS FOR A DESCRIPTION OF DTSBU203
|
|
00029 * THE REQUIRED LOGIC. DTSBU203
|
|
00030 * DTSBU203
|
|
00031 * DTSBU203
|
|
00032 * IF A NECESSARY MTAD RECORD IS NOT FOUND, THEN RETURN DTSBU203
|
|
00033 * L203-ADDR-NOT-FOUND-88. DTSBU203
|
|
00034 * DTSBU203
|
|
00035 * IF THE MASTER FILE IS NOT AVAILABLE, THEN RETURN DTSBU203
|
|
00036 * L203-FILE-CLOSED-88. DTSBU203
|
|
00037 * DTSBU203
|
|
00038 ***** DTSBU203
|
|
00039 SKIP3 DTSBU203
|
|
00040 ENVIRONMENT DIVISION. DTSBU203
|
|
00041 SKIP3 DTSBU203
|
|
00042 DATA DIVISION. DTSBU203
|
|
00043 SKIP3 DTSBU203
|
|
00044 WORKING-STORAGE SECTION. DTSBU203
|
|
000445 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU203 09/09/25'. DTSBU203
|
|
00045 SKIP3 DTSBU203
|
|
00046 01 WRK-AREA. DTSBU203
|
|
00047 05 WRK-ABEND-CODE PIC X(04) VALUE 'U203'. DTSBU203
|
|
00048 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU203
|
|
00049 EJECT DTSBU203
|
|
00050 01 L910-LINK-AREA. DTSBU203
|
|
00051 05 L910-CONTROL-AREA. DTSBU203
|
|
00052 ++INCLUDE DTSIL910 DTSBU203
|
|
00053 SKIP3 DTSBU203
|
|
00054 05 MSKL-REC. DTSBU203
|
|
00055 ++INCLUDE DTSIMSKL DTSBU203
|
|
00056 SKIP3 DTSBU203
|
|
00057 05 MTAD-REC REDEFINES MSKL-REC. DTSBU203
|
|
00058 ++INCLUDE DTSIMTAD DTSBU203
|
|
00059 EJECT DTSBU203
|
|
00060 LINKAGE SECTION. DTSBU203
|
|
00061 SKIP3 DTSBU203
|
|
00062 01 L203-LINK-AREA. DTSBU203
|
|
00063 ++INCLUDE DTSIL203 DTSBU203
|
|
00064 EJECT DTSBU203
|
|
00065 PROCEDURE DIVISION USING L203-LINK-AREA. DTSBU203
|
|
00066 SKIP2 DTSBU203
|
|
00067 SET L203-OK-88 TO TRUE. DTSBU203
|
|
00068 MOVE SPACE TO L203-FLD-ZIP DTSBU203
|
|
00069 L203-FLD-STATE DTSBU203
|
|
00070 L203-MSG-AREA. DTSBU203
|
|
00071 SKIP1 DTSBU203
|
|
00072 IF L203-TAX-REC-ADDR-NO-88 DTSBU203
|
|
00073 PERFORM P1000-READ-INITIALIZE THRU P1000-EXIT DTSBU203
|
|
00074 MOVE +001 TO MTAD-ID-NO DTSBU203
|
|
00075 PERFORM P2000-FIND-ZIP THRU P2000-EXIT DTSBU203
|
|
00076 ELSE DTSBU203
|
|
00077 PERFORM P1000-READ-INITIALIZE THRU P1000-EXIT DTSBU203
|
|
00078 MOVE +002 TO MTAD-ID-NO DTSBU203
|
|
00079 PERFORM P2000-FIND-ZIP THRU P2000-EXIT. DTSBU203
|
|
00080 SKIP1 DTSBU203
|
|
00081 IF L203-OK-88 DTSBU203
|
|
00082 IF L203-FLD-ZIP = SPACE DTSBU203
|
|
00083 OR L203-FLD-STATE = SPACE DTSBU203
|
|
00084 SET L203-ADDR-NOT-FOUND-88 TO TRUE. DTSBU203
|
|
00085 SKIP2 DTSBU203
|
|
00086 P0000-EXIT. DTSBU203
|
|
00087 SKIP2 DTSBU203
|
|
00088 GOBACK. DTSBU203
|
|
00089 EJECT DTSBU203
|
|
00090 P1000-READ-INITIALIZE. DTSBU203
|
|
00091 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBU203
|
|
00092 MOVE L203-EMP-NO TO MTAD-EMP-NO. DTSBU203
|
|
00093 SET MTAD-TAD-88 TO TRUE. DTSBU203
|
|
00094 P1000-EXIT. DTSBU203
|
|
00095 EXIT. DTSBU203
|
|
00096 SKIP1 DTSBU203
|
|
00097 P2000-FIND-ZIP. DTSBU203
|
|
00098 PERFORM S910-READ THRU S910-EXIT. DTSBU203
|
|
00099 IF L910-OK-88 DTSBU203
|
|
00100 MOVE MTAD-ZIP TO L203-FLD-ZIP DTSBU203
|
|
00101 MOVE MTAD-ST TO L203-FLD-STATE. DTSBU203
|
|
00102 P2000-EXIT. DTSBU203
|
|
00103 EXIT. DTSBU203
|
|
00104 SKIP1 DTSBU203
|
|
00105 EJECT DTSBU203
|
|
00106 S910-READ. DTSBU203
|
|
00107 SET L910-READ-88 TO TRUE. DTSBU203
|
|
00108 GO TO S910-MSTR-IO. DTSBU203
|
|
00109 SKIP1 DTSBU203
|
|
00110 S910-MSTR-IO. DTSBU203
|
|
00111 SKIP1 DTSBU203
|
|
00112 CALL 'DTSBU910' USING L910-LINK-AREA DTSBU203
|
|
00113 MSKL-REC. DTSBU203
|
|
00114 SKIP1 DTSBU203
|
|
00115 S910-EXIT. DTSBU203
|
|
00116 EXIT. DTSBU203
|
|
00117 SKIP3 DTSBU203
|
|
00118 ****************** S899-ABEND NOT USED. DTSBU203
|
|
00119 *S899-ABEND. DTSBU203
|
|
00120 * SKIP1 DTSBU203
|
|
00121 * CALL 'DTSBU999' USING WRK-ABEND-CODE. DTSBU203
|
|
00122 * SKIP1 DTSBU203
|
|
00123 *S899-EXIT. DTSBU203
|
|
00124 * EXIT. DTSBU203
|