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