110 lines
8.6 KiB
COBOL
110 lines
8.6 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/06/98
|
|
00002 PROGRAM-ID. DTSCU026 DTSCU026
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN JANUARY 1995. DTSCU026
|
|
00005 DATE-COMPILED. DTSCU026
|
|
00006 SKIP3 DTSCU026
|
|
00007 ***** DTSCU026
|
|
00008 * DTSCU026
|
|
00009 * FUNCTION: OPID TO/FROM ACCOUNTING ENTRY SCREEN DTSCU026
|
|
00010 * FORMATTING. DTSCU026
|
|
00011 * DTSCU026
|
|
00012 * DTSCU026
|
|
00013 * MODIFICATION LOG: DTSCU026
|
|
00014 * DTSCU026
|
|
00015 * 08/04/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU026. CL**2
|
|
00016 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
|
00017 * DTSCU026
|
|
00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU026
|
|
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU026
|
|
00020 * WORK ORDER: PROGRAMMER: DTSCU026
|
|
00021 * DTSCU026
|
|
00022 * DTSCU026
|
|
00023 * DESCRIPTION: DTSCU026
|
|
00024 * DTSCU026
|
|
00025 ***** DTSCU026
|
|
00026 SKIP3 DTSCU026
|
|
00027 ENVIRONMENT DIVISION. DTSCU026
|
|
00028 SKIP3 DTSCU026
|
|
00029 DATA DIVISION. DTSCU026
|
|
00030 SKIP3 DTSCU026
|
|
00031 WORKING-STORAGE SECTION. DTSCU026
|
|
000315 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU026 08/06/98'. DTSCU026
|
|
00032 SKIP3 DTSCU026
|
|
00033 01 WRK-AREA. DTSCU026
|
|
00034 05 WRK-ABEND-CD PIC X(04) VALUE 'U026'.DTSCU026
|
|
00035 DTSCU026
|
|
00036 05 WRK-DEFAULT-OPID-PREFIX PIC X(02) VALUE 'EC'. CL**2
|
|
00037 EJECT DTSCU026
|
|
00038 LINKAGE SECTION. DTSCU026
|
|
00039 SKIP3 DTSCU026
|
|
00040 01 DFHCOMMAREA. DTSCU026
|
|
00041 ++INCLUDE DTSIL026 CL**3
|
|
00042 EJECT DTSCU026
|
|
00043 PROCEDURE DIVISION. DTSCU026
|
|
00044 SKIP2 DTSCU026
|
|
00045 IF L026-SCR-TO-INT-88 DTSCU026
|
|
00046 PERFORM P1000-SCR-TO-INT THRU P1000-EXIT DTSCU026
|
|
00047 ELSE DTSCU026
|
|
00048 IF L026-INT-TO-SCR-88 DTSCU026
|
|
00049 PERFORM P2000-INT-TO-SCR THRU P2000-EXIT DTSCU026
|
|
00050 ELSE DTSCU026
|
|
00051 PERFORM S899-ABEND THRU S899-EXIT. DTSCU026
|
|
00052 SKIP2 DTSCU026
|
|
00053 EXEC CICS DTSCU026
|
|
00054 RETURN DTSCU026
|
|
00055 END-EXEC. DTSCU026
|
|
00056 SKIP2 DTSCU026
|
|
00057 GOBACK. DTSCU026
|
|
00058 EJECT DTSCU026
|
|
00059 P1000-SCR-TO-INT. DTSCU026
|
|
00060 SET L026-NO-ENTRY-88 TO TRUE. DTSCU026
|
|
00061 DTSCU026
|
|
00062 MOVE SPACES TO L026-INT-OPID. DTSCU026
|
|
00063 DTSCU026
|
|
00064 INSPECT L026-SCR-OPID-SUF DTSCU026
|
|
00065 CONVERTING LOW-VALUES TO SPACES. DTSCU026
|
|
00066 DTSCU026
|
|
00067 INSPECT L026-SCR-OPID-PRE DTSCU026
|
|
00068 CONVERTING LOW-VALUES TO SPACES. DTSCU026
|
|
00069 DTSCU026
|
|
00070 IF (L026-SCR-OPID-SUF = SPACES) DTSCU026
|
|
00071 AND DTSCU026
|
|
00072 (L026-SCR-OPID-PRE = SPACES) DTSCU026
|
|
00073 GO TO P1000-EXIT. DTSCU026
|
|
00074 DTSCU026
|
|
00075 SET L026-ENTRY-88 TO TRUE. DTSCU026
|
|
00076 DTSCU026
|
|
00077 IF L026-SCR-OPID-PRE = SPACES DTSCU026
|
|
00078 MOVE WRK-DEFAULT-OPID-PREFIX TO L026-INT-OPID-PRE DTSCU026
|
|
00079 L026-SCR-OPID-PRE DTSCU026
|
|
00080 ELSE DTSCU026
|
|
00081 MOVE L026-SCR-OPID-PRE TO L026-INT-OPID-PRE. DTSCU026
|
|
00082 DTSCU026
|
|
00083 MOVE L026-SCR-OPID-SUF TO L026-INT-OPID-SUF. DTSCU026
|
|
00084 P1000-EXIT. DTSCU026
|
|
00085 EXIT. DTSCU026
|
|
00086 EJECT DTSCU026
|
|
00087 P2000-INT-TO-SCR. DTSCU026
|
|
00088 IF L026-INT-OPID = SPACES OR LOW-VALUES DTSCU026
|
|
00089 MOVE SPACES TO L026-SCR-OPID-SUF DTSCU026
|
|
00090 L026-SCR-OPID-PRE DTSCU026
|
|
00091 SET L026-NO-ENTRY-88 TO TRUE DTSCU026
|
|
00092 GO TO P2000-EXIT. DTSCU026
|
|
00093 DTSCU026
|
|
00094 SET L026-ENTRY-88 TO TRUE. DTSCU026
|
|
00095 DTSCU026
|
|
00096 MOVE L026-INT-OPID-SUF TO L026-SCR-OPID-SUF. DTSCU026
|
|
00097 DTSCU026
|
|
00098 MOVE L026-INT-OPID-PRE TO L026-SCR-OPID-PRE. DTSCU026
|
|
00099 P2000-EXIT. DTSCU026
|
|
00100 EXIT. DTSCU026
|
|
00101 EJECT DTSCU026
|
|
00102 S899-ABEND. DTSCU026
|
|
00103 EXEC CICS DTSCU026
|
|
00104 ABEND DTSCU026
|
|
00105 ABCODE (WRK-ABEND-CD) DTSCU026
|
|
00106 END-EXEC. DTSCU026
|
|
00107 S899-EXIT. DTSCU026
|
|
00108 EXIT. DTSCU026
|