|
 |
Simple lookup display
Just a simple example of a subfile window select.
The utility consists of one Iseries display file and one RPGLE(RPG400) program.
DOWNLOAD
Download text files
screen shot
Pass two parameters the first is a position to selction field, the second
is the returning value.
View the source to ZLUKWHSR
FZLUKWHSD CF E WORKSTN INFDS(INFDS)
F SFILE(SUB01:RRN1)
FSRBCTLSS IF E K DISK
F*
D*
D* Constants
D*
D CMP01 C CONST(01)
D Digits C CONST('0123456789')
D
D*
D* Program Info
D*
D SDS
D @PGM 001 010
D @PARMS 037 039 0
D @JOB 244 253
D @USER 254 263
D @JOB# 264 269 0
D*
D* Field Definitions.
D*
D ISOdate S D
D @Scrn1 S 1 Inz('Y')
D ScreenError S 1
D RRN1 S Like(SCRRN)
D SavRrn S Like(SCRRN)
D CmdString S 256
D CmdLength S 15 5
D DayOfWeek S 07 0
D InWHS S 03
D OutWHS S 03
D*
D* Informational data structure.
D*
D INFDS DS
D CURREC 378 379B 0
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C* M A I N L I N E
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C Eval @Scrn1 = 'Y'
C*
C Exsr $Day
C*
C Exsr $ClearSFL
C*
C If InWHS <> *Blanks
C InWHS Setll SRBCTLSS
C Endif
C*
C Exsr $LoadSFL
C*
C Dow @Scrn1 = 'Y'
C*
C Exfmt SUB01CTL
C*
C If CURREC <> *Zeros
C Eval RRN1 = CURREC
C Eval SCRRN = CURREC
C Endif
C*
C Clear ScreenError
C*
C*
C Select
C*
C* F3 pressed end the program
C*
C When *In03
C Eval @Scrn1 = *Blanks
C*
C* F12 End the program
C*
C When *In12
C Eval @Scrn1 = *Blanks
C*
C* F33 Rolling the page.
C*
C When *In33
C Exsr $LoadSFL
C*
C* Other = ENTER key has been pressed.
C*
C Other
C*
C If C1WHS <> *Blanks
C Exsr $ClearSFL
C C1WHS Setll SRBCTLSS
C Exsr $LoadSFL
C Clear C1WHS
C Else
C Exsr $Process
C Endif
C*
C Endsl
C*
C Enddo
C*
C Eval *Inlr = *On
C Return
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C* $LoadSFL - Load the Main Menu.
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
CSR $LoadSFL Begsr
C*
C If SavRrn > *Zeros
C Z-add SavRrn RRN1
C Z-add SavRrn SCRRN
C Endif
C*
C Dou %Eof(SRBCTLSS)
C*
C Read SRBCTLSS 89
C*
C If Not*In89
C*
C Movel(p) CTSROM S1WHS
C Movel(p) CTSDES S1WNAME
C*
C Add 1. RRN1
C Add 1. SCRRN
C*
C*
C Write SUB01
C*
C Endif
C Enddo
C*
C Z-add SCRRN SavRrn
C*
C* If no records in subfile then do not disply the subfile.
C*
C If SavRrn = *Zeros And *In89
C Eval *In50 = *Off
C Else
C Z-add 1. SCRRN
C Z-add 1. RRN1
C Endif
C
C*
C Endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C* $ClearSFL - Clear the subfile.
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
CSR $ClearSfl Begsr
C*
C *Start Setll SRBCTLSS
C*
C Eval *In50 = *Off
C Eval *In51 = *Off
C Eval *In52 = *On
C*
C Write FMT1
C Write SUB01CTL
C*
C Eval *In50 = *On
C Eval *In51 = *On
C Eval *In52 = *Off
C*
C Clear RRN1
C Clear SCRRN
C Clear SavRrn
C*
C*
C Endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C* $Day - What Day is Today.
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $Day Begsr
C*
C*
C IsoDate Subdur D'1899-12-30' DayofWeek:*D
C Div 7 DayOfWeek
C Mvr DayOfWeek
C*
C If DayOfWeek < 1.
C Eval DayOfWeek = DayOfWeek + 7.
C Endif
C*
C Select
C When DayOfWeek = 1.
C Movel(p) 'Sunday' C1DAY
C When DayOfWeek = 2.
C Movel(p) 'Monday' C1DAY
C When DayOfWeek = 3.
C Movel(p) 'Tuesday' C1DAY
C When DayOfWeek = 4.
C Movel(p) 'Wednesday' C1DAY
C When DayOfWeek = 5.
C Movel(p) 'Thursday' C1DAY
C When DayOfWeek = 6.
C Movel(p) 'Friday' C1DAY
C When DayOfWeek = 7.
C Movel(p) 'Saturday' C1DAY
C Endsl
C*
C Endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C* $Process - Process the subfile.
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $Process Begsr
C*
C If Where > *Zeros
C*
C Where Chain SUB01
C If %Found
C*
C Movel(p) S1WHS OutWHS
C Eval @Scrn1 = *Blanks
C*
C Endif
C*
C Endif
C*
C Endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C* *INZSR - Initial one time run subroutine
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C *INZSR Begsr
C*
C *Entry Plist
C Parm InWHS
C Parm OutWHS
C*
C *MDY Move UDATE IsoDate
C*
C Endsr
C*
|
