DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
257
CICS/DTSCU803.cob
Normal file
257
CICS/DTSCU803.cob
Normal file
@ -0,0 +1,257 @@
|
||||
00001 IDENTIFICATION DIVISION. 12/14/09
|
||||
00002 PROGRAM-ID. DTSCU803. DTSCU803
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV022
|
||||
00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU803
|
||||
00005 DATE-COMPILED. DTSCU803
|
||||
00006 SKIP3 DTSCU803
|
||||
00007 ***** DTSCU803
|
||||
00008 * DTSCU803
|
||||
00009 * FUNCTION: REQUESTED SCREEN IDENTIFIER EDIT. DTSCU803
|
||||
00010 * DTSCU803
|
||||
00011 * DTSCU803
|
||||
00012 * MODIFICATION LOG: DTSCU803
|
||||
00013 * DTSCU803
|
||||
00014 * 11/05/91 INITIAL DEVELOPMENT. DTSCU803
|
||||
00015 * WORK ORDER: PROGRAMMER: TCL DTSCU803
|
||||
00016 * DTSCU803
|
||||
00017 * 04/01/94 MODIFIED FOR MONTANA. DTSCU803
|
||||
00018 * WORK ORDER: PROGRAMMER: EHH DTSCU803
|
||||
00019 * DTSCU803
|
||||
00020 * 09/21/95 ADD SCREEN '1E' TO THE INVENTORY OF VALID DTSCU803
|
||||
00021 * SCREEN IDENTIFIERS. DTSCU803
|
||||
00022 * WORK ORDER: JR PROGRAMMER: EHH DTSCU803
|
||||
00023 * DTSCU803
|
||||
00024 * 05/14/96 ADD SCREEN '7A' TO THE INVENTORY OF VALID DTSCU803
|
||||
00025 * SCREEN IDENTIFIERS. DTSCU803
|
||||
00026 * REFERENCE RFP: WARP II PROGRAMMER: MJA DTSCU803
|
||||
00027 * DTSCU803
|
||||
00028 * 08/12/1998 REVIEW AND MODIFY FOR DC. DTSCU803
|
||||
00029 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCU803
|
||||
00030 * DTSCU803
|
||||
00031 * 05/21/1999 P2000-EDIT-FOR-CONSTRUCTION DISABLED. DTSCU803
|
||||
00032 * REFERENCE: DC DEVELOPMENT PROGRAMMER: GD DTSCU803
|
||||
00033 * DTSCU803
|
||||
00034 * 06/17/2000 ADDED SCREEN 88 AS A VALID SCREEN. DTSCU803
|
||||
00035 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1 DTSCU803
|
||||
00036 * DTSCU803
|
||||
00037 * 01/23/2001 ADDED SCREENS L5 THROUGH L9 DTSCU803
|
||||
00038 * REFERENCE: ELECTRONIC MEDIA PROGRAMMER: GD DTSCU803
|
||||
00039 * DTSCU803
|
||||
00040 * 10/15/2001 ADDED SCREENS 7C AND 89 - 8B DTSCU803
|
||||
00041 * REFERENCE: HOUSEHOLD, ONLINE JOB REQUEST DTSCU803
|
||||
00042 * PROGRAMMER: GD DTSCU803
|
||||
00043 * DTSCU803
|
||||
00044 * 05/10/2002 ADDED SCREENS 89 (ANNUAL FILER) DTSCU803
|
||||
00045 * REFERENCE: HOUSEHOLD, DTSCU803
|
||||
00046 * PROGRAMMER: ZL1 DTSCU803
|
||||
00047 * DTSCU803
|
||||
00048 * 01/03/2003 ADDED SCREEN 7D (EMPLOYER WAGE REQUEST) DTSCU803
|
||||
00049 * REFERENCE: VERA RILEY REQUEST DTSCU803
|
||||
00050 * PROGRAMMER: SCM DTSCU803
|
||||
00051 * DTSCU803
|
||||
00052 * 04/24/2004 ADDED SCREEN 48 (COMPROMISE SETTLEMENT) DTSCU803
|
||||
00053 * REFERENCE: COMPROMISE DTSCU803
|
||||
00054 * PROGRAMMER: GD DTSCU803
|
||||
00055 * DTSCU803
|
||||
00056 * 10/09/2009 ADDED SCREENS 69 (AUDIT SCHEDULE) DTSCU803
|
||||
00057 * REFERENCE: AUDIT DIR, DTSCU803
|
||||
00058 * PROGRAMMER: ZL1 DTSCU803
|
||||
00059 * DTSCU803
|
||||
00060 * DTSCU803
|
||||
00061 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU803
|
||||
00062 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU803
|
||||
00063 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCU803
|
||||
00064 * DTSCU803
|
||||
00065 * DTSCU803
|
||||
00066 * DESCRIPTION: DTSCU803
|
||||
00067 * DTSCU803
|
||||
00068 * IF THE TERMINAL OPERATOR REQUESTS A SWITCH BETWEEN SCREEN DTSCU803
|
||||
00069 * TYPES, THEN A SCREEN PROCESSING MODULE PLACES THE SCREEN DTSCU803
|
||||
00070 * IDENTIFIER OF THE REQUESTED SCREEN IN LCCM-REQ-SCR-ID AND DTSCU803
|
||||
00071 * LINK'S TO DTSCU803. DTSCU803
|
||||
00072 * DTSCU803
|
||||
00073 * DTSCU803 EDITS LCCM-REQ-SCR-ID FOR VALIDITY AND FOR ACCESS DTSCU803
|
||||
00074 * BY THIS PARTICULAR OPERATOR. DTSCU803
|
||||
00075 * DTSCU803
|
||||
00076 * IF LCCM-REQ-SCR-ID IS NOT A VALID SCREEN IDENTIFIER DTSCU803
|
||||
00077 * PLACE EMSG-INVALID-OPTION IN LCCM-MSG-AREA DTSCU803
|
||||
00078 * ELSE DTSCU803
|
||||
00079 * IF LCCM-REQ-SCR-ID IS NOT (A MENU SCREEN OR 'SF') DTSCU803
|
||||
00080 * AND DTSCU803
|
||||
00081 * CURRENT OPERATOR DOES NOT HAVE ACCESS TO LCCM-SCR-ID DTSCU803
|
||||
00082 * PLACE EMSG-NO-ACCESS IN LCCM-MSG-AREA. DTSCU803
|
||||
00083 * ELSE DTSCU803
|
||||
00084 * IF SCREEN TEMPORARILY DISABLED (ADDED TO WRK-CON-SCR-ID-88) DTSCU803
|
||||
00085 * PLACE EMSG-UNDER-CONSTRUCTION IN LCCM-MSG-AREA. DTSCU803
|
||||
00086 * DTSCU803
|
||||
00087 ***** DTSCU803
|
||||
00088 SKIP3 DTSCU803
|
||||
00089 ENVIRONMENT DIVISION. DTSCU803
|
||||
00090 SKIP3 DTSCU803
|
||||
00091 DATA DIVISION. DTSCU803
|
||||
00092 SKIP3 DTSCU803
|
||||
00093 WORKING-STORAGE SECTION. DTSCU803
|
||||
000935 77 PAN-VALET PICTURE X(24) VALUE '022DTSCU803 12/14/09'. DTSCU803
|
||||
00094 SKIP3 DTSCU803
|
||||
00095 01 WRK-AREA. DTSCU803
|
||||
00096 05 WRK-ABEND-CODE PIC X(04) VALUE 'U803'. DTSCU803
|
||||
00097 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU803
|
||||
00098 DTSCU803
|
||||
00099 05 WRK-SCR-ID PIC X(02). DTSCU803
|
||||
00100 88 WRK-VALID-SCR-ID VALUE '00' DTSCU803
|
||||
00101 '10' THRU '19' DTSCU803
|
||||
00102 '1A' '1C' '1D' DTSCU803
|
||||
00103 '20' THRU '22' DTSCU803
|
||||
00104 '24' THRU '27' DTSCU803
|
||||
00105 '30' THRU '37' DTSCU803
|
||||
00106 '40' THRU '48' DTSCU803
|
||||
00107 '50' THRU '53' DTSCU803
|
||||
00108 '60' THRU '69' DTSCU803
|
||||
00109 '70' THRU '79' DTSCU803
|
||||
00110 '7A' '7B' '7C' '7D' DTSCU803
|
||||
00111 '80' THRU '89' DTSCU803
|
||||
00112 '8A' '8B' DTSCU803
|
||||
00113 '90' THRU '92' DTSCU803
|
||||
00114 'L0' THRU 'L2' DTSCU803
|
||||
00115 'L5' THRU 'L9' DTSCU803
|
||||
00116 '98' '99' 'SF'. DTSCU803
|
||||
00117 05 FILLER REDEFINES WRK-SCR-ID. DTSCU803
|
||||
00118 10 FILLER PIC X(01). DTSCU803
|
||||
00119 10 FILLER PIC X(01). DTSCU803
|
||||
00120 88 WRK-MENU-SCR-ID VALUE '0'. DTSCU803
|
||||
00121 05 WRK-SCR-ID-9 REDEFINES WRK-SCR-ID DTSCU803
|
||||
00122 PIC 9(02). DTSCU803
|
||||
00123 SKIP3 DTSCU803
|
||||
00124 05 WRK-OP-ID PIC X(04). DTSCU803
|
||||
00125 88 WRK-TRW-OP-ID-88 VALUE 'ECNT'. DTSCU803
|
||||
00126 DTSCU803
|
||||
00127 05 WRK-CON-SCR-ID PIC X(02). DTSCU803
|
||||
00128 88 WRK-CON-SCR-ID-88 VALUE '46' DTSCU803
|
||||
00129 '76'. DTSCU803
|
||||
00130 DTSCU803
|
||||
00131 05 WRK-ACCESS-IND PIC X(01). DTSCU803
|
||||
00132 EJECT DTSCU803
|
||||
00133 01 EMSG-LITERALS. DTSCU803
|
||||
00134 05 EMSG-NO-ACCESS. DTSCU803
|
||||
00135 10 FILLER PIC X(04) VALUE 'E093'. DTSCU803
|
||||
00136 10 FILLER PIC X(17) DTSCU803
|
||||
00137 VALUE 'ACCESS TO SCREEN '. DTSCU803
|
||||
00138 10 EMSG-NO-ACCESS-SCR-ID PIC X(02). DTSCU803
|
||||
00139 10 FILLER PIC X(29) DTSCU803
|
||||
00140 VALUE ' NOT ALLOWED FOR OPERATOR ID '. DTSCU803
|
||||
00141 10 EMSG-OP-ID PIC X(08). DTSCU803
|
||||
00142 DTSCU803
|
||||
00143 05 EMSG-INVALID-OPTION. DTSCU803
|
||||
00144 10 FILLER PIC X(04) VALUE 'E094'. DTSCU803
|
||||
00145 10 EMSG-INVALID-OPTION-SCR-ID DTSCU803
|
||||
00146 PIC X(02). DTSCU803
|
||||
00147 10 FILLER PIC X(22) DTSCU803
|
||||
00148 VALUE ' IS NOT A VALID OPTION'. DTSCU803
|
||||
00149 DTSCU803
|
||||
00150 05 EMSG-INVALID-SCREEN. DTSCU803
|
||||
00151 10 FILLER PIC X(04) VALUE 'E095'. DTSCU803
|
||||
00152 10 EMSG-INVALID-SCREEN-SCR-ID DTSCU803
|
||||
00153 PIC X(02). DTSCU803
|
||||
00154 10 FILLER PIC X(33) DTSCU803
|
||||
00155 VALUE ' IS NOT A VALID SCREEN IDENTIFIER'. DTSCU803
|
||||
00156 DTSCU803
|
||||
00157 05 EMSG-UNDER-CONSTRUCTION. DTSCU803
|
||||
00158 10 FILLER PIC X(04) VALUE 'E099'. DTSCU803
|
||||
00159 10 FILLER PIC X(07) DTSCU803
|
||||
00160 VALUE 'SCREEN '. DTSCU803
|
||||
00161 10 EMSG-UNDER-CON-SCR-ID PIC X(02). DTSCU803
|
||||
00162 10 FILLER PIC X(40) DTSCU803
|
||||
00163 VALUE ' NOT AVAILABLE CONSTRUCTION IN PROGRESS'. DTSCU803
|
||||
00164 EJECT DTSCU803
|
||||
00165 LINKAGE SECTION. DTSCU803
|
||||
00166 SKIP3 DTSCU803
|
||||
00167 01 DFHCOMMAREA. DTSCU803
|
||||
00168 ++INCLUDE DTSILCCM DTSCU803
|
||||
00169 EJECT DTSCU803
|
||||
00170 PROCEDURE DIVISION. DTSCU803
|
||||
00171 SKIP2 DTSCU803
|
||||
00172 PERFORM P1000-EDIT-REQ-SCR-ID THRU P1000-EXIT. DTSCU803
|
||||
00173 SKIP2 DTSCU803
|
||||
00174 **** IF LCCM-NO-MSG DTSCU803
|
||||
00175 **** PERFORM P2000-EDIT-FOR-CONSTRUCTION THRU P2000-EXIT. DTSCU803
|
||||
00176 SKIP2 DTSCU803
|
||||
00177 EXEC CICS DTSCU803
|
||||
00178 RETURN DTSCU803
|
||||
00179 END-EXEC. DTSCU803
|
||||
00180 SKIP2 DTSCU803
|
||||
00181 GOBACK. DTSCU803
|
||||
00182 EJECT DTSCU803
|
||||
00183 P1000-EDIT-REQ-SCR-ID. DTSCU803
|
||||
00184 MOVE LCCM-REQ-SCR-ID TO WRK-SCR-ID. DTSCU803
|
||||
00185 DTSCU803
|
||||
00186 IF NOT WRK-VALID-SCR-ID DTSCU803
|
||||
00187 IF LCCM-SCR-MENU-88 DTSCU803
|
||||
00188 MOVE WRK-SCR-ID TO EMSG-INVALID-OPTION-SCR-ID DTSCU803
|
||||
00189 MOVE EMSG-INVALID-OPTION TO LCCM-MSG-AREA DTSCU803
|
||||
00190 GO TO P1000-EXIT DTSCU803
|
||||
00191 ELSE DTSCU803
|
||||
00192 MOVE WRK-SCR-ID TO EMSG-INVALID-SCREEN-SCR-ID DTSCU803
|
||||
00193 MOVE EMSG-INVALID-SCREEN TO LCCM-MSG-AREA DTSCU803
|
||||
00194 GO TO P1000-EXIT. DTSCU803
|
||||
00195 DTSCU803
|
||||
00196 IF WRK-MENU-SCR-ID DTSCU803
|
||||
00197 OR DTSCU803
|
||||
00198 WRK-SCR-ID = 'SF' DTSCU803
|
||||
00199 GO TO P1000-EXIT. DTSCU803
|
||||
00200 DTSCU803
|
||||
00201 IF (WRK-SCR-ID NUMERIC) DTSCU803
|
||||
00202 AND DTSCU803
|
||||
00203 (WRK-SCR-ID NOT = '00') DTSCU803
|
||||
00204 IF LCCM-SCR-NUM-I-U-ACCESS-88 (WRK-SCR-ID-9) OR DTSCU803
|
||||
00205 LCCM-SCR-NUM-IUS-ACCESS-88 (WRK-SCR-ID-9) DTSCU803
|
||||
00206 NEXT SENTENCE DTSCU803
|
||||
00207 ELSE DTSCU803
|
||||
00208 PERFORM P1900-NO-ACCESS THRU P1900-EXIT DTSCU803
|
||||
00209 ELSE DTSCU803
|
||||
00210 MOVE 'N' TO WRK-ACCESS-IND DTSCU803
|
||||
00211 PERFORM P1100-NONUM-SEARCH THRU P1100-EXIT DTSCU803
|
||||
00212 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCU803
|
||||
00213 UNTIL (LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT) DTSCU803
|
||||
00214 OR DTSCU803
|
||||
00215 (WRK-ACCESS-IND = 'Y') DTSCU803
|
||||
00216 IF WRK-ACCESS-IND = 'N' DTSCU803
|
||||
00217 PERFORM P1900-NO-ACCESS THRU P1900-EXIT. DTSCU803
|
||||
00218 P1000-EXIT. DTSCU803
|
||||
00219 EXIT. DTSCU803
|
||||
00220 SKIP3 DTSCU803
|
||||
00221 P1100-NONUM-SEARCH. DTSCU803
|
||||
00222 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCU803
|
||||
00223 IF LCCM-SCR-NONUM-I-U-ACCESS-88 (LCCM-NONUM-IDX) OR DTSCU803
|
||||
00224 LCCM-SCR-NONUM-IUS-ACCESS-88 (LCCM-NONUM-IDX) DTSCU803
|
||||
00225 MOVE 'Y' TO WRK-ACCESS-IND. DTSCU803
|
||||
00226 P1100-EXIT. DTSCU803
|
||||
00227 EXIT. DTSCU803
|
||||
00228 SKIP3 DTSCU803
|
||||
00229 P1900-NO-ACCESS. DTSCU803
|
||||
00230 MOVE WRK-SCR-ID TO EMSG-NO-ACCESS-SCR-ID. DTSCU803
|
||||
00231 MOVE LCCM-OP-ID TO EMSG-OP-ID. DTSCU803
|
||||
00232 MOVE EMSG-NO-ACCESS TO LCCM-MSG-AREA. DTSCU803
|
||||
00233 P1900-EXIT. DTSCU803
|
||||
00234 EXIT. DTSCU803
|
||||
00235 EJECT DTSCU803
|
||||
00236 P2000-EDIT-FOR-CONSTRUCTION. DTSCU803
|
||||
00237 MOVE LCCM-OP-ID TO WRK-OP-ID. DTSCU803
|
||||
00238 DTSCU803
|
||||
00239 IF WRK-TRW-OP-ID-88 DTSCU803
|
||||
00240 GO TO P2000-EXIT. DTSCU803
|
||||
00241 DTSCU803
|
||||
00242 MOVE LCCM-REQ-SCR-ID TO WRK-CON-SCR-ID. DTSCU803
|
||||
00243 DTSCU803
|
||||
00244 ***** DTSCU803
|
||||
00245 * DTSCU803
|
||||
00246 * FOLLOWING SENTENCE COMMENTED OUT UNTIL THE PROBLEM OF NOT DTSCU803
|
||||
00247 * BEING ABLE TO SIGN ON TO TSTMDOES WITH A RACF OP ID IS DTSCU803
|
||||
00248 * SOLVED. DTSCU803
|
||||
00249 * DTSCU803
|
||||
00250 ***** DTSCU803
|
||||
00251 DTSCU803
|
||||
00252 *****IF WRK-CON-SCR-ID-88 DTSCU803
|
||||
00253 *********MOVE WRK-CON-SCR-ID TO EMSG-UNDER-CON-SCR-ID DTSCU803
|
||||
00254 *********MOVE EMSG-UNDER-CONSTRUCTION TO LCCM-MSG-AREA. DTSCU803
|
||||
00255 P2000-EXIT. DTSCU803
|
||||
00256 EXIT. DTSCU803
|
||||
Reference in New Issue
Block a user