Article

Enhanced method for displaying users' sessions -- code











     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*----------------------------------------------------------------
 

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

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: