00001 IDENTIFICATION DIVISION. 11/18/98 00002 PROGRAM-ID. DTSBD330. DTSBD330 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. NOVEMBER 1998. CL**2 00005 DATE-COMPILED. DTSBD330 00006 SKIP3 DTSBD330 00007 ***** DTSBD330 00008 * DTSBD330 00009 * FUNCTION: FIELD SUPPORT PROCESSING DRIVER. DTSBD330 00010 * DTSBD330 00011 * DTSBD330 00012 * MODIFICATION LOG: DTSBD330 00013 * DTSBD330 00014 * 11/18/1998 INITIAL DEVELOPMENT. MODIFIED FROM MACBD330. CL**2 00015 * WORK ORDER: PROGRAMMER: GD CL**2 00016 * DTSBD330 00017 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00019 * WORK ORDER: PROGRAMMER: XXX CL**2 00020 * DTSBD330 00021 * DTSBD330 00022 * DESCRIPTION: DTSBD330 00023 * DTSBD330 00024 * EXAMINES TSKL-REC-TYPE AND CALLS THE APPROPRIATE DTSBD330 00025 * FIELD SUPPORT PROCESSING MODULE. DTSBD330 00026 * DTSBD330 00027 ***** DTSBD330 00028 SKIP3 DTSBD330 00029 ENVIRONMENT DIVISION. DTSBD330 00030 EJECT DTSBD330 00031 DATA DIVISION. DTSBD330 00032 SKIP3 DTSBD330 00033 WORKING-STORAGE SECTION. DTSBD330 000335 77 PAN-VALET PICTURE X(24) VALUE '002DTSBD330 11/18/98'. DTSBD330 00034 SKIP3 DTSBD330 00035 01 WRK-AREA. DTSBD330 00036 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +330.DTSBD330 00037 EJECT DTSBD330 00038 01 MSG-TABLE. DTSBD330 00039 05 MSG1-INVALID-REC-TYPE. DTSBD330 00040 10 MSG1-ID PIC X(11) VALUE 'DTSBD330904'. CL**2 00041 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'INVALID TRN TYP'. DTSBD330 00042 10 MSG1-LONG-TEXT. DTSBD330 00043 15 FILLER PIC X(30) DTSBD330 00044 VALUE 'TRANSACTION FAILED - TRANSACTI'. DTSBD330 00045 15 FILLER PIC X(30) DTSBD330 00046 VALUE 'ON TYPE NOT VALID '. DTSBD330 00047 EJECT DTSBD330 00048 LINKAGE SECTION. DTSBD330 00049 SKIP3 DTSBD330 00050 01 LBCM-LINK-AREA. DTSBD330 00051 ++INCLUDE DTSILBCM CL**2 00052 EJECT DTSBD330 00053 01 MPRF-REC. DTSBD330 00054 ++INCLUDE DTSIMPRF CL**2 00055 EJECT DTSBD330 00056 01 TSKL-REC. DTSBD330 00057 ++INCLUDE DTSITSKL CL**2 00058 EJECT DTSBD330 00059 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD330 00060 MPRF-REC DTSBD330 00061 TSKL-REC. DTSBD330 00062 SKIP2 DTSBD330 00063 IF TSKL-FS-DOWNLOAD-88 DTSBD330 00064 CALL 'DTSBD331' USING LBCM-LINK-AREA CL**2 00065 MPRF-REC DTSBD330 00066 TSKL-REC DTSBD330 00067 ELSE DTSBD330 00068 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD330 00069 MOVE MSG1-INVALID-REC-TYPE TO LBCM-TRN-MSG-AREA. DTSBD330 00070 SKIP2 DTSBD330 00071 GOBACK. DTSBD330 00072 EJECT DTSBD330 00073 S999-ABEND. DTSBD330 00074 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 00075 S999-EXIT. DTSBD330 00076 EXIT. DTSBD330