This is the RPG III source code for the Add/Change/Delete program named CUSTR01.
FCUSTD01 CF E WORKSTN
FCUST UF E K DISK A
*----------------------------------------------------------------
* Define error messages here
I 'RECORD ALREADY ON FI-C ERR1
I 'LE'
I 'RECORD IS NOT ON FIL-C ERR2
I 'E'
I 'NO MORE RECORDS' C ERR3
I 'ZIP CANNOT BE ZERO' C ERR6
I 'NAME MUST NOT BE BL-C ERR7
I 'ANK'
I 'STATE MUST NOT BE BL-C ERR8
I 'ANK'
I 'ACTION MUST BE A, U,-C ERR9
I ' D OR I'
I 'RECORD ADDED SUCCE- C MSG1
I 'SSFULLY'
I 'RECORD UPDATED SUC- C MSG2
I 'CESSFULLY'
I 'RECORD DELETED SUC- C MSG3
I 'CESSFULLY'
I 'HIT F9 TO DELETE' C MSG4
I 'NO ACTION TAKEN' C MSG9
*----------------------------------------------------------------
* Key List for customer file
* (a key list is not needed since this file has only 1 key
* field, but this makes the program easier to modify if
* the file has multiple key fields)
C KEYLST KLIST
C KFLD CSNBR
*----------------------------------------------------------------
* Stay in Main DO LOOP until F3 is hit from SCR1
*----------------------------------------------------------------
C *IN03 DOWEQ*OFF
* Show main ADD/UPD/INQ/DLT screen
C EXFMTSCR1
C CLEARERRLIN
C MOVE *OFF *IN90
* If user didn't hit F3, process screen based on action
C *IN03 IFEQ *OFF
C SELEC
C ACTION WHEQ 'A'
C EXSR ADDREC
C ACTION WHEQ 'D'
C EXSR DLTREC
C ACTION WHEQ 'I'
C EXSR INQREC
C ACTION WHEQ 'N'
C EXSR NXTREC
C ACTION WHEQ 'U'
C EXSR UPDREC
C OTHER
C CLEARERRLIN
C MOVELERR9 ERRLIN
C MOVE *ON *IN90
C ENDSL
C ENDIF
C ENDDO
*
C MOVE *ON *INLR
C RETRN
*----------------------------------------------------------------
C ADDREC BEGSR
* Unprotect fields but setting *in80 off
C MOVE *OFF *IN80
C MOVE ' ADD ' MODE
* See if customer # is already in CUST file
C KEYLST CHAINCUST 91
C *IN91 IFEQ *OFF
* If customer # is already in cust file, load up ERR MSG
C CLEARERRLIN
C MOVELERR1 ERRLIN
C MOVE *ON *IN90
C ELSE
C EXSR ADDSCR
C ENDIF
C ENDSR
*----------------------------------------------------------------
* SHOW ADD SCREEN
*----------------------------------------------------------------
C ADDSCR BEGSR
* Clear customer record except for key field(s)
C *NOKEY CLEARCSREC
C MOVE 'N' RECOK 1
* Keep showing screen until record passes edit or F3 is hit
C RECOK DOWEQ'N'
C *IN03 ANDEQ*OFF
C EXFMTSCR2
*
C *IN03 IFEQ *OFF
C EXSR EDTCUS
C RECOK IFEQ 'Y'
C WRITECSREC
* Show messaage that ADD was successful
C CLEARERRLIN
C MOVELMSG1 ERRLIN
C ENDIF
C ELSE
* Show message that no action was taken because F3 was hit
C CLEARERRLIN
C MOVELMSG9 ERRLIN
C ENDIF
C ENDDO
*
C MOVE *OFF *IN03
*
C ENDSR
*----------------------------------------------------------------
C DLTREC BEGSR
* Disable fields for entry by setting *IN80 on
C MOVE *ON *IN80
C MOVE 'DELETE' MODE
C CLEARERRLIN
C MOVELMSG4 ERRLIN
C MOVE *ON *IN90
* See if customer # is in CUST file
C KEYLST CHAINCUST 91
C *IN91 IFEQ *ON
* If customer # is not in CUST file, show ERR MSG
C CLEARERRLIN
C MOVELERR2 ERRLIN
C MOVE *ON *IN90
C ELSE
C EXFMTSCR2
C MOVE *OFF *IN90
C *IN09 IFEQ *ON
C DELETCSREC
C CLEARERRLIN
C MOVELMSG3 ERRLIN
C ELSE
C CLEARERRLIN
C MOVELMSG9 ERRLIN
C ENDIF
C ENDIF
*
C MOVE *OFF *IN03
*
C ENDSR
*----------------------------------------------------------------
C INQREC BEGSR
* Disable fields for entry by setting *IN80 on
C MOVE *ON *IN80
C MOVE 'INQUIRY' MODE
* See if customer # is in CUST file
C KEYLST CHAINCUST 91
C *IN91 IFEQ *ON
* If customer # is not in CUST file, show ERR MSG
C CLEARERRLIN
C MOVELERR2 ERRLIN
C MOVE *ON *IN90
C ELSE
* Show Inquiry Screen
C EXFMTSCR2
C ENDIF
*
C MOVE *OFF *IN03
*
C ENDSR
*----------------------------------------------------------------
C NXTREC BEGSR
*
C MOVE *ON *IN80
C MOVE 'INQUIRY' MODE
C CLEARERRLIN
* Go forward in the file to the next record
C KEYLST SETLLCUST 92 93
* If *in92 is on, we have reached end of file
C *IN92 IFEQ *ON
C MOVELERR3 ERRLIN
C MOVE *ON *IN90
C ENDIF
* Read next record
C ERRLIN IFEQ *BLANKS
C READ CUST 90
* If *in90 is on, we have reached end of file
C *IN92 IFEQ *ON
C MOVELERR3 ERRLIN
C MOVE *ON *IN90
C ENDIF
C ENDIF
* If *in93 is on, we are at an existing record and we need
* to read past it
C ERRLIN IFEQ *BLANKS
C *IN93 IFEQ *ON
C READ CUST 90
* If *in90 is on, we have reached end of file
C *IN90 IFEQ *ON
C MOVELERR3 ERRLIN
C MOVE *ON *IN90
C ENDIF
C ENDIF
C ENDIF
*
C ERRLIN IFEQ *BLANKS
C EXFMTSCR2
C ENDIF
*
C MOVE *OFF *IN03
*
C ENDSR
*----------------------------------------------------------------
C UPDREC BEGSR
* Unprotect fields but setting *in80 off
C MOVE *OFF *IN80
C MOVE 'UPDATE ' MODE
* See if customer # is already in CUST file
C KEYLST CHAINCUST 91
C *IN91 IFEQ *ON
* If customer # is not in cust file, load up ERR MSG
C CLEARERRLIN
C MOVELERR2 ERRLIN
C MOVE *ON *IN90
C ELSE
C EXSR UPDSCR
C ENDIF
C ENDSR
*----------------------------------------------------------------
* SHOW UPDATE SCREEN
*----------------------------------------------------------------
C UPDSCR BEGSR
C MOVE 'N' RECOK 1
* Keep showing screen until record passes edit or F3 is hit
C RECOK DOWEQ'N'
C *IN03 ANDEQ*OFF
C EXFMTSCR2
*
C *IN03 IFEQ *OFF
C EXSR EDTCUS
C RECOK IFEQ 'Y'
C UPDATCSREC
* Show messaage that UPDATE was successful
C CLEARERRLIN
C MOVELMSG2 ERRLIN
C ENDIF
C ELSE
* Show message that no action was taken because F3 was hit
C CLEARERRLIN
C MOVELMSG9 ERRLIN
C ENDIF
C ENDDO
*
C MOVE *OFF *IN03
*
C ENDSR
*----------------------------------------------------------------
C EDTCUS BEGSR
* First, set error switch that record is OK
C MOVE 'Y' RECOK
* Now, perform each edit
C CSNAME IFEQ *BLANKS
C MOVE 'N' RECOK
C CLEARERRLIN
C MOVELERR7 ERRLIN
C MOVE *ON *IN90
C ENDIF
*
C CSSTE IFEQ *BLANKS
C MOVE 'N' RECOK
C CLEARERRLIN
C MOVELERR8 ERRLIN
C MOVE *ON *IN90
C ENDIF
*
C CSZIP IFEQ *ZERO
C MOVE 'N' RECOK
C CLEARERRLIN
C MOVELERR6 ERRLIN
C MOVE *ON *IN90
C ENDIF
*
C ENDSR
*----------------------------------------------------------------