Re: Break Messages

Neil Palmer wrote:

> How about writing a CL program to do  WRKUSRJOB USER(insert_user_name_here)
> STATUS(*ACTIVE)
> and then processing the jobs that are type INTER
> Job         User        Type     -----Status-----  Function
> CHKFWDMAIL  NEIL        BATCH    ACTIVE            DLY-1800
> PALMER_1    NEIL        INTER    ACTIVE            CMD-WRKUSRJOB
> PALMER_2    NEIL        INTER    ACTIVE            CMD-TELNET

Its possible to redirect print file info to a DB file without a CPYSPLF.

I have a CL that sends a print to a DB file as follows.
Use at OWN RISK etc etc. I am not sure where this code came from, or if I wrote
it myself apologise in advance if I stole it.
Basically it shows how to send a *print job to a DB file.
I created a LGL to replace the IBM print file over DB files that simulate the
formats in the print file.
Then override the IBM print file to the LGL.  Its a bit tricky getting the
necessary formats and fields and linking up the lgl.

This is the command processor for a command that has a message and a simple list
of up to 32 users.
The first couple of characters in the list is filled in by the system saying how
many entries are in the list, in hex.
*************** Beginning of data *******************************
PGM (&MSG &USRS)

/* SET UP LIST OF USERS  FOR A BREAK MESSAGE */

DCL &MSG *CHAR 400
DCL &USRS *CHAR 302
DCL &X   *DEC (3 0)
DCL &Y   *DEC (3 0)
DCL &Z   *DEC (3 0)
DCL &USR *CHAR 10
DCL &HX  *CHAR 31 (X'000102030405060708090A0B0C0D0E0F1011121314+
                       15161718192021222324')
NXTZ:    /* get number of user entries, probable could have used a BIN to DEC
calc */
CHGVAR &Z (&Z + 1)
IF (%SST(&USRS 2 1) *EQ %SST(&HX &Z 1)) (GOTO CONT)
GOTO NXTZ

CONT:
CRTDUPOBJ QPDSP* UTLDTA *FILE QTEMP
MONMSG CPF0000
CLRPFM  QTEMP/QPDSP2
OVRPRTF QPDSPSBJ QTEMP/QPDSPSBJ

NEXT:
     CHGVAR &X  (&X + 1)
     IF (&X *GE &Z) (GOTO SEND)

     CHGVAR &Y  ((&X - 1)*10 +3)
     CHGVAR &USR (%SST(&USRS &Y 10))

     WRKSBSJOB  SBS(QINTER) USER(&USR) OUTPUT(*PRINT)
GOTO NEXT

SEND:

CALL BRKMSG1  (&MSG)

ENDPGM
These are the LGL and PF's
  UTLOBJ/QDDSSRC       QPDSPSBJ
 *************** Beginning of data ****************************
      A          R SUBSYSDSP                 PFILE(QPDSP1)
                 K *NONE
      A          R SUBSYDSFL                 PFILE(QPDSP2)
      A          K USER
      A          R SUBSYSEND                 PFILE(QPDSP3)
                 K *NONE
      A          R SUBSYDSNOJ                PFILE(QPDSP4)
                 K *NONE
 ****************** End of data *******************************
 UTLOBJ/QDDSSRC                 QPDSP1
 *************** Beginning of data *****************************
      A          R SUBSYSDSP
      A            IN11           1A         TEXT('                            
')

      A            IN12           1A         TEXT('                            
')

      A            IN13           1A         TEXT('                            
')

      A            IN14           1A         TEXT('                            
')

      A            IN15           1A         TEXT('                            
')

      A            IN16           1A         TEXT('                            
')

      A            IN17           1A         TEXT('                            
')

      A            RELDATA       14A         TEXT('                            
')

      A            SYSNAME        8A         TEXT('                            
')

      A            SBSNAME       10A         TEXT('                            
')

      A            USRNAME       10A         TEXT('                            
')

 ****************** End of data ***********************************
UTLOBJ/QDDSSRC  QPDSP2
*************** Beginning of data
************************************************
     A          R SUBSYDSFL
     A            JOBNAM        10A         TEXT('                            ')
     A            USER          10A         TEXT('                            ')
     A            NUMBER         6A         TEXT('                            ')
     A            TYPE           7A         TEXT('                            ')
     A            STATUS1        7A         TEXT('                            ')
     A            STATUS2        7A         TEXT('                            ')
     A            FUNCTION      14A         TEXT('                            ')
****************** End of data
***************************************************
UTLOBJ/QDDSSRC         QPDSP3
*************** Beginning of data **********************************************
     A          R SUBSYSEND
     A            J              1A         TEXT('                            ')
****************** End of data *************************************************
UTLOBJ/QDDSSRC     QPDSP4
 *************** Beginning of data
***********************************************
      A          R SUBSYDSNOJ
      A            J              1A         TEXT('                            
')

 ****************** End of data
**************************************************



+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---