RPGLE - Renaming record format with prefix fields
FC$USRBLDL1UF E K DISK rename(C$USRR:ByModel) Prefix(Z)
RPGLE - Example of displaying a screen
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
* $DispSFL01 - Survey Type LookUp
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C $DispSFL01 begsr
*
C exsr $ClearSFL01
C exsr $LoadSFL01
C exsr $CLRMSG
*
C dow @Scrn01 = 'Y'
*
C write SUB01FKEY
C write MSGCTL 99
C exfmt SUB01CTL
*
C if CURREC <> *zeros
C eval RRn01 = CURREC
C eval ScRRn01 = CURREC
C endif
*
C eval SavScRRn01 = 1
C if ScRRn01 > 0
C eval SavScRRn01 = ScRRn01
C endif
*
C exsr $CLRMSG
*
C select
*
* F3 pressed end the program
*
C when *in03 = *on
C eval @Scrn01 = 'N'
*
* F6=Add
*
C when *in06 = *on
C eval ChangedRecord = 'Y'
C eval ScreenMode = 'ADD'
C exsr $Screen01
*
* F12=Return
*
C when *in12 = *on
C eval @Scrn01 = 'N'
*
* other
*
C other
C if RRn01 > 0
C exsr $Process01
C endif
*
C endsl
*
C if ChangedRecord = 'Y' and ScreenError = 'N'
C exsr $ClearSFL01
C exsr $LoadSFL01
C eval ScreenError = 'N'
C eval ChangedRecord = 'N'
C eval ScRRn01 = SavScRRn01
C endif
*
C enddo
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
RPGLE - Loading an entire subfile all at once
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
* $LoadSFL01 - Load subfile display
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C $LoadSFL01 begsr
*
C eval S01CNAM = CompName
C eval S01CDAY = $GetDoW(%date())
*
C if SavRRn01 > *zeros
C eval RRn01 = SavRRn01
C eval ScRRn01 = SavRRn01
C endif
C eval ScRRn01 = (SavRRn01 + 1)
*
* Load the subfile fields
*
C *start setll MONITORL2
C read MONITORL2 89
C dow not %eof(MONITORL2)
*
C reset SUB01
C eval S01SPLF = SFILE
C eval S01UDTA = SUSERDATA
C eval S01HTML = HTML
C eval S01PDF = PDF
C eval S01JNAM = SJOB
*
C eval RRn01 = (RRn01 + 1)
C write SUB01
*
C read MONITORL2 89
C enddo
*
C if RRn01 = 0
C eval RRn01 = 1
C eval *in50 = *off
C endif
C if RRn01 > 0 and *in89 = *on
C eval ScRRn01 = (SavRRn01 + 1)
C endif
C eval SavRRn01 = RRn01
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
RPGLE - Clearing a subfile by writing subfile control
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
* $ClearSFL01 - Clear the subfile.
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C $ClearSFL01 begsr
*
C eval *in50 = *off
C eval *in51 = *off
C eval *in52 = *on
*
C write SUB01CTL
*
C eval *in50 = *on
C eval *in51 = *on
C eval *in52 = *off
*
C eval RRn01 = 0
C eval ScRRn01 = 0
C eval SavRRn01 = 0
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
RPGLE - Simple if statment with error message subfile write
*
* SPLF/Job Name/User Data must not be blanks
*
C if C01SPLF = *blanks or C01JNAM = *blanks or
C C01UDTA = *blanks
C eval MsgId = 'ROL0053'
C eval MsgDta = *blanks
C exsr $SndMsg
C eval *in40 = *on
C eval ScreenError01 = 'Y'
C endif
No comments:
Post a Comment