Monday 17 October 2011

RPGLE - Renaming record format with prefix fields


    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