F*---------------------------------------------------------------*
F* THIS IS A SHELL FOR A SIMPLE (LOAD ALL) ADD/EDIT
SUBFILE
F* CURRENT RECORDS FROM A FILE WILL BE DISPLAYED WITH
THE OPTION
F* TO EDIT A RECORD BY PLACING AN X ON IT. NEW
RECORDS MAY BE
F* ADDED BY PRESSING F6.
F*
F* MINIMUM CHANGES TO USE THIS SHELL
F* 1) CHANGE FIELDS IN RECORD SUBFILEREC OF DISPLAY
FILE S_SFL01DF
F* TO LENGTHS AND NAMES OF FIELDS
FROM YOUR FILE. NEW FIELDS
F* MAY ALSO BE ADDED.
F*
F* 2) CHANGE FIELDS IN SCREEN2 TO MATCH THE FIELDS
FROM YOUR FILE
F* THAT YOU WOULD LIKE TO ADD/EDIT.
GIVE THEM A NAME OTHER THAN
F* THE FIELD NAME USED IN THE FILE.
F*
F* 3) REPLACE ALL OCCURENCES OF FILE01 IN THIS
PROGRAM TO YOUR FILE
F* NAME.
F*
F* 4) REPLACE ALL OCCURENCES OF FILE01REC IN THIS
PROGRAM TO THE
F* RECORD FORMAT NAME FROM YOUR
FILE.
F*
F* 5) CHANGE ALL OCCURENCES XXXXX TO THE CORRECT FILE
OR DISPLAY
F* FILE FIELD NAMES.
F*
F*---------------------------------------------------------------*
F* PROGRAM NAME
:
*
F* PROGRAM DESCRIPTION:
*
F* CREATED BY
:
*
F*
*
F* CREATE DATE
:
*
F*---------------------------------------------------------------*
F* MODIFICATIONS:
*
F*---------------------------------------------------------------*
F* MODIFIED BY
:
*
F* MODIFY DATE
:
*
F* MODIFICATION
:
*
F* SCAN FOR
:
*
F*---------------------------------------------------------------*
F*
F*
FFILE01 UF A E
K DISK
F*
F*
FS_SFL01D CF E
WORKSTN
F
SFILE(SUBFILEREC:RRN01)
F*
D*---------------------------------------------------------------------
D* Program Field Definition
D*--------------------------------------------------------------------
D RRN01
S
5 0
D RRNREAD
S
5 0
D #SubRecords S
5 0
D
D* DUMMY VALUE TO BE REPLACED WITH REAL VALUES
D XXXXX
S
5
D
D*--------------------------------------------------------------------
D*System Data Structure
D*--------------------------------------------------------------------
D
SDS
D DSP_PGM
*PROC
D
C*--------------------------------------------------------------------
C* MAINLINE
C*--------------------------------------------------------------------
C*
C*
----------------------------
C*
LOAD AND DISPLAY ALL RECORDS
C*
CURRENTLY IN FILE01
C*
----------------------------
C
DOW *IN03 = *OFF
C
EXSR $SRCLEAR
C
EXSR $SRLOAD
C
MOVE *OFF
*IN25
C
WRITE MESSAGE
C
EXFMT CONTROLREC
C *IN06
CASEQ *ON
$SRADD
C
CAS
$SREDIT
C
ENDCS
C
ENDDO
C
MOVE *ON
*INLR
C
RETURN
C
C*--------------------------------------------------------------------
C* CLEAR SUBFILE AND SETUP
C*--------------------------------------------------------------------
C $SRCLEAR
BEGSR
C
Z-ADD 0
RRN01
C
MOVE *ON
*IN31
C
WRITE CONTROLREC
C
MOVEA '0100'
*IN(29)
C
ENDSR
C
C*--------------------------------------------------------------------
C* LOAD SUBFILE
C*--------------------------------------------------------------------
C $SRLOAD
BEGSR
C *LOVAL
SETLL FILE01
C
READ FILE01
32
C
C
DOW *IN32 = *OFF
C
ADD 1
RRN01
C
EVAL DSP_OPT = ' '
C
WRITE SUBFILEREC
C
MOVE *ON
*IN29
C
C
READ FILE01
32
C
ENDDO
C
ENDSR
C
C*--------------------------------------------------------------------
C* ADD NEW RECORD
C*--------------------------------------------------------------------
C $SRADD
BEGSR
C
C*
------------------------
C*
CLEAR SCREEN2 FIELDS FOR
C*
ENTRY OF NEW RECORD
C*
------------------------
C
EVAL XXXXX = *ZEROS
C
EVAL XXXXX = *BLANKS
C
C
DOU ERROR = *BLANKS
C
OR *IN12 = *ON
C
EXFMT SCREEN2
C
EVAL ERROR = *BLANKS
C
C*
------------------------
C*
PUT CONDITION STATEMENTS
C*
HERE.
C*
------------------------
C
IF XXXXX <> XXXXX
C
EVAL ERROR = 'ERROR HERE'
C
ENDIF
C
C
ENDDO
C
C
C
IF *IN12 = *OFF
C*
------------------------
C*
SET FILE VALUES EQUAL TO
C*
SCREEN2 VALUES HERE
C*
------------------------
C
EVAL XXXXX = XXXXX
C
EVAL XXXXX = XXXXX
C
WRITE FILE01REC
C
ENDIF
C
C
ENDSR
C
C*--------------------------------------------------------------------
C* EDIT EXISTING RECORD
C*--------------------------------------------------------------------
C $SREDIT
BEGSR
C
C*
-----------------------------
C*
READ SUBFILE AND DISPLAY
C*
ANY RECORD WITH AN X FOR EDIT
C*
-----------------------------
C
EVAL #SubRecords = RRN01
C
DO #SubRecords RRNREAD
C
C RRNREAD
CHAIN SUBFILEREC
C
IF DSP_OPT = 'X'
C
C*
------------------------
C*
SET SCREEN2 VALUES EQUAL
C*
TO FILE01 VALUES
C*
------------------------
C
EVAL XXXXX = XXXXX
C
EVAL XXXXX = XXXXX
C
C
DOU ERROR = *BLANKS
C
OR *IN12 = *ON
C
EXFMT SCREEN2
C
EVAL ERROR = *BLANKS
C
C*
------------------------
C*
PUT CONDITION STATEMENTS
C*
HERE.
C*
------------------------
C
IF XXXXX <> XXXXX
C
EVAL ERROR = 'ERROR HERE'
C
ENDIF
C
C
ENDDO
C
C
C
IF *IN12 = *OFF
C FILE01_KEY
CHAIN FILE01
C*
------------------------
C*
SET FILE VALUES EQUAL TO
C*
SCREEN2 VALUES HERE
C*
------------------------
C
EVAL XXXXX = XXXXX
C
EVAL XXXXX = XXXXX
C
C
IF %FOUND(FILE01)
C
UPDATE FILE01REC
C
ENDIF
C
C
ENDIF
C
C
C
ENDIF
C
C
ENDDO
C
C
ENDSR
C
C*--------------------------------------------------------------------
C* INITIAL SETUP
C*--------------------------------------------------------------------
C *INZSR
BEGSR
C
C FILE01_KEY
KLIST
C
KFLD
XXXXX
C
KFLD
XXXXX
C
KFLD
XXXXX
C
KFLD
XXXXX
C
C
ENDSR
C