* 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 indicates combined input and output. WORKSTN is
* always used to indicate a display file.
FTUTD010 CF E WORKSTN
*----------------------------------------------------------------
D* This next few statements define constants that will be used
D* as error messages.
D ERR1 C CONST('You must enter A, C,-
D or D')
D ERR2 C CONST('Customer # is not fo-
D und')
D ERR3 C CONST('Name cannot be blank')
D ERR4 C CONST('Addr cannot be blank')
D ERR5 C CONST('City cannot be blank')
D ERR6 C CONST('State cannot be blan-
D k')
D ERR7 C CONST('Zip is invalid')
*----------------------------------------------------------------
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 DoW *in03 = *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 ExFmt SCRN1
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 If *in03 = *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 statments end the program.
C Eval *inlr = *on
C Return
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 statements 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 Chain CUST 95
C*
C Eval DSPMSG = *blanks
C Eval *in90 = *off
C*
C* Because this will eventually test for Add, Chg, Delete
C* use the SELECT instead of IF.
C Select
C When DSPACT = '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 If *in95 = *on
C Eval DSPMSG = ERR2
C Eval *in90 = *on
C Else
C ExSr ChangeRecord
C EndIf
C*
C Other
C Eval DSPMSG = ERR1
C* Setting *IN90 to *ON will cause the error message to be
C* displayed in reverse image (see the DDS for DSPMSG).
C Eval *in90 = *on
C EndSl
C*
C EndSr
C*----------------------------------------------------------------
C ChangeRecord BegSr
C*
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 EDITVALUES will put
C* a message in DSPMSG if there is an error. If DSPMSG is
C* still blank after EDITVALUES, 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 DoU DSPMSG = *BLANKS or
C *in12 = *on
C ExFmt SCRN2
C* If the user hits F12 do not process,
C* otherwise, Edit the values to see if they are OK.
C If *in12 = *off
C ExSr EditValues
C* If there are no errors, update the record. The UPDATE
C* uses the record name for the CUST file.
C If DSPMSG = *blanks
C* UPDATE 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 Update CSREC
C* LEAVE will go to the ENDDO.
C Leave
C EndIf
C EndIf
C*
C EndDo
C*
C EndSr
C*----------------------------------------------------------------
C EditValues BegSr
C* Make sure the values on the screen are OK.
C If CSNAME = *BLANKS
C Eval DSPMSG = ERR3
C Eval *in90 = *on
C EndIf
C*
C If CSADR1 = *BLANKS
C Eval DSPMSG = ERR4
C Eval *in90 = *on
C EndIf
C*
C If CSCTY = *BLANKS
C Eval DSPMSG = ERR5
C Eval *in90 = *on
C EndIf
C*
C If CSSTE = *BLANKS
C Eval DSPMSG = ERR6
C Eval *in90 = *on
C EndIf
C*
C If CSZIP = ' '
C Eval DSPMSG = ERR7
C Eval *in90 = *on
C EndIf
C*
C EndSr