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