Enhanced method for displaying users' sessions -- code

code for tip











     A*                                    Line Numbers: Start   End
     A* Display Files  - SCREEN                            19    39
     A*                  SCREEN2                           40    52
     A*                  CUDDSP                            53    133
     A*
     A* Physical Files - CUPDSP                           134    149
     A*                  CUPDSPA                          150    166
     A*
     A* Logical Files  - CULDSP                           167    177
     A*
     A* CLP Programs   - DSPSCRNCL                        178    244
     A*                  GETDSPCL                         245    282
     A*                  CUCDSP10                         283    341
     A*                  CUCDSP20                         342    356
     A*                  CUCDSP30                         357    373
     A*                  CUCDSP40                         374    384
     A*
     A* RPG Programs   - CUGDSP                           385    615
     A*
     /*  Member .....: SCREEN                                      */
     /*  Member type : DSPF                                        */
     /*  Description : Display screen for Active User Session      */
     /*  Compile ....: CRTDSPF  FILE(QGPL/SCREEN)  +               */
     /*                  SRCFILE(YOURLIB/QDDSSRC)                  */
     A*                                                               *
     A*
     A                                      DSPSIZ(27 132 *DS4                 -
     A                                             24  80 *DS3)
     A                                      CA03(03 'END-OF-JOB')
     A          R SCREEN
     A                                      KEEP
     A                                      DSPMOD(*DS3)
     A            LINES       3564A  H
     A          R SCREEN80
     A                                      DSPMOD(*DS3)
     A            LINES80     1917A  O  1  2
     A          R SCREEN132
     A                                      DSPMOD(*DS4)
     A            LINES132    3561A  O  1  2
     A*
     /*  Member .....: SCREEN2                                     */
     /*  Member type : DSPF                                        */
     /*  Description : Display screen for Active User Session      */
     /*  Compile ....: CRTDSPF  FILE(QGPL/SCREEN2) +               */
     /*                  SRCFILE(YOURLIB/QDDSSRC)                  */
     A*                                                               *
     A*
     A          R DUMMY
     A                                      KEEP
     A            LINES       3564A  H
     A          R SCREEN                    USRDFN
     A                                      KEEP
     A*
     /*  Member .....: CUDDSP                                      */
     /*  Member type : DSPF                                        */
     /*  Description : Display screen for records form WRKSBSJOB   */
     /*  Compile ....: CRTDSPF  FILE(QGPL/CUDDSP)  +               */
     /*                  SRCFILE(YOURLIB/QDDSSRC)                  */
     A*                                                               *
     A*
     A                                      DSPSIZ(24 80 *DS3)
     A                                      MSGLOC(24)
     A                                      PRINT
     A                                      WDWBORDER((*COLOR GRN) (*DSPATR RI))
     A                                      CF03(03 'EXIT PROGRAM')
     A                                      CA05(05 'FOLD/DROP DESC')
     A                                      CF12(12 'PREVIOUS')
     A          R DATASUB                   SFL
     A*%%TS  SD  20020604  103659  ISDWIGHT    REL-V4R4M0  5769-PW1
     A            @SEL      R        B  6  4REFFLD(XHSTAT)
     A                                      DSPATR(CS)
     A                                      DSPATR(HI)
     A                                      COLOR(WHT)
     A  82                                  DSPATR(PR)
     A  82                                  DSPATR(ND)
     A                                      VALUES(' ' '1' '5')
     A            @SJBNM        10A  O  6  7
     A            @SUSNM        10A  O  6 18
     A            @SJBNO         6A  O  6 29
     A            @SUPNM        30A  O  6 36
     A            @SOUTQ        10A  O  6 67
     A                                  7 19'Msg Type:'
     A                                      DSPATR(HI)
     A            @SMSTY        10   O  7 29DSPATR(HI)
     A                                      DSPATR(RI)
     A                                  7 44'Group Profile:'
     A                                      DSPATR(HI)
     A            @SGPRF        10   O  7 59DSPATR(RI)
     A                                      DSPATR(HI)
     A*  92/08/05  14:13:37    ISDWIGHT    REL-R03M00  5728-PW1
     A          R DATACTL                   SFLCTL(DATASUB)
     A*%%TS  SD  20020531  083936  ISDWIGHT    REL-V4R4M0  5769-PW1
     A                                      SFLSIZ(0900)
     A                                      SFLPAG(0008)
     A                                      OVERLAY
     A                                      SFLDROP(CA05)
     A N30                                  SFLDSP
     A N30                                  SFLDSPCTL
     A  30                                  SFLDLT
     A  30                                  SFLCLR
     A N30                                  SFLEND
     A            REC#           4S 0H      SFLRCDNBR
     A                                  1  3DATE
     A                                      EDTCDE(Y)
     A                                  1 12TIME
     A                                  1 27'    Work with QINTER Jobs    '
     A                                      DSPATR(RI)
     A                                      DSPATR(HI)
     A                                  1 62'CUGDSP  '
     A                                  1 72'CUDDSP  '
     A                                  2  3'                         Display A-
     A                                      ctive User Screens                 -
     A                                              '
     A                                      DSPATR(RI)
     A                                  5  3'Sel'
     A                                  5 18'User ID  '
     A                                  5 29'Job #'
     A                                  5  7'Device'
     A                                  5 36'User Name'
     A                                  5 67'Outq'
     A*  91/10/01  08:38:28    ISDWIGHT    REL-R03M00  5728-PW1
     A          R DATAFOOT
     A*%%TS  SD  20020531  083936  ISDWIGHT    REL-V4R4M0  5769-PW1
     A                                 23  2'F3=Exit'
     A                                      DSPATR(HI)
     A                                      DSPATR(RI)
     A                                      COLOR(TRQ)
     A                                 22  2'(Sel:'
     A                                 22  8'1'
     A                                      DSPATR(HI)
     A                                 22 10'Display Screen)'
     A                                 23  2'F3=Exit'
     A                                 23 12'F5=More Info'
     A*
     /*  Member .....: CUPDSP                                      */
     /*  Member type : DDS                                         */
     /*  Description : Physical file of CUPDSP Records             */
     /*  Compile ....: CRTPF  FILE(QGPL/CUPDSP)  +                 */
     /*                  SRCFILE(YOURLIB/QDDSSRC)                  */
     A*                                                               *
     A          R RDSP
     A            FLD1           3
     A            DSPDEV        10
     A            FLD2           3
     A            DSPUSR        10
     A            FLD3           3
     A            DSPNBR         6
     A            FLD4          13
     A            DSPSTS         6
     A*
     /*  Member .....: CULDSP                                      */
     /*  Member type : LF                                          */
     /*  Description : Logical view of CUPDSP Records              */
     /*  Compile ....: CRTLF  FILE(QGPL/CULDSP)  +                 */
     /*                  SRCFILE(YOURLIB/QDDSSRC)                  */
     A*                                                               *
     A                                      DYNSLT
     A          R RDSP                      PFILE(CUPDSP)
     A            DSPDEV
     A            DSPUSR
     A            DSPNBR
     A            DSPSTS
     A          S DSPNBR                    COMP(NE ':   QI')
     A            DSPNBR                    COMP(NE '      ')
     A            DSPNBR                    COMP(NE 'Number')
     A            DSPNBR                    COMP(NE ' * * *')
     A*
     /*  Member .....: CUPDSPA                                     */
     /*  Member type : PF                                          */
     /*  Description : Physical file of CUPDSPA Records            */
     /*                of ACTIVE records from WRKUSRJOB            */
     /*  Compile ....: CRTPF  FILE(QGPL/CUPDSPA) +                 */
     /*                  SRCFILE(YOURLIB/QDDSSRC)                  */
     A*                                                               *
     A          R RDSP
     A            FLD1          29
     A            DSPNBR         6
