diff --git a/CICS/DTSCU357.cob b/CICS/DTSCU357.cob deleted file mode 100644 index 04cba3e..0000000 --- a/CICS/DTSCU357.cob +++ /dev/null @@ -1,319 +0,0 @@ -00001 IDENTIFICATION DIVISION. 08/11/99 -00002 PROGRAM-ID. DTSCU357. DTSCU357 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV013 -00004 DATE-WRITTEN. MAY 1994. DTSCU357 -00005 DATE-COMPILED. DTSCU357 -00006 SKIP3 DTSCU357 -00007 ***** DTSCU357 -00008 * DTSCU357 -00009 * FUNCTION: DTSCU357 -00010 * DTSCU357 -00011 * ON-LINE PRINT UTILITY. DTSCU357 -00012 * DTSCU357 -00013 * DTSCU357 -00014 * MODIFICATION LOG: DTSCU357 -00015 * DTSCU357 -00016 * 05/03/99 INITIAL DEVELOPMENT. COPIED FROM MACCU357. CL**2 -00017 * WORK ORDER: PROGRAMMER: ZL1 CL**2 -00018 * DTSCU357 -00019 * 05/30/95 MOVE REPETITIVE CODE FROM MACCU356 TO HERE. DTSCU357 -00020 * WORK ORDER: PROGRAMMER: RHC CL*12 -00021 * DTSCU357 -00022 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU357 -00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU357 -00024 * WORK ORDER: PROGRAMMER: XXX DTSCU357 -00025 * DTSCU357 -00026 * DTSCU357 -00027 ***** DTSCU357 -00028 SKIP3 DTSCU357 -00029 ENVIRONMENT DIVISION. DTSCU357 -00030 SKIP3 DTSCU357 -00031 DATA DIVISION. DTSCU357 -00032 SKIP3 DTSCU357 -00033 WORKING-STORAGE SECTION. DTSCU357 -000335 77 PAN-VALET PICTURE X(24) VALUE '013DTSCU357 08/11/99'. DTSCU357 -00034 SKIP3 DTSCU357 -00035 01 WRK-AREA. DTSCU357 -00036 05 WRK-ABEND-CD PIC X(04) VALUE 'U357'. DTSCU357 -00037 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU357 -00038 DTSCU357 -00039 05 MAPSET-NAME PIC X(08) VALUE 'DTSMSET'. CL**2 -00040 05 MAP-NAME PIC X(08) VALUE 'DTSMPR'. CL**2 -00041 DTSCU357 -00042 05 WRK-DEVICE-TYPE PIC S9(08) COMP. DTSCU357 -00043 DTSCU357 -00044 05 ITEM-CNT PIC S9(04) COMP. DTSCU357 -00045 DTSCU357 -00046 05 LINE-CNT PIC S9(04) COMP. DTSCU357 -00047 DTSCU357 -00048 05 BLANK-CNT PIC S9(04) COMP. DTSCU357 -00049 DTSCU357 -00050 05 ITEM-LENGTH PIC S9(04) COMP. CL**9 -00051 SKIP3 DTSCU357 -00052 05 ROUTE-LIST. DTSCU357 -00053 10 RT-PRINTER-ID PIC X(04). DTSCU357 -00054 10 RT-LDC-MNEM PIC X(02) VALUE SPACES. DTSCU357 -00055 10 RT-OPERATOR-ID PIC X(03) VALUE SPACES. DTSCU357 -00056 10 RT-STATUS-FLAG PIC X(01). DTSCU357 -00057 10 FILLER PIC X(06) VALUE SPACES. DTSCU357 -00058 10 RT-END-LIST PIC S9(04) COMP VALUE -1. DTSCU357 -00059 EJECT DTSCU357 -00060 01 L356-COMM-AREA. DTSCU357 -00061 ++INCLUDE DTSIL356 CL**2 -00062 EJECT DTSCU357 -00063 01 L829-COMM-AREA. DTSCU357 -00064 05 L829-CONTROL-BLOCK. DTSCU357 -00065 ++INCLUDE DTSIL829 CL**2 -00066 SKIP3 DTSCU357 -00067 05 L829-REC. DTSCU357 -00068 ++INCLUDE DTSIXPTS CL**2 -00069 EJECT DTSCU357 -00070 01 MAP-AREA. DTSCU357 -00071 ++INCLUDE DTSISPR CL**2 -00072 EJECT DTSCU357 -00073 01 CPRT-LITERALS. DTSCU357 -00074 ++INCLUDE DTSICPRT CL**2 -00075 EJECT DTSCU357 -00076 LINKAGE SECTION. DTSCU357 -00077 SKIP3 DTSCU357 -00078 01 DFHCOMMAREA. DTSCU357 -00079 ++INCLUDE DTSIL357 CL**2 -00080 EJECT DTSCU357 -00081 PROCEDURE DIVISION. DTSCU357 -00082 SKIP2 DTSCU357 -00083 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSCU357 -00084 SKIP2 DTSCU357 -00085 EXEC CICS DTSCU357 -00086 RETURN DTSCU357 -00087 END-EXEC. DTSCU357 -00088 SKIP2 DTSCU357 -00089 GOBACK. DTSCU357 -00090 EJECT DTSCU357 -00091 P0000-PROCESS. DTSCU357 -00092 SET L357-OK-88 TO TRUE. DTSCU357 -00093 DTSCU357 -00094 MOVE LOW-VALUES TO MAP-AREA. DTSCU357 -00095 DTSCU357 -00096 MOVE L357-QUEUE-NAME TO L829-QUEUE-NAME. DTSCU357 -00097 DTSCU357 -00098 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCU357 -00099 DTSCU357 -00100 MOVE L357-PRINTER-ID TO RT-PRINTER-ID. DTSCU357 -00101 DTSCU357 -00102 EXEC CICS DTSCU357 -00103 ROUTE DTSCU357 -00104 LIST (ROUTE-LIST) DTSCU357 -00105 NLEOM DTSCU357 -00106 RESP (WRK-RESP-CD) DTSCU357 -00107 END-EXEC. DTSCU357 -00108 DTSCU357 -00109 IF WRK-RESP-CD = DFHRESP (RTEFAIL) DTSCU357 -00110 SET L357-FAILED-88 TO TRUE DTSCU357 -00111 MOVE +0 TO L829-REC-LENGTH DTSCU357 -00112 PERFORM S829-DELETE-QUEUE THRU S829-EXIT DTSCU357 -00113 GO TO P0000-EXIT. DTSCU357 -00114 DTSCU357 -00115 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU357 -00116 NEXT SENTENCE DTSCU357 -00117 ELSE DTSCU357 -00118 GO TO S899-ABEND. DTSCU357 -00119 DTSCU357 -00120 MOVE L357-PRINTER-ID TO L356-DEVICE-ID. DTSCU357 -00121 DTSCU357 -00122 ***** DTSCU357 -00123 * DTSCU357 -00124 * THE FOLLOWING BIT OF CODE DETERMINES WHETHER OR NOT DTSCU357 -00125 * THE DEVICE TO WHICH THE PRINT IS BEING SENT IS A DTSCU357 -00126 * DEVICE THAT CAN ACCEPT HP LASER JET PRINTER CONTROL DTSCU357 -00127 * (PCL5) COMMANDS. DTSCU357 -00128 * DTSCU357 -00129 * THIS CODE DEPENDS ON THE HP LASER JET PRINTERS BEING DTSCU357 -00130 * DEFINED AS T3790SCSP TYPE DEVICES IN THE CICS TCT. DTSCU357 -00131 * DTSCU357 -00132 * DON GRINSELL SAYS THAT THIS IS LIKELY TO REMAIN TRUE. DTSCU357 -00133 * DTSCU357 -00134 * INTERESTINGLY, THE INQUIRE COMMAND IS PART OF THE COMMAND DTSCU357 -00135 * LEVEL API BUT IS NOT DESCRIBED IN THE COMMAND LEVEL DTSCU357 -00136 * APPLICATION PROGRAMMERS REFERENCE. THE INQUIRE COMMAND DTSCU357 -00137 * IS DESCRIBED IN CHAPTER 5.9 OF THE CICS CUSTOMIZATION GUIDE. DTSCU357 -00138 * DTSCU357 -00139 ***** DTSCU357 -00140 DTSCU357 -00141 EXEC CICS CL**6 -00142 INQUIRE CL**5 -00143 TERMINAL (L356-DEVICE-ID) CL**5 -00144 DEVICE (WRK-DEVICE-TYPE) CL**7 -00145 RESP (WRK-RESP-CD) CL**5 -00146 END-EXEC. CL**5 -00147 DTSCU357 -00148 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU357 -00149 IF WRK-DEVICE-TYPE = DFHVALUE (T3790SCSP) DTSCU357 -00150 SET L356-DEVICE-PCL5-YES-88 TO TRUE DTSCU357 -00151 ELSE DTSCU357 -00152 SET L356-DEVICE-PCL5-NO-88 TO TRUE DTSCU357 -00153 ELSE DTSCU357 -00154 SET L356-DEVICE-PCL5-NO-88 TO TRUE. DTSCU357 -00155 SKIP3 DTSCU357 -00156 MOVE +0 TO LINE-CNT. DTSCU357 -00157 DTSCU357 -00158 MOVE +0 TO ITEM-CNT. DTSCU357 -00159 DTSCU357 -00160 MOVE LENGTH OF L829-REC TO ITEM-LENGTH. CL**9 -00161 DTSCU357 -00162 SET L829-OK-88 TO TRUE. DTSCU357 -00163 DTSCU357 -00164 DTSCU357 -00165 PERFORM P1000-LINE THRU P1000-EXIT DTSCU357 -00166 UNTIL L829-NO-REC-88. DTSCU357 -00167 DTSCU357 -00168 DTSCU357 -00169 IF ITEM-CNT = +0 DTSCU357 -00170 NEXT SENTENCE DTSCU357 -00171 ELSE DTSCU357 -00172 PERFORM P0100-COMPLETE-PAGE THRU P0100-EXIT. DTSCU357 -00173 SKIP1 DTSCU357 -00174 EXEC CICS DTSCU357 -00175 SEND PAGE DTSCU357 -00176 RESP (WRK-RESP-CD) DTSCU357 -00177 END-EXEC. DTSCU357 -00178 SKIP1 DTSCU357 -00179 MOVE +0 TO L829-REC-LENGTH. DTSCU357 -00180 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCU357 -00181 SKIP1 DTSCU357 -00182 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCU357 -00183 P0000-EXIT. DTSCU357 -00184 EXIT. DTSCU357 -00185 SKIP3 DTSCU357 -00186 P0100-COMPLETE-PAGE. DTSCU357 -00187 IF LINE-CNT < +60 DTSCU357 -00188 COMPUTE BLANK-CNT = 60 - LINE-CNT DTSCU357 -00189 PERFORM DTSCU357 -00190 BLANK-CNT TIMES DTSCU357 -00191 MOVE SPACES TO MAP-PRINT-LINE DTSCU357 -00192 PERFORM S1000-SEND-ACCUM THRU S1000-EXIT DTSCU357 -00193 END-PERFORM. DTSCU357 -00194 P0100-EXIT. DTSCU357 -00195 EXIT. DTSCU357 -00196 EJECT DTSCU357 -00197 P1000-LINE. DTSCU357 -00198 ADD +1 TO ITEM-CNT. DTSCU357 -00199 SKIP1 DTSCU357 -00200 MOVE ITEM-LENGTH TO L829-REC-LENGTH. DTSCU357 -00201 MOVE ITEM-CNT TO L829-ITEM-NO. DTSCU357 -00202 SKIP1 DTSCU357 -00203 PERFORM S829-READ-ITEM THRU S829-EXIT. DTSCU357 -00204 SKIP1 DTSCU357 -00205 IF L829-NO-REC-88 DTSCU357 -00206 SUBTRACT 1 FROM ITEM-CNT DTSCU357 -00207 GO TO P1000-EXIT. DTSCU357 -00208 SKIP1 DTSCU357 -00209 MOVE SPACES TO MAP-PRINT-LINE. DTSCU357 -00210 SKIP1 DTSCU357 -00211 IF XPTS-FF-88 DTSCU357 -00212 IF ITEM-CNT = +1 DTSCU357 -00213 PERFORM P1100-FORM-FEED THRU P1100-EXIT DTSCU357 -00214 ELSE DTSCU357 -00215 PERFORM P1200-COMPLETE-PAGE THRU P1200-EXIT DTSCU357 -00216 PERFORM P1100-FORM-FEED THRU P1100-EXIT DTSCU357 -00217 ELSE DTSCU357 -00218 IF XPTS-DS-88 DTSCU357 -00219 MOVE SPACE TO MAP-PRINT-LINE DTSCU357 -00220 PERFORM S1000-SEND-ACCUM THRU S1000-EXIT DTSCU357 -00221 MOVE XPTS-DATA TO MAP-PRINT-LINE DTSCU357 -00222 ELSE DTSCU357 -00223 IF XPTS-TS-88 DTSCU357 -00224 MOVE SPACE TO MAP-PRINT-LINE DTSCU357 -00225 PERFORM S1000-SEND-ACCUM THRU S1000-EXIT DTSCU357 -00226 MOVE SPACE TO MAP-PRINT-LINE DTSCU357 -00227 PERFORM S1000-SEND-ACCUM THRU S1000-EXIT DTSCU357 -00228 MOVE XPTS-DATA TO MAP-PRINT-LINE DTSCU357 -00229 ELSE DTSCU357 -00230 MOVE XPTS-DATA TO MAP-PRINT-LINE. DTSCU357 -00231 SKIP1 DTSCU357 -00232 PERFORM S1000-SEND-ACCUM THRU S1000-EXIT. DTSCU357 -00233 P1000-EXIT. DTSCU357 -00234 EXIT. DTSCU357 -00235 SKIP3 DTSCU357 -00236 P1100-FORM-FEED. DTSCU357 -00237 MOVE SPACE TO MAP-PRINT-LINE. DTSCU357 -00238 DTSCU357 -00239 STRING DTSCU357 -00240 CPRT-FORM-FEED DELIMITED BY SIZE DTSCU357 -00241 XPTS-DATA DELIMITED BY SIZE DTSCU357 -00242 INTO DTSCU357 -00243 MAP-PRINT-LINE. DTSCU357 -00244 DTSCU357 -00245 MOVE +0 TO LINE-CNT. DTSCU357 -00246 P1100-EXIT. DTSCU357 -00247 EXIT. DTSCU357 -00248 SKIP3 DTSCU357 -00249 P1200-COMPLETE-PAGE. DTSCU357 -00250 IF LINE-CNT < +60 DTSCU357 -00251 COMPUTE BLANK-CNT = 60 - LINE-CNT DTSCU357 -00252 PERFORM DTSCU357 -00253 BLANK-CNT TIMES DTSCU357 -00254 MOVE SPACES TO MAP-PRINT-LINE DTSCU357 -00255 PERFORM S1000-SEND-ACCUM THRU S1000-EXIT DTSCU357 -00256 END-PERFORM. DTSCU357 -00257 P1200-EXIT. DTSCU357 -00258 EXIT. DTSCU357 -00259 EJECT DTSCU357 -00260 S829-READ-ITEM. DTSCU357 -00261 SET L829-READ-ITEM-88 TO TRUE. DTSCU357 -00262 GO TO S829-TS-IO. DTSCU357 -00263 SKIP1 DTSCU357 -00264 S829-DELETE-QUEUE. DTSCU357 -00265 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCU357 -00266 GO TO S829-TS-IO. DTSCU357 -00267 SKIP1 DTSCU357 -00268 S829-TS-IO. DTSCU357 -00269 SKIP1 DTSCU357 -00270 EXEC CICS DTSCU357 -00271 LINK DTSCU357 -00272 PROGRAM ('DTSCU829') CL**2 -00273 COMMAREA (L829-COMM-AREA) DTSCU357 -00274 END-EXEC. DTSCU357 -00275 S829-EXIT. DTSCU357 -00276 EXIT. DTSCU357 -00277 SKIP3 DTSCU357 -00278 S899-ABEND. DTSCU357 -00279 SKIP1 DTSCU357 -00280 EXEC CICS DTSCU357 -00281 ABEND DTSCU357 -00282 ABCODE (WRK-ABEND-CD) DTSCU357 -00283 END-EXEC. DTSCU357 -00284 SKIP1 DTSCU357 -00285 S899-EXIT. DTSCU357 -00286 EXIT. DTSCU357 -00287 EJECT DTSCU357 -00288 S1000-SEND-ACCUM. DTSCU357 -00289 MOVE MAP-PRINT-LINE TO L356-PRINT-LINE. DTSCU357 -00290 DTSCU357 -00291 EXEC CICS DTSCU357 -00292 LINK DTSCU357 -00293 PROGRAM('DTSCU356') CL**2 -00294 COMMAREA (L356-COMM-AREA) DTSCU357 -00295 END-EXEC. DTSCU357 -00296 DTSCU357 -00297 MOVE L356-PRINT-LINE TO MAP-PRINT-LINE. DTSCU357 -00298 DTSCU357 -00299 EXEC CICS DTSCU357 -00300 SEND DTSCU357 -00301 MAP (MAP-NAME) DTSCU357 -00302 MAPSET (MAPSET-NAME) DTSCU357 -00303 FROM (MAP-AREA) DTSCU357 -00304 ERASE DTSCU357 -00305 PAGING CL*11 -00306 ACCUM CL*10 -00307 RESP (WRK-RESP-CD) DTSCU357 -00308 END-EXEC. DTSCU357 -00309 CL*13 -00310 IF WRK-RESP-CD = DFHRESP (NORMAL) CL*13 -00311 NEXT SENTENCE CL*13 -00312 ELSE CL*13 -00313 GO TO S899-ABEND. CL*13 -00314 CL*13 -00315 DTSCU357 -00316 ADD +1 TO LINE-CNT. DTSCU357 -00317 S1000-EXIT. DTSCU357 -00318 EXIT. DTSCU357