* H-Specs * I use /copy for my h-specs, so below is just an axample of * copying in the h-specs. You can do the same or simply add * by hand. /copy yourlib/qrpglesrc,cp_hspecs * The RPGNEXTLIB h-specs, includes the correct BNDDIR statements * for using the RPGNEXT library functions. /copy rpgnextlib/qrpglesrc,cp_hspecs * File Specs fDSPFNAME cf e workstn infds(wsds) f sfile(subfile1:rrn1) * Prototypes * The prototypes for the RPGNEXT library procedures. /copy rpgnextlib/qrpglesrc,cp_longprs d init pr d keyPressed pr n d clearSub1 pr d loadSub1 pr d processOption pr d declare pr d setOptions pr d shutDown pr d PGMNAME pr d PGMNAME pi * Arrays and Data Structures * I use Bob Cozzi's function key file (which he has published * numerous times) to copy in the function key names and * corresponding hex codes as constants. /copy yourlib/qrpglesrc,funckeys d mainDS e ds extname( MAINFILE ) d prefix( m_ ) * Indicators d indPtr s * inz( %addr(*in) ) d indicators ds 99 based( indPtr ) * Option Displays d optF6 n overlay( indicators : 6 ) d opt2 n overlay( indicators : 32 ) d opt3 n overlay( indicators : 33 ) d opt4 n overlay( indicators : 34 ) d opt5 n overlay( indicators : 35 ) * Position Cursor d posPC n overlay( indicators : 50 ) * Position Reverse Image d posRI n overlay( indicators : 51 ) * These change indicators are used to indicate that subfile * position selection/order fields have been changed d change1 n overlay( indicators : 77 ) d change2 n overlay( indicators : 78 ) d change3 n overlay( indicators : 79 ) * Standard Subfile Indicators d sflEndMore n overlay( indicators : 85 ) d sflDisplayCtl n overlay( indicators : 90 ) d sflDisplay n overlay( indicators : 95 ) * Standalone Fields d sflComplete s n inz(*off) d sqlStatement s 32000a varying d saveRrn s like( rcdnbr ) d mainStatement s like( sqlStatement ) * Constants * This /copy brings in some constants, including true and false. /copy rpgnextlib/qrpglesrc,cp_const // uncomment this!!! d*sflSize c const(SFLSIZE) * Main Line /free init(); clearSub1(); loadSub1(); dow not sflComplete ; write FOOTERNAME ; exfmt control1 ; posCursor = false ; if not keyPressed(); processOption(); endif ; enddo ; shutdown(); *inlr = true ; /end-free *-------------------------------------------------------------------- p init b d init pi /free // Use this to set the initial cursor position. posPC = true ; /end-free p init e *-------------------------------------------------------------------- p declare b d declare pi c/exec SQL c+ declare mainCursor Cursor c+ for mainSelect c/end-exec c/exec sql c+ prepare mainSelect c+ from :mainStatement c/end-exec p declare e *---------------------------------------------------------------- * subproc for clearing subfile 1 *---------------------------------------------------------------- p clearSub1 b d clearSub1 pi /free sflDisplayCtl = false ; write control1 ; sflDisplayCtl = true ; sflDisplay = false ; sflEndMore = false ; clear rrn1 ; clear saveRrn ; // Example positional and order changes // These are just samples, but I believe the field names // roughly match the sample DSPF. At any rate, if the // user changes the value of one of the selection fields, // the change indicator assigned to changes to true and // the program will clear and rebuild the subfile. if change1 = true ; mainStatement = 'Select * from cam500ap where TPID >= ' + %trim( %editc(CTL1ID:'Z') ) + ' order by TPID ' + 'for read only ' + 'optimize for ' + %char(sflSize) + ' rows' ; elseif change2 = true ; mainStatement = 'Select * from cam500ap where ' + 'SOCSEC1 = ' + %trim( %editc(CTL1ID:'Z') ) + 'or SOCSEC2 = ' + %trim( %editc(CTL1ID:'Z') ) + ' order by TPID ' + 'for read only ' + 'optimize for ' + %char(sflSize) + ' rows' ; elseif CTL1NAME <> ' ' ; mainStatement = 'Select * from cam500ap where NAME1 >= ' + singleQuote + %trim( CTL1NAME ) + singleQuote + ' order by NAME1 ' + 'for read only ' + 'optimize for ' + %char(sflSize) + ' rows' ; else ; mainStatement = 'Select * from cam500ap order by NAME1 ' + 'for read only ' + 'optimize for ' + %char(sflSize) + ' rows' ; endif ; // makes sure the mainCursor is not already open shutdown(); declare(); /end-free c/exec sql c+ open mainCursor c/end-exec p clearSub1 e *---------------------------------------------------------------- * subproc for loading subfile 1 *---------------------------------------------------------------- p loadSub1 b d loadSub1 pi d i s 5i 0 inz(0) /free setOptions(); sflDisplay = false ; // Can I read this from the DSPF somehow??? // This is the only change I would like to make: can I get the // display file itself to tell me what the SFLSIZE is? If so // I would not need to put it in as a constant. That way if you // change the subfile screen you don't have to remember to // change the constant in this program. for i=1 to sflSize ; /end-free c/exec SQL c+ fetch next from mainCursor into :mainDS c/end-exec /free if sqlstt = '00000' ; // fill in subfile field names // increment subfile RRN and turn display on rrn1 = rrn1 + 1 ; sflDisplay = true ; clear sub1opt ; write subfile1 ; else ; leave ; endif ; endfor ; if i < sflSize ; sflEndMore = true ; endif ; // Position screen if saveRrn = 0 ; rcdnbr = 1 ; else ; rcdNbr = saveRrn ; endif ; saveRrn = rrn1 + 1 ; /end-free p loadSub1 e *---------------------------------------------------------------- * subproc for processing funciton keys * * Again, these funcitonKey names (and the variable "functionKey") * come from the /copy "funckeys" *---------------------------------------------------------------- p keyPressed b d keyPressed pi n d isKey s n inz( *off ) /free if functionKey = F3 ; sflComplete = true ; isKey = true ; elseif functionKey = F5 ; clearSub1(); loadSub1(); posPC = true ; isKey = true ; elseif functionKey = F6 ; // Process add logic // ADDPROC() is what ever procedures or logic you want to // execute to add a record. if optF6 ; ADDPROC(); clearSub1(); loadSub1(); posPC = true ; endif ; isKey = true ; elseif functionKey = ROLLUP ; loadSub1(); isKey = true ; elseif nameChange = true or idChange = true or ssnChange = true ; clearSub1(); loadSub1(); isKey = true ; endif ; return isKey ; /end-free p keyPressed e *---------------------------------------------------------------- * subproc for processing options * * If you want to add or delete options do so here. *---------------------------------------------------------------- p processOption b d processOption pi d didOption s n inz( *off ) d rebuild s n inz( *off ) /free readc subfile1 ; dow not %eof( DSPFNAME ); reset didOption ; if sub1Opt = '2' ; // process change logic if opt2 ; // CHANGEPROC() is what ever procedures or logic you want to // execute to change the record. CHANGEPROC(); didOption = true ; endif ; elseif sub1Opt = '3' ; // process copy logic if opt3 ; // COPYPROC() is what ever procedures or logic you want to // execute to copy the record. COPYPROC(); didOption = true ; endif ; elseif sub1Opt = '4' ; // process delete logic if opt4 ; // DELETEPROC() is what ever procedures or logic you want to // execute to delete the record. DELETEPROC(); didOption = true ; // we rebuild the screen after a delete to prevent // the user from selecting a deleted item rebuild = true ; endif ; elseif sub1Opt = '5' ; // process display logic // DISPLAYPROC() is what ever procedures or logic you want to // execute to display the record. if opt5 ; DISPLAYPROC(); didOption = true ; endif ; endif ; // position subfile cursor if didOption ; chain rrn1 subfile1 ; clear sub1opt ; update subfile1 ; rcdnbr = rrn1 ; endif ; readc subfile1 ; enddo ; if rebuild ; clearSub1(); loadSub1(); else ; rrn1 = saveRrn - 1 ; endif ; /end-free p processOption e *-------------------------------------------------------------------- p setOptions b d setOptions pi /free opt2 = check_auth( '**NAME**' : '2' ); opt3 = check_auth( '**NAMES**' : '3' ); opt4 = check_auth( '**NAMES**' : '4' ); opt5 = check_auth( '**NAMES**' : '5' ); optF6 = check_auth( '**NAMES**' : 'F6' ); /end-free p setOptions e *-------------------------------------------------------------------- p shutDown b d shutDown pi c/exec sql c+ close mainCursor c/end-exec p shutDown e