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