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
