TexAS400 Tutorial
TUTR010 in QRPGSRC in USER000
* Define the CUST file with file type U for UPDATE
* (update means that you can read and re-write data)
* and with record address type K for Keyed.
* (Keyed means the data can be directly read using the key field
FCUST UF E K DISK
* Next, define the display file. It must already exist.
* The C indeicates combined input and output. WORKSTN is
* always used to indicate a display file.
FTUTD010 CF E WORKSTN
*----------------------------------------------------------------
I* This next few statements define constants that will be used
I* as error messages
I 'You must enter A, C,-C ERR1
I ' or D'
I 'Customer # is not fo-C ERR2
I 'und'
I 'Name cannot be blank'C ERR3
I 'Addr cannot be blank'C ERR4
I 'City cannot be blank'C ERR5
I 'State cannot be blan-C ERR6
I 'k'
I 'Zip is invalid' C ERR7
*---------------------------------------------------------------
C* This is the main loop.
C* It will continue to show the first screen until F3 is pressed.
C* When F3 is pressed, *IN03 will be truned *ON
C *IN03 DOWEQ*OFF
C* The next statement, executes the format (EXFMT) for SCRN1.
C* EXFMT displays the SCRN1 and waits until the user presses
C* ENTER or F3. Then, it continues to the next statement.
C EXFMTSCRN1
C* If F3 was pressed, *IN03 will be *ON so the IF will go to
C* ENDIF and the DO will go to ENDDO
C *IN03 IFEQ *OFF
C* EXSR is Execute Subroutine. It will process the subroutine
C* named MAIN.
C EXSR MAIN
C ENDIF
C ENDDO
C* The next 2 statements end the program.
C MOVE *ON *INLR
C RETRN
C*----------------------------------------------------------------
C* Subroutines begin with BEGSR and end with ENDSR.
C*
C MAIN BEGSR
C* Use the CHAIN instruction to look for the Cust# entered in
C* the field DSPCST.
C* This statement says to use the value in DSPACT to look up
C* the value in CUST and to turn *IN90 to *ON if it is NOT found.
C DSPCST CHAINCUST 95
C*
C MOVE *BLANKS DSPMSG
C MOVE *OFF *IN90
C*
C* Because this will eventually test for Add, Chg, Delete
C* use the SELEC instead of IF.
C SELEC
C DSPACT WHEQ 'C'
C* If user wants to Change the record but it was not found,
C* show error message. Otherwise Execute Subroutine to change it.
C *IN95 IFEQ *ON
C MOVELERR2 DSPMSG
C MOVE *ON *IN90
C ELSE
C EXSR CHG
C ENDIF
C*
C OTHER
C* MOVEL is Move Left. It moves the value and justifies left.
C MOVELERR1 DSPMSG
C* Setting *IN90 to *ON will cause the error message to be
C* displayed in reverse image (see the DDS for DSPMSG).
C MOVE *ON *IN90
C ENDSL
C*
C ENDSR
C*----------------------------------------------------------------
C CHG BEGSR
C*
C* Show SCRN2. The values will be loaded from the CHAIN.
C* Continue showing SCRN2 until either F12 is pressed or
C* the data entered is OK. The subroutine EDTVAL will put
C* a message in DSPMSG if there is an error. If DSPMSG is
C* still blank after EDTVAL, then data is OK.
C*
C* This starts a DO loop that will continue to loop
C* until DSPMSG is not blank OR *IN12 is *ON.
C DSPMSG DOUNE*BLANKS
C *IN12 OREQ *ON
C EXFMTSCRN2
C* If the user hits F12 do not process,
C* otherwise, Edit the values to see if they are OK.
C *IN12 IFEQ *OFF
C EXSR EDTVAL
C* If there are no errors, update the record. The UPDAT
C* uses the record name for the CUST file.
C DSPMSG IFEQ *BLANK
C* UPDAT rewrites the record in the database file. Since the
C* field names in the display file are the same as in the
C* database file, RPG synchronizes the values.
C UPDATCSREC
C* LEAVE will go to the ENDDO.
C LEAVE
C ENDIF
C ENDIF
C*
C ENDDO
C*
C ENDSR
C*----------------------------------------------------------------
C EDTVAL BEGSR
C* Make sure the values on the screen are OK.
C CSNAME IFEQ *BLANKS
C MOVELERR3 DSPMSG
C MOVE *ON *IN90
C ENDIF
C*
C CSADR1 IFEQ *BLANKS
C MOVELERR4 DSPMSG
C MOVE *ON *IN90
C ENDIF
C*
C CSCTY IFEQ *BLANKS
C MOVELERR5 DSPMSG
C MOVE *ON *IN90
C ENDIF
C*
C CSSTE IFEQ *BLANKS
C MOVELERR6 DSPMSG
C MOVE *ON *IN90
C ENDIF
C*
C CSZIP IFLT 10000000
C MOVELERR7 DSPMSG
C MOVE *ON *IN90
C ENDIF
C*
C ENDSR
Back to Table of Contents | Main Page