[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

method to read spooled files from an outq in a program

Posted on 2004-11-17
3
Medium Priority
?
927 Views
Last Modified: 2009-12-16
What would a program look like to read all the spool files from a outq and do something with them?

thanks,

Don
0
Comment
Question by:dprice7
2 Comments
 
LVL 1

Accepted Solution

by:
odumbruce earned 500 total points
ID: 12613630
I have a program that will do that based on some setup files that allow you to change some spool options.  I wrote it a long time ago and it still keeps on trucking.  It uses the spool API's Its a little big to post here but I can if you wish.  Or send me an email at bodum@usxpress.com and i will see about getting you a copy.  Here is the code without the files     F****************************************************************
     F*               Program Description
     F****************************************************************
     F*
     F*  APPLICATION : Print Handling
     F*  PROGRAM     : PTR00011
     F*  PROGRAMMER  : Bruce Odum
     F*  DATE        : 07/03/95
     F*
     F*  FUNCTION    :  Spool File Distribution
     F*
     F*****************************************************************
     F* APIs USED:                                                    *
     F*            QUSCRTUS -- Create User Space                      *
     F*            QUSLSPL  -- List Spooled Files                     *
     F*            QUSRTVUS -- Retrieve User Space                    *
     F*            QUSRSPLA -- Retrieve Spooled File Attributes       *
     F*            QUSDLTUS -- Delete User Space                      *
     F*            QSPGETSP -- Get Spooled File Data                  *
     F*            QSPOPNSP -- Open Spooled File                      *
     F*            QSPCLOSP -- Close Spooled File                     *
     F*            QSPPUTSP -- Put Spooled File Data                  *
     F*ptpd      QSPCRTSP -- Create Spooled File                    *
     F*                                                               *
     F* ***************************************************************
     F* Print File Control
     FPTPCTL01  IF   E           K DISK
     F                                     INFDS(@FIL01)
     F* Print Outq Control
     FPTPQUE01  IF   E           K DISK
     F                                     INFDS(@FIL02)
     F* Print Distribution Control
     FPTPDST01  IF   E           K DISK
     F                                     INFDS(@FIL03)
     D*  Command Override
     D CM              S              1    DIM(160) CTDATA PERRCD(80)           Chg Splf
     D CMA             S              1    DIM(75) CTDATA PERRCD(75)            Hld Splf
     D CMB             S              1    DIM(75) CTDATA PERRCD(75)            Dlt Splf
     D CMC             S              1    DIM(160) CTDATA PERRCD(80)           Chg Splf
     D HAN             S              4  0 DIM(50)                              Splf Handle
     D QUE             S             10    DIM(50)                              Splf Outq
     D LIB             S             10    DIM(50)                              Splf Lib
     D USR             S             10    DIM(50)                              Splf User
     D FTP             S             10    DIM(50)                              Form Type
     D UDT             S             10    DIM(50)                              User Data
     D HLD             S             10    DIM(50)                              Hold Print
     D SAV             S             10    DIM(50)                              Save Print
     D CPY             S              3  0 DIM(50)                              Nbr. Copies
     D*  DS: General Data Structure's For API Work Fields
     D STRUCT          DS
     D  USSIZE                 1      4B 0
     D  GENLEN                 5      8B 0
     D  RTVLEN                 9     12B 0
     D  STRPOS                13     16B 0
     D  RCVLEN                17     20B 0
     D  SPLF#                 21     24B 0
     D  MSGDLN                25     28B 0
     D  MSGQ#                 29     32B 0
     D  FIL#                  33     38
     D  USRSP1                39     58    INZ('SPLIST    QTEMP     ')
     D  OUTQ                  59     78    INZ('                    ')
     D  USRNME                79     88    INZ('*ALL      ')
     D  SECHND                89     92B 0
     D  ORDBUF                93     96B 0
     D  USRSP2                97    116    INZ('SPLGET    QTEMP     ')
     D  PRIHND               117    120B 0
     D  GETBUF               121    124B 0
     D  IJOBW                125    140
     D  STRPS2               141    144B 0
     D*  DS: Error Data Structure's For API Usage
     D ERRCOD          DS
     D  BYTPRO                 1      4B 0
     D  BYTAVA                 5      8B 0
     D  EXCID                  9     15
     D  RSRVD                 16     16
     D  EXCDTA                17    116
     D*  DS: Header Data Structure For QSPGETSP API
     D GETHDR          DS
     D  GENUSR                 1     64
     D  HEDSIZ                65     68B 0
     D  STRLVL                69     72
     D  SPFLVL                73     78
     D  GETSTR                79     86
     D  INFCMP                87     87
     D  RES001                88     88
     D  SPCUSD                89     92B 0
     D  OFFFST                93     96B 0
     D  REQBUF                97    100B 0
     D  RETBUF               101    104B 0
     D  PRTSIZ               105    108B 0
     D  RES002               109    128
     D*  DS: Header Data Structure For QUSRTVUS API Used To Find
     D*      Offset To Data In List
     D GENHDR          DS
     D  OFFSET                 1      4B 0
     D  NUMENT                 9     12B 0
     D  LSTSIZ                13     16B 0
     D*  DS: Detail Data Structure For QUSRTVUS API Used To Retrieve
     D*      Job Identifier And Spool File
     D RTVVAR          DS
     D  USRNM1                 1     10
     D  OUTQNA                11     30
     D  USRDT1                31     40
     D  FRMTY1                41     50
     D  IJOBID                51     66
     D  ISPLID                67     82
     D*  DS: Spool File SPLA0200 Data Structure's
     D RCVVAR          DS
     D  BYTRTN                 1      4B 0
     D  BYTVAL                 5      8B 0
     D  FMTNAM                 9     16
     D  JOBID                 17     32
     D  SPLFID                33     48
     D  JOBNAM                49     58
     D  USRNAM                59     68
     D  JOBNUM                69     74
     D  QJOBNM                49     74
     D  FILNAM                75     84
     D  FILNUM                85     88B 0
     D  FRMTYP                89     98
     D  USRDTA                99    108
     D  STATUS               109    118
     D  FILAVL               119    128
     D  HLDF                 129    138
     D  SAVF                 139    148
     D  TOTPAG               149    152B 0
     D  PAGWRT               153    156B 0
     D  STRPAG               157    160B 0
     D  ENDPAG               161    164B 0
     D  LASPAG               165    168B 0
     D  RESPRT               169    172B 0
     D  TOTCPY               173    176B 0
     D  CPYLFT               177    180B 0
     D  LPI                  181    184B 0
     D  CPI                  185    188B 0
     D  OUTPRI               189    190
     D  OUTQNM               191    200
     D  OUTQLB               201    210
     D  DATFOP               211    217
     D  TIMFOP               218    223
     D  DEVFNA               224    233
     D  DEVFLB               234    243
     D  PGMOPF               244    253
     D  PGMOPL               254    263
     D  ACCCOD               264    278
     D  PRTTXT               279    308
     D  RCDLEN               309    312B 0
     D  MAXRCD               313    316B 0
     D  DEVCLS               317    326
     D  PRTTYP               327    336
     D  DOCNAM               337    348
     D  FLDNAM               349    412
     D  S36PRC               413    420
     D  PRTFID               421    430
     D  RPLUN                431    431
     D  RPLCHR               432    432
     D  PAGLEN               433    436B 0
     D  PAGWID               437    440B 0
     D  NUMSEP               441    444B 0
     D  OVRLIN               445    448B 0
     D  DBCSDA               449    458
     D  DBCSEC               459    468
     D  DBCSSO               469    478
     D  DBCSCR               479    488
     D  DBCSCI               489    492B 0
     D  GRAPHI               493    502
     D  CODPAG               503    512
     D  FORNAM               513    522
     D  FORLIB               523    532
     D  SRCDRW               533    536B 0
     D  PRTFON               537    546
     D  S36SPL               547    552
     D  PAGROT               553    556B 0
     D  JUSTIF               557    560B 0
     D  PRTBOT               561    570
     D  FLDRCD               571    580
     D  CTLCHR               581    590
     D  ALGFRM               591    600
     D  PRTQUA               601    610
     D  FRMFED               611    620
     D  VOLUME               621    691
     D  FLABID               692    708
     D  EXCTYP               709    718
     D  CHRCOD               719    728
     D  TOTRCD               729    732B 0
     D  PGPSID               733    736B 0
     D  FOVNAM               737    746
     D  FOVLIB               747    756
     D  FOVOFD               757    764P 5
     D  FOVOFA               765    772P 5
     D  BOVNAM               773    782
     D  BOVLIB               783    792
     D  BOVOFD               793    800P 5
     D  BOVOFA               801    808P 5
     D  UOM                  809    818
     D  PAGNAM               819    828
     D  PAGLIB               829    838
     D  LINSPC               839    848
     D  PNTSIZ               849    856P 5
     D  MAXSIZ               857    860B 0
     D  BUFSIZ               861    864B 0
     D  SPLLVL               865    870
     D  CODFNT               871    886
     D  CHLMOD               887    896
     D  CHLCOD               897    944
     D  GPHTKN               945    952
     D  RECFMT               953    962
     D  RSVRD1               963    964
     D  HGTDW1               965    972P 5
     D  WIDDW1               973    980P 5
     D  HGTDW2               981    988P 5
     D  WIDDW2               989    996P 5
     D  NBRBUF               997   1000B 0
     D  MAXFMW              1001   1004B 0
     D  ALTFMW              1005   1008B 0
     D  ALTFML              1009   1012B 0
     D  ALTLPI              1013   1016B 0
     D  TXTFLG              1017   1018
     D  FILOPN              1019   1019
     D  PGEEST              1020   1020
     D  PGEBND              1021   1021
     D  TRCCHR              1022   1022
     D  DEFCHR              1023   1023
     D  CHRCPI              1024   1024
     D  TRANSP              1025   1025
     D  DBLWID              1026   1026
     D  CHRROT              1027   1027
     D  CODPGE              1028   1028
     D  FFTEMP              1029   1029
     D  SCS381              1030   1030
     D  SETLDN              1031   1031
     D  GPHERA              1032   1032
     D  CMD521              1033   1033
     D  CMD381              1034   1034
     D  OUTLIN              1035   1035
     D  FORMTX              1036   1036
     D  BARCOD              1037   1037
     D  COLOR               1038   1038
     D  DWRCHG              1039   1039
     D  CHARID              1040   1040
     D  FLGLPI              1041   1041
     D  FLGFNT              1042   1042
     D  HIGHLI              1043   1043
     D  PGEROT              1044   1044
     D  SUBSCR              1045   1045
     D  SUPSCR              1046   1046
     D  FLGDDS              1047   1047
     D  FORMFD              1048   1048
     D  SCSDTA              1049   1049
     D  USRGEN              1050   1050
     D  GRPHIC              1051   1051
     D  UNRDTA              1052   1052
     D  ASCIIT              1053   1053
     D  IPDSTR              1054   1054
     D  OFFVIS              1055   1055
     D  LPINOS              1056   1056
     D  CPAMSG              1057   1057
     D  SETEXC              1058   1058
     D  CARRCC              1059   1059
     D  PAGPOS              1060   1060
     D  INVCHR              1061   1061
     D  LNGTHS              1062   1062
     D  PRES5A              1063   1063
     D  RSVRD2              1064   1064
     D  NBRFNT              1065   1068B 0
     D  NBRLIB              1069   1072B 0
     D  FNTAR1              1073   1328
     D  FNTAR2              1329   1584
     D  FNTAR3              1585   1840
     D  FNTAR4              1841   2096
     D  FNTAR5              2097   2225
     D  LIBAR1              2226   2475
     D  LIBAR2              2476   2725
     D  LIBAR3              2726   2856
     D  NTVAFP              2857   2857
     D  JOBSID              2858   2858
     D  RSVRD3              2859   3114
     D  RSVRD4              3115   3153
     D  FMRFOD              3153   3160P 5
     D  FMRFOA              3161   3168P 5
     D  BMRFOD              3169   3176P 5
     D  BMRFOA              3177   3184P 5
     D  MPGLEN              3185   3192P 5
     D  MPGWID              3193   3200P 5
     D  MEAMTH              3201   3210
     D  AFPRES              3211   3211
     D  FCHSNM              3212   3221
     D  FCHSLB              3222   3231
     D  CDPGNM              3232   3241
     D  CDPGLB              3242   3251
     D  CFNTNM              3252   3261
     D  CFNTLB              3262   3271
     D  DCFTNM              3272   3281
     D  DCFTLB              3282   3291
     D  USRFIL              3292   3301
     D* IFD Structure For Printer Control File
     D @FIL01          DS
     D  @FLN01           *FILE
     D  @STP01           *STATUS
     D* IFD Structure For Printer Outq File
     D @FIL02          DS
     D  @FLN02           *FILE
     D  @STP02           *STATUS
     D* IFD Structure For Printer Distribution File
     D @FIL03          DS
     D  @FLN03           *FILE
     D  @STP03           *STATUS
     ‚* Work Fields
     D bytecnt         S              5s 0
     D wfilnam         S             10
     š*
     š**************************************************************************
     ƒ* Program Mainline
     š**************************************************************************
     š* Retrieve First Spool File
     C     *LOVAL        SETLL     PTPCTL01
     C                   READ      PTPCTL01                               99
     š* Process All Spool Files In Control File
     C     @STP01        DOWEQ     @FOUND
     š*
     C                   MOVEL     PRSPLF        OUTQ
     C                   MOVE      PRSLIB        OUTQ
     š* Create A User Space
     C                   EXSR      #CUSER
     š* Fill User Space With Spool File Data For Que Entered
     C                   EXSR      #FUSER
     š* Query User Space Retreive For Offset and Size
     C                   EXSR      #QUSER
     š* Build Selection List And Process
     C                   EXSR      #BUILD
     š* Delete User Space
     C                   EXSR      #DUSER
     š*
     C                   READ      PTPCTL01                               99
     š*
     C                   ENDDO
     š*
     C                   MOVE      *ON           *INLR
     *                                                    
     **************************************************************************
     “* Subroutine #BUILD - Build List
     **************************************************************************
     *
     C     #BUILD        BEGSR
     š*
     C     COUNT         DOWLE     NUMENT
     š* Retrieve Job Identifier And Spool File.
     C                   CALL      'QUSRTVUS'
     C                   PARM                    USRSP1
     C                   PARM                    STRPOS
     C                   PARM                    RTVLEN
     C                   PARM                    RTVVAR
     C                   PARM                    ERRCOD
     š* Retrieve Spool File Attributes
     C                   MOVE      *BLANKS       JOBINF
     C                   MOVEL     '*INT'        JOBINF           26
     C                   MOVE      IJOBID        JOBID
     C                   MOVE      ISPLID        SPLFID
     C                   MOVEL     '*INT'        SPLFNM           10
     C                   MOVE      *BLANKS       SPLF#
     š*
     C                   CALL      'QUSRSPLA'
     C                   PARM                    RCVVAR
     C                   PARM                    RCVLEN
     C                   PARM      'SPLA0200'    FMTNM2            8
     C                   PARM                    JOBINF
     C                   PARM                    JOBID
     C                   PARM                    SPLFID
     C                   PARM                    SPLFNM
     C                   PARM                    SPLF#
     C                   PARM                    ERRCOD
     š* If Status Is Set To *READY Continue
     C     STATUS        IFEQ      '*READY'
     š* Chain User Que Control File And Process Using File, User, Userdata
     C     KEY02A        CHAIN     PTPQUE01                           99
     š* If Not Found Try With File And User Name Only
     C     @STP02        IFNE      @FOUND
     C     KEY02B        CHAIN     PTPQUE01                           99
     C                   ENDIF
     š*
     C     @STP02        IFEQ      @FOUND
     š* If Record Is Active Continue
     C     PRACTV        IFEQ      'Y'
     š*
     C                   Z-ADD     FILNUM        FILNMX
     š*
     C                   MOVE      *BLANKS       FileName        100
     C                   MOVE      *BLANKS       ZipFile         100
     C                   MOVE      FILNAM        #BLDA1           10
     C                   MOVE      *BLANKS       #BLDA2           28
     C                   MOVE      FILNMX        #BLDA3            4
     C                   MOVE      *BLANKS       #BLDA4           21
     C                   MOVE      *BLANKS       #BLDA5           14
     C                   MOVE      *BLANKS       #BLDA6            4
     C                   MOVE      '/CSD'        #BLDA6
     C                   Eval      bytecnt = %Len(%Trim(filnam))
     C                   move      *all'_'       wfilnam
     C                   eval      %subst(wfilnam:1:bytecnt) = filnam
     C     wfilnam       CAT       '.PDF':0      #BLDA5
     C     #bldA6        CAT       '/':0         filename
     C     filename      CAT       #blda5:0      filename
     C     filename      CAT       '.gz':0       zipfile
     š*
     C     JOBNUM        CAT       '/':0         #BLDA2
     C     #BLDA2        CAT       USRNAM:0      #BLDA2
     C     #BLDA2        CAT       '/':0         #BLDA2
     C     #BLDA2        CAT       JOBNAM:0      #BLDA2
     C     PRTLIB        CAT       '/':0         #BLDA4
     C     #BLDA4        CAT       PRTOTQ:0      #BLDA4
     š* Hold Spool File If Requested
     C     PRTHLD        IFEQ      '*YES'
     C                   MOVEA     #BLDA1        CMA(14)
     C                   MOVEA     #BLDA2        CMA(30)
     C                   MOVEA     #BLDA3        CMA(67)
     š*
     C                   CALL      'QCMDEXC'                            99
     C                   PARM                    CMA
     C                   PARM      75            LGTH             15 5
     š*
     C                   ENDIF
     š* Process Distribution If Selected
     C     PRTDST        IFEQ      'Y'
     š*
     C     PRTSAV        IFEQ      '*YES'
     C                   MOVEL     '*YES'        SAVF
     C                   ENDIF
     š*
     C     PRTHLD        IFEQ      '*YES'
     C                   MOVEL     '*YES'        HLDF
     C                   ENDIF
     š*
     C                   EXSR      #SDIST
     š*
     C                   ENDIF
     š*
     C                   ENDIF
     š* Remove Spool File From Que?
     C     PRTRBS        IFEQ      '*YES'
     š*
     C                   MOVEA     #BLDA1        CMB(14)
     C                   MOVEA     #BLDA2        CMB(30)
     C                   MOVEA     #BLDA3        CMB(67)
     š*
     C                   CALL      'QCMDEXC'                            99
     C                   PARM                    CMB
     C                   PARM      75            LGTH             15 5
     š*
     C                   ELSE
     š* Change Spool File Attributes
     C                   If        Prtotq <> *blanks
     C                   MOVEA     #BLDA1        CM(15)
     C                   MOVEA     #BLDA2        CM(31)
     C                   MOVEA     #BLDA3        CM(68)
     C                   MOVEA     PRTCOP        CM(81)
     C                   MOVEA     #BLDA4        CM(93)
     C                   MOVEA     PRTSAV        CM(121)
     &#154;*
     C                   CALL      'QCMDEXC'                            99
     C                   PARM                    CM
     C                   PARM      160           LGTH             15 5
     &#154;*
     C                   ENDIF
     C                   ENDIF
     &#154;*
     C                   ENDIF
     &#154;*
     C                   ENDIF
     &#154;*
     C*                  ENDIF
     &#154;* Adjust STRPOS To Position To Next Spool File Entry
     C     LSTSIZ        ADD       STRPOS        STRPOS
     C     1             ADD       COUNT         COUNT
     &#154;*
     C                   ENDDO
     &#154;*
     C                   ENDSR
     *
     **************************************************************************
     &#147;* Subroutine #CSUER - Create User Space
     **************************************************************************
     *
     C     #CUSER        BEGSR
     &#154;*
     C                   CALL      'QUSCRTUS'
     C                   PARM                    USRSP1
     C                   PARM      *BLANKS       USEXAT           10
     C                   PARM      1024          USSIZE
     C                   PARM      ' '           USINIT            1
     C                   PARM      '*CHANGE '    USAUTH           10
     C                   PARM      *BLANKS       USTEXT           50
     C                   PARM      '*YES    '    USREPL           10
     C                   PARM                    ERRCOD
     &#154;*
     C                   ENDSR
     *
     **************************************************************************
     &#147;* Subroutine #DUSER - Delete User Space
     **************************************************************************
     *
     C     #DUSER        BEGSR
     &#154;*
     C                   CALL      'QUSDLTUS'
     C                   PARM                    USRSP1
     C                   PARM                    ERRCOD
     &#154;*
     C                   ENDSR
     *
     **************************************************************************
     &#147;* Subroutine #FUSER - Fill User Space With Spool File Data
     **************************************************************************
     *
     C     #FUSER        BEGSR
     &#154;*
     C                   CALL      'QUSLSPL'
     C                   PARM                    USRSP1
     C                   PARM      'SPLF0100'    FMTNM1            8
     C                   PARM                    USRNME
     C                   PARM                    OUTQ
     C                   PARM      '*ALL    '    FRMTYP           10
     C                   PARM      '*ALL    '    USRDTA           10
     C                   PARM                    ERRCOD
     &#154;*
     C                   ENDSR
     *
     **************************************************************************
     &#147;* Subroutine #QUSER - Query User Space Get Size And Offset
     **************************************************************************
     *
     C     #QUSER        BEGSR
     &#154;*
     C                   Z-ADD     16            GENLEN
     C                   Z-ADD     125           STRPOS
     &#154;*
     C                   CALL      'QUSRTVUS'
     C                   PARM                    USRSP1
     C                   PARM                    STRPOS
     C                   PARM                    GENLEN
     C                   PARM                    GENHDR
     C                   PARM                    ERRCOD
     &#154;* Check Header For Number Of Entries, Offset To List And Size
     C                   Z-ADD     OFFSET        STRPOS
     C                   ADD       1             STRPOS
     C                   Z-ADD     LSTSIZ        RTVLEN
     C                   Z-ADD     3301          RCVLEN
     C                   Z-ADD     1             COUNT            15 0
     &#154;*
     C                   ENDSR
     *
     **************************************************************************
     &#147;* Subroutine #SDIST - Spool File Distribution
     **************************************************************************
     *
     C     #SDIST        BEGSR
     &#154;* Clear work fields
     C                   MOVE      *BLANKS       IJOBW
     C                   Z-ADD     0             SECHND
     C                   Z-ADD     0             PRIHND
     C                   Z-ADD     8             GETBUF
     C                   Z-ADD     0             HAN
     C                   Z-ADD     0             W
     C                   Z-ADD     0             X
     C                   Z-ADD     0             Y
     C                   MOVE      *BLANKS       QUE
     C                   MOVE      *BLANKS       LIB
     C                   MOVE      *BLANKS       USR
     C                   MOVE      *BLANKS       UDT
     C                   MOVE      *BLANKS       FTP
     C                   MOVE      *BLANKS       HLD
     C                   MOVE      *BLANKS       SAV
     C                   Z-ADD     0             CPY
     &#154;* Save Primary User Information
     C                   MOVE      OUTQNM        SOUTQ
     C                   MOVE      OUTQLB        SLIB
     C                   MOVE      USRNAM        SNAME
     C                   MOVE      USRDTA        SUDTA
     C                   MOVE      QJOBNM        SJOBNM
     C                   MOVE      FRMTYP        SFRMT
     C                   MOVE      HLDF          SHLDP
     C                   MOVE      SAVF          SSAVF
     C                   Z-ADD     CPYLFT        SCOPY
     &#154;* Read Distribution List Till End
     C     KEY03         CHAIN     PTPDST01                           99
     C     @STP03        DOWEQ     @FOUND
     &#154;*
     C                   If        Prdotq <> *blanks
     C                   ADD       1             X
     C                   MOVE      PRDOTQ        QUE(X)
     C                   MOVE      PRDLIB        LIB(X)
     C                   MOVE      PRDNUS        USR(X)
     C                   MOVE      PRDFRM        FTP(X)
     C                   MOVEL     PRDHLD        HLD(X)
     C                   MOVEL     PRDSAV        SAV(X)
     C                   Z-ADD     PRDCOP        CPY(X)
     C                   SELECT
     C     PRDFAX        WHENGT    *BLANKS
     C                   MOVE      PRDFAX        UDT(X)
     C     PRDFAX        WHENEQ    *BLANKS
     C                   MOVE      SUDTA         UDT(X)
     C                   ENDSL
     C                   Endif
     &#154;* PDF File
     C                   If        Prdpdf = 'Y'
     C                   MOVEA     #BLDA1        CMC(21)
     C                   MOVEA     #BLDA5        CMC(40)
     C                   MOVEA     #BLDA6        CMC(63)
     C                   MOVEA     #BLDA2        CMC(74)
     C                   MOVEA     #BLDA3        CMC(111)
     &#154;*
     C*                  CALL      'QCMDEXC'                            99
     C                   CALL      'QCMDEXC'
     C                   PARM                    CMC
     C                   PARM      160           LGTH             15 5
     C                   Endif
     &#154;* Send Out Email
     C                   If        Prdeml = 'Y'
     C                   Eval      Text = 'Spool File Distribution From '+
     C                                    sname
     C                   Call      'SBMJAVAM2'
     C                   PARM                    prdfem
     C                   PARM                    prdtem
     C                   PARM                    prdrem
     C                   PARM                    prdsln
     C                   PARM                    text           9999
     C                   PARM                    filename
     C                   PARM                    zipfile
     C                   PARM                    prdzip
     C                   Endif
     &#154;*
     C     KEY03         READE     PTPDST01                               99
     C                   ENDDO
     C                   Z-ADD     1             W
     &#154;* Create Spool Files In Distribution List
     C                   If        x > 0
     C     W             DO        X             W
     &#154;*
     C                   MOVE      QUE(W)        OUTQNM
     C                   MOVE      LIB(W)        OUTQLB
     C                   MOVE      USR(W)        USRNAM
     C                   MOVE      UDT(W)        USRDTA
     C                   MOVE      FTP(W)        FRMTYP
     C                   MOVE      HLD(W)        HLDF
     C                   MOVE      SAV(W)        SAVF
     C                   Z-ADD     CPY(W)        CPYLFT
     &#154;*
     C                   CALL      'QSPCRTSP'
     C                   PARM                    SECHND
     C                   PARM                    RCVVAR
     C                   PARM                    ERRCOD
     &#154;*
     C                   ADD       1             Y
     C                   Z-ADD     SECHND        HAN(Y)
     &#154;*
     C                   ENDDO
     &#154;* Create New User Space To Hold Primary Spool File Data
     C     BUFSIZ        MULT      8             USSIZE
     C                   ADD       500           USSIZE
     &#154;*
     C                   CALL      'QUSCRTUS'
     C                   PARM                    USRSP2
     C                   PARM      *BLANKS       USEXAT
     C                   PARM                    USSIZE
     C                   PARM      ' '           USINIT
     C                   PARM      '*CHANGE '    USAUTH
     C                   PARM      *BLANKS       USTEXT
     C                   PARM      '*YES    '    USREPL
     C                   PARM                    ERRCOD
     &#154;* Open Primary Spool File
     C                   CALL      'QSPOPNSP'
     C                   PARM                    PRIHND
     C                   PARM                    SJOBNM
     C                   PARM                    IJOBW
     C                   PARM                    IJOBW
     C                   PARM                    FILNAM
     C                   PARM                    FILNUM
     C                   PARM                    GETBUF
     C                   PARM                    ERRCOD
     &#154;* Process All Information Until End Of Spool File
     C                   Z-ADD     1             ORDBUF
     C                   Z-ADD     NBRBUF        BUFCNT
     &#154;*
     C     BUFCNT        DOULE     BUFCMP
     &#154;* Get Spooled File Data From Primary Spool File
     C                   CALL      'QSPGETSP'
     C                   PARM                    PRIHND
     C                   PARM                    USRSP2
     C                   PARM      'SPFR0200'    FORMAT            8
     C                   PARM                    ORDBUF
     C                   PARM      '*WAIT   '    ENDOPN           10
     C                   PARM                    ERRCOD
     &#154;* Put Spool File Data Into All Requested Ques
     C                   Z-ADD     1             W
     C     W             DO        Y             W
     C                   Z-ADD     HAN(W)        SECHND
     C                   CALL      'QSPPUTSP'
     C                   PARM                    SECHND
     C                   PARM                    USRSP2
     C                   PARM                    ERRCOD
     &#154;*
     C                   ENDDO
     &#154;* Update Buffer Count
     C                   Z-SUB     1             ORDBUF
     C     BUFCNT        SUB       GETBUF        BUFCNT
     C                   ENDDO
     &#154;* Close Secondary Spool Files
     C                   Z-ADD     1             W
     C     W             DO        Y             W
     C                   Z-ADD     HAN(W)        SECHND
     C                   CALL      'QSPCLOSP'
     C                   PARM                    SECHND
     C                   PARM                    ERRCOD
     C                   ENDDO
     &#154;* Close Primary Spool File
     C                   CALL      'QSPCLOSP'
     C                   PARM                    PRIHND
     C                   PARM                    ERRCOD
     &#154;* Delete User Space
     C                   CALL      'QUSDLTUS'
     C                   PARM                    USRSP2
     C                   PARM                    ERRCOD

     C                   Endif
     &#154;* Move Save Fields Back Into Primary Data Fields
     C                   MOVE      SOUTQ         OUTQNM
     C                   MOVE      SLIB          OUTQLB
     C                   MOVE      SNAME         USRNAM
     C                   MOVE      SFRMT         FRMTYP
     C                   MOVE      SUDTA         USRDTA
     C                   MOVEL     SHLDP         HLDF
     C                   MOVEL     SSAVF         SAVF
     C                   Z-ADD     SCOPY         CPYLFT
     &#154;*
     C                   ENDSR
     *
     **************************************************************************
     &#153;* Subroutine *INZSR - Program Entry
     **************************************************************************
     *
     C     *INZSR        BEGSR
     &#154;*
     C                   MOVE      *BLANKS       ERRCOD
     C                   Z-ADD     116           BYTPRO
     C                   Z-ADD     0             FILNMX            4 0
     C                   Z-ADD     0             BUFCNT            4 0
     C                   Z-SUB     8             BUFCMP            4 0
     C                   Z-ADD     0             W                 2 0
     C                   Z-ADD     0             X                 2 0
     C                   Z-ADD     0             Y                 2 0
     C                   MOVE      'Y'           @PROC             1
     C                   MOVE      'Y'           @YES              1
     C                   MOVE      'N'           @NO               1
     C                   MOVE      'N'           @ERROR            1
     C                   MOVE      *BLANKS       SOUTQ            10
     C                   MOVE      *BLANKS       SLIB             10
     C                   MOVE      *BLANKS       SUDTA            10
     C                   MOVE      *BLANKS       SNAME            10
     C                   MOVE      *BLANKS       SFRMT            10
     C                   MOVE      *BLANKS       SHLDP            10
     C                   MOVE      *BLANKS       SSAVF            10
     C                   Z-ADD     0             SCOPY             3 0
     C     *LIKE         DEFINE    QJOBNM        SJOBNM
     &#154;* 00000 = No Exception/Error Found
     C     *LIKE         DEFINE    @STP01        @FOUND
     C                   Z-ADD     00000         @FOUND
     &#154;* 00011 = End Of File On A Read(input)
     C     *LIKE         DEFINE    @STP01        @EOF
     C                   Z-ADD     00011         @EOF
     &#154;* 00012 = No-Record-Found Condition On A Chain, SETLL, And SETGT
     C     *LIKE         DEFINE    @STP01        @NFND
     C                   Z-ADD     00012         @NFND
     &#154;* Key to User Control File
     C     KEY02A        KLIST
     C                   KFLD                    FILNAM
     C                   KFLD                    USRNAM
     C                   KFLD                    USRDTA
     &#154;*
     C     KEY02B        KLIST
     C                   KFLD                    FILNAM
     C                   KFLD                    USRNAM
     &#154;* Key to Distribution Control File
     C     KEY03         KLIST
     C                   KFLD                    FILNAM
     C                   KFLD                    USRDTA
     C                   KFLD                    USRNAM
     &#154;*
     C                   ENDSR
     &#154;*
** CM
CHGSPLFA FILE(F123456789) JOB(N23456/U234567890/F234567890) SPLNBR(S234) COPIES(
S2345) OUTQ(L234567890/Q234567890) SAVE(S2345)
** CMA
HLDSPLF FILE(F123456789) JOB(N23456/U234567890/F234567890) SPLNBR(S234)
** CMB
DLTSPLF FILE(F123456789) JOB(N23456/U234567890/F234567890) SPLNBR(S234)
** CMC
CVTSPLSTMF FROMFILE(F123456789) TOSTMF(F1234567890PDF) TODIR('D123') JOB(N23456/
U234567890/F234567890) SPLNBR(S234) TOFMT(*PDF)                                                                                  
0
 
LVL 14

Expert Comment

by:daveslater
ID: 12787171
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:

Accept odumbruce comment as answer

Please leave any comments here within the next four days.

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
daveslater
Page Editor
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this article I will be showing you how to subnet the easiest way possible for IPv4 (Internet Protocol version 4). This article does not cover IPv6. Keep in mind that subnetting requires lots of practice and time.
Currently, there is an issue with being able to copy values from an external application to a dropdown list in Project Web Access (PWA).  The standard copy and paste methods don't seem to work properly. Here is a way to accomplish this task to s…
This video shows how to quickly and easily deploy an email signature for all users in Office 365 and prevent it from being added to replies and forwards. (the resulting signature is applied on the server level in Exchange Online) The email signat…
Screencast - Getting to Know the Pipeline
Suggested Courses

872 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question