DDS Display Code: A DSPSIZ(24 80 *DS3) A PRINT A CA03 A CA12 A R SFLRCD SFL A 55 SFLNXTCHG A SPFILN 6A H A SPNAME 10A H A SELOPT 1A B 8 3 A JOBNAM 10A O 8 7 A USRNAM 10A O 8 19 A JOBNUM 6A O 8 31 A PAGES 6Y 0O 8 39EDTCDE(Z) A OUTQ 10A O 8 47 A OUTQLIB 10A O 8 59 A R SFLCTL SFLCTL(SFLRCD) A SFLSIZ(0500) A SFLPAG(0014) A RTNCSRLOC(&CURRCD &CURFLD) A CSRLOC(ROWNBR COLNBR) A OVERLAY A 50 SFLDSP A 51 SFLDSPCTL A 52 SFLDLT A 53 SFLCLR A 54 SFLEND(*MORE) A N54 ROLLUP(25) A SFLCSRRRN(&CSRRRN) A CSRRRN 5S 0H A SFLRRN 4S 0H SFLRCDNBR(CURSOR) A CURRCD 10A H TEXT('Cursor Record') A CURFLD 10A H TEXT('Cursor Field') A ROWNBR 3S 0H TEXT('Row Number') A COLNBR 3S 0H TEXT('Col Number') A 1 5DATE A EDTCDE(Y) A 1 25'Work with Spooled Print File' A DSPATR(HI) A COLOR(WHT) A 1 69SYSNAME A 2 5TIME A 2 31'File:' A SPFILE 10A O 2 37 A 2 69USER A 4 4'Type options, press Enter.' A COLOR(BLU) A 5 6'5=Display' A COLOR(BLU) A 7 2'Opt' A DSPATR(HI) A 7 7'Job Name' A DSPATR(HI) A 7 19'User' A DSPATR(HI) A 7 31'Job#' A DSPATR(HI) A 7 39'Pages' A DSPATR(HI) A 7 47'Outqueue' A DSPATR(HI) A 7 59'Library' A DSPATR(HI) A R SFLCMD A TEXT('Command keys') A 23 4'F3=Exit' A COLOR(BLU) A 23 16'F12=Cancel' A COLOR(BLU) A*-------------------------------------------------- A R MSGSFL SFL A*-------------------------------------------------- A SFLMSGRCD(24) A MSGKEY SFLMSGKEY A PGMQ SFLPGMQ A*-------------------------------------------------- A* MESSAGE SUBFILE CONTROL RECORD A*-------------------------------------------------- A R MSGCTL SFLCTL(MSGSFL) A OVERLAY A SFLSIZ(0050) A SFLPAG(0001) A N99 SFLEND A N99 SFLDSP A N99 SFLDSPCTL A N99 SFLINZ A PGMQ SFLPGMQ RPG Code: ********************************************************************* * To Create: * CRTBNDRPG PGM(WRKPRTFR) DFTACTGRP(*NO) ACTGRP(ILE) * * Note: Add library QGY to your library list prior to running this pgm * ********************************************************************* fWrkprtfd cf e workstn f sfile(SflRcd:SflRrn) f infds(info) d F03 c const(x'33') d F12 c const(x'3C') '*---------------------------------------------------------------- '* Used for sending messages - API '*---------------------------------------------------------------- d ds inz d DtaLen 9B 0 d StkCnt 9B 0 d ErrCod 9B 0 '*---------------------------------------------------------------- '* Program Data Structure '*---------------------------------------------------------------- d psds sds d parms *parms d pgm 1 10 d UsrPrf 254 263 d WstnId 244 253 '*---------------------------------------------------------------- '* Command to Display Print File '*---------------------------------------------------------------- *DSPSPLF FILE(QSYSPRT) JOB(999999/USER/JOBNAM) SPLNBR(99999) d Cmd1 C Const('DSPSPLF FILE(') d Cmd2 C Const(') JOB(') d Cmd3 C Const('/') d Cmd4 C Const(') SPLNBR(') d Cmd5 C Const(')') '*---------------------------------------------------------------- '* Workstation Data Structure '*---------------------------------------------------------------- d Info ds d key 369 369 '*---------------------------------------------------------------- '* Stand alone fields '*---------------------------------------------------------------- d MsgDta s 80 d MsgF s 20 d MsgId s 7 d MsgKy s 4 d MsgRmv s 10 d MsgTyp s 10 d Command s 320a INZ d CommandLen s 15p 5 INZ(320) d FmtName s 8 d FormType s 10 inz('*ALL') d GetNbrRcds s 10i 0 inz(5000) d JobName s 26 d ListInfo s 80 d SflRrn s 4 0 d RcdCnt s 4 0 d StartRcd s 10i 0 inz(1) d Users s 12 dim(2) d UsrSpcData s 10 inz('*ALL') d Variable s 1920 d VarLength s 10i 0 inz(%len(Variable)) d VarStart s 5 0 d X s 4 0 Inz(1) d Y s 4 0 d ErrFlg s 1 d CurLoc s 3 0 d FstLoc s 3 0 d ScdLoc s 3 0 d FstTxt ds d Fst1 1 overlay(FstTxt:1) d Fst2 1 overlay(FstTxt:2) d Fst3 1 overlay(FstTxt:3) d ScdTxt ds d Scd1 1 overlay(ScdTxt:1) d Scd2 1 overlay(ScdTxt:2) d Scd3 1 overlay(ScdTxt:3) * Filter/select information data structure dFilterInfo DS 1000 d NbrUsrName 1 4b 0 inz(1) d FilterInf 5 1000 * OutQueue Selection array dOutQueDs DS 24 d NbrOutQs 1 4b 0 inz(1) d OutqFilt 5 24 inz('*ALL') * Status selection array dStatusDs DS 16 d NbrStats 1 4b 0 inz(1) d StatusFilt 5 16 inz('*ALL') * Device selection array dDeviceDs DS 16 d NbrDevices 1 4b 0 inz(1) d DeviceFilt 5 16 inz('*ALL') * Sort information data structure dSortInfo DS 16 d NbrKeySort 1 4B 0 Inz(0) d KeySortStr 5 8B 0 Inz(0) d SortKeyLen 9 12B 0 inz(0) d KeyDataTyp 13 14B 0 inz(x'0000') d SortOrder 15 15 inz(x'00') d Reserved 16 16 inz(x'00') * Standard Error Code data structure dQUSEC DS 116 d QUSBPRV 1 4B 0 inz(116) * Format OGYV020000 Open List of Spooled Files. Copied from * member QGYOLSPL, source file QRPGLESRC, in library QSYSINC dQGYV020000 DS 192 D* Qgy Olspl RecVar 0200 D*QGYV010001 160 D* RecVar 0100 D QGYSFILN04 1 10 D* Spooled File Name D QGYJN02 11 20 D* Job Name D QGYUN02 21 30 D* User Name D QGYJN03 31 36 D* Job No D QGYSFILN05 37 40B 0 D* Spooled File No D QGYTP00 41 44B 0 D* Total Pages D QGYCP05 45 48B 0 D* Current Page D QGYCTP00 49 52B 0 D* Copies To Print D QGYOQN03 53 62 D* Out Q Name D QGYOQLN01 63 72 D* Out Q Lib Name D QGYUSD00 73 82 D* User Spec Data D QGYTATUS01 83 92 D* Status D QGYFT01 93 102 D* Form Type D QGYORITY00 103 104 D* Priority D QGYIJID00 105 120 D* Int Job ID D QGYISFID00 121 136 D* Int SF ID D QGYDT06 137 146 D* Device Type D QGYERVED36 147 160 D* Reserved D QGYDO 161 167 D* Date Opened D QGYTO 168 173 D* Time Opened D QGYPA 174 174 D* Printer Assigned D QGYPN 175 184 D* Printer Name D QGYERVED37 185 192 D* Reserved * Format OGYOLI02 Open List of Spooled Files. Copied from * member QGYOLSPL, source file QRPGLESRC, in library QSYSINC dQGYOLI02 DS 80 D* Qgy Olspl ListInfo D QGYTR03 1 4B 0 D* Total Records D QGYRR02 5 8B 0 D* Records Retd D QGYRH03 9 12 D* Request Handle D QGYRL03 13 16B 0 D* Record Length D QGYIC03 17 17 D* Info Complete D QGYDT07 18 30 D* Date Time D QGYLS02 31 31 D* List Status D QGYRSV108 32 32 D* Reserved1 D QGYIL02 33 36B 0 D* Info Length D QGYFR02 37 40B 0 D* First Record D QGYRSV207 41 80 D* Reserved2 c *entry plist c parm SpFile * Create FilterInfo field c movel '*ALL' Users(1) c exsr CrtFiltInf * List spooled files to variable c Call 'QGYOLSPL' c Parm Variable c Parm VarLength c Parm QgyOLI02 c Parm GetNbrRcds c Parm SortInfo c Parm FilterInfo c Parm JobName c Parm 'OSPL0200' FmtName c Parm QusEc * Clear the subfile records c movea '000100' *IN(50) c write SflCtl c movea '010001' *IN(50) c eval RcdCnt = 0 c eval SflRrn = 0 c eval CsrRrn = 0 * Process the variable field into subfile records c Exsr ProcessVar * Do until all the records are processed c dow RcdCnt < QGYTR03 c Exsr GetMorRecs c Exsr ProcessVar c enddo * Close the list c Call 'QGYCLST' c Parm QgyRH03 c Parm QusEc * Display Spool List c Dow Key <> F03 c and Key <> F12 c if CsrRrn > *zero c eval SflRrn = CsrRrn c else c if SflRrn <> *zero c eval SflRrn = 1 c endif c endif c write SflCmd 002 c write MsgCtl c Exfmt SflCtl c exsr ClrMsg * Check for exit/cancel c if Key = F03 c or Key = F12 c leave c endif c if SflRrn > 0 c eval *IN80 = *off c readc SflRcd 80 c dow *IN80 = *OFF c if SelOpt = '5' c eval Command = Cmd1 + c %TRIMR(SpName) + Cmd2 + c %TRIMR(JobNum) + Cmd3 + c %TRIMR(UsrNam) + Cmd3 + c %TRIMR(JobNam) + Cmd4 + c %TRIMR(spfiln) + Cmd5 c CALL 'QCMDEXC' c PARM Command c PARM CommandLen c clear SelOpt c update SflRcd c endif c readc SflRcd 80 c clear Key c enddo c endif c enddo c eval *inlr = *on ********************************************************************* ** Get more records from the open list via QGYGTLE ********************************************************************* c GetMorRecs Begsr c Eval StartRcd = StartRcd + QgyRR02 * Get more entries from the list c Call 'QGYGTLE' c Parm Variable c Parm VarLength c Parm QgyRH03 c Parm QgyOLI02 c Parm GetNbrRcds c Parm StartRcd c Parm QusEc c Endsr '*---------------------------------------------------------------- c ProcessVar Begsr '*---------------------------------------------------------------- ** Process variable returned from open list API c Eval VarStart = 1 c Do QgyRR02 c Eval QgyV020000 = %subst(Variable:VarStart: c QgyRL03) * Process the information in data structure QgyV020000 * Write to a subfile record, print it, whatever * c move QgySFilN04 SpName c move QgySFilN05 spfiln c move QgyJN02 JobNam c move QgyUN02 UsrNam c move QgyJN03 JobNum c move QgyTP00 Pages c move QgyOQN03 Outq c move QgyOQLN01 OutqLib c eval RcdCnt = RcdCnt + 1 c if SpFile = SpName c eval SflRrn = SflRrn + 1 c write SflRcd c endif c Eval VarStart = VarStart + QgyRL03 c Enddo c if SflRrn <> 0 c eval *IN50 = *ON c endif c eval *IN54 = *ON c Endsr '*---------------------------------------------------------------- c CrtFiltInf Begsr '*---------------------------------------------------------------- ** Create filter info field using parameters passed to program c do NbrUsrName Y c eval FilterInf = %replace(Users(Y):FilterInf :x) c eval x = x + 12 c enddo c eval FilterInf = %replace(OutqueDs:FilterInf:x) c eval x = x + 24 c eval FilterInf = %replace(FormType:FilterInf:x) c eval x = x + 10 c eval FilterInf = %replace(UsrSpcData: c FilterInf:x) c eval x = x + 10 c eval FilterInf = %replace(StatusDs:FilterInf:x) c eval x = x + 16 c eval FilterInf = %replace(DeviceDs:FilterInf:x) c eval x = x + 16 c Endsr '*---------------------------------------------------------------- c ClrMsg BEGSR '*---------------------------------------------------------------- c CALL 'QMHRMVPM' c PARM PGMQ c PARM STKCNT c PARM MSGKY c PARM MSGRMV c PARM ERRCOD '* c ENDSR '*---------------------------------------------------------------- c SndMsg BEGSR '*---------------------------------------------------------------- c CALL 'QMHSNDPM' c PARM MSGID c PARM MSGF c PARM MSGDTA c PARM DTALEN c PARM MSGTYP c PARM PGMQ c PARM STKCNT c PARM MSGKEY c PARM ERRCOD '* c ENDSR '*---------------------------------------------------------------- c *INZSR BEGSR '*---------------------------------------------------------------- '* SET UP MESSAGE PARMS - API c MOVEL '*' PGMQ c eval MSGKY = *BLANKS c eval MSGDTA = *BLANKS c MOVEL '*DIAG' MSGTYP c MOVEL '*ALL' MSGRMV c 'CPWMSG' CAT(P) '*LIBL':4 MSGF '* Send Welcome Message 006 c eval MsgId = 'EML0001' 006 c exsr SndMsg c ENDSR '*---------------------------------------------------------------- CMD Code: CMD PROMPT('Work Spool Print File') PARM KWD(SPFILE) TYPE(*CNAME) LEN(10) MIN(1) + CHOICE('Enter Spool Print File') + PROMPT('SPOOL FILE NAME')