00001 IDENTIFICATION DIVISION. 09/09/98 00002 PROGRAM-ID. DTSCU825. DTSCU825 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU825 00005 DATE-COMPILED. DTSCU825 00006 SKIP3 DTSCU825 00007 ***** DTSCU825 00008 * DTSCU825 00009 * FUNCTION: ONLINE ACTIVITY FILE OUTPUT DTSCU825 00010 * DTSCU825 00011 * DTSCU825 00012 * MODIFICATION LOG: DTSCU825 00013 * DTSCU825 00014 * 11/13/91 INITIAL DEVELOPMENT. DTSCU825 00015 * WORK ORDER: PROGRAMMER: TCL DTSCU825 00016 * DTSCU825 00017 * 04/06/94 MODIFIED FOR MONTANA. DTSCU825 00018 * WORK ORDER: PROGRAMMER: EHH DTSCU825 00019 * DTSCU825 00020 * 09/09/1998 REVIEWED AND MODIFIED FOR DC. CL**2 00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2 00022 * CL**2 00023 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00025 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2 00026 * DTSCU825 00027 * DTSCU825 00028 * DESCRIPTION: DTSCU825 00029 * DTSCU825 00030 * DTSCU825 WRITES VARIABLE LENGTH RECORDS TO THE CL**2 00031 * ON-LINE ACTIVITY FILE. DTSCU825'S COMMAREA CONSIST OF CL**2 00032 * DTSIL825, FOLLOWED BY DTSIRSK3. SEE DFHCOMMAREA CL**2 00033 * OF THIS MODULE FOR AN EXAMPLE. DTSCU825 00034 * DTSCU825 00035 * ACTUALLY, DTSIRSK1 OR DTSIRSK2 MAY BE SUBSITITUED FOR CL**2 00036 * DTSIRSK3 IN THE LINKING MODULE. USE OF DTSIRSK1 OR CL**2 00037 * DTSIRSK2 IN THE LINKING MODULE (RATHER THAN DTSIRSK3) CL**2 00038 * WILL RESULT IN A SHORTER LINKING MODULE WORKING DTSCU825 00039 * STORAGE AREA. DTSCU825 00040 * DTSCU825 00041 * PRIOR TO THE LINK TO DTSIL825, THE LINKING MODULE CL**2 00042 * MUST CALCULATE L825-LENGTH. L825-LENGTH = DTSCU825 00043 * L825-CB-LENGTH + R***-LENGTH. DTSCU825 00044 * DTSCU825 00045 * GENERAL SPECIFICATIONS: DTSCU825 00046 * DTSCU825 00047 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DTSCU825 00048 * MODULE. DTSCU825 00049 * DTSCU825 00050 * IF THE WRITE COMMAND YIELDS A RESPONSE OTHER THAN DTSCU825 00051 * NORMAL, NOTOPEN, OR DISABLED, THEN ABEND THE MODULE. DTSCU825 00052 * DTSCU825 00053 * RSK3-REC IS THE RECORD TO BE WRITTEN. DTSCU825 00054 * DTSCU825 00055 * RSK3-LENGTH IS THE LENGTH OF THE RECORD TO BE WRITTEN. DTSCU825 00056 * IF RSK3-LENGTH IS LESS THAN RLEN-MIN-LENGTH OR DTSCU825 00057 * RSK3-LENGTH IS GREATER THAN RLEN-MAX-LENGTH, THEN DTSCU825 00058 * ABEND THE MODULE. DTSCU825 00059 * DTSCU825 00060 * DTS*OLA IS A VSAM ESDS. A VSAM ESDS WRITE COMMAND CL**2 00061 * RETURNS THE RELATIVE BYTE ADDRESS (RBA) OF THE RECORD DTSCU825 00062 * IN RIDFLD. SPECIFY RIDFLD (WRK-RBA). DTSCU825 00063 * DTSCU825 00064 * DTSCU825 00065 ***** DTSCU825 00066 SKIP3 DTSCU825 00067 ENVIRONMENT DIVISION. DTSCU825 00068 SKIP3 DTSCU825 00069 DATA DIVISION. DTSCU825 00070 SKIP3 DTSCU825 00071 WORKING-STORAGE SECTION. DTSCU825 000715 77 PAN-VALET PICTURE X(24) VALUE '002DTSCU825 09/09/98'. DTSCU825 00072 SKIP3 DTSCU825 00073 01 WRK-AREA. DTSCU825 00074 05 WRK-ABEND-CD PIC X(04) VALUE 'U825'. DTSCU825 00075 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU825 00076 CL**2 00077 05 WRK-PROD-FILE-NAME PIC X(08) VALUE 'DTSFOLA'. CL**2 00078 CL**2 00079 05 EMSG-NOT-AVAILABLE. DTSCU825 00080 10 FILLER PIC X(04) VALUE 'E091'. DTSCU825 00081 10 FILLER PIC X(06) VALUE 'FILE '. DTSCU825 00082 10 EMSG-FILE-NAME PIC X(08). DTSCU825 00083 10 FILLER PIC X(33) DTSCU825 00084 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU825 00085 05 WRK-FILE-NAME PIC X(08). DTSCU825 00086 CL**2 00087 05 WRK-RBA PIC S9(08) COMP. DTSCU825 00088 EJECT DTSCU825 00089 01 RLEN-LITERALS. DTSCU825 00090 ++INCLUDE DTSIRLEN CL**2 00091 EJECT DTSCU825 00092 LINKAGE SECTION. DTSCU825 00093 SKIP3 DTSCU825 00094 01 DFHCOMMAREA. DTSCU825 00095 05 L825-CONTROL-BLOCK. DTSCU825 00096 ++INCLUDE DTSIL825 CL**2 00097 SKIP3 DTSCU825 00098 05 RSK3-REC. DTSCU825 00099 ++INCLUDE DTSIRSK3 CL**2 00100 EJECT DTSCU825 00101 PROCEDURE DIVISION. DTSCU825 00102 CL**2 00103 MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME. CL**2 00104 CL**2 00105 MOVE SPACES TO L825-MSG-AREA. DTSCU825 00106 CL**2 00107 SET L825-OK-88 TO TRUE. DTSCU825 00108 CL**2 00109 IF L825-WRITE-88 DTSCU825 00110 PERFORM P3100-WRITE THRU P3100-EXIT DTSCU825 00111 ELSE DTSCU825 00112 PERFORM S899-ABEND THRU S899-EXIT. DTSCU825 00113 CL**2 00114 CL**2 00115 EXEC CICS DTSCU825 00116 RETURN DTSCU825 00117 END-EXEC. DTSCU825 00118 CL**2 00119 CL**2 00120 CL**2 00121 GOBACK. DTSCU825 00122 EJECT DTSCU825 00123 P3100-WRITE. DTSCU825 00124 PERFORM S2300-CHECK-LENGTH THRU S2300-EXIT. DTSCU825 00125 CL**2 00126 EXEC CICS DTSCU825 00127 WRITE DTSCU825 00128 DATASET (WRK-FILE-NAME) DTSCU825 00129 FROM (RSK3-REC) DTSCU825 00130 LENGTH (RSK3-LENGTH) DTSCU825 00131 RIDFLD (WRK-RBA) DTSCU825 00132 RBA DTSCU825 00133 RESP (WRK-RESP-CD) DTSCU825 00134 END-EXEC. DTSCU825 00135 CL**2 00136 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU825 00137 OR DFHRESP (SYSIDERR) DTSCU825 00138 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU825 00139 GO TO P3100-EXIT. DTSCU825 00140 CL**2 00141 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU825 00142 NEXT SENTENCE DTSCU825 00143 ELSE DTSCU825 00144 PERFORM S899-ABEND THRU S899-EXIT. DTSCU825 00145 P3100-EXIT. DTSCU825 00146 EXIT. DTSCU825 00147 EJECT DTSCU825 00148 S1100-NOT-AVAILABLE. DTSCU825 00149 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU825 00150 CL**2 00151 MOVE EMSG-NOT-AVAILABLE TO L825-MSG-AREA. DTSCU825 00152 CL**2 00153 SET L825-FILE-CLOSED-88 TO TRUE. DTSCU825 00154 S1100-EXIT. DTSCU825 00155 EXIT. DTSCU825 00156 EJECT DTSCU825 00157 S2300-CHECK-LENGTH. DTSCU825 00158 IF RSK3-LENGTH IS GREATER THAN RLEN-MAX-LENGTH DTSCU825 00159 OR RSK3-LENGTH IS LESS THAN RLEN-MIN-LENGTH DTSCU825 00160 PERFORM S899-ABEND THRU S899-EXIT. DTSCU825 00161 S2300-EXIT. DTSCU825 00162 EXIT. DTSCU825 00163 EJECT DTSCU825 00164 S899-ABEND. DTSCU825 00165 CL**2 00166 EXEC CICS DTSCU825 00167 ABEND DTSCU825 00168 ABCODE (WRK-ABEND-CD) DTSCU825 00169 END-EXEC. DTSCU825 00170 CL**2 00171 S899-EXIT. DTSCU825 00172 EXIT. DTSCU825