00001  IDENTIFICATION DIVISION.                                         12/09/04
00002  PROGRAM-ID.             DTSCS40.                                 DTSCS40
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSCS40
00005  DATE-COMPILED.                                                   DTSCS40
00006      SKIP3                                                        DTSCS40
00007 *****                                                             DTSCS40
00008 *                                                                 DTSCS40
00009 *    FUNCTION:  COLLECTIONS MENU SCREEN PROCESSOR.                DTSCS40
00010 *                                                                 DTSCS40
00011 *                                                                 DTSCS40
00012 *    MODIFICATION LOG:                                            DTSCS40
00013 *                                                                 DTSCS40
00014 *    11/06/91  INITIAL DEVELOPMENT.                               DTSCS40
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCS40
00016 *                                                                 DTSCS40
00017 *    04/11/94  MODIFIED FOR MONTANA.                              DTSCS40
00018 *              WORK ORDER:                      PROGRAMMER: RHC   DTSCS40
00019 *                                                                 DTSCS40
00020 *    08/13/1998  REVIEWED AND MODIFIED FOR DC.                    DTSCS40
00021 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCS40
00022 *                                                                 DTSCS40
00023 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS40
00024 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS40
00025 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCS40
00026 *                                                                 DTSCS40
00027 *                                                                 DTSCS40
00028 *    DESCRIPTION:                                                 DTSCS40
00029 *                                                                 DTSCS40
00030 *    IF SCREEN '40' NOT CURRENTLY DISPLAYED                       DTSCS40
00031 *        SEND SCREEN 40 (WITH PMSG-KEY-OPTION MESSAGE)            DTSCS40
00032 *        RETURN TO DRIVER.                                        DTSCS40
00033 *                                                                 DTSCS40
00034 *    RECEIVE SCREEN '40'.                                         DTSCS40
00035 *                                                                 DTSCS40
00036 *    IF CLEAR KEY PRESSED                                         DTSCS40
00037 *        SEND SCREEN 40 (WITH PMSG-KEY-OPTION MESSAGE)            DTSCS40
00038 *        SET LCCM-END-TASK-88 TO TRUE                             DTSCS40
00039 *        RETURN TO DRIVER.                                        DTSCS40
00040 *                                                                 DTSCS40
00041 *    IF PA2 KEY PRESSED                                           DTSCS40
00042 *        SEND SCREEN 40 (DATA ONLY)                               DTSCS40
00043 *        SET LCCM-END-TASK-88 TO TRUE                             DTSCS40
00044 *        RETURN TO DRIVER.                                        DTSCS40
00045 *                                                                 DTSCS40
00046 *    IF F3 KEY PRESSED                                            DTSCS40
00047 *        MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                   DTSCS40
00048 *        SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS40
00049 *        RETURN TO DRIVER.                                        DTSCS40
00050 *                                                                 DTSCS40
00051 *    IF F4 KEY PRESSED                                            DTSCS40
00052 *        MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                DTSCS40
00053 *        SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS40
00054 *        RETURN TO DRIVER.                                        DTSCS40
00055 *                                                                 DTSCS40
00056 *    IF NOT ENTER KEY PRESSED                                     DTSCS40
00057 *        BUILD INVALID KEY MESSAGE (VIA LINK TO DTSCU804)         DTSCS40
00058 *        SEND SCREEN 40 (WITH THE INVALID KEY PRESSED MESSAGE)    DTSCS40
00059 *        SET LCCM-END-TASK-88 TO TRUE                             DTSCS40
00060 *        RETURN TO DRIVER.                                        DTSCS40
00061 *                                                                 DTSCS40
00062 *                                                                 DTSCS40
00063 *    IF MAP-OPT = SPACES OR LOW-VALUES OR '40'                    DTSCS40
00064 *        SEND SCREEN 00 (WITH THE PMSG-KEY-OPTION MESSAGE)        DTSCS40
00065 *        SET LCCM-END-TASK-88 TO TRUE                             DTSCS40
00066 *        RETURN TO DRIVER.                                        DTSCS40
00067 *                                                                 DTSCS40
00068 *    CONVERT MAP-OPT INTO A SCREEN IDENTIFIER, PLACING THE        DTSCS40
00069 *    RESULT IN LCCM-REQ-SCR-ID.                                   DTSCS40
00070 *                                                                 DTSCS40
00071 *    EDIT LCCM-REQ-SCR-ID FOR VALIDITY (VIA A CALL TO DTSIU803).  DTSCS40
00072 *                                                                 DTSCS40
00073 *    IF LCCM-REQ-SCR-ID VALID (LCCM-NO-MSG)                       DTSCS40
00074 *        SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS40
00075 *        RETURN TO DRIVER                                         DTSCS40
00076 *    ELSE                                                         DTSCS40
00077 *        SEND SCREEN 40 (WITH ERROR MESSAGE)                      DTSCS40
00078 *        SET LCCM-END-TASK-88 TO TRUE                             DTSCS40
00079 *        RETURN TO DRIVER.                                        DTSCS40
00080 *                                                                 DTSCS40
00081 *                                                                 DTSCS40
00082 *****                                                             DTSCS40
00083      SKIP3                                                        DTSCS40
00084  ENVIRONMENT DIVISION.                                            DTSCS40
00085      SKIP3                                                        DTSCS40
00086  DATA DIVISION.                                                   DTSCS40
00087      SKIP3                                                        DTSCS40
00088  WORKING-STORAGE SECTION.                                         DTSCS40
000885 77  PAN-VALET PICTURE X(24) VALUE '004DTSCS40   12/09/04'.       DTSCS40
00089      SKIP3                                                        DTSCS40
00090  01  WRK-AREA.                                                    DTSCS40
00091      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S40 '.    DTSCS40
00092      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCS40
00093                                                                   DTSCS40
00094      05  WRK-SCR-ID                  PIC  X(02)  VALUE '40'.      DTSCS40
00095      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '00'.      DTSCS40
00096                                                                   DTSCS40
00097      05  RESP-IND                    PIC  X(01).                  DTSCS40
00098          88  RESP-CURSOR-TO-OPT-88           VALUE 'C'.           DTSCS40
00099          88  RESP-MSGONLY-88                 VALUE 'M'.           DTSCS40
00100          88  RESP-SCREEN-88                  VALUE 'S'.           DTSCS40
00101          88  RESP-JUMP-88                    VALUE 'J'.           DTSCS40
00102                                                                   DTSCS40
00103      05  CURSOR-IND                  PIC  X(01).                  DTSCS40
00104          88  CURSOR-SET-88                  VALUE 'Y'.            DTSCS40
00105                                                                   DTSCS40
00106      05  WRK-DATE-AREA.                                           DTSCS40
00107          10  WRK-DATE                PIC  X(08).                  DTSCS40
00108          10  FILLER                  PIC  X(01)  VALUE '.'.       DTSCS40
00109      EJECT                                                        DTSCS40
00110  01  L851-COMM-AREA.                                              DTSCS40
00111  ++INCLUDE DTSIL851                                               DTSCS40
00112      SKIP3                                                        DTSCS40
00113      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS40
00114  ++INCLUDE DTSISSM                                                DTSCS40
00115      EJECT                                                        DTSCS40
00116  01  L805-COMM-AREA.                                              DTSCS40
00117  ++INCLUDE DTSIL805                                               DTSCS40
00118      EJECT                                                        DTSCS40
00119  01  CATB-LITERALS.                                               DTSCS40
00120  ++INCLUDE DTSICATB                                               DTSCS40
00121      SKIP3                                                        DTSCS40
00122  01  EMSG-LITERALS.                                               DTSCS40
00123  ++INCLUDE DTSICECD                                               DTSCS40
00124      SKIP3                                                        DTSCS40
00125  01  PMSG-LITERALS.                                               DTSCS40
00126  ++INCLUDE DTSICPCD                                               DTSCS40
00127      EJECT                                                        DTSCS40
00128  LINKAGE SECTION.                                                 DTSCS40
00129      SKIP3                                                        DTSCS40
00130  01  DFHCOMMAREA.                                                 DTSCS40
00131  ++INCLUDE DTSILCCM                                               DTSCS40
00132      EJECT                                                        DTSCS40
00133  PROCEDURE DIVISION.                                              DTSCS40
00134      SKIP2                                                        DTSCS40
00135      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS40
00136                                                                   DTSCS40
00137      MOVE 'N' TO CURSOR-IND.                                      DTSCS40
00138      SKIP2                                                        DTSCS40
00139      MOVE SPACE TO RESP-IND.                                      DTSCS40
00140      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS40
00141      SKIP2                                                        DTSCS40
00142      IF RESP-MSGONLY-88                                           DTSCS40
00143          MOVE LOW-VALUES TO MAP-AREA                              DTSCS40
00144          PERFORM S805-MSG-AREA THRU S805-EXIT                     DTSCS40
00145          PERFORM S2200-SEND-DATAONLY THRU S2200-EXIT              DTSCS40
00146          SET LCCM-END-TASK-88 TO TRUE                             DTSCS40
00147      ELSE                                                         DTSCS40
00148      IF RESP-SCREEN-88                                            DTSCS40
00149          PERFORM P2000-CONSTRUCT-S-AREA THRU P2000-EXIT           DTSCS40
00150          PERFORM S2100-SEND THRU S2100-EXIT                       DTSCS40
00151          SET LCCM-END-TASK-88 TO TRUE                             DTSCS40
00152      ELSE                                                         DTSCS40
00153      IF RESP-JUMP-88                                              DTSCS40
00154          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS40
00155      ELSE                                                         DTSCS40
00156      IF RESP-CURSOR-TO-OPT-88                                     DTSCS40
00157          MOVE LOW-VALUES TO MAP-AREA                              DTSCS40
00158          MOVE CATB-CURSOR TO MAP-OPT-L                            DTSCS40
00159          SET CURSOR-SET-88 TO TRUE                                DTSCS40
00160          PERFORM S2200-SEND-DATAONLY THRU S2200-EXIT              DTSCS40
00161          SET LCCM-END-TASK-88 TO TRUE                             DTSCS40
00162      ELSE                                                         DTSCS40
00163          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCS40
00164      SKIP2                                                        DTSCS40
00165      EXEC CICS                                                    DTSCS40
00166          RETURN                                                   DTSCS40
00167      END-EXEC.                                                    DTSCS40
00168      SKIP2                                                        DTSCS40
00169      GOBACK.                                                      DTSCS40
00170      EJECT                                                        DTSCS40
00171  P1000-ANALYZE-REQUEST.                                           DTSCS40
00172      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS40
00173          MOVE PMSG-KEY-OPTION TO LCCM-MSG-AREA                    DTSCS40
00174          SET RESP-SCREEN-88 TO TRUE                               DTSCS40
00175          GO TO P1000-EXIT.                                        DTSCS40
00176                                                                   DTSCS40
00177      PERFORM S1100-RECEIVE THRU S1100-EXIT.                       DTSCS40
00178                                                                   DTSCS40
00179      IF LCCM-CLEAR-88 OR LCCM-F12-88                              DTSCS40
00180          MOVE LOW-VALUES TO MAP-AREA                              DTSCS40
00181          MOVE PMSG-KEY-OPTION TO LCCM-MSG-AREA                    DTSCS40
00182          SET RESP-SCREEN-88 TO TRUE                               DTSCS40
00183          GO TO P1000-EXIT.                                        DTSCS40
00184                                                                   DTSCS40
00185      IF LCCM-PA2-88                                               DTSCS40
00186          SET RESP-CURSOR-TO-OPT-88 TO TRUE                        DTSCS40
00187          GO TO P1000-EXIT.                                        DTSCS40
00188                                                                   DTSCS40
00189      IF LCCM-ENTER-88 OR LCCM-F03-88 OR LCCM-F04-88 OR LCCM-F14-88DTSCS40
00190          NEXT SENTENCE                                            DTSCS40
00191      ELSE                                                         DTSCS40
00192          PERFORM S804-INVALID-KEY THRU S804-EXIT                  DTSCS40
00193          SET RESP-MSGONLY-88 TO TRUE                              DTSCS40
00194          GO TO P1000-EXIT.                                        DTSCS40
00195                                                                   DTSCS40
00196      IF LCCM-F03-88                                               DTSCS40
00197          MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                   DTSCS40
00198          SET RESP-JUMP-88 TO TRUE                                 DTSCS40
00199          GO TO P1000-EXIT.                                        DTSCS40
00200                                                                   DTSCS40
00201      IF LCCM-F04-88                                               DTSCS40
00202          MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                DTSCS40
00203          SET RESP-JUMP-88 TO TRUE                                 DTSCS40
00204          GO TO P1000-EXIT.                                        DTSCS40
00205                                                                   DTSCS40
00206      IF LCCM-F14-88                                               DTSCS40
00207          MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS40
00208          PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT              DTSCS40
00209          IF LCCM-MSG                                              DTSCS40
00210              SET RESP-SCREEN-88 TO TRUE                           DTSCS40
00211              GO TO P1000-EXIT                                     DTSCS40
00212          ELSE                                                     DTSCS40
00213              SET RESP-JUMP-88 TO TRUE                             DTSCS40
00214              GO TO P1000-EXIT.                                    DTSCS40
00215                                                                   DTSCS40
00216      IF MAP-OPT = SPACES OR LOW-VALUES OR WRK-SCR-ID              DTSCS40
00217          MOVE PMSG-KEY-OPTION TO LCCM-MSG-AREA                    DTSCS40
00218          SET RESP-SCREEN-88 TO TRUE                               DTSCS40
00219          GO TO P1000-EXIT.                                        DTSCS40
00220                                                                   DTSCS40
00221      IF MAP-OPT = '1 ' OR ' 1'                                    DTSCS40
00222          MOVE '41' TO LCCM-REQ-SCR-ID                             DTSCS40
00223      ELSE                                                         DTSCS40
00224      IF MAP-OPT = '2 ' OR ' 2'                                    DTSCS40
00225          MOVE '42' TO LCCM-REQ-SCR-ID                             DTSCS40
00226      ELSE                                                         DTSCS40
00227      IF MAP-OPT = '3 ' OR ' 3'                                    DTSCS40
00228          MOVE '43' TO LCCM-REQ-SCR-ID                             DTSCS40
00229      ELSE                                                         DTSCS40
00230      IF MAP-OPT = '4 ' OR ' 4'                                    DTSCS40
00231          MOVE '44' TO LCCM-REQ-SCR-ID                             DTSCS40
00232      ELSE                                                         DTSCS40
00233      IF MAP-OPT = '5 ' OR ' 5'                                    DTSCS40
00234          MOVE '45' TO LCCM-REQ-SCR-ID                             DTSCS40
00235      ELSE                                                         DTSCS40
00236      IF MAP-OPT = '6 ' OR ' 6'                                    DTSCS40
00237          MOVE '46' TO LCCM-REQ-SCR-ID                             DTSCS40
00238      ELSE                                                         DTSCS40
00239      IF MAP-OPT = '7 ' OR ' 7'                                    DTSCS40
00240          MOVE '47' TO LCCM-REQ-SCR-ID                             DTSCS40
00241      ELSE                                                         DTSCS40
00242      IF MAP-OPT = '8 ' OR ' 8'                                    DTSCS40
00243          MOVE '48' TO LCCM-REQ-SCR-ID                             DTSCS40
00244      ELSE                                                         DTSCS40
00245          MOVE MAP-OPT TO LCCM-REQ-SCR-ID.                         DTSCS40
00246                                                                   DTSCS40
00247      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS40
00248      IF LCCM-MSG                                                  DTSCS40
00249          SET RESP-SCREEN-88 TO TRUE                               DTSCS40
00250      ELSE                                                         DTSCS40
00251          SET RESP-JUMP-88 TO TRUE.                                DTSCS40
00252  P1000-EXIT.                                                      DTSCS40
00253      EXIT.                                                        DTSCS40
00254      EJECT                                                        DTSCS40
00255  P2000-CONSTRUCT-S-AREA.                                          DTSCS40
00256      MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.              DTSCS40
00257      MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.              DTSCS40
00258      MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.          DTSCS40
00259                                                                   DTSCS40
00260      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS40
00261  P2000-EXIT.                                                      DTSCS40
00262      EXIT.                                                        DTSCS40
00263      EJECT                                                        DTSCS40
00264  S803-REQ-SCR-ID-EDIT.                                            DTSCS40
00265                                                                   DTSCS40
00266      EXEC CICS                                                    DTSCS40
00267          LINK                                                     DTSCS40
00268              PROGRAM ('DTSCU803')                                 DTSCS40
00269              COMMAREA (DFHCOMMAREA)                               DTSCS40
00270      END-EXEC.                                                    DTSCS40
00271                                                                   DTSCS40
00272  S803-EXIT.                                                       DTSCS40
00273      EXIT.                                                        DTSCS40
00274      SKIP3                                                        DTSCS40
00275  S804-INVALID-KEY.                                                DTSCS40
00276                                                                   DTSCS40
00277      EXEC CICS                                                    DTSCS40
00278          LINK                                                     DTSCS40
00279              PROGRAM ('DTSCU804')                                 DTSCS40
00280              COMMAREA (DFHCOMMAREA)                               DTSCS40
00281      END-EXEC.                                                    DTSCS40
00282                                                                   DTSCS40
00283  S804-EXIT.                                                       DTSCS40
00284      EXIT.                                                        DTSCS40
00285      SKIP3                                                        DTSCS40
00286  S805-MSG-AREA.                                                   DTSCS40
00287      MOVE LCCM-MSG-AREA TO L805-MSG-AREA.                         DTSCS40
00288                                                                   DTSCS40
00289      EXEC CICS                                                    DTSCS40
00290          LINK                                                     DTSCS40
00291              PROGRAM ('DTSCU805')                                 DTSCS40
00292              COMMAREA (L805-COMM-AREA)                            DTSCS40
00293      END-EXEC.                                                    DTSCS40
00294                                                                   DTSCS40
00295      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS40
00296  S805-EXIT.                                                       DTSCS40
00297      EXIT.                                                        DTSCS40
00298      SKIP3                                                        DTSCS40
00299  S851-SCREEN-PROCESSING.                                          DTSCS40
00300      EXEC CICS                                                    DTSCS40
00301          LINK                                                     DTSCS40
00302              PROGRAM ('DTSCU851')                                 DTSCS40
00303              COMMAREA (L851-COMM-AREA)                            DTSCS40
00304      END-EXEC.                                                    DTSCS40
00305  S851-EXIT.                                                       DTSCS40
00306      EXIT.                                                        DTSCS40
00307      SKIP3                                                        DTSCS40
00308  S899-ABEND.                                                      DTSCS40
00309                                                                   DTSCS40
00310      EXEC CICS                                                    DTSCS40
00311          ABEND                                                    DTSCS40
00312              ABCODE (WRK-ABEND-CD)                                DTSCS40
00313      END-EXEC.                                                    DTSCS40
00314                                                                   DTSCS40
00315  S899-EXIT.                                                       DTSCS40
00316      EXIT.                                                        DTSCS40
00317      EJECT                                                        DTSCS40
00318  S1100-RECEIVE.                                                   DTSCS40
00319      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS40
00320      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS40
00321      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS40
00322      MOVE L851-AID TO LCCM-AID.                                   DTSCS40
00323      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS40
00324  S1100-EXIT.                                                      DTSCS40
00325      EXIT.                                                        DTSCS40
00326      SKIP3                                                        DTSCS40
00327  S2100-SEND.                                                      DTSCS40
00328      SET L851-SEND-88 TO TRUE.                                    DTSCS40
00329      PERFORM S2900-PREPARE-SEND THRU S2900-EXIT.                  DTSCS40
00330      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS40
00331  S2100-EXIT.                                                      DTSCS40
00332      EXIT.                                                        DTSCS40
00333      SKIP3                                                        DTSCS40
00334  S2200-SEND-DATAONLY.                                             DTSCS40
00335      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS40
00336      PERFORM S2900-PREPARE-SEND THRU S2900-EXIT.                  DTSCS40
00337      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS40
00338  S2200-EXIT.                                                      DTSCS40
00339      EXIT.                                                        DTSCS40
00340      SKIP3                                                        DTSCS40
00341  S2900-PREPARE-SEND.                                              DTSCS40
00342      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS40
00343                         LCCM-SCR-ID.                              DTSCS40
00344      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS40
00345      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS40
00346      IF CURSOR-SET-88                                             DTSCS40
00347          NEXT SENTENCE                                            DTSCS40
00348      ELSE                                                         DTSCS40
00349          MOVE CATB-CURSOR TO MAP-OPT-L.                           DTSCS40
00350  S2900-EXIT.                                                      DTSCS40
00351      EXIT.                                                        DTSCS40
