QWTCHGJB sample

[BGray]

I accidentally posted this in ANYTHING GOES last night... sorry for the repost.
-------------------------------------------------------------------------------------------------
HELP!

I need to set Server Mode for SQL to OFF after a vendor tool has turned it ON.
It seems that the QWTCHGJB API using JOBC0200 is the way to do it.

Does anybody have a sample of how to code this API call?

TIA,

Bernard Gray

[jamief]

Re: QWTCHGJB sample

No you posted it correct I moved it

The tips are actual tips not questions.....

Your not crazy

you can pick it outta here

       *******************************
      *Program Name        :  VFNDOBJ
      *Author              :  Victor Voilevitch
      *Date                :  25.05.1999
      *Programming Language:  RPG
      *Description: This program finds an object by its description text
      *Header Files Included: QUSGEN - Generic Header of a User Space
      *                       QUSEC - Error Code Parameter
      *                               (Copied into Program)
      *                       QUSLOBJ - List Objects API
      *
      *APIs Used:  QUSCRTUS - Create User Space
      *            QUSLOBJ  - List Objects
      *            QUSRTVUS - Retrieve User Space
      *            QUSDLTUS - Delete User Space
      *            QMHSNDPM - Send Program Message
      *            QMHRMVPM - Remove Program Message
      *            QUSRJOBI - Retrieve Job Information API
      *            QWTCHGJB - Change Job API
     F* Display file
     FVFNDOBJDCF  E                    WORKSTN
     E*  Message Arrays                                          
     E                    #ER    80  80  1
     E                    #E2     1   2 80
     E                    #WH     1  25 23
     E*  Message Id Array
     E                    #ID         7  1
     E*  RUNSQL command
     E                    #RS     1   1 50
     E*  Select parameter
     E                    #SS        50  1
     E*  File/Library Name
     E                    #NN        10  1
     E                    #N2        10  1
      *
     I*  Data Structures                                                 
     I* I.   Generic Header of a User Space Include
     I*
     I/COPY QSYSINC/QRPGSRC,QUSGEN
     I*
     I* II.  Error Code Parameter Include for the APIs
     I*
     I* The following QUSEC include is copied into this program
     I* so that the variable length field can be defined as a
     I* fixed length.
     I*
     I*Header File Name: H/QUSEC
     I*
     IQUSBN       DS
     I*                                             Qus EC
     I                                    B   1   40QUSBNB
     I*                                             Bytes Provided
     I                                    B   5   80QUSBNC
     I*                                             Bytes Available
     I                                        9  15 QUSBND
     I*                                             Exception Id
     I                                       16  16 QUSBNF
     I*                                             Reserved
     I*                                      17  17 QUSBNG
     I*
     I*                                      Varying length
     I                                       17 100 QUSBNG
     I*
     I*
     I* III. List Objects API Include
     I*
     I/COPY QSYSINC/QRPGSRC,QUSLOBJ
     I*
     I* Qualified User Space Data Structure
     I*
     IUSERSP      DS
     I I            'VFNDOBJUS '              1  10 USRSPC
     I I            'QTEMP     '             11  20 SPCLIB
     I* Qualified Object Name Data Structure
     I*
     IOBJECT      DS
     I I            '*ALL      '              1  10 OBJNAM
     I I            '*LIBL     '             11  20 OBJLIB
     I*
     I* Miscellaneous Data Structure
     I*
     I            DS
     I* Set up parameters for the Create User Space API
     I I            'VFNDOBJUS '              1  10 EXTATR
     I I            X'00'                    11  11 INTVAL
     I                                       12  12 RSVD1
     I I            256                   B  13  160INTSIZ
     I I            '*ALL      '             17  26 PUBAUT
     I I            'User space for      -   27  76 TEXT
     I              'objects list        -
     I              'STORE     '
     I I            '*YES      '             77  87 REPLAC
     I* Set up parameters for the List Objects API
     I I            'OBJL0200'               88  95 FORMAT
     I I            '*ALL      '             96 105 OBJTYP
     I                                      106 108 RSVD2
     I* Set up parameters for the Retrieve User Space API
     I I            1                     B 109 1120STRPOS
     I I            192                   B 113 1160LENDTA
     I                                    B 117 1200COUNT
     I*
     I* Parameters DS for send pgm msg API
     I*
     I            DS
     I I            'CPF9898'                 1   7 #MSGID
     I                                        8  27 #MSGF
     I I            'QCPFMSG'                 8  17 #MSGFI
     I I            '*LIBL'                  18  27 #MSGFL
     I                                       28 155 #MSGDT
     I I            80                    B 156 1590#MSGDL
     I I            '*INFO'                 160 169 #MSGTP
     I I            'VFNDOBJ'               170 179 #QUEUE
     I I            0                     B 180 1830#SNDTO
     I                                      184 187 #MSGKY
     I I            0                     B 188 1910#ERRCD
     I*
     I* Parameters DS for send pgm msg API (SQL messages)
     I*
     I            DS
     I                                        1   7 #QSGID
     I                                        8  27 #QSGF
     I I            'QCPFMSG'                 8  17 #QSGFI
     I I            '*LIBL'                  18  27 #QSGFL
     I                                       28 155 #QSGDT
     I                                    B 156 1590#QSGDL
     I I            '*INFO'                 160 169 #QSGTP
     I I            'VFNDOBJ'               170 179 #QSQUE
     I I            0                     B 180 1830#QSSTO
     I                                      184 187 #QSMKY
     I I            0                     B 188 1910#QSRCD
     I*
     I* Parameters DS for retrieve Job Information
     I* a) Information Returned
     I@JOBI       DS
     I*                                   Run Priority
     I                                    B  65  680#JIRUN
     I* b) Length of a)
     I            DS
     I I            68                    B   1   40#JILEN
     I*
     I* Parameters DS for changing Job
     I* Information Transferred
     I@JOBC       DS
     I*                             Number Of Keys
     I I            1                     B   1   40#JCKEN
     I*                             Length Of Whole Key
     I I            20                    B   5   80#JCKEL
     I*                             Key
     I I            1802                  B   9  120#JCKEY
     I*                             Type Of Data
     I I            'B'                      13  13 #JCDAP
     I*                             Reserved
     I                                       14  16 #JCD1
     I*                             Length Of Data
     I I            4                     B  17  200#JCDAL
     I*                             Data
     I                                    B  21  240#JCRUN
     I*
     I* Program status information DS
     I*
     I@SPSDS     SDS
     I                                     *PROGRAM MSGPQ
     I*
     I* Binary 4-digits zeroes field
     I              X'00000000'           C         C#0000
     I* Binary 4,0 to Zoned 4,0 conversion DS
     I            DS
     I                                    B   1   40#XER1
     I                                        1   40#XID
     I* Parameters DS for copy into file command
     I*
     I@COPYS      DS
     I I            'CPYF       FROMFILE('    1  20 #CPY1
     I I            'QTEMP/FINDTBL2)     '   21  40 #CPY2
     I I            'TOFILE(             '   41  60 #CPY3
     I                                       61  70 #LNAME
     I I            '/'                      71  71 #CPY4
     I                                       72  81 #FNAME
     I I            ') MBROPT(*ADD)      '   82 101 #CPY5
     I I            'CRTFILE(*YES)       '  102 121 #CPY6
       *
     C*  Mainline                                                  ****
     C*
     C* Change Run Priority.
     C*
     C* a) Retrieve Current Run Priority.
     C                     CALL 'QUSRJOBI'@PJOBI
     C* See if any errors were returned in the error code parameter.
     C           QUSBNC    IFGT 0
     C                     MOVEL*OFF      #RUNF
     C                     ENDIF
     C                     Z-ADD24        #N               Error #
     C                     EXSR ERRCOD
     C*
     C* b) Change Run Priority.
     C           #RUNF     IFEQ *ON
     C                     Z-ADD1         #JCRUN
     C                     CALL 'QWTCHGJB'@PJOBC
     C* See if any errors were returned in the error code parameter.
     C           QUSBNC    IFGT 0
     C                     MOVEL*OFF      #RUNF
     C                     ENDIF
     C                     Z-ADD25        #N               Error #
     C                     EXSR ERRCOD
     C                     ENDIF
     C*
     C* Create a user space.
     C                     Z-ADD100       QUSBNB           len of QUSBN
     C                     CALL 'QUSCRTUS'
     C                     PARM           USERSP
     C                     PARM           EXTATR
     C                     PARM           INTSIZ
     C                     PARM           INTVAL
     C                     PARM           PUBAUT
     C                     PARM           TEXT
     C                     PARM           REPLAC
     C                     PARM           QUSBN
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD1         #N               Error #
     C                     EXSR ERRCOD
     C*
     C* Default input
     C                     MOVELOBJLIB    $LIBL     P
     C                     MOVELOBJTYP    $TYPE     P
     C                     MOVEL'Y'       $CASE     P
     C*
     C* Create a tables.
     C/EXEC SQL
     C+ Create Table QTEMP/FINDTBL1
     C+ ( Library Char(10),
     C+   Object  Char(10),
     C+   Type    Char( 7),
     C+   Desc    Char(50)
     C+ )
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD6         #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Create Table QTEMP/FINDTBL2
     C+ ( Library Char(10),
     C+   Object  Char(10),
     C+   Type    Char( 7),
     C+   Desc    Char(50)
     C+ )
     C/END-EXEC
     C*
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD7         #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Label On Table QTEMP/FINDTBL2 Is
     C+ 'VFNDOBJ - output file'
     C/END-EXEC
     C*
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD17        #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Create Table QTEMP/FINDTBL3
     C+ ( Desc    Char(50)
     C+ )
     C/END-EXEC
     C*
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD18        #N
     C                     EXSR ERRSQL
     C*
     C*=========================
     C*==       Start of main cycle                    
     C*==       get input and process it               
     C*=========================
     C           *INKC     DOWEQ*OFF
     C*
     C* Get user input values
     C                     WRITEMSGCTL
     C                     EXFMTMAIN
     C*
     C* HELP pressed
     C           *IN01     IFEQ *ON
     C                     EXFMTWHELP
     C                     ITER
     C                     ENDIF
     C* F3 pressed
     C           *INKC     IFEQ *ON
     C                     ITER
     C                     ENDIF
     C*
     C* F8 pressed
     C           *INKH     IFEQ *ON                        F8 pressed
     C           *IN20     IFEQ *ON                        Found any
     C                     CALL 'QCMDEXC'              21
     C                     PARM           #RS
     C                     PARM 50        #RSL   155
     C           *IN21     IFEQ *ON                        QCMDEXC error
     C* Process errors returned from the API.
     C                     MOVEL#WH,10    #STR
     C                     MOVEA#STR      #ER,18
     C                     MOVEA#ER       #MSGDT
     C                     EXSR MSGSND
     C                     ENDIF                           QCMDEXC error
     C                     ENDIF                           Found any
     C                     ITER
     C                     ENDIF                           F8 pressed
     C*
     C* F9 pressed
     C           *INKI     IFEQ *ON                        F9 pressed
     C           *IN20     IFEQ *ON                        Found any
     C           *IN26     DOWEQ*ON                        While not Enter
     C           *INKL     ANDEQ*OFF                       And   not F12
     C                     EXFMTWCOPY
     C                     ENDDO
     C           *IN26     IFNE *ON                        Enter Pressed
     C* Prepare names and copy into
     C                     CLEAR#FNAME
     C                     CLEAR#LNAME
     C                     CLEAR#N2
     C* File name...
     C                     MOVEA$FNAME    #NN       P
     C           ' '       CHECK$FNAME    #C             23
     C   23                MOVEA#NN,#C    #FNAME            file......
     C* Library name...
     C                     MOVEA$LNAME    #NN       P
     C           ' '       CHECK$LNAME    #C             23 Left  char
     C           ' '       CHEKR$LNAME    #G      20     23 Right char
     C                     Z-ADD10        #J      20        Last pos to
     C                     Z-ADD#G        #K      20        Last pos from
     C   23      #C        DO   #G        #P
     C                     MOVE #NN,#K    #N2,#J
     C                     SUB  1         #J
     C                     SUB  1         #K
     C                     ENDDO
     C                     MOVEA#N2       #LNAME            .......lib
     C* Copying...
     C                     CALL 'QCMDEXC'              21
     C                     PARM           @COPYS
     C                     PARM 121       #RSL
     C           *IN21     IFEQ *ON                        QCMDEXC error
     C* Process errors returned from the API.
     C                     MOVEL#WH,16    #STR
     C                     MOVEA#STR      #ER,18
     C                     MOVEA#ER       #MSGDT
     C                     EXSR MSGSND
     C                     ENDIF                           QCMDEXC error
     C                     ENDIF                           Enter Pressed
     C                     ENDIF                           Found any
     C                     ITER
     C                     ENDIF                           F9 pressed
     C*
     C* Not Enter pressed
     C           *IN26     IFEQ *ON
     C                     ITER
     C                     ENDIF
     C*
     C* Hide F8, F9 Buttons
     C                     MOVE *OFF      *IN20
     C                     Z-ADD0         NNALL
     C                     Z-ADD0         NNSEL
     C*
     C* Clearing tables.
     C/EXEC SQL
     C+ Delete From QTEMP/FINDTBL1
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD13        #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Delete From QTEMP/FINDTBL2
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD14        #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Delete From QTEMP/FINDTBL3
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD22        #N
     C                     EXSR ERRSQL
     C*
     C* Clear messages
     C                     CALL 'QMHRMVPM'
     C                     PARM 'VFNDOBJ' #CLRQ  10
     C                     PARM C#0000    #CLRCN  4
     C                     PARM '    '    #CLRKY  4
     C                     PARM '*ALL'    #CLRRM 10
     C                     PARM C#0000    #CLRER  4
     C*
     C* Handle input request
     C                     MOVEL$LIBL     OBJLIB    P
     C                     MOVEL$TYPE     OBJTYP    P
     C*
     C* Get a list of all objects in the library.
     C                     CALL 'QUSLOBJ'
     C                     PARM           USERSP
     C                     PARM           FORMAT
     C                     PARM           OBJECT
     C                     PARM           OBJTYP
     C                     PARM           QUSBN
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD2         #N
     C                     EXSR ERRCOD
     C*
     C* Look at the generic header. This contains information
     C* about the list data section that is needed when processing
     C* the entries.
     C                     Z-ADD1         STRPOS           start of QUSBP
     C                     Z-ADD192       LENDTA           len of QUSBP
     C                     CALL 'QUSRTVUS'
     C                     PARM           USERSP
     C                     PARM           STRPOS
     C                     PARM           LENDTA
     C                     PARM           QUSBP
     C                     PARM           QUSBN
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD3         #N
     C                     EXSR ERRCOD
     C*
     C*
     C* Check the information status field, QUSBPJ, to see if the
     C* API was able to return all the information. Possible values
     C* are:  C -- Complete and accurate
     C*       P -- Partial but accurate
     C*       I -- Incomplete.
     C           QUSBPJ    IFEQ 'C'
     C           QUSBPJ    OREQ 'P'
     C*
     C* Issue message how many objects found with any description.
     C                     MOVE *ON       *IN22
     C                     Z-ADDQUSBPS    NNALL
     C*
     C*         --------------------------------
     C*         -- handle list of objects     --
     C*         --------------------------------
     C* Check to see if any entries were put into the user space.
     C           QUSBPS    IFGT 0
     C                     Z-ADD1         COUNT
     C* Because RPG is Base 1, the offset must be increased by one.
     C           QUSBPQ    ADD  1         STRPOS
     C                     Z-ADD91        LENDTA
     C*
     C* Build selecting criteria.
     C*
     C* Convert to Uppercase if needed
     C           $CASE     IFNE 'Y'                        no match case
     C* Add one row into the table 3 for conversion to uppercase
     C/EXEC SQL
     C+ Insert Into QTEMP/FINDTBL3
     C+   Values (:$DESC)
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD20        #N
     C                     EXSR ERRSQL
     C*
     C* Read one row from table 3 (converted to uppercase by standard
     C*                            SQL tools independent of language)
     C/EXEC SQL
     C+ Select Upper(Desc)
     C+   Into :$DESC
     C+   From QTEMP/FINDTBL3
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD21        #N
     C                     EXSR ERRSQL
     C*
     C                     ENDIF                           no match case
     C*
     C                     CLEAR#SS
     C                     MOVEA$DESC     #SS,1
     C* Fill left blanks with '%'
     C           ' '       CHECK$DESC     #C      20     23
     C  N23                Z-ADD50        #C               all blanks
     C   23                SUB  1         #C               last blank
     C           1         DO   #C        #P      20
     C                     MOVE '%'       #SS,#P
     C                     ENDDO
     C* Fill right blanks with '%'
     C           ' '       CHEKR$DESC     #C      20     23
     C   23                ADD  1         #C
     C   23      #C        DO   50        #P
     C                     MOVE '%'       #SS,#P
     C                     ENDDO
     C* Selecting criteria is ready.
     C                     MOVEA#SS       #SELCT 50
     C*
     C* Walk through all the entries in the user space.
     C           COUNT     DOWLEQUSBPS
     C                     CALL 'QUSRTVUS'
     C                     PARM           USERSP
     C                     PARM           STRPOS
     C                     PARM           LENDTA
     C                     PARM           QUSDN
     C                     PARM           QUSBN
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD4         #N
     C                     EXSR ERRCOD
     C*
     C* ============= Process the concrete object ==============.
     C* 1. Add one row in the table 1 ==========================.
     C/EXEC SQL
     C+ Insert Into QTEMP/FINDTBL1
     C+   Values (:QUSDNC, :QUSDNB, :QUSDND, :QUSDNH)
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD8         #N
     C                     EXSR ERRSQL
     C*
     C* 2. Select the row into table 2 =========================.
     C           $CASE     IFNE 'Y'                        NO match case
     C/EXEC SQL
     C+ Insert Into QTEMP/FINDTBL2
     C+   Select *
     C+     From QTEMP/FINDTBL1
     C+     Where Upper(Desc) Like :#SELCT
     C/END-EXEC
     C                     ELSE                            match case !
     C/EXEC SQL
     C+ Insert Into QTEMP/FINDTBL2
     C+   Select *
     C+     From QTEMP/FINDTBL1
     C+     Where Desc Like :#SELCT
     C/END-EXEC
     C                     ENDIF                           match case ?
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD9         #N
     C                     EXSR ERRSQL
     C*
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD15        #N
     C                     EXSR ERRSQL
     C* 3. Delete the row from table 1 =========================.
     C/EXEC SQL
     C+ Delete From QTEMP/FINDTBL1
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD13        #N
     C                     EXSR ERRSQL
     C*
     C* ============= End of processing the concrete object ====.
     C*
     C                     ADD  1         COUNT
     C                     ADD  QUSBPT    STRPOS
     C*                 ** do for each objects
     C                     ENDDO
     C*
     C* Count the selected objects.
     C/EXEC SQL
     C+ Select Count(*)
     C+   Into :NNSEL
     C+   From QTEMP/FINDTBL2
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD15        #N
     C                     EXSR ERRSQL
     C*
     C* Show F8, F9 Buttons
     C           NNSEL     IFGT 0
     C                     MOVE *ON       *IN20
     C                     ENDIF
     C*
     C*         --------------------------------
     C*         -- end handle list of objects --
     C*         --------------------------------
     C*                 ** if objects > 0
     C                     ENDIF
     C*
     C*                 ** if status is 'C' or 'P'
     C                     ENDIF
     C*
     C* Information in the user space is not accurate.
     C           QUSBPJ    IFEQ 'I'
     C                     MOVEA#E2,1     #MSGDT
     C                     EXSR MSGSND
     C                     ENDIF
     C*
     C* Information in the user space is partial.
     C           QUSBPJ    IFEQ 'P'
     C                     MOVEA#E2,2     #MSGDT
     C                     EXSR MSGSND
     C                     ENDIF
     C*
     C*                 ** do until F3 pressed
     C                     ENDDO
     C*====================================================
     C*==       End   of main cycle                    ====
     C*==       get input and process it               ====
     C*====================================================
     C*
     C* Delete the user space called APIUG1 in library QGPL.
     C                     CALL 'QUSDLTUS'
     C                     PARM           USERSP
     C                     PARM           QUSBN
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD5         #N
     C                     EXSR ERRCOD
     C*
     C* Deleting tables.
     C/EXEC SQL
     C+ Drop Table QTEMP/FINDTBL1
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD11        #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Drop Table QTEMP/FINDTBL2
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD12        #N
     C                     EXSR ERRSQL
     C*
     C/EXEC SQL
     C+ Drop Table QTEMP/FINDTBL3
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD19        #N
     C                     EXSR ERRSQL
     C*
     C*
     C* Restore Run Priority.
     C           #RUNF     IFEQ *ON
     C                     Z-ADD#JIRUN    #JCRUN
     C                     CALL 'QWTCHGJB'@PJOBC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD25        #N               Error #
     C                     EXSR ERRCOD
     C                     ENDIF
     C*
     C*
     C*
     C                     SETON                     LR
     C                     RETRN
     C*
     C*****************************************************************
     C* End of Mainline                                            ****
     C*****************************************************************
     C*
     C*****************************************************************
     C* Subroutine to handle errors returned in the error code     ****
     C* parameter (User Space errors).                             ****
     C*****************************************************************
     C*
     C           ERRCOD    BEGSR
     C           QUSBNC    IFGT 0
     C*
     C* Process errors returned from the API.
     C                     MOVEL#WH,#N    #STR
     C                     MOVEA#STR      #ER,18
     C                     MOVEA#ER       #MSGDT
     C                     EXSR MSGSND
     C* Original message returned by API
     C                     CALL 'QMHSNDPM'
     C                     PARM           QUSBND
     C                     PARM           #MSGF
     C                     PARM           QUSBNG
     C                     PARM           QUSBNC
     C                     PARM           #MSGTP
     C                     PARM           #QUEUE
     C                     PARM           #SNDTO
     C                     PARM           #MSGKY
     C                     PARM           #ERRCD
     C* Exit if US create/delete error
     C           #N        IFEQ 1
     C           #N        OREQ 5
     C                     EXSR EXIT
     C                     ENDIF
     C*
     C                     ENDIF
     C                     ENDSR
     C*
      *
     C*****************************************************************
     C* Subroutine to handle errors returned in the error code     ****
     C* parameter (SQL errors).                                    ****
     C*****************************************************************
     C*
     C           ERRSQL    BEGSR
     C           SQLCOD    IFLT 0
     C*
     C* Process errors returned from the API.
     C                     MOVEL#WH,#N    #STR
     C                     MOVEA#STR      #ER,18
     C                     MOVEA#ER       #MSGDT
     C                     EXSR MSGSND
     C* Original message returned by API
     C                     MOVEA'CPF'     #ID,1
     C                     Z-ADDSQLER1    #XER1
     C                     MOVEL#XID      ##TMPS  4
     C                     MOVEA##TMPS    #ID,4
     C                     MOVEA#ID       #QSGID
     C                     CALL 'QMHSNDPM'
     C                     PARM           #QSGID
     C                     PARM           #QSGF
     C                     PARM SQLERM    #QSGDT
     C                     PARM SQLERL    #QSGDL
     C                     PARM           #QSGTP
     C                     PARM           #QSQUE
     C                     PARM           #QSSTO
     C                     PARM           #QSMKY
     C                     PARM           #QSRCD
     C* Exit if tables create/drop error
     C           #N        IFEQ 6                          create error
     C           SQLCOD    ANDNE-601                       already exist
     C           #N        OREQ 7                          create error
     C           SQLCOD    ANDNE-601                       already exist
     C           #N        OREQ 18                         create error
     C           SQLCOD    ANDNE-601                       already exist
     C           #N        OREQ 11
     C           #N        OREQ 12
     C           #N        OREQ 19
     C                     EXSR EXIT
     C                     ENDIF
     C*
     C                     ENDIF
     C                     ENDSR
     C*
      *
     C*****************************************************************
     C* Subroutine to send program message to current message queue****
     C*****************************************************************
     C*
     C           MSGSND    BEGSR
     C                     CALL 'QMHSNDPM'
     C                     PARM           #MSGID
     C                     PARM           #MSGF
     C                     PARM           #MSGDT
     C                     PARM           #MSGDL
     C                     PARM           #MSGTP
     C                     PARM           #QUEUE
     C                     PARM           #SNDTO
     C                     PARM           #MSGKY
     C                     PARM           #ERRCD
     C                     ENDSR
     C*****************************************************************
     C* Subroutine to exit                                         ****
     C*****************************************************************
     C*
     C           EXIT      BEGSR
     C                     SETON                     LR
     C                     RETRN
     C                     ENDSR
     C*
     C*****************************************************************
     C* Initialization                                             ****
     C*****************************************************************
     C*
     C           *INZSR    BEGSR
     C*
     C           *NAMVAR   DEFN           #N      20       err#
     C           *NAMVAR   DEFN           #STR   23        err data
     C                     MOVEL*ON       #RUNF   1        Run Prty Flag
     C*
     C* Cancel Commitment
     C/EXEC SQL
     C+ Set Transaction Isolation Level No Commit
     C/END-EXEC
     C* See if any errors were returned in the error code parameter.
     C                     Z-ADD23        #N
     C                     EXSR ERRSQL
     C*
     C                     ENDSR
     C*
     C*****************************************************************
     C* Parameters List                                            ****
     C*****************************************************************
     C*
     C* Retrieving Job Information API
     C           @PJOBI    PLIST
     C                     PARM           @JOBI
     C                     PARM           #JILEN
     C                     PARM 'JOBI0100'P@FORM  8
     C                     PARM '*'       P@JOB  26
     C                     PARM *BLANKS   P@JOBN 16
     C                     PARM           QUSBN
     C*
     C* Change Job API
     C           @PJOBC    PLIST
     C                     PARM '*'       P@JOB  26
     C                     PARM *BLANKS   P@JOBN 16
     C                     PARM 'JOBC0100'P@FORM  8
     C                     PARM           @JOBC
     C                     PARM           QUSBN
     C*
     C*****************************************************************
**
Error occured by
**
The objects information is incomplete - process stopped
The objects information is partial but accurate - process was continued
**
creating userspace                 1
getting list of objects            2
retrieving header                  3
retrieving object info             4
deleting userspace                 5
creating table 1                   6
creating table 2                   7
inserting into table 1             8
inserting into table 2             9
viewing table 2                   10
dropping table 1                  11
dropping table 2                  12
deleting from table 1             13
deleting from table 2             14
counting table 2                  15
copying into file                 16
labeling table 2                  17
creating table 3                  18
dropping table 3                  19
inserting into table 3            20
selecting from table 3            21
deleting from table 3             22
cancelling commitment             23
retrieving Job inf.               24
changing run priority             25
**
RUNQRY QRYFILE((QTEMP/FINDTBL2))

[BGray]

Re: QWTCHGJB sample

Thanks, Jamie. I really DID think I was going crazy (crazier).

I'll work to dig out the particulars from the code. Might call on you if I get in over my head. Thanks again!