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