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