RPG CODE
H DFTACTGRP(*NO)
H/DEFINE PROFOUNDUI
FMRA0100D CF E WORKSTN EXTFILE('APPANV/MRA0100D')
f infds(kyinfds)
f indds(indinfds)
f sfile(GridData:s_GridRow)
f prefix(s_)
* fill resource grid parms
*/copy qcpylesrc,mra0109s
*/if not defined(ResourceMasterGrid)
d rmRwNd s 3 0 rows needed
d rmRwRt s 3 0 rows returned
d rmGSts s 1a table status:
d 'S' = table start
d 'E' = tablew end
d 'W' = within table
d 'N' = empty table
d rmGrid ds qualified dim(gr) result set of rows
d RescID 16a resource id
d Locatn 10a location
d RunRte 9 2 run rate
*/endif
*/define ResourceMasterGrid
* application constants
*/copy qcpylesrc,uua1000r
*/if not defined(ApplicationConstants)
* constants
d gr c const(999) Rows in Grid
d eof c const(00012) End of File
d on c const('1') On
d off c const('0') Off
d Invalid c const('1') Invalid
d Valid c const('0') Valid
d No c const('0') No = off
d Yes c const('1') Yes = on
d Exit c const('X') Exit Condition
d Cancel c const('C') Cancel Condition
d Continue c const(' ') Continue Condition
d Start c const('S') Start of Table
d End c const('E') End of Table
d Within c const('W') Within Table
d Null c const('N') Null Table (empty)
d Cmp c const('01') AppCon Company 01
d Div c const('00') AppCon Division 00
* working variables
d Action s 1a inz(*blank) Action to take:
d 'X' = Exit
d 'C' = Cancel
d ' ' = Continue
d Response s 1a Response to send:
d 'X' = Exit
d 'C' = Cancel
d ' ' = Continue
d Compny s 2a inz('01') AppCon Company 01
d Divisn s 2a inz('00') AppCon Division 00
d ErrNum s 7a error id
d ErrDsc s 132a error description
d ErrFld s 2 0 error field
d WinLne s 2 0 window start line
d WinPos s 3 0 window start pos.
* boolean defs
d Errors s n inz(*off) Error condition
d EndPgm s n inz(*off) End of Program
d Refresh s n inz(*off) Refresh
* grid options
d oView s 1a inz('1') View Row
d oSelect s 1a inz('1') Select Row
d oEdit s 1a inz('2') Edit Row
d oCopy s 1a inz('3') Copy Row
d oDelete s 1a inz('4') Delete Row
* program status data structure
d sds 263
d UserID 254 263a
* display file indicator representation
d indinfds ds
d dClrGrid 87 87n Clear Grid
d dHidGrid 88 88n Hide Grid
d dEndGrid 89 89n End of Grid
* representation of which key was pressed on the keyboard
d kyinfds ds
d KeyPressed 369 369 Key Pressed
* keyboard key constants
d kExit c x'33' Exit Function (F3)
d kCancel c x'3C' Cancel Func. (F12)
d kPrompt c x'34' Refresh Func. (F5)
d kRefresh c x'35' Refresh Func. (F5)
d kAdd c x'36' Add Function (F6)
d kEnter c x'F1' Enter
*/endif
*/define ApplicationConstants
* work field definitions
d SavGridRow s like(s_GridRow) inz(1)
* columns from grid
d ScrDta ds
d s_RescID
d s_Locatn
d s_RunRte
* backup fields from grid
d bScrDta ds likeds(ScrDta)
**********************************************************************************************
* initial processing - begin
*
* do one time, at program startup
c exsr FillGrid
c eval s_GridRow = 1
c reset EndPgm
* initial processing - end
**********************************************************************************************
**********************************************************************************************
* main program loop - begin
*
* process grid options and commands until user presses (f3)exit
c dow not EndPgm
c exsr DspWindow
c select
**********************************************************************************************
*** (f3)exit key from grid - begin
***
*** if user presses (f3)exit from grid, return to caller
c when (KeyPressed = kExit)
c eval EndPgm = Yes
c iter
*** (f3)exit key from grid - end
**********************************************************************************************
**********************************************************************************************
*** (f6)add key from grid - begin
***
*** if user presses (f6)add from grid, call add program
c when (KeyPressed = kAdd)
c call 'MRA0140R'
c parm WinLne
c parm WinPos
c parm Action
c if Action = Exit
c eval EndPgm = Yes
c endif
c exsr RfrGrid
c iter
*** (f6)add key from grid - end
**********************************************************************************************
**********************************************************************************************
*** no rows to display - begin
***
*** if user presses a key other than (f3)exit or f(6)add, when there are no rows in the grid -
*** redisplay
c when (rmGSts = Null)
c eval dHidGrid = On
*** no rows to display - end
**********************************************************************************************
**********************************************************************************************
*** (f12)cancel key from grid - begin
***
*** if user presses (f12)cancel from grid, clear all options and redisplay
c when (KeyPressed = kCancel)
c readc GridData
c dow (not %eof)
c eval s_Opt = *blanks
c update GridData
c readc GridData
c enddo
*** (f12)cancel key from grid - end
**********************************************************************************************
**********************************************************************************************
*** (enter) from grid - begin
***
*** if user presses enter from grid, process all options, if any
c when (KeyPressed = kEnter)
c exsr PosCursor
c readc GridData
c eval bScrDta = ScrDta
c dow (not %eof)
c select
***** (1)view option
c when (s_Opt = oView)
c call 'MRA0110R'
c parm WinLne
c parm WinPos
c parm ScrDta
c parm Action
******* (f3)exit on view window
c if Action = Exit
c return
c endif
***** (2)edit option
c when (s_Opt = oEdit)
c call 'MRA0120R'
c parm WinLne
c parm WinPos
c parm ScrDta
c parm Action
******* (f3)exit on edit window
c if Action = Exit
c return
c endif
***** (4)delete option
c when (s_Opt = oDelete)
c call 'MRA0130R'
c parm WinLne
c parm WinPos
c parm ScrDta
c parm Action
******* (f3)exit on delete window
c if Action = Exit
c return
c endif
c endsl
***** get next option
c eval s_Opt = *blanks
c update GridData
c readc GridData
c eval WinLne = WinLne + 1
c eval WinPos = WinPos + 2
c enddo
***** refresh grid after processing all options, if necessary
c exsr RfrGrid
*** (enter) from grid - end
***************************************************************************
c endsl
c enddo
c return
* main program loop - end
***************************************************************************
***************************************************************************
* subroutine to fill the grid
c FillGrid begsr
*** call program to fill the grid
c eval rmRwNd = gr
c call 'MRA0109R'
c parm rmRwNd
c parm rmRwRt
c parm rmGSts
c parm rmGrid
*** add grid to subfile
c select
***** no rows in grid
c when rmGSts = Null
c eval dHidGrid = On
***** end of grid reached
c other
c if rmGSts = End
c eval dEndGrid = On
c endif
***** process grid rows
c 1 do rmRwRt s_GridRow
c eval s_RescID = rmGrid(s_GridRow).RescID
c eval s_Locatn = rmGrid(s_GridRow).Locatn
c eval s_RunRte = rmGrid(s_GridRow).RunRte
c write GridData
c enddo
c if s_GridRow = *zero
c eval rmGSts = Null
c eval dHidGrid = On
c endif
c endsl
c eval WinLne = 3
c eval WinPos = 3
c endsr
**********************************************************************************************
* subroutine to refresh grid
c RfrGrid begsr
c eval SavGridRow = s_GridRow
c exsr ClrGrid
c exsr FillGrid
c if SavGridRow > rmRwRt
c eval s_GridRow = rmRwRt
c endif
c if SavGridRow < s_GridRow
c eval s_GridRow = SavGridRow
c endif
c endsr
**********************************************************************************************
* subroutine to clear grid and turn off eof
c ClrGrid begsr
c eval dClrGrid = On
c write GridCtrl
c eval dClrGrid = Off
c eval dEndGrid = Off
c endsr
**********************************************************************************************
* subprocedure to position the cursor
c PosCursor begsr
c if s_CsrLoc > 0
c eval s_GridRow = s_CsrLoc
c else
c if s_GetCol = 4 and
c s_GetRow < 25 and
c s_GetRow > 5
c eval s_GridRow = rmRwRt
c else
c eval s_GridRow = 1
c endif
c endif
c endsr
**********************************************************************************************
* subroutine to display a window
c DspWindow begsr
c write Title
c write Options
c if (dHidGrid = On)
c eval s_SetRow = 1
c eval s_SetCol = 2
c write EmptyGrid
c endif
c write Functions
c exfmt GridCtrl
c eval s_SetRow = *zero
c eval s_SetCol = *zero
c eval dHidGrid = Off
c eval Errors = Off
c endsrRPG CODE
* display controls
A DSPSIZ(*DS4)
A CSRINPONLY
A INDARA
* grid data fields
A R GRIDDATA
A SFL
A OPT 1A B 5 3VALUES(' ' '1' '2' '4')
A RESCID R O 5 8REFFLD(MR01RSC APPLIB/MR0100P)
A LOCATN R O 5 27REFFLD(MR01LOC APPLIB/MR0100P)
A RUNRTE R O 5 38REFFLD(MR01RNR APPLIB/MR0100P)
A EDTCDE(4)
* grid control fields
A R GRIDCTRL
A SFLCTL(GRIDDATA)
A CF03 CF12 CF06
A N87 SFLDSPCTL
A N88 SFLDSP
A SFLSIZ(999)
A SFLPAG(19)
A OVERLAY
A 87 SFLCLR
A 89 SFLEND(*MORE)
A SFLCSRRRN(&CSRLOC)
A RTNCSRLOC(*WINDOW &GETROW &GETCOL)
A CSRLOC(SETROW SETCOL)
A SETROW 3 0H
A SETCOL 3 0H
A GETROW 3 0H
A GETCOL 3 0H
A CSRLOC 5 0H
A GRIDROW 4 0H SFLRCDNBR(CURSOR)
A 4 3'Opt'
A COLOR(WHT)
A 4 8'Resource ID'
A COLOR(WHT)
A 4 27'Location'
A COLOR(WHT)
A 4 40'Run Rate'
A COLOR(WHT)
* title
A R TITLE
A 1 2'MRA0100D'
A COLOR(PNK)
A 1 51'Manufacturing Routing Management'
A COLOR(PNK)
A 1122DATE(*SYS *YY) EDTCDE(Y)
A COLOR(PNK)
A 2 2USER
A COLOR(PNK)
A 2 58'Manage Resources'
A COLOR(PNK)
A 2124TIME
A COLOR(PNK)
* options
A R OPTIONS
A OVERLAY
A 3 2'Options:'
A COLOR(BLU)
A 3 13'1=View'
A COLOR(BLU)
A 3 23'2=Edit'
A COLOR(BLU)
A 3 33'4=Delete'
A COLOR(BLU)
* no records to display
A R EMPTYGRID
A OVERLAY
A 11 43'There are no Resources to display'
* functions
A R FUNCTIONS
A OVERLAY
A 26 2'F3=Exit'
A COLOR(BLU)
A 26 15'F12=Cancel'
A COLOR(BLU)
A 26 31'F6=Add a Resource'
A COLOR(BLU)
* assume display
A R ASSUME
A ASSUME
A BLANK 1A 1 2DSPATR(ND)Message . . . . : The call to GETPARAMET ended in error (C G D F).
Cause . . . . . : RPG procedure PUI0001300 in program PROFOUNDUI/PUI0001300
at statement 2971 called program or procedure GETPARAMET, which ended in
error. If the name is *N, the call was a bound call by procedure pointer.
Recovery . . . : Check the job log for more information on the cause of the
error and contact the person responsible for program maintenance.
Possible choices for replying to message . . . . . . . . . . . . . . . :
D -- Obtain RPG formatted dump.
S -- Obtain system dump.
G -- Continue processing at *GETIN.
C -- Cancel.
F -- Obtain full formatted dump.
Let me know what you find. Thanks.