/*                                                            */
/*  Member .....: DSPSCRNCL                                   */
/*  Member type : CLP                                         */
/*  Description : CPP for DSPSCRN                             */
/*  Compile ....: CRTCLPGM PGM(QGPL/DSPSCRNCL) +              */
/*                  SRCFILE(YOURLIB/QCLSRC)                   */
/*                                                            */
        PGM        PARM(&JOBNAME &USER &JOBNO &IN03)
        DCL        VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
        DCL        VAR(&USER)    TYPE(*CHAR) LEN(10)
        DCL        VAR(&JOBNO)   TYPE(*CHAR) LEN(06)

        DCL        VAR(&DTAQA)   TYPE(*CHAR) LEN(10)
        DCL        VAR(&DTAQB)   TYPE(*CHAR) LEN(10)
        DCL        VAR(&LEN)     TYPE(*DEC)  LEN(5 0) VALUE(1)
        DCL        VAR(&WAIT)    TYPE(*DEC)  LEN(5 0) VALUE(30)
START:
        DCLF       FILE(SCREEN)
        MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
        CHGVAR     VAR(&DTAQA) VALUE('DSP' || &JOBNO)
        CHGVAR     VAR(&DTAQB) VALUE('STS' || &JOBNO)

/* If DTAQ doesn't exist, then create it.                     */
        CHKOBJ     OBJ(QGPL/&DTAQA) OBJTYPE(*DTAQ)
        MONMSG     MSGID(CPF9801) EXEC(DO)
        CRTDTAQ    DTAQ(QGPL/&DTAQA) MAXLEN(3564)
        CRTDTAQ    DTAQ(QGPL/&DTAQB) MAXLEN(1)
        ENDDO

