RPG Alive
  illustration  

RPG Alive Indenter

RPG Example:

CL Example:

 

Printout Example:

   5769PW1 V4R2M0  980228                  SEU SOURCE LISTING
   SOURCE FILE . . . . . . .  RPGALIVE/QINDSRC
   MEMBER  . . . . . . . . .  EXMPLINDR
   SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+...
     100      F***************************************************************
     200      F*  Description: MAINTAIN ITEM MASTER                          *
     300      F***************************************************************
     400      FITM001D   CF   E             WORKSTN
     500      F                                     SFILE(PANEL1S:RRN01)
     600      FITM001P   UF A E           K DISK
     700      F*                       ITEM MASTER         FORMAT: ITM001R
     800      D****************************************************************
     900      D @SAVE         E DS                  OCCURS(2) EXTNAME(ITM001P)
    1000      D  XTMNR        E                     EXTFLD(ITMNR)
    1100
    1200      D* Data structure for options
    1300      D ##OPT           DS
    1400      D  ##OPT1                 1      1
    1500      D  ##OPT2                 2      2
    1600
    1700      D RRN01           S              5  0 INZ(0)
    1800      D SAVSEC          S              3    INZ('000')
    1900      D SFSIZ           S              3  0 INZ(8)
    2000      D #FLAG           S              1    INZ(' ')
    2100      D #I              S              2  0 INZ(0)
    2200      D #IN90           S              5    INZ('     ')
    2300      D #P              S              2  0 INZ(0)
    2400      D #REFR           S              1    INZ(*ON)
    2500      D #SVRRN          S              5  0 INZ(0)
    2600      D #TOP1           S                   LIKE( ITMNR )
    2700
    2800      D* CONSTANTS
    2900      D ##DGTS          C                   CONST('0123456789')
    3000      C****************************************************************
    3100      C                   EXSR      $FRM01
    3200      C     *LOVAL        SETLL     ITM001R
    3300      C                   EXSR      $LOAD1
    3400      C*
    3500      C     *ON           DOWEQ     *ON
    3600      C*                  |
    3700      C     RRN01         | IFEQ      *ZERO
    3800      C                   | | SETOFF                                       90
    3900      C                   | END
    4000      C*                  |
    4100      C  N99              | WRITE     BLINE
    4200      C                   | EXFMT     PANEL1C
    4300      C                   | EXSR      $RESET
    4400      C                   | SELECT
    4500      C* WAS A VALID COMMAND KEY USED?
    4600      C     *IN40         | WHENEQ    *ON
    4700      C* EXIT PROGRAM?    | |
    4800      C     *INKC         | | IFEQ      *ON
    4900      C     *INKL         | | OREQ      *ON
    5000      C                   | | | LEAVE
    5100      C                   | | ELSE
    5200      C                   | | | EXSR      $CMD1
    5300      C                   | | END
    5400      C* WAS THE REPOSITIONER USED?.
    5500      C     *IN41         | WHENEQ    *ON
    5600      C     @@GOTO        | | SETLL     ITM001R
    5700      C                   | | MOVE      *BLANKS       @GOTO1
    5800      C                   | | EXSR      $LOAD1
    5900      C* CHECK FOR AN OPEN|OPTION REQUEST.
    6000      C     *IN42         | WHENEQ    *ON
    6100      C     @OPT          | ANDNE     *BLANKS
    6200      C                   | | EXSR      $VROO1
    6300      C                   | OTHER
    6400      C                   | | MOVE      *OFF          #REFR
    6500      C                   | | READC     PANEL1S                                80
    6600      C     *IN80         | | DOWEQ     *OFF
    6700      C                   | | | MOVEA     '00000'       *IN(01)
    6800      C     @OPT          | | | IFNE      '  '
    6900      C                   | | | | EXSR      $VROO1
    7000      C     *IN99         | | | | IFEQ      *OFF
    7100      C                   | | | | | MOVE      RRN01         #SVRRN
    7200      C                   | | | | | EXSR      $PROC1
    7300      C     #SVRRN        | | | | | CHAIN     PANEL1S                            80
    7400      C                   | | | | | MOVE      '  '          @OPT
    7500      C                   | | | | | SETON                                        01
    7600      C                   | | | | END
    7700      C                   | | | END
    7800      C                   | | | UPDATE    PANEL1S
    7900      C     *IN99         | | | IFEQ      *ON
    8000      C                   | | | | LEAVE
    8100      C                   | | | END
    8200      C                   | | | READC     PANEL1S                                80
    8300      C                   | | ENDDO
    8400      C                   | | SETON                                            94
    8500      C                   | | MOVEA     A#F(1)        @FKEY1
    8600      C                   | ENDSL
    8700      C*                  |
    8800      C* REFRESH?         |
    8900      C     #REFR         | IFEQ      *ON
    9000      C     @@TOP         | | SETLL     ITM001R
    9100      C                   | | EXSR      $LOAD1
    9200      C                   | END
    9300      C                   ENDDO
    9400      C*
    9500      C                   SETON                                        LR
    9600      C****************************************************************
    9700      C* RESET INDICATORS AND VARIABLES.
    9800      C****************************************************************
    9900      C=====$RESET========BEGSR==================================================
   10000      C*
   10100      C                   MOVEA     '00000000'    *IN(01)
   10200      C                   MOVEA     '00000000'    *IN(10)
   10300      C                   MOVEA     '00000000'    *IN(20)
   10400      C                   SETOFF                                       9499
   10500      C*
   10600      C                   ENDSR
   10700      C****************************************************************
   10800      C* FORMAT PANEL 1.
   10900      C****************************************************************
   11000      C=====$FRM01========BEGSR==================================================
   11100      C*
   11200      C                   Z-ADD     1             #P
   11300      C                   SETON                                        38
   11400      C                   SETON                                        94
   11500      C                   MOVEL     A#H(1)        @HLIN1
   11600      C                   MOVEL     A#H(2)        @HLIN2
   11700      C                   MOVEL     A#O(1)        @OLIN1
   11800      C                   MOVEL     A#O(2)        @OLIN2
   11900      C                   MOVEL     A#D(1)        @DLIN1
   12000      C                   MOVEL     A#D(2)        @DLIN2
   12100      C                   MOVEL     A#F(1)        @FKEY1
   12200      C                   MOVEL     A#F(2)        @FKEY2
   12300      C                   MOVE      *BLANKS       @GOTO1
   12400      C*
   12500      C                   ENDSR
   12600      C****************************************************************
   12700      C* PROCESS ALL VALID COMMAND KEYS FROM PANEL 1.
   12800      C****************************************************************
   12900      C=====$CMD1=========BEGSR==================================================
   13000      C*
   13100      C                   SELECT
   13200      C*
   13300      C* REFRESH.
   13400      C     *INKE         WHENEQ    *ON
   13500      C     @@TOP         | SETLL     ITM001R
   13600      C                   | EXSR      $LOAD1
   13700      C*                  |
   13800      C* ROLL UP?         |
   13900      C     *IN97         WHENEQ    *ON
   14000      C                   | EXSR      $LOAD1
   14100      C* ROLL DOWN?       |
   14200      C     *IN98         WHENEQ    *ON
   14300      C                   | EXSR      $ROLL1
   14400      C                   | EXSR      $LOAD1
   14500      C*                  |
   14600      C                   ENDSL
   14700      C*
   14800      C                   ENDSR
   14900      C****************************************************************
   15000      C* LOAD ONE PAGE OF A SUBFILE FOR PANEL 1.
   15100      C****************************************************************
   15200      C=====$LOAD1========BEGSR==================================================
   15300      C*
   15400      C                   EXSR      $CLR1
   15500      C*
   15600      C                   DO        SFSIZ
   15700      C*                  |
   15800      C                   | READ(N)   ITM001R                                95
   15900      C*                  |
   16000      C     *IN95         | IFEQ      *ON
   16100      C     *HIVAL        | | SETGT     ITM001R
   16200      C                   | | LEAVE
   16300      C                   | ELSE
   16400      C*                  | |
   16500      C                   | | ADD       1             RRN01
   16600      C*                  | |
   16700      C     RRN01         | | IFEQ      1
   16800      C                   | | | MOVE      ITMNR         #TOP1
   16900      C                   | | END
   17000      C*                  | |
   17100      C                   | | WRITE     PANEL1S                              01
   17200      C                   | END
   17300      C*                  |
   17400      C                   ENDDO
   17500      C*
   17600      C                   SETON                                        10
   17700      C*
   17800      C                   ENDSR
   17900      C***********************************************************
   18000      C* CLEAR SUBFILE FOR PANEL 1.
   18100      C***********************************************************
   18200      C=====$CLR1=========BEGSR==================================================
   18300      C*
   18400      C                   CLEAR                   PANEL1S
   18500      C                   SETOFF                                       9091
   18600      C                   SETON                                        92
   18700      C                   WRITE     PANEL1C
   18800      C                   SETOFF                                       92
   18900      C                   SETON                                        9091
   19000      C                   Z-ADD     *ZERO         RRN01
   19100      C*
   19200      C                   ENDSR
   19300      C****************************************************************
   19400      C* READ PREVIOUS SET OF RECORDS FOR PANEL1.
   19500      C****************************************************************
   19600      C=====$ROLL1========BEGSR==================================================
   19700      C*
   19800      C     @@TOP         SETLL     ITM001R
   19900      C*
   20000      C                   DO        SFSIZ
   20100      C                   | READP(N)  ITM001R                                80
   20200      C*                  |
   20300      C     *IN80         | IFEQ      *ON
   20400      C     *LOVAL        | | SETLL     ITM001R
   20500      C                   | | LEAVE
   20600      C                   | ELSE
   20700      C*                  | |
   20800      C     @@KEY         | | SETLL     ITM001R
   20900      C                   | END
   21000      C*                  |
   21100      C                   ENDDO
   21200      C*
   21300      C                   ENDSR

Back to registration/pricing

© Profound Logic Software, Inc. All rights reserved.