142 lines
11 KiB
COBOL
142 lines
11 KiB
COBOL
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
|