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