/* Clears the DTAQ, then sends a request to capture screen    */
        CALL       PGM(QCLRDTAQ) PARM(&DTAQA 'QGPL')
        CALL       PGM(QCLRDTAQ) PARM(&DTAQB 'QGPL')
        CALL       PGM(QSNDDTAQ) PARM(&DTAQB 'QGPL' &LEN '*')

        STRSRVJOB  JOB(&JOBNO/&USER/&JOBNAME)
        TRCJOB     MAXSTG(1024) EXITPGM(QGPL/GETDSPCL)

        CALL       PGM(QRCVDTAQ) PARM(&DTAQA 'QGPL' &LEN &LINES +
                     &WAIT)

        DLYJOB     DLY(2)
        TRCJOB     SET(*END) MAXSTG(1024)
        ENDSRVJOB

/* The captured screen image is returned in &LINES            */
/* &LEN of 1920=24x80; otherwise it is 27x132 screen size      */
        IF         COND(&LEN *EQ 1920) THEN(DO)
            CHGVAR     VAR(&LINES80) VALUE(&LINES)
            SNDRCVF    RCDFMT(SCREEN80)
            ENDDO
            ELSE       CMD(DO)
            CHGVAR     VAR(&LINES132) VALUE(&LINES)
            SNDRCVF    RCDFMT(SCREEN132)
            ENDDO

            GOTO       CMDLBL(FINISH)

