Display source: A*%%TS SD 20030305 104509 RICHQSEC REL-V5R1M0 5722-WDS A*%%EC A DSPSIZ(24 80 *DS3) A PRINT A*---------------------------------------------------------------- A R SCNSFL SFL A*%%TS SD 20030305 104509 RICHQSEC REL-V5R1M0 5722-WDS A 95 SFLNXTCHG A @NAME 10A O 6 3 A @TXT 36A O 6 15 A @STS 16A O 6 52 A @OUTQ 10A O 6 69 A*---------------------------------------------------------------- A R SCNCTL SFLCTL(SCNSFL) A*%%TS SD 20030108 142427 RICHQSEC REL-V5R1M0 5722-WDS A SFLSIZ(0200) A SFLPAG(0015) A CF03(03 'EXIT') A CF05(05 'REFRESH') A CF07(07 'SORT BY') A CF12(12 'CANCEL') A OVERLAY A SFLCSRRRN(&CURRRN) A 90 SFLDSP A 91 SFLDSPCTL A 92 SFLDLT A 93 SFLCLR A 94 SFLEND(*MORE) A CURRRN 5S 0H A 1 3DATE A EDTCDE(Y) A 1 12TIME A 1 27'Display Device Output Queues' A DSPATR(HI) A 1 62SYSNAME A 3 3'Output Que:' A DSPATR(HI) A PMOUTQ 10A B 3 15 A 5 3'Device ' A DSPATR(HI) A DSPATR(UL) A 5 15'Description - A ' A DSPATR(HI) A DSPATR(UL) A 5 52'Status' A DSPATR(HI) A DSPATR(UL) A 5 69'Output Que' A DSPATR(HI) A DSPATR(UL) A R SCNFTR A*%%TS SD 20030305 095140 RICHQSEC REL-V5R1M0 5722-WDS A 23 3'F3=Exit' A COLOR(BLU) A 23 15'F5=Refresh' A COLOR(BLU) A N44 23 30'F7=Sort by Outque' A COLOR(BLU) A 44 23 30'F7=Sort by Device' A COLOR(BLU) A 23 52'F12=Cancel' A COLOR(BLU) RPG Source Code: H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) ‚‚*-------------------------------------------------------------------- ‚‚* DISPLAY DEVICE OUTPUT QUEUES ‚‚*-------------------------------------------------------------------- ˜fdevoutqd cf e workstn f sfile(scnsfl:sflrrn) ‚‚*-------------------------------------------------------------------- ‚‚* Device Array -- holds all print data ‚‚*-------------------------------------------------------------------- d dev s 144 dim(1000) ascend ‚‚*-------------------------------------------------------------------- ‚‚* DEV Array Data Structure by Device ‚‚*-------------------------------------------------------------------- d devda ds d desort 10 d dename 10 d declas 10 d dectl 10 d deport 2 0 d deswit 2 0 d decatg 10 d detype 10 d detext 50 d destat 20 d deoutq 10 ‚‚*-------------------------------------------------------------------- ‚‚* API error data structure ‚‚*-------------------------------------------------------------------- d apierr ds d errprv 9b 0 d erravl 9b 0 d errid 7 d errpdt 17 96 ‚‚*-------------------------------------------------------------------- ‚‚* API display device description DS (DEVD0600) ‚‚*-------------------------------------------------------------------- d locdsp ds 830 d ldscat 31 40 d ldstxt 52 101 d ldsswi 129 132b 0 d ldspor 9b 0 d ldscls 165 174 d ldstyp 174 183 d ldctl 205 214 d ldoutq 335 344 ‚‚*-------------------------------------------------------------------- ‚‚* API configuration description DS (CFGD0200) ‚‚*-------------------------------------------------------------------- d cfgd ds d junk1 4 d apinam 10 d junk2 116 d apists 20 overlay(junk2:11) ‚‚*-------------------------------------------------------------------- ‚‚* API general header ‚‚*-------------------------------------------------------------------- d apihdr ds d gusoff 125 128b 0 d gusnbe 133 136b 0 d guslen 9b 0 ‚‚*-------------------------------------------------------------------- ‚‚* Binary variables declaration ‚‚*-------------------------------------------------------------------- d ds d gusspo 9b 0 d gushln 9b 0 d cusize 9b 0 d apivln 9b 0 d clrstr 9b 0 ‚‚*-------------------------------------------------------------------- ‚‚* Constant values ‚‚*-------------------------------------------------------------------- d cusnm c const('DEVOUTQ QTEMP ') d cusvl c const(x'00') d devdsp c const('*DSP ') d apifm1 c const('DEVD0600') d cfgfm1 c const('CFGD0200') ‚‚*--------------------------------------------------------------------- ‚‚* Stand Alone Fields ‚‚*--------------------------------------------------------------------- d apifmt s 8 d cfgfmt s 8 d cfgqlf s 40 d cfgsql s 20 d cfgtyp s 10 d cusatr s 10 d cusaut s 10 d cusnam s 20 d cusrpl s 10 d custxt s 50 d cusval s 1 d len s 15 5 d sflrrn s 4 0 d x s 4 0 d y s like(x) d svoutq s 10 ‚‚*---------------------------------------------------------------- ‚‚* MAINLINE ‚‚*---------------------------------------------------------------- c exsr getdev c exsr clrsfl c exsr lodsfl c exsr dsply c eval *inlr = *on ‚‚*-------------------------------------------------------------------- c getdev begsr ‚‚*-------------------------------------------------------------------- ‚‚* Create user space c call 'QUSCRTUS' usrspc ‚ ‚‚* Set variables to call device API (QDCLDFGD) for displays Cc movel devdsp cfgqlf c call 'QDCLCFGD' cfgprm ‚ ‚‚* Get header data from user space c call 'QUSRTVUS' gtushd ‚ ‚‚* Add one to the offset and get ready to read other data in ‚‚* user space c gusoff add 1 gusspo ‚ ‚‚* Set format field for displays and get display information c movel apifm1 apifmt c exsr lodard c clear apihdr ‚ ‚‚* Delete user space c call 'QUSDLTUS' dltspc c endsr ‚‚*-------------------------------------------------------------------- c lodard begsr ‚‚*-------------------------------------------------------------------- c reset x c clear dev ‚‚* Get device information c do gusnbe c call 'QUSRTVUS' gtusdt c eval dename = apinam c eval destat = apists ‚ ‚‚* Other configuration information c call 'QDCRDEVD' crdevd ‚ ‚‚* Move the fields retrieved to an array DS c z-add ldspor deport c eval dectl = ldctl c z-add ldsswi deswit c eval decatg = ldscat c eval detype = ldstyp c eval declas = ldscls c eval detext = ldstxt c eval deoutq = ldoutq ‚ ‚‚* Now the DS to the DEV array element c add 1 x c if *in44 = *off c eval desort = apinam c else c eval desort = ldoutq c endif c move devda dev(x) c clear devda c clear locdsp c clear cfgd c add guslen gusspo c if x >= 1000 c leave c endif c enddo c endsr ‚‚*---------------------------------------------------------------- ‚‚* CLEAR SUBFILE ‚‚*---------------------------------------------------------------- c clrsfl begsr ‚‚* c eval *in93 = *on c write scnctl c eval *in93 = *off c eval *in95 = *on c eval sflrrn = 0 ‚‚* c endsr ‚‚*-------------------------------------------------------------------- c lodsfl begsr ‚‚*-------------------------------------------------------------------- ‚‚* First, sort the array c sorta dev c reset x c do 1000 ‚‚* ‚‚* Move array to DS c move dev(x) devda c add 1 x ‚ ‚‚* If the class is blank, then no data exists in array C if DECLAS <> *BLANKS ‚ ‚‚* Write Subfile Records c if deoutq <> *blanks c and deoutq <> '*DEV' c if deoutq = pmoutq c and pmoutq <> *blanks c or pmoutq = *blanks c eval @name = dename c eval @txt = detext c eval @sts = destat c eval @outq = deoutq c add 1 sflrrn c write scnsfl c endif c endif c endif c enddo ‚ ‚‚* SET UP SUBFILE CONTROL c if sflrrn = 0 c eval *in91 = *on c else c eval *in94 = *on c eval *in90 = *on c eval *in91 = *on c endif ‚ c endsr ‚‚*---------------------------------------------------------------- c dsply begsr ‚‚*---------------------------------------------------------------- ‚‚* Display Workstaton Screen c dow *inkl = *off c and *inkc = *off c write scnftr c exfmt scnctl ‚‚* Check for Refresh c if *inke = *on c eval svoutq = *blanks c eval pmoutq = *blanks c exsr getdev c exsr clrsfl c exsr lodsfl c iter c endif ‚‚* Check for Sort by c if *inkg = *on c if *in44 = *off c eval *in44 = *on c else c eval *in44 = *off c endif c eval svoutq = *blanks c eval pmoutq = *blanks c exsr getdev c exsr clrsfl c exsr lodsfl c iter c endif ‚‚* Check for Selected Output Queue c if pmoutq <> svoutq c eval svoutq = pmoutq c exsr clrsfl c exsr lodsfl c endif c enddo ‚ c endsr ‚‚*-------------------------------------------------------------------- c *inzsr begsr ‚‚*-------------------------------------------------------------------- ‚‚* Initialize array counter c eval x = 1 ‚ ‚‚* Initialize variable for create user space c eval errprv = 96 ‚ ‚‚* Initialize variables for Create User Space API c movel cusnm cusnam c eval cusatr = *blanks c eval cusize = 4096 c movel cusvl cusval c eval %subst(cusaut:1:7) = '*CHANGE' c eval custxt = *blanks c eval %subst(cusrpl:1:4) = '*YES' ‚ ‚‚* Get user space variables c eval gushln = 140 ‚ ‚‚* Init the get config devices variables c eval %subst(cfgtyp:1:5) = '*DEVD' c eval cfgsql = *blanks c eval cfgfmt = 'CFGD0200' ‚ ‚‚* Create user space parameter list c usrspc plist c parm cusnam c parm cusatr c parm cusize c parm cusval c parm cusaut c parm custxt c parm cusrpl c parm apierr ‚ ‚‚* Delete user space parameter list c dltspc plist c parm cusnam c parm apierr ‚ ‚‚* Get configuration descriptions c cfgprm plist c parm cusnam c parm cfgfmt c parm cfgtyp c parm cfgqlf c parm cfgsql c parm apierr ‚ ‚‚* Get user space header parameter list c gtushd plist c parm cusnam c parm 1 gusspo c parm gushln c parm apihdr ‚ ‚‚* Get user space detail parameter list c gtusdt plist c parm cusnam c parm gusspo c parm guslen c parm cfgd ‚ ‚‚* QCRDEVD parameter list for displays c crdevd plist c parm locdsp c parm 830 apivln c parm apifmt c parm apinam c parm apierr c endsr ‚‚*--------------------------------------------------------------------- Command Source Code: /*------------------------------------------------------------------*/ /* COMMAND.....: DSPDEVOUTQ */ /* DESCRIPTION.: DISPLAY DEVICE OUTPUT QUEUES */ /* COMPILE.....: CRTCMD CMD(SYCUST/DSPDEVOUTQ) PGM(SYCUST/DEVOUTQR) */ /* SRCFILE(SYCUST/QCMDSRC) */ /*------------------------------------------------------------------*/ CMD PROMPT('Display Device Output Queues')