| illustration |
RPG Alive Indenter
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
|
© Profound Logic Software, Inc. All rights reserved.