ERROR:      SNDPGMMSG  MSG('Errors occurred in command. Display job +
                         log for more details.')

FINISH:     DLTDTAQ    DTAQ(QGPL/&DTAQA)
            MONMSG     MSGID(CPF0000)
            DLTDTAQ    DTAQ(QGPL/&DTAQB)
            MONMSG     MSGID(CPF0000)
            RETURN

            ENDPGM
     /*                                                            */
     /*  Member .....: GETDSPCL                                    */
     /*  Member type : CLP                                         */
     /*  Description : Reads the screen and sends it to a DTAQ     */
     /*  Compile ....: CRTCLPGM PGM(QGPL/GETDSPCL)  +              */
     /*                  SRCFILE(YOURLIB/QCLSRC)                   */
     /*                                                            */
             PGM        PARM(&NOTUSED)
             DCL        VAR(&NOTUSED) TYPE(*CHAR) LEN(100)
             DCL        VAR(&DTAQA)   TYPE(*CHAR) LEN(10)
             DCL        VAR(&DTAQB)   TYPE(*CHAR) LEN(10)
             DCL        VAR(&LEN)     TYPE(*DEC)  LEN(5 0)
             DCL        VAR(&WAIT)    TYPE(*DEC)  LEN(5 0) VALUE(0)
             DCL        VAR(&JOBNO)   TYPE(*CHAR) LEN(06)
             DCLF       FILE(SCREEN)

             RTVJOBA    NBR(&JOBNO)
             CHGVAR     VAR(&DTAQA) VALUE('DSP' || &JOBNO)
             CHGVAR     VAR(&DTAQB) VALUE('STS' || &JOBNO)

             CALL       PGM(QRCVDTAQ) PARM(&DTAQB 'QGPL' &LEN &LINES +
                          &WAIT)
             IF         COND(&LEN *EQ 0) THEN(GOTO CMDLBL(FINISH))

     /* This part reads the screen contents and puts it into &LINES  */
             OVRDSPF    FILE(SCREEN) TOFILE(QGPL/SCREEN2) +
                          LVLCHK(*NO)
             CHGVAR     VAR(&LINES) VALUE(X'00021000730462')
             SNDRCVF    RCDFMT(SCREEN)

     /* Determines the display size:- 1920=24x80; 3564=27x132        */
             CHGVAR     VAR(&LEN) VALUE(3564)
             CHGVAR     VAR(&LINES) VALUE(%SST(&LINES 2 3563))
             IF         COND(%SST(&LINES 1921 1643) *EQ ' ') +
                          THEN(CHGVAR VAR(&LEN) VALUE(1920))
             CALL       PGM(QSNDDTAQ) PARM(&DTAQA 'QGPL' &LEN &LINES)

 FINISH:     ENDPGM
/*                                                            */
/*  Member .....: CUCDSP10                                    */
/*  Member type : CLP                                         */
/*  Description : CPP for ASK PERMISSION TO VIEW SCREEN      */
/*                AND THEN DISPLAY SCREEN                    */
/*  Compile ....: CRTCLPGM PGM(QGPL/CUCDSP10)        +              */
/*                  SRCFILE(YOURLIB/QCLSRC)                   */
/*                                                            */
             PGM        PARM(&JOBNAME &USER &JOBNO)
             DCL        VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
             DCL        VAR(&USER) TYPE(*CHAR) LEN(10)
             DCL        VAR(&JOBNO) TYPE(*CHAR) LEN(06)
             DCL        VAR(&REPLY) TYPE(*CHAR) LEN(01)
             DCL        VAR(&IN03) TYPE(*CHAR) LEN(01)
             DCL        VAR(&USRPRF) TYPE(*CHAR) LEN(50)
             DCL        VAR(&MSGTXT) TYPE(*CHAR) LEN(116)
             DCLF       FILE(QGPL/CUPDSPA)
/*                                                            */
/* CHECK TO SEE IF JOB/USER IS STILL ACTIVE                   */
/*                                                            */
             WRKUSRJOB  USER(&USER) STATUS(*ACTIVE) OUTPUT(*PRINT) +
                          JOBTYPE(*INTERACT)
             CLRPFM     FILE(QGPL/CUPDSPA)
             CPYSPLF    FILE(QPDSPSBJ) TOFILE(QGPL/CUPDSPA) +
                          SPLNBR(*LAST)
             DLTSPLF    FILE(QPDSPSBJ) SPLNBR(*LAST)
             OPNDBF     FILE(QGPL/CUPDSPA) OPTION(*INP)
/*------------------------------------------------------------------*/
/*  VERIFY THAT THE USER JOB IS STILL ACTIVE                        */
/*------------------------------------------------------------------*/

 READ:       RCVF
             MONMSG     MSGID(CPF0000) EXEC(DO)
               CLOF       OPNID(CUPDSPA)
               SNDUSRMSG  MSG('The User:' *CAT &USER *CAT ' with +
                            Job#:' *CAT &JOBNO *CAT ' is no longer active. +
                            Press 
 
  ')
               GOTO       CMDLBL(END)
             ENDDO

             IF         COND(&DSPNBR *NE &JOBNO) THEN(GOTO CMDLBL(READ))

             CHGVAR     VAR(&IN03) VALUE('0')
             RTVUSRPRF  TEXT(&USRPRF)
             CHGVAR     VAR(%SST(&MSGTXT 1 25)) VALUE('Please give +
                          authority to ')
             CHGVAR     VAR(%SST(&MSGTXT 26 50)) VALUE(&USRPRF)
             CHGVAR     VAR(%SST(&MSGTXT 76 41)) VALUE('to view your +
                          AS/400 display screen (Y/N).')
             SNDUSRMSG  MSG(&MSGTXT) VALUES('Y' 'N') DFT('N') +
                          TOMSGQ(&JOBNAME) MSGRPY(&REPLY)
             IF         COND(&REPLY *NE 'Y') THEN(GOTO CMDLBL(END))
START:
             CALL       PGM(DSPSCRNCL) PARM(&JOBNAME &USER &JOBNO +
                          &IN03)
             IF         COND(&IN03 *EQ '0') THEN(GOTO CMDLBL(START))
             CLOF       OPNID(CUPDSPA)
END:
             ENDPGM
/*                                                            */
/*  Member .....: CUCDSP20                                    */
/*  Member type : CLP                                         */
/*  Description : CPP for RETRIEVE ALL JOBS IN QINTER AND     */
/*                INSERT INTO A DATA FILE                     */
/*  Compile ....: CRTCLPGM PGM(QGPL/CUCDSP20)        +              */
/*                  SRCFILE(YOURLIB/QCLSRC)                   */
/*                                                            */
/*                                                                  */
             WRKSBSJOB  SBS(QINTER) OUTPUT(*PRINT)
             CLRPFM     FILE(QGPL/CUPDSP)
             CPYSPLF    FILE(QPDSPSBJ) TOFILE(QGPL/CUPDSP) +
                          SPLNBR(*LAST)
             DLTSPLF    FILE(QPDSPSBJ) SPLNBR(*LAST)
             ENDPGM
/*                                                            */
/*  Member .....: CUCDSP30                                    */
/*  Member type : CLP                                         */
/*  Description : CPP for RETRIEVE USER PROFILE INFORMATION   */
/*  Compile ....: CRTCLPGM PGM(QGPL/CUCDSP30)        +              */
/*                  SRCFILE(YOURLIB/QCLSRC)                   */
/*                                                            */
/*                                                                  */
             PGM        PARM(&USRPRF &TEXT &OUTQ &DLVRY &GPRF)
             DCL        VAR(&USRPRF) TYPE(*CHAR) LEN(10)
             DCL        VAR(&TEXT)   TYPE(*CHAR) LEN(50)
             DCL        VAR(&OUTQ)   TYPE(*CHAR) LEN(10)
             DCL        VAR(&GPRF)   TYPE(*CHAR) LEN(10)
             DCL        VAR(&DLVRY)  TYPE(*CHAR) LEN(10)
             RTVUSRPRF  USRPRF(&USRPRF) GRPPRF(&GPRF) OUTQ(&OUTQ) +
                          TEXT(&TEXT) DLVRY(&DLVRY)
             ENDPGM
/*                                                                  */
/*  Member .....: CUCDSP40                                          */
/*  Member type : CLP                                               */
/*  Description : CPP for RETRIEVING JOB ATTRIBUTES OF CALLING JOB  */
/*  Compile ....: CRTCLPGM PGM(CAMECO_SYS/DSPSCRNCL) +              */
/*                  SRCFILE(YOURLIB/QCLSRC)                         */
/*                                                                  */
             PGM        PARM(&JOBNO)
             DCL        VAR(&JOBNO)  TYPE(*CHAR) LEN(06)
             RTVJOBA    NBR(&JOBNO)
             ENDPGM
     F*****************************************************************
     F*                                                               *
     F*  Member .....: CUGDSP                                         *
     F*  Member type : RPG                                            *
     F*  Compile ....: CRTRPGPGM PGM(QGPL/CUGDSP)  +                  *
     F*                  SRCFILE(YOURLIB/QRPGSRC)                     *
     F************************************T****************************
     F*                                                               *
     F* UTILITY PROGRAM                                               *
     F*                                                               *
     F*****************************************************************
     F*                                                               *
     F* CUGDSP - DISPLAY ACTIVE USERS FOR VIEWING DISPLAY SCREEN FOR  *
     F*          TROUBLESHOOTING                                      *
     F*                                                               *
     F* DATE WRITTEN - 06/14/02                                       *
     F* WRITTEN BY   - D.BEECH                                        *
     F*****************************************************************
     F*                                                               *
     F* FILES USED:                                                   *
     F*  CUDDSP   - DISPLAY ACTIVE SESSIONS                           *
     F*    FORMAT - DATASUB, DATACTL, DATAFOOT                        *
     F*  CULDSP   - LOGICAL OF ACTIVE SESSIONS FILE                   *
     F*    FORMAT - RSPLF                                             *
     F*                                                               *
     F* DISPLAY FORMAT INDICATORS USED:                               *
     F*      CF03 - EXIT PROGRAM                                      *
     F*        30 - SUBFILE INITIALIZATION                            *
     F*                                                               *
     F* PROGRAM INDICATORS USED:                                      *
     F*        90 - GENERAL PURPOSE CHAIN,READ,WRITE                  *
     F*        91 - EOF OPTIONS FILE                                  *
     F*        92 - EOF DATA SUB-FILE                                 *
     F*        99 - GENERAL ERROR                                     *
     F*                                                               *
     F* SUBROUTINES USED:                                             *
     F*    $INIT  - INITIALIZATIONS FOR DATA SUB-FILE                 *
     F*    $FILL  - FILL DATA SUB-FILE                                *
     F*    $CHECK - CHECK THAT AT LEAST 1 REC IN SUB-FILE             *
     F*    $DISP  - PROCESS DATA SUB-FILE IN DISPLAY MODE             *
     F*    $RESET - RESET DISPLAY FORMAT ERROR INDICATORS             *
     F*    $READS - READ SELECTION FROM SUBFILE                       *
     F*                                                               *
     F*****************************************************************
     F*
     FCUDDSP  CF  E                    WORKSTN
     F                                        SFKEY KSFILE DATASUB
     FCULDSP  IF  E                    DISK
     C*
     C                     MOVE '0'       *IN94
     C*
     C*----------------------------------------------------------------
     C*  RTVJOBA COMMAND TO RETURN JOB NUMBER OF CURRENT SESSION
     C*----------------------------------------------------------------
     C                     CALL 'CUCDSP40'
     C                     PARM           JOBNO   6
     C*
     C*----------------------------------------------------------------
     C*  MAIN PROCESSING...
     C*  DO UNTIL F3 "EXIT PROGRAM"
     C*----------------------------------------------------------------
B1   C           *IN03     DOUEQ'1'
     C*
     C                     Z-ADD1         REC#
     C                     EXSR $INIT                      INIT. DATA SUB-FILE
     C                     EXSR $FILL                      BUILD DATA SUB-FILE
     C                     EXSR $DISP
     C*
E1   C                     END
     C*
     C                     MOVE '1'       *INLR            END
     C                     RETRN
     C*
     C*----------------------------------------------------------------
     C*  INITIALIZE DATA SUB-FILE
     C*----------------------------------------------------------------
     C           $INIT     BEGSR
     C                     MOVE '1'       *IN30
     C                     WRITEDATACTL
     C                     MOVE '0'       *IN30
     C*
     C                     Z-ADD0         SFKEY   30        SUB-FILE KEY
     C                     ENDSR
     C*
     C*----------------------------------------------------------------
     C*  FILL SUB-FILE WITH ACTIVE SESSIONS ONLY
     C*----------------------------------------------------------------
     C           $FILL     BEGSR
     C                     MOVE '0'       *IN91
     C                     MOVE '0'       *IN92
     C                     MOVE '1'       PRVDEV 10
     C                     MOVE '1'       PRVUSR 10
     C*
     C*----------------------------------------------------------------
     C*  RE-INITIALIZE ACTIVE SESSIONS FILE CUPDSP - PHYSICAL
     C*                                FILE CULDSP - LOGICAL
     C*----------------------------------------------------------------
     C                     CLOSECULDSP
     C                     CALL 'CUCDSP20'
     C                     OPEN CULDSP
     C*
     C*  DO UNTIL EOF FOR INPUT FILE OR SUB-FILE
B1   C           *IN91     DOUEQ'1'
     C           *IN92     OREQ '1'
     C*
     C                     READ RDSP                     91
     C*
B2   C           *IN91     IFNE '1'
     C           *IN92     ANDNE'1'
     C           PRVDEV    IFNE DSPDEV
     C           PRVUSR    ORNE DSPUSR
     C           DSPDEV    IFEQ *BLANKS
     C                     ELSE
     C                     MOVELDSPDEV    PRVDEV
     C                     MOVELDSPUSR    PRVUSR
     C                     END
     C                     END
     C                     MOVELPRVDEV    @SJBNM
     C                     MOVELPRVUSR    @SUSNM
     C                     MOVELDSPNBR    @SJBNO
     C*
     C*----------------------------------------------------------------
     C* GET USER PROFILE NAME AND OUTQ
     C*----------------------------------------------------------------
     C                     CALL 'CUCDSP30'
     C                     PARM           @SUSNM
     C                     PARM           #SUPNM 50
     C                     PARM           @SOUTQ
     C                     PARM           @SMSTY
     C                     PARM           @SGPRF
     C                     MOVEL#SUPNM    @SUPNM
     C*
     C*----------------------------------------------------------------
     C* LOAD ACTIVE SESSIONS ONLY TO SUBFILE AND OMIT CALLING SESSION
     C* TO AVOID VIEW OF THE CURRENT SESSION, CAUSES PROGRAM TO HANG
     C*----------------------------------------------------------------
     C           DSPSTS    IFEQ 'ACTIVE'
     C           JOBNO     ANDNE@SJBNO
     C                     ADD  1         SFKEY            INCR.RECD.#
     C                     WRITEDATASUB                  92
E3   C                     END
E2   C                     END
E1   C                     END
     C*
     C                     EXSR $CHECK
     C                     ENDSR
     C*
     C*----------------------------------------------------------------
     C*  CHECK TO ENSURE AT LEAST 1 RECORD IN SUBFILE
     C*----------------------------------------------------------------
     C           $CHECK    BEGSR
B1   C           SFKEY     IFEQ 0                          NO RECORDS
     C                     MOVE *BLANKS   @SJBNM
     C                     MOVE *BLANKS   @SUSNM
     C                     MOVE *BLANKS   @SJBNO
     C                     MOVE *BLANKS   @SUPNM
     C                     MOVE *BLANKS   @SOUTQ
     C                     MOVEL'NO ACT'  @SJBNM
     C                     MOVE 'IVE '    @SJBNM
     C                     MOVEL'JOBS'    @SUSNM
     C*
     C                     MOVE '1'       *IN94
     C                     ADD  1         SFKEY
     C                     WRITEDATASUB                  90
E1   C                     END
     C                     ENDSR
     C*
     C*----------------------------------------------------------------
     C*  PROCESS SUB-FILE & CALL SUBROUTINES TO PERFORM FUNCTIONS
     C*----------------------------------------------------------------
     C           $DISP     BEGSR
     C*
B1   C           *IN03     DOUEQ'1'                        DO UNTIL F3-EXIT
B1   C           *IN12     OREQ '1'                        DO UNTIL F3-EXIT
     C*
     C                     EXSR $INIT
     C                     EXSR $FILL
     C                     WRITEDATAFOOT
     C*
     C                     EXFMTDATACTL
     C*
B2   C           *IN03     IFNE '1'                        IF NOT F3
B2   C           *IN12     ANDNE'1'                        IF NOT F3
B3   C           *IN94     IFEQ '0'
     C                     EXSR $READS
E3   C                     END
E2   C                     END
E1   C                     END
     C                     ENDSR
     C*
     C*----------------------------------------------------------------
     C*  RESET ERROR INDICATORS
     C*----------------------------------------------------------------
     C           $RESET    BEGSR
B1   C           41        DO   46        I       20
     C                     MOVE '0'       *IN,I
E1   C                     END
     C                     MOVE '0'       *IN99
     C                     ENDSR
     C*
     C*----------------------------------------------------------------
     C* READ THE SUB-FILE AND CALL THE DISPLAY ENTRY OR DELETE FUNCTION
     C* OR THE TCP/IP DATA LOAD FILE
     C*----------------------------------------------------------------
     C           $READS    BEGSR
     C                     MOVE '0'       *IN93
     C*
B1   C           *IN93     DOUEQ'1'
     C                     READCDATASUB                  93
     C*
B2   C           *IN93     IFNE '1'
B3   C           @SEL      IFNE ' '
     C*
     C*----------------------------------------------------------------
     C* CALL CUCDSP10 TO DISPLAY SESSION REQUESTED
     C*----------------------------------------------------------------
     C                     CALL 'CUCDSP10'
     C                     PARM           @SJBNM
     C                     PARM           @SUSNM
     C                     PARM           @SJBNO
E3   C                     END
     C*
     C                     MOVE *BLANKS   @SEL
     C                     Z-ADDSFKEY     REC#
     C                     UPDATDATASUB
     C*
E2   C                     END
E1   C                     END
     C*
     C                     ENDSR
     C*----------------------------------------------------------------
 
 

Dig deeper on iSeries programming commands

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

SearchEnterpriseLinux

SearchDataCenter

Close