home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hall of Fame
/
HallofFameCDROM.cdr
/
3x400
/
clrdsp.lzh
/
CPP3201.RPG
< prev
next >
Wrap
Text File
|
1986-02-12
|
5KB
|
130 lines
/TITLE Q38 - Sample maintenance program w/clear display.
*
* Program - CPP3201
* Author - R. Cozzi, Jr.
* Date - 01/02/86
* Description - Example of clearing the display
* using only DDS.
*
FCPP3201 CF E WORKSTN
FCUSTMASTUF E K DISK A
I SDS
I *PROGRAM PGMNAM
I *PARMS PARMS
/SPACE
C *LIKE DEFN MODE UPDATE
C *LIKE DEFN MODE ADD
C MOVE 'UPDATE' UPDATE
C MOVE 'ADD' ADD
C MOVE UPDATE MODE
* Write top display
C WRITECPP3201T
* Write bottom display
C WRITECPP3201B
* Stay in loop until CMD 1 is pressed
C *IN01 DOWEQ'0'
* Display prompt for account number
C START TAG
C EXFMTCPP3201A
* If CMD 1 then get out.
C *IN01 CABEQ'1' ENDPGM
C *IN03 IFEQ '1'
C MODE IFEQ UPDATE
C MOVE ADD MODE
C ELSE
C MOVE UPDATE MODE
C END
C GOTO START
C END
* If CMD 7, then perform scan
C *IN07 IFEQ '1'
* If SCHDTA contains data, then call search program
C SCHDTA ANDGT*BLANKS
*-------------------------------------------------*
* *
* Insert your search program's program name *
* *
*-------------------------------------------------*
C CALL 'SEARCH' 52
C PARM SCHDTA
C PARM ACTNBR
C *IN52 IFEQ '1'
C Z-ADD0 ACTNBR
C END
C END
/SPACE
C ACTNBR CABEQ0 START
/SPACE
C ACTNBR CHAINCSTMST 10
C *IN10 IFEQ '1'
C MODE CABEQUPDATE START
C ELSE
C MODE CABEQADD START 11
C END
/SPACE
C GOTDBR TAG
C MOVEL'0' *IN95
C MODE IFEQ ADD
C MOVEL'1' *IN95
C WRITECPP3201C
C END
/SPACE
C DSPDBF TAG
* Stay in loop if nullify is pressed
C *IN06 DOUEQ'0'
C EXFMTCPP3201C
C END
C MOVEL'0' *IN95
C *IN91 CASEQ'1' DLTCST DELETE CUSTOMER
C *IN91 CASEQ'0' DTAMGT DATA MANAGEMENT
C END
/SPACE
* Roll up key press?
C *IN45 IFEQ '1'
C ACTNBR SETGTCSTMST
C READ CSTMST 92
C *IN92 CABEQ'1' DSPDBF
C GOTO GOTDBR GOT DATA RCD
C END
/SPACE
* Roll down key press?
C *IN46 IFEQ '1'
C ACTNBR SETLLCSTMST
C READPCSTMST 93
C *IN93 CABEQ'1' DSPDBF
C GOTO GOTDBR GOT DATA RECD
C END
/SPACE
C END
/SPACE
C ENDPGM TAG
C MOVEL'1' *INLR
/SPACE
CSR DTAMGT BEGSR
C *IN02 IFEQ '1'
C *IN06 OREQ '1'
C EXCPTRELEAS
C ELSE
C *IN10 IFEQ '1'
* Add to the master file
C WRITECSTMST
C ELSE
* Update the master file
C UPDATCSTMST
C END
C END
CSR ENDSR
/SPACE
CSR DLTCST BEGSR
* Delete the data record.
C EXFMTCPP3201D
C ANSWER IFEQ 'Y'
C *IN01 ANDEQ'0'
C *IN02 ANDEQ'0'
C *IN10 ANDEQ'0'
C DELETCSTMST
C END
CSR ENDSR
/SPACE
OCSTMST E N10 RELEAS