111 lines
8.7 KiB
COBOL
111 lines
8.7 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/06/98
|
|
00002 PROGRAM-ID. DTSCU019 DTSCU019
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN NOVEMBER 1991. DTSCU019
|
|
00005 DATE-COMPILED. DTSCU019
|
|
00006 SKIP3 DTSCU019
|
|
00007 ***** DTSCU019
|
|
00008 * DTSCU019
|
|
00009 * FUNCTION: EDIT AND FORMAT BATCH FROM SCREEN DTSCU019
|
|
00010 * DTSCU019
|
|
00011 * DTSCU019
|
|
00012 * MODIFICATION LOG: DTSCU019
|
|
00013 * DTSCU019
|
|
00014 * 08/04/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU019. CL**2
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
|
00016 * DTSCU019
|
|
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU019
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU019
|
|
00019 * WORK ORDER: PROGRAMMER: DTSCU019
|
|
00020 * DTSCU019
|
|
00021 * DTSCU019
|
|
00022 * DESCRIPTION: DTSCU019
|
|
00023 * DTSCU019
|
|
00024 ***** DTSCU019
|
|
00025 SKIP3 DTSCU019
|
|
00026 ENVIRONMENT DIVISION. DTSCU019
|
|
00027 SKIP3 DTSCU019
|
|
00028 DATA DIVISION. DTSCU019
|
|
00029 SKIP3 DTSCU019
|
|
00030 WORKING-STORAGE SECTION. DTSCU019
|
|
000305 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU019 08/06/98'. DTSCU019
|
|
00031 SKIP3 DTSCU019
|
|
00032 01 WRK-AREA. DTSCU019
|
|
00033 05 WS-BATCH-NO PIC 9(05). DTSCU019
|
|
00034 DTSCU019
|
|
00035 05 WS-ITEM-NO PIC 9(03). DTSCU019
|
|
00036 DTSCU019
|
|
00037 05 WRK-BATCH-ENTRY PIC X(01). DTSCU019
|
|
00038 88 WRK-BATCH-ENTRY-YES VALUE 'Y'. DTSCU019
|
|
00039 88 WRK-BATCH-ENTRY-NO VALUE 'N'. DTSCU019
|
|
00040 88 WRK-BATCH-ENTRY-ERROR VALUE 'E'. DTSCU019
|
|
00041 DTSCU019
|
|
00042 05 WRK-ITEM-ENTRY PIC X(01). DTSCU019
|
|
00043 88 WRK-ITEM-ENTRY-YES VALUE 'Y'. DTSCU019
|
|
00044 88 WRK-ITEM-ENTRY-NO VALUE 'N'. DTSCU019
|
|
00045 88 WRK-ITEM-ENTRY-ERROR VALUE 'E'. DTSCU019
|
|
00046 EJECT DTSCU019
|
|
00047 LINKAGE SECTION. DTSCU019
|
|
00048 DTSCU019
|
|
00049 01 DFHCOMMAREA. DTSCU019
|
|
00050 ++INCLUDE DTSIL019 CL**3
|
|
00051 EJECT DTSCU019
|
|
00052 PROCEDURE DIVISION. DTSCU019
|
|
00053 DTSCU019
|
|
00054 MOVE +0 TO L019-BATCH-NO DTSCU019
|
|
00055 L019-DOC-NO. DTSCU019
|
|
00056 DTSCU019
|
|
00057 IF L019-S-BATCH-NO = SPACES OR LOW-VALUES DTSCU019
|
|
00058 SET WRK-BATCH-ENTRY-NO TO TRUE CL**2
|
|
00059 MOVE +0 TO L019-BATCH-NO DTSCU019
|
|
00060 ELSE DTSCU019
|
|
00061 IF L019-S-BATCH-NO NUMERIC DTSCU019
|
|
00062 SET WRK-BATCH-ENTRY-YES TO TRUE CL**2
|
|
00063 MOVE L019-S-BATCH-NO TO WS-BATCH-NO DTSCU019
|
|
00064 MOVE WS-BATCH-NO TO L019-BATCH-NO DTSCU019
|
|
00065 ELSE DTSCU019
|
|
00066 SET WRK-BATCH-ENTRY-ERROR TO TRUE CL**2
|
|
00067 MOVE +0 TO L019-BATCH-NO. DTSCU019
|
|
00068 DTSCU019
|
|
00069 IF L019-S-ITEM-NO = SPACE OR LOW-VALUES DTSCU019
|
|
00070 SET WRK-ITEM-ENTRY-NO TO TRUE CL**2
|
|
00071 MOVE +0 TO L019-ITEM-NO DTSCU019
|
|
00072 ELSE DTSCU019
|
|
00073 IF L019-S-ITEM-NO NUMERIC DTSCU019
|
|
00074 SET WRK-ITEM-ENTRY-YES TO TRUE CL**2
|
|
00075 MOVE L019-S-ITEM-NO TO WS-ITEM-NO DTSCU019
|
|
00076 MOVE WS-ITEM-NO TO L019-ITEM-NO DTSCU019
|
|
00077 ELSE DTSCU019
|
|
00078 SET WRK-ITEM-ENTRY-ERROR TO TRUE CL**2
|
|
00079 MOVE +0 TO L019-ITEM-NO. DTSCU019
|
|
00080 DTSCU019
|
|
00081 IF WRK-BATCH-ENTRY-ERROR DTSCU019
|
|
00082 OR WRK-ITEM-ENTRY-ERROR DTSCU019
|
|
00083 PERFORM NOT-VALID-ENTRY THRU NOT-VALID-EXIT DTSCU019
|
|
00084 GO TO INIT0199-GO-BACK. DTSCU019
|
|
00085 DTSCU019
|
|
00086 IF WRK-ITEM-ENTRY-YES DTSCU019
|
|
00087 AND WRK-BATCH-ENTRY-NO DTSCU019
|
|
00088 PERFORM NOT-VALID-ENTRY THRU NOT-VALID-EXIT DTSCU019
|
|
00089 GO TO INIT0199-GO-BACK. DTSCU019
|
|
00090 DTSCU019
|
|
00091 IF WRK-BATCH-ENTRY-NO DTSCU019
|
|
00092 AND WRK-ITEM-ENTRY-NO DTSCU019
|
|
00093 SET L019-NO-ENTRY TO TRUE CL**2
|
|
00094 GO TO INIT0199-GO-BACK. DTSCU019
|
|
00095 DTSCU019
|
|
00096 SET L019-VALID TO TRUE. DTSCU019
|
|
00097 DTSCU019
|
|
00098 INIT0199-GO-BACK. DTSCU019
|
|
00099 EXEC CICS DTSCU019
|
|
00100 RETURN DTSCU019
|
|
00101 END-EXEC. DTSCU019
|
|
00102 GOBACK. DTSCU019
|
|
00103 NOT-VALID-ENTRY. DTSCU019
|
|
00104 SET L019-NOT-VALID TO TRUE CL**2
|
|
00105 MOVE ZERO TO DTSCU019
|
|
00106 L019-BATCH-NO DTSCU019
|
|
00107 L019-ITEM-NO. DTSCU019
|
|
00108 NOT-VALID-EXIT. DTSCU019
|
|
00109 EXIT. DTSCU019
|