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