ILE COBOL – Subfiles
Display Files
| Opt | Member | Type | Text |
|---|---|---|---|
| DSP01 | DSPF | Authorized User List maintenance screen |
Programmers create display files by using the CL command Create Display File (CRTDSPF). And the display is either coded using DDS specification or using SDA (Screen Design Aid).
Levels of display files
Following are the levels in a display file:
- File level: Describes file level entries like size of display file, indicator area, file level functions and attentions, change default input keywords.
- Record format level: Describes record format level entries like record type – RECORD, USRDFN, SFL, SFLMSG, WINDOW, WDWSFL, PULLDWN, PDNSFL, MNUBAR. This level start with ‘R’ at 17th column.
- Help level: Describes help level entries.
- Field level: Describes fields level entries.
File level Keywords
- DSPSIZ (Display Size): It is a file-level keyword that describes size of display file.
- DSPSIZ (24 80) – It tells compiler that display file is size of 24 rows & 80 columns.
- DSPSIZ (27 132) – It tells compiler that display file is size of 27 rows & 132 columns.
- DSPSIZ (*DS3) – Primary default display size (24*80).
- DSPSIZ (*DS4) – Secondary default display size (27 * 132).
- INDARA (Indicator Area): It is a file-level keyword that moves all 99 indicators from the record buffer into a separate 99-byte memory area, keeping your data and indicators distinct in display or subfile programs.
- CFnn, CAnn(Command functions and command attentions): It is a file-level or record-level keyword used to receive user specific commands. Keywords used to enable F1–F24 for user interaction. CAnn (Command Attention): Returns the function key pressed to the program without transmitting any data or changes from the screen. CFnn (Command Function): Returns the function key and transmits all modified screen data back to the program buffer.
- CHGINPDFT (Change Input Default): It is a file-level, record-level or field-level keyword used to set default display attributes and validation check codes for all input-capable fields in a file, record, or field.
Record Format Level Keywords
- Type of record format (RECORD/USRDFN/SFL/ SFLMSG/WINDOW/WDWSFL /PULDWN/ PDNSFL/MNUBAR): It describes the record format type. Record format can be a normal record format or subfile record format. It can a window etc.
- OVERLAY: It is a record-level keyword that allows you to display a new record format without clearing the existing records from the screen.
- SFL: It is a record-level keyword that describes like record format is subfile.
- SFLCTL: It is a record-level keyword that describes like record format is subfile control.
- SFLDSP: It is a record-level keyword is used to display the Subfile record format on the screen.
- SFLDSPCTL: It is a record-level keyword used to display the Subfile record format on the screen.
- SFLPAG: It is an attribute which specifies the number of records that can be displayed in a screen. This keyword can be used to specify the maximum number of records that can be in one subfile page. That is the maximum number of records that the system will display in the screen at a time. Maximum records to be displayed in subfile buffer.
- SFLSIZ: SFLSIZ: It is an attribute which specifies the number of records can be stored in Subfile. SFLSIZ value specifies the number of records that can be placed into the subfile buffer. Maximum records to be displayed in screen.
Field Level Keywords
- CHECK: It is the field-level keyword is used to perform validity checking, keyboard control, and cursor control for input-capable fields. It works by applying specific codes as parameters to define how the system handles user input for that field.
- CHECK(AB): Allow Blank. Permits the user to leave a mandatory field empty.
- CHECK(ER): End of Record. Automatically performs an “Enter” function when the field is filled.
- CHECK (FE): Field exit. User cannot advance to the next input field until user press field exit key.
- CHECK(LC): Lower Case. Allows the field to accept lowercase characters.
- CHECK(ME): Mandatory Enter. Requires at least one character to be entered in the field.
- CHECK(MF): Mandatory Fill. Requires every position in the field to be filled.
- CHECK(RB): Right-adjust Blank-fill. Aligns numeric data to the right and fills the left with blanks.
- CHECK(RZ): Right-adjust Zero-fill. Aligns numeric data to the right and fills the left with zeros.
- CHECK(VN): Validate Name. Ensures the entry is a valid name (starts with A-Z, $, #, or @).
- CHECK(VNE): Validate Name Extended. Similar to VN but allows more characters.
- RANGE: It is a field-level keyword that sets the minimum and maximum values allowed for an entry. For numeric fields, use RANGE(4 9); for character fields, use quotes like RANGE(‘4’ ‘9’).
- VALUES: It is a field-level keyword that sets the minimum and maximum values allowed for an entry. For numeric fields, use RANGE(4 9); for character fields, use quotes like RANGE(‘4’ ‘9’).
- COLOR: It is a field-level keyword that sets the colour in display. COLOR(BLU): Blue COLOR(RED): Red COLOR(WHT): White COLOR(GRN): Green COLOR(TRQ): Turquoise COLOR(YLW): Yellow COLOR(PNK): Pink
- DSPATR: It is a field-level keyword that sets the features like underline, reverse image, position colour.
- DSPATR(HI): High Intensity / White Colour
- DSPATR(UL): Underline
- DSPATR(RI): Reverse Image
- DSPATR(PC): Position Cursor
- DSPATR(ND): Non-display
- DSPATR(BL): Blinking fields
- DSPATR(CS): Column separator
Types of display file record formats:
There are 2 types of record formats:
- Non-Subfile (Normal): These are used for standard screens where every record format is unique.
- Subfile: Subfile is group of records of same record format and can be read from or write to the display in a single operation. These allow you to display a list of similar records (like a table or grid). A subfile requires two specific formats to work:
- Subfile Record (SFL): Defines the layout of an individual row. This row can be considered as details.
- Subfile Control (SFLCTL): Manages the overall list, including headers and display settings. This row can be considered as header.
Transaction Files
In ILE COBOL, a TRANSACTION file facilitates communication between a COBOL program and workstation files. This allows the program to interact with a user at a display station(screen), presenting information and receiving input. TRANSACTION file in ILE COBOL program is either display file (DSPF) or inter communication file (ICF). In this section we are only dealing with display files (DSPF).
Declaration of transaction files in ILE COBOL
CBLLE Program – File Control.
ENVIRONMENT-DIVISION.
FILE CONTROL.
SELECT DISPLAY-FILE
ASSIGN TO WORKSTATION-DSP01-SI
ORGANIZATION IS TRANSACTION
ACCESS MODE IS SEQUENTIAL/DYNAMIC
RELATIVE KEY IS WS-RELATIVE-RECORD-NUMBER
FILE STATUS IS WS-DSP01-FILE-STATUS
CONTROL-AREA IS WS-CONTROL-AREA.
RPGLE Replica Program – F-Spec.
**free
// F-Spec
Dcl-F DISPLAY-FILE Workstn ExtFile(‘DSP01’)
UsrOpn
SFile(SFL01:RRN1)
Usage(*input:*output:*update:*delete)
InfDs(ds_Infds)
IndDs(ds_Infds);
Program-described file name
‘DISPLAY-FILE’ is the program-described name assigned to the display file ‘DSP01’. Because the file name assigned in the program is different from the file name externally, the programmer must use the program-described file name in the program for I/O operations throughout the program.
CBLLE Program – Procedure Division.
OPEN I-O DISPLAY-FILE. CLOSE DISPLAY-FILE.
RPGLE Replica Program – C-Spec.
Open DISPLAY-FILE; Close DISPLAY-FILE;
When program-described file name assigned is same as externally-described file name as shown below.
ENVIRONMENT-DIVISION.
FILE CONTROL.
SELECT DSP01
ASSIGN TO WORKSTATION-DSP01
RPGLE Replica Program:
**free // F-Spec Dcl-F DSP01 Workstn ExtFile(‘DSP01’);
Externally-described file name
‘DSP01’ is the external name of the display file. During compilation, the library list must contain the object ‘DSP01’ with the type ‘*FILE’ and the attribute ‘DSPF’, otherwise the program will throw a compilation error.
WORKSTATION
Display files in ILE COBOL programs are declared as WORKSTATION files. This is similar to RPGLE program f-spec keyword ‘Workstn’ declaration as shown below.
**free // F-Spec Dcl-F DSP01 Workstn ExtFile(‘DSP01’) IndDs(ds_IndDs);
Suffix -SI
The suffix ‘-SI’ in ‘WORKSTATION-DSPF01-SI’ indicates special indicator area. It is similar to f-spec INDDS keyword of RPGLE program.
**free
// F-Spec
Dcl-F DSP01 Workstn Extname(‘DSP01’) SFile(SFL01:RRN1)
IndDs(ds_IndDs);
// D-Spec
// Indicator data structure
Dcl-DS ds_IndDs;
Exit ind Pos(3);
Refresh ind Pos(5);
AddRcd ind Pos(6);
End-DS;
It is related to INDARA keyword of file level entries of the display file. This suffix tells the ILE COBOL compiler to use a separate data area for indicators.
DATA DIVISION.
WORKING-STORAGE SECTION.
* // Indicator data area.
01 WS-INDICATORS.
03 WS-IND-EXIT PIC 1 INDIC 03.
88 EXIT-ON VALUE B"1".
88 EXIT-OFF VALUE B"0".
03 WS-IND-REFRESH PIC 1 INDIC 05.
88 REFRESH-ON VALUE B"1".
88 REFRESH-OFF VALUE B"0".
03 WS-IND-ADD PIC 1 INDIC 06.
88 ADD-ON VALUE B"1".
88 ADD-OFF VALUE B"0".
03 WS-IND-CHANGE PIC 1 INDIC 08.
88 CHANGE-ON VALUE B"1".
88 CHANGE-OFF VALUE B"0".
03 WS-IND-PREVIOUS PIC 1 INDIC 12.
88 PREVIOUS-ON VALUE B"1".
88 PREVIOUS-OFF VALUE B"0".
03 WS-IND-SFLDSP PIC 1 INDIC 25.
88 SFLDSP-ON VALUE B"1".
88 SFLDSP-OFF VALUE B"0".
03 WS-IND-SFLDSPCTL PIC 1 INDIC 26.
88 SFLDSPCTL-ON VALUE B"1".
88 SFLDSPCTL-OFF VALUE B"0".
03 WS-IND-SFLCLR PIC 1 INDIC 27.
88 SFLCLR-ON VALUE B"1".
88 SFLCLR-OFF VALUE B"0".
03 WS-IND-SFLEND PIC 1 INDIC 28.
88 SFLEND-ON VALUE B"1".
88 SFLEND-OFF VALUE B"0".
03 WS-IND-SFLNXTCHG PIC 1 INDIC 29.
88 SFLNXTCHG-ON VALUE B"1".
88 SFLNXTCHG-OFF VALUE B"0".
TRANSACTION
Display files are typically defined as ORGANIZATION IS TRANSACTION. It defines a special file type due to which ILE COBOL program provides following features:
- Interactive communication with workstations or remote systems.
- Enabling interfaces like record format display, windows display, subfile display, message subfile display.
- Enabling command functions, display fields, and also hidden fields of display files.
- Enabling Sequential IO operations (READ FORMAT, WRITE FORMAT, REWRITE FORMAT) for simple record format display file.
- Enabling Dynamic IO operations (READ SUBFILE, WRITE SUBFILE, REWRITE SUBFILE) for subfile record format display file.
- Enabling program-to-program messaging, program message queue.
SEQUENTIAL/DYNAMIC access mode
- The ACCESS MODE clause is optional for transaction files.
- If the ACCESS MODE clause is not defined, it automatically selects SEQUENTIAL or DYNAMIC based on the display file type.
- If the programmer is defining the ACCESS MODE for transaction files, simple record format display files should be defined as SEQUENTIAL. This is because they contain only single record data at any given time.
- If the programmer is defining the ACCESS MODE for transaction files, subfile record format display files should be defined as DYNAMIC. This is because they can contain zero or multiple record data at any given time. When the DYNAMIC access mode is active, the ‘WRITE SUBFILE’, ‘READ SUBFILE NEXT MODIFIED RECORD’, and ‘REWRITE SUBFILE’ operations are applicable for subfile record format display file programming.
- Typically, display files contain 1 or 2 subfiles and several simple record formats. In this case, the ACCESS MODE clause should be defined as DYNAMIC.
RELATIVE KEY Clause
The RELATIVE clause applies only to subfile display file programming to control the number of records. For example, in load-all mode, it should not exceed 9999 records, and in single-page mode, it should not exceed SFLPAG. This is not the same as the RECORD clause used for files with INDEXED organization. WS-RELATIVE-RECORD-NUMBER must be defined in the Working-Storage section.
DATA DIVISION. WORKING-STORAGE SECTION. * // Relative record number 01 WS-RELATIVE-RECORD-NUMBER PIC S9(4) VALUE ZEROS.
RPGLE Replica Program – D-Spec.
// D-Spec. // Relative record number Dcl-S RRN1 Zoned(4:0) Inz(0);
CONTROL-AREA Clause
CONTROL-AREA clause in FILE-CONTROL paragraph of the INPUT-OUTPUT SECTION of the ENVIRONMENT DIVISION specifies device-dependent and system-dependent information used to control input/output operations for TRANSACTION files. In the current example, WS-CONTROL-
AREA needs to be defined as below:
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-CONTROL-AREA.
05 FUNCTION-KEY PIC X(02).
05 DEVICE-NAME PIC X(10).
05 RECORD-FORMAT PIC X(10).
FUNCTION-KEY is a 2-digit number inserted in the field by the workstation interface that identifies the function key the operator pressed to initiate the transaction.
| Number | Meaning | Number | Meaning |
|---|---|---|---|
| 00 | Enter | 16 | Shift + F4 |
| 01 | F1 | 17 | Shift + F5 |
| 02 | F2 | 18 | Shift + F6 |
| 03 | F3 | 19 | Shift + F7 |
| 04 | F4 | 20 | Shift + F8 |
| 05 | F5 | 21 | Shift + F9 |
| 06 | F6 | 22 | Shift + F10 |
| 07 | F7 | 23 | Shift + F11 |
| 08 | F8 | 24 | Shift + F12 |
| 09 | F9 | 90 | Roll Up / Page Down Key |
| 10 | F10 | 91 | Roll Down / Page Up Key |
| 11 | F11 | 92 | Print Key |
| 12 | F12 | 93 | Help Key |
| 13 | Shift + F1 | 94 | Clear Key |
| 14 | Shift + F2 | 95 | Home Key |
| 15 | Shift + F3 | 99 | Undefined |
DEVICE-NAME describes the program workstation device name. In the current example, it will always show ‘DSP01’.
RECORD-FORMAT describes the DDS record format name that was referenced by the last input/output statement run. Generally, display files have multiple record formats and one or two subfiles, and may also include windows, message subfiles. So, developers programing must use the below check for finding whether in screen user has pressed ENTER-KEY in record format ‘FILRCD’.
CBLLE Program to check ENTER key is pressed:
* // In Procedure Division
* // Write FILRCD record format.
WRITE DSP01-REC
FROM FILRCD-O
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-WRITE.
* // Display FILRCD record format.
READ DSP01
INTO FILRCD-I
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-READ.
* // Check whether user has pressed ENTER KEY in ‘FILRCD’ record
* // format.
IF RECORD-FORMAT = ‘FILRCD’ AND FUNCTION-KEY = ‘00’
* //Process ENTER Key operations of the FILRCD record format
END-IF.
RPGLE Replica Program to check ENTER key is pressed.
**free
// F-Spec
Dcl-F DSP01 Workstn Extname(‘DSP01’) SFile(SFL01:RRN1)
InfDs(ds_InfDs);
// D-Spec
// File information data structure
Dcl-DS ds_InfDs;
KeyPressed Char(1) pos(369);
End-DS;
// Constant declaration
Dcl-C EnterKey Const(x’F1’);
//C-Spec
ExFmt FILRCD;
If KeyPressed = EnterKey;
// Process EnterKey
EndIf;
FILE STATUS Clause
FILE STATUS clause is used to capture file status for ’00’ and ‘9S’. After any I/O operation in display file record formats, check WS-DSP01-FILE-STATUS for values other than “00”.
- ‘00’ – Operation not successful
- ‘9S’ – Session Device Error
COBOL verb used for simple record format display files
Opcode EXFMT of RPGLE programming is similar to WRITE + READ of COBOL programming.
RPGLE:
//C-Spec // Write & Display FILRCD record format. ExFmt FILRCD; // Or Write FILRCD; Read FILRCD;
CBLLE:
* In Procedure Division
* // Write FILRCD record format.
WRITE DSP01-REC
FROM FILRCD-O
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-WRITE.
* // Display FILRCD record format.
READ DSP01
INTO FILRCD-I
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-READ.
COBOL verb used for Subfile record format display files
Opcode EXFMT of RPGLE programming is similar to WRITE + READ of COBOL programming.
CBLLE Program:
* In Procedure Division
* // Write subfile record formats - SFL01.
WRITE SUBFILE DSP01-REC
FROM SFL01-O
FORMAT IS "SFL01"
INDICATORS ARE WS-INDICATORS
END-WRITE
* ====
* ====
* // Write MAIN-SCREEN subfile control record format
WRITE DSP01-REC
FROM SFLCTL01-O
FORMAT IS "SFLCTL01"
INDICATORS ARE WS-INDICATORS
END-WRITE.
* // Read Subfile control record format
READ DSP01
INTO SFLCTL01-I
FORMAT IS "SFLCTL01"
INDICATORS ARE WS-INDICATORS
END-READ.
* ====
* ====
* // Read next modified record.
READ SUBFILE DSP01 NEXT MODIFIED RECORD
INTO SFL01-I
FORMAT IS "SFL01"
AT END GO TO 090-PROCESS-ENTER-EXIT
END-READ.
* ====
* ====
* // Update SFL record if read, subfile record formats - SFL01.
REWRITE SUBFILE DSP01-REC
FROM SFL01-O
FORMAT IS "SFL01"
INDICATORS ARE WS-INDICATORS
END-REWRITE.
RPGLE Replica program:
//C-Spec
// Write subfile record formats - SFL01.
Write SFL01;
//====
//====
// Write & display subfile control record formats - SFL01.
ExFmt SFLCTL01;
//====
//====
// Read next modified subfile record formats - SFL01.
ReadC SFL01;
If %Eof();
// Handle Error
EndIf;
//====
//====
// Update SFL record if read, subfile record formats - SFL01.
Update SFL01;
Subfile Programming
ILE COBOL subfile programming is a technique used on IBM i systems to display and manage multiple records on a single screen through a WORKSTATION device. A subfile consists of two primary components defined in Data Description Specifications (DDS): the Subfile Record Format (SFL), which defines the individual record layout, and the Subfile Control Record Format (SFLCTL), which manages the display and behaviour of the entire list.
Type of loading technique
| Feature | Load All | Expandable (Self-Extending) | Single Page (Page-at-a-Time) |
|---|---|---|---|
| DDS Definition | SFLSIZ > SFLPAG | SFLSIZ > SFLPAG | SFLSIZ = SFLPAG |
| Paging Logic | Handled by OS | Program handles Page Down | Program handles Up & Down |
| Record Limit | Max 9,999 records | Max 9,999 records | Unlimited |
| Memory Use | Highest (loads all at once) | Moderate (loads as needed) | Lowest (loads one page) |
| Data Recency | Static (until reloaded) | Mixed (older pages are static) | Dynamic (fresh on every page) |
Example of load all programming
DDS for file – DB01 – Authorized User List against fields
* -----------------------------------------------------------------------* * FILE LEVEL DESCRIPTIONS * * -----------------------------------------------------------------------* A UNIQUE * -----------------------------------------------------------------------* * RECORD FORMAT LEVEL DESCRIPTIONS * * -----------------------------------------------------------------------* A R DB01R A XXUSRPRF 10A A XXFILE 10A A XXFIELD 10A A XXTEXT 30A A XXFLAG 1A A XXDESC 30A * -----------------------------------------------------------------------* * KEY FIELD FORMAT LEVEL DESCRIPTIONS * * -----------------------------------------------------------------------* A K XXUSRPRF A K XXFILE A K XXFIELD * -----------------------------------------------------------------------*
DDS for DSP01 display file – Authorized User List maintenance screen
* -----------------------------------------------------------------------*
* File Level Descriptions *
* -----------------------------------------------------------------------*
A DSPSIZ(24 80 *DS3)
A INDARA
* -----------------------------------------------------------------------*
* Subfile Record Format Level Descriptions - SFL01 *
* -----------------------------------------------------------------------*
A R SFL01 SFL
A 29 SFLNXTCHG
A S1OPT 1A B 9 2
A N30 DSPATR(HI UL)
A 30 DSPATR(RI PC)
A S1USRPRF 10A O 9 5
A S1FILE 10A O 9 19
A S1FIELD 10A O 9 31
A S1TEXT 30A O 9 43
A S1FLAG 1A O 9 75
A S1DESC 30A O 10 43
* -----------------------------------------------------------------------*
* Subfile Control Record Format Level Descriptions - SFLCTL01 *
* -----------------------------------------------------------------------*
A R SFLCTL01 SFLCTL(SFL01)
* Command Functions
A CF03(03 'Exit')
A 25 CF05(05 'Refresh')
A CF06(06 'Add')
* Other Functions
A OVERLAY
* Subfile Functions
A 25 SFLDSP
A 26 SFLDSPCTL
A 27 SFLCLR
A 28 SFLEND(*MORE)
A 38 SFLDROP(CF11)
A N38 SFLFOLD(CF11)
A SFLSIZ(9999)
A SFLPAG(0006)
A SFLMODE(&MODE)
A SFLCSRRRN(&CSRRRN)
A RRN1 4S 0H SFLRCDNBR(CURSOR)
A CSRRRN 5S 0H
A MODE 1A H
* Row 1
A D1PGM 10A O 1 2COLOR(BLU)
A 1 25'Authorized user for file/fields'
A COLOR(WHT)
A 1 72DATE
A EDTCDE(Y)
A COLOR(BLU)
* Row 2
A 2 72TIME
A EDTWRD(' : : ')
A COLOR(BLU)
* Row 4-5
A 4 2'Type Options, Press Enter.'
A 25 COLOR(BLU)
A N25 DSPATR(ND)
A 5 2'2=Edit 3=Copy 4=Delete 5=Displ-
A ay'
A 25 COLOR(BLU)
A N25 DSPATR(ND)
* Row 7
A 7 1'OPT'
A DSPATR(HI)
A 7 5'USER PROFILE'
A DSPATR(HI)
A 7 19'FILE'
A DSPATR(HI)
A 7 31'FIELD'
A DSPATR(HI)
A 7 43'FIELD DESC'
A DSPATR(HI)
A 7 74'INCLUDE'
A DSPATR(HI)
* Row 8
A 8 43'EXTERNAL DESC'
A DSPATR(HI)
* -----------------------------------------------------------------------*
* Record Format Level Descriptions - FOOTER1 *
* -----------------------------------------------------------------------*
A R FOOTER1
A 25 23 2'F3=Exit F5=Refresh F6=Add F11=D-
A rop/Fold'
A COLOR(BLU)
A N25 23 2'F3=Exit F6=Add F11=Drop/Fold'
A COLOR(BLU)
A D1MSG 78A O 24 2DSPATR(HI)
* -----------------------------------------------------------------------*
* Record Format Level Descriptions - FILRCD *
* -----------------------------------------------------------------------*
A R FILRCD
* Command Functions
A N36
AON37 CF05(05 'Refresh')
A N43 CF08(08 'Change')
A CF12(12 'Previous')
* Other Functions
A OVERLAY
* Row 1
A D2PGM 10A O 1 2COLOR(BLU)
A 1 25'Include File List Maintenance'
A COLOR(WHT)
A 1 72DATE
A EDTCDE(Y)
A COLOR(BLU)
* Row 2
A 2 2'Mode:'
A D2MOD 8A O 2 9COLOR(RED)
A 2 72TIME
A EDTWRD(' : : ')
A COLOR(BLU)
* Row 8
A 8 27'User Profile:'
A D2USRPRF 10A B 8 42
A N31N36 DSPATR(HI UL)
A 31N36 DSPATR(RI PC)
A N31 36 DSPATR(PR)
* Row 10
A 10 27'File:'
A D2FILE 10A B 10 42
A N32N36 DSPATR(HI UL)
A 32N36 DSPATR(RI PC)
A N32 36 DSPATR(PR)
* Row 12
A 12 27'Field:'
A D2FIELD 10A B 12 42
A N33N36 DSPATR(HI UL)
A 33N36 DSPATR(RI PC)
A N33 36 DSPATR(PR)
* Row 14
A 14 27'External Desc:'
A D2DESC 30A B 14 42CHECK(LC)
A N34N37 DSPATR(HI UL)
A 34N37 DSPATR(RI PC)
A N34 37 DSPATR(PR)
* Row 16
A 16 27'Include File:'
A D2FLAG 1A B 16 42
A N35N37 DSPATR(HI UL)
A 35N37 DSPATR(RI PC)
A N35 37 DSPATR(PR)
A 16 53'(Y/N)'
A COLOR(BLU)
* -----------------------------------------------------------------------*
* Record Format Level Descriptions - FOOTER2A - ADD *
* -----------------------------------------------------------------------*
A R FOOTER2
A N36N37 40 23 2'F5=Refresh F8=Add F12=Previous'
A COLOR(BLU)
A 36 37 40 23 2'F8=Confirm Add F12=Previous'
A COLOR(BLU)
A 36N37 41 23 2'F5=Refresh F8=Edit F12=Previous'
A COLOR(BLU)
A 36 37 41 23 2'F8=Confirm Edit F12=Previous'
A COLOR(BLU)
A 36 37N42
AAN43 23 2'F8=Delete F12=Previous'
A COLOR(BLU)
A 36 37 42
AAN43 23 2'F8=Confirm Delete F12=Previous'
A COLOR(BLU)
A 36 37N42
AA 43 23 2'F12=Previous'
A COLOR(BLU)
A D2MSG 78A O 24 2DSPATR(HI)
* -----------------------------------------------------------------------*
* Record Format Level Descriptions - CPYRCD *
* -----------------------------------------------------------------------*
A R CPYRCD
* Command Functions
A N36N37 CF05(05 'Refresh')
A CF08(08 'Copy')
A CF12(12 'Previous')
* Other Functions
A OVERLAY
* Row 1
A D3PGM 10A O 1 2COLOR(BLU)
A 1 25'Include File List Maintenance'
A COLOR(WHT)
A 1 72DATE
A EDTCDE(Y)
A COLOR(BLU)
* Row 2
A 2 2'Mode:'
A D3MOD 8A O 2 9COLOR(RED)
A 2 72TIME
A EDTWRD(' : : ')
* Row 7
A 7 11'VALUE'
A COLOR(WHT)
A 7 42'NEW VALUE'
A COLOR(WHT)
* Row 8
A 8 1'User Prf:'
A D3USRPRF 10A O 8 11
A D2USRPRF 10A B 8 42
A N31N36 DSPATR(HI UL)
A 31N36 DSPATR(RI PC)
* Row 10
A 10 1'File:'
A D3FILE 10A O 10 11
A D2FILE 10A B 10 42
A N32N36 DSPATR(HI UL)
A 32N36 DSPATR(RI PC)
A N32 36 DSPATR(PR)
* Row 12
A 12 1'Field:'
A D3FIELD 10A O 12 11
A D2FIELD 10A B 12 42
A N35N37 DSPATR(HI UL)
A 35N37 DSPATR(RI PC)
A N35 37 DSPATR(PR)
* Row 14
A 14 1'External:'
A D3DESC 30A O 14 11
A D2DESC 30A B 14 42CHECK(LC)
A N34N37 DSPATR(HI UL)
A 34N37 DSPATR(RI PC)
A N34 37 DSPATR(PR)
* Row 16
A 16 1'Include:'
A D3FLAG 1A O 16 11
A D2FLAG 1A B 16 42
A N35N37 DSPATR(HI UL)
A 35N37 DSPATR(RI PC)
A N35 37 DSPATR(PR)
* -----------------------------------------------------------------------*
* Record Format Level Descriptions - FOOTER3 *
* -----------------------------------------------------------------------*
A R FOOTER3
A N36N37 23 2'F5=Refresh F8=Copy F12=Previous'
A COLOR(BLU)
A 36 37 23 2'F8=Confirm Copy F12=Previous'
A COLOR(BLU)
A D3MSG 78A O 24 2DSPATR(HI)
* -----------------------------------------------------------------------*
Load All subfile programming
PROCESS FLAG (29), APOST.
IDENTIFICATION DIVISION.
* ----------------------*
PROGRAM-ID. SFLPGM01.
AUTHOR. PROGRAMMER.
* -------------------*
ENVIRONMENT DIVISION.
* -------------------*
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-ISERIES.
OBJECT-COMPUTER. IBM-ISERIES.
* -------------------*
INPUT-OUTPUT SECTION.
* -------------------*
FILE-CONTROL.
SELECT DSP01
ASSIGN TO WORKSTATION-DSP01-SI
ORGANIZATION IS TRANSACTION
ACCESS MODE IS DYNAMIC
RELATIVE KEY IS WS-RRN1
FILE STATUS IS WS-DSP01-STATUS
SELECT DB01
ASSIGN TO DATABASE-DB01
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY
FILE STATUS IS WS-DB01-STATUS.
* ------------*
DATA DIVISION.
* ------------*
FILE SECTION.
FD DSP01.
01 DSP01-REC PIC X(1920).
FD DB01.
01 DB01-REC.
COPY DDS-ALL-FORMATS OF DB01.
* ----------------------*
WORKING-STORAGE SECTION.
* ----------------------*
* // Display File Input Record Formats
01 DSP01-REC-IN1.
COPY DD-SFL01-I OF DSP01.
01 DSP01-REC-IN2.
COPY DD-SFLCTL01-I OF DSP01.
01 DSP01-REC-IN4.
COPY DD-FILRCD-I OF DSP01.
01 DSP01-REC-IN5.
COPY DD-CPYRCD-I OF DSP01.
* // Display File Output Record Formats
01 DSP01-REC-OUT1.
COPY DD-SFL01-O OF DSP01.
01 DSP01-REC-OUT2.
COPY DD-SFLCTL01-O OF DSP01.
01 DSP01-REC-OUT3.
COPY DD-FOOTER1-O OF DSP01.
01 DSP01-REC-OUT4.
COPY DD-FILRCD-O OF DSP01.
01 DSP01-REC-OUT5.
COPY DD-CPYRCD-O OF DSP01.
01 DSP01-REC-OUT6.
COPY DD-FOOTER2-O OF DSP01.
01 DSP01-REC-OUT7.
COPY DD-FOOTER3-O OF DSP01.
* // Program Variables (File-Control paragraph).
01 WS-RRN1 PIC 9(4) VALUE ZEROS.
01 WS-FILE-STATUS.
03 WS-DSP01-STATUS PIC X(2).
03 WS-DB01-STATUS PIC X(2).
88 DB01-SUCCESSFUL VALUE "00".
88 DB01-END-OF-FILE VALUE "10".
88 DB01-RECORD-NOT-FND VALUE "23".
* // Indicator data structure.
01 WS-INDICATORS.
03 WS-IND-EXIT PIC 1 INDIC 03.
88 EXIT-ON VALUE B"1".
88 EXIT-OFF VALUE B"0".
03 WS-IND-REFRESH PIC 1 INDIC 05.
88 REFRESH-ON VALUE B"1".
88 REFRESH-OFF VALUE B"0".
03 WS-IND-ADD PIC 1 INDIC 06.
88 ADD-ON VALUE B"1".
88 ADD-OFF VALUE B"0".
03 WS-IND-CHANGE PIC 1 INDIC 08.
88 CHANGE-ON VALUE B"1".
88 CHANGE-OFF VALUE B"0".
03 WS-IND-PREVIOUS PIC 1 INDIC 12.
88 PREVIOUS-ON VALUE B"1".
88 PREVIOUS-OFF VALUE B"0".
03 WS-IND-SFLDSP PIC 1 INDIC 25.
88 SFLDSP-ON VALUE B"1".
88 SFLDSP-OFF VALUE B"0".
03 WS-IND-SFLDSPCTL PIC 1 INDIC 26.
88 SFLDSPCTL-ON VALUE B"1".
88 SFLDSPCTL-OFF VALUE B"0".
03 WS-IND-SFLCLR PIC 1 INDIC 27.
88 SFLCLR-ON VALUE B"1".
88 SFLCLR-OFF VALUE B"0".
03 WS-IND-SFLEND PIC 1 INDIC 28.
88 SFLEND-ON VALUE B"1".
88 SFLEND-OFF VALUE B"0".
03 WS-IND-SFLNXTCHG PIC 1 INDIC 29.
88 SFLNXTCHG-ON VALUE B"1".
88 SFLNXTCHG-OFF VALUE B"0".
03 WS-IND-RIS1OPT PIC 1 INDIC 30.
88 RIS1OPT-ON VALUE B"1".
88 RIS1OPT-OFF VALUE B"0".
03 WS-IND-RID2USRPRF PIC 1 INDIC 31.
88 RID2USRPRF-ON VALUE B"1".
88 RID2USRPRF-OFF VALUE B"0".
03 WS-IND-RID2FILE PIC 1 INDIC 32.
88 RID2FILE-ON VALUE B"1".
88 RID2FILE-OFF VALUE B"0".
03 WS-IND-RID2FIELD PIC 1 INDIC 33.
88 RID2FIELD-ON VALUE B"1".
88 RID2FIELD-OFF VALUE B"0".
03 WS-IND-RID2DESC PIC 1 INDIC 34.
88 RID2DESC-ON VALUE B"1".
88 RID2DESC-OFF VALUE B"0".
03 WS-IND-RID2FLAG PIC 1 INDIC 35.
88 RID2FLAG-ON VALUE B"1".
88 RID2FLAG-OFF VALUE B"0".
03 WS-IND-PRD2USRPRF PIC 1 INDIC 36.
88 PRD2USRPRF-ON VALUE B"1".
88 PRD2USRPRF-OFF VALUE B"0".
03 WS-IND-PRD2FLAG PIC 1 INDIC 37.
88 PRD2FLAG-ON VALUE B"1".
88 PRD2FLAG-OFF VALUE B"0".
03 WS-IND-SFLDROP PIC 1 INDIC 38.
88 SFLDROP-ON VALUE B"1".
88 SFLDROP-OFF VALUE B"0".
03 WS-IND-APPLY-ADDFMT PIC 1 INDIC 40.
88 APPLY-ADDFMT-ON VALUE B"1".
88 APPLY-ADDFMT-OFF VALUE B"0".
03 WS-IND-APPLY-EDTFMT PIC 1 INDIC 41.
88 APPLY-EDTFMT-ON VALUE B"1".
88 APPLY-EDTFMT-OFF VALUE B"0".
03 WS-IND-APPLY-DLTFMT PIC 1 INDIC 42.
88 APPLY-DLTFMT-ON VALUE B"1".
88 APPLY-DLTFMT-OFF VALUE B"0".
03 WS-IND-APPLY-DSPFMT PIC 1 INDIC 43.
88 APPLY-DSPFMT-ON VALUE B"1".
88 APPLY-DSPFMT-OFF VALUE B"0".
* // Program Variables.
01 WS-ERROR-FLAG PIC 1.
88 ERROR-FLAG-ON VALUE B"1".
88 ERROR-FLAG-OFF VALUE B"0".
01 WS-SCREEN PIC X(15)
VALUE "MAINSCREEN".
88 MAIN-SCREEN VALUE "MAINSCREEN".
88 ADD-SCREEN VALUE "ADDSCREEN".
88 EDIT-SCREEN VALUE "EDITSCREEN".
88 COPY-SCREEN VALUE "COPYSCREEN".
88 DELETE-SCREEN VALUE "DELETESCREEN".
88 DISPLAY-SCREEN VALUE "DISPLAYSCREEN".
88 CLEAR-SCREEN VALUE "CLEARSCREEN".
01 WS-IND-ON PIC 1 VALUE B"1".
01 WS-IND-OFF PIC 1 VALUE B"0".
01 WS-CMD PIC X(500).
01 WS-CMD-LEN PIC 9(10)V9(5)
USAGE PACKED-DECIMAL VALUE 40.
01 WS-CL-CMD PIC X(10).
01 WS-OBJ-NAM PIC X(10).
01 WS-OBJ-TYP PIC X(10).
* // Program Variables (Constants).
01 SUBFILE-SIZE CONSTANT 9999.
01 ENTER-KEY CONSTANT x’F1’.
01 SUCCESSFUL CONSTANT “00”.
01 END-OF-FILE CONSTANT “10”.
01 RECORD-NOT-FOUND CONSTANT "23".
* -----------------*
PROCEDURE DIVISION.
* -----------------*
000-MAINLINE.
* // Initialize Program variables and open files.
PERFORM 010-INIT-PARA
THRU 010-INIT-PARA-EXIT.
* // Clear Subfile
PERFORM 020-CLR-SFL
THRU 020-CLR-SFL-EXIT.
* // Load Subfile
PERFORM 030-LOD-SFL
THRU 030-LOD-SFL-EXIT.
* // Set Subfile Indicators
PERFORM 040-SET-SFL-IND
THRU 040-SET-SFL-IND-EXIT.
* // Display MAINSCREEN and process all function key/options.
PERFORM 050-DSP-SFL
THRU 050-DSP-SFL-EXIT
UNTIL EXIT-ON.
* // Close all files.
PERFORM 999-CLOSE-PARA
THRU 999-CLOSE-PARA-EXIT.
* // End Program!
STOP RUN.
* ---------------------------------------------------------------*
* Initialize paragraph *
* ---------------------------------------------------------------*
010-INIT-PARA.
* // Open all files.
OPEN I-O DSP01
DB01.
* // Initialize all record formats.
INITIALIZE DSP01-REC-IN1
DSP01-REC-IN2
DSP01-REC-IN4
DSP01-REC-IN5
DSP01-REC-OUT1
DSP01-REC-OUT2
DSP01-REC-OUT3
DSP01-REC-OUT4
DSP01-REC-OUT5
DSP01-REC-OUT6.
* // Initialize program and screen variables.
MOVE "DSPPGM01" TO D1PGM OF SFLCTL01-O
D2PGM OF FILRCD-O
D3PGM OF CPYRCD-O.
010-INIT-PARA-EXIT. EXIT.
* ---------------------------------------------------------------*
* Clear Subfile Para *
* ---------------------------------------------------------------*
020-CLR-SFL.
* // Set off SFLDSP and SFLDSPCTL and set on to SFLCLR indicators.
SET SFLDSP-OFF
SFLDSPCTL-OFF
SFLEND-OFF
SFLCLR-ON TO TRUE.
* // Clear Subfile.
WRITE DSP01-REC
FROM SFLCTL01-O
FORMAT IS "SFLCTL01"
INDICATORS ARE WS-INDICATORS.
* // Set Off SFLCLR indicator.
SET SFLCLR-OFF TO TRUE.
COMPUTE WS-RRN1 = 0.
020-CLR-SFL-EXIT. EXIT.
* ---------------------------------------------------------------*
* Load Subfile Para *
* ---------------------------------------------------------------*
030-LOD-SFL.
* // Setll *LOVAL
INITIALIZE XXUSRPRF
XXFILE
XXFIELD.
START DB01 KEY >= EXTERNALLY-DESCRIBED-KEY
INVALID KEY GO TO 030-LOD-SFL-EXIT.
* // Read DB01 and load subfile record formats.
READ DB01 NEXT RECORD WITH NO LOCK
AT END GO TO 030-LOD-SFL-EXIT.
PERFORM UNTIL WS-DB01-STATUS = END-OF-FILE
OR WS-RRN1 >= SUBFILE-SIZE
ADD 1 TO WS-RRN1
SET SFLNXTCHG-OFF TO TRUE
MOVE SPACES TO S1OPT OF SFL01-O
MOVE XXUSRPRF TO S1USRPRF OF SFL01-O
MOVE XXFILE TO S1FILE OF SFL01-O
MOVE XXFIELD TO S1FIELD OF SFL01-O
MOVE XXTEXT TO S1TEXT OF SFL01-O
MOVE XXFLAG TO S1FLAG OF SFL01-O
MOVE XXDESC TO S1DESC OF SFL01-O
* // Write subfile record formats - SFL01.
WRITE SUBFILE DSP01-REC
FROM SFL01-O
FORMAT IS "SFL01"
INDICATORS ARE WS-INDICATORS
READ DB01 NEXT RECORD WITH NO LOCK
END-PERFORM.
030-LOD-SFL-EXIT. EXIT.
* ---------------------------------------------------------------*
* Set Subfile Indicators Para *
* ---------------------------------------------------------------*
040-SET-SFL-IND.
* // Set on SFLDSPCTL
SET SFLDSPCTL-ON TO TRUE.
* // Depending on WS-RRN1 set SFLDSP
IF WS-RRN1 = ZEROS
SET SFLDSP-OFF TO TRUE
MOVE "No records found in file DB01."
TO D1MSG OF FOOTER1-O
ELSE
COMPUTE WS-RRN1 = 1
MOVE 1 TO RRN1 OF SFLCTL01-O
RRN1 OF SFLCTL01-I
SET SFLDSP-ON TO TRUE
END-IF.
* // Depending on File Status set SFLEND
IF WS-DB01-STATUS = END-OF-FILE
SET SFLEND-ON TO TRUE
ELSE
SET SFLEND-OFF TO TRUE
END-IF.
040-SET-SFL-IND-EXIT. EXIT.
* ---------------------------------------------------------------*
* Display Subfile para. *
* ---------------------------------------------------------------*
050-DSP-SFL.
* // Display MAINSCREEN until user press F3
PERFORM UNTIL EXIT-ON
* // Write FOOTER1 record format
WRITE DSP01-REC
FROM FOOTER1-O
FORMAT IS "FOOTER1"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Write MAIN-SCREEN subfile control record format
WRITE DSP01-REC
FROM SFLCTL01-O
FORMAT IS "SFLCTL01"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Read Subfile control record format
READ DSP01
INTO SFLCTL01-I
FORMAT IS "SFLCTL01"
INDICATORS ARE WS-INDICATORS
END-READ
* // Reset Error and message indicators
PERFORM 060-RESET-ERROR
THRU 060-RESET-ERROR-EXIT
EVALUATE TRUE
* // When user press F3
WHEN EXIT-ON
GO TO 050-DSP-SFL-EXIT
* // When user press F5
WHEN SFLDSP-ON AND REFRESH-ON
SET REFRESH-OFF TO TRUE
PERFORM 070-PROCESS-REFRESH
THRU 070-PROCESS-REFRESH-EXIT
PERFORM 055-DSP-SFL-RELOD
THRU 055-DSP-SFL-RELOD-EXIT
* // When user press F6
WHEN ADD-ON
SET ADD-OFF TO TRUE
PERFORM 080-ADD-NEW-RCD
THRU 080-ADD-NEW-RCD-EXIT
PERFORM 055-DSP-SFL-RELOD
THRU 055-DSP-SFL-RELOD-EXIT
* // When user press ENTER
WHEN OTHER
PERFORM 090-PROCESS-ENTER
THRU 090-PROCESS-ENTER-EXIT
IF RIS1OPT-ON
NEXT SENTENCE
ELSE
PERFORM 055-DSP-SFL-RELOD
THRU 055-DSP-SFL-RELOD-EXIT
END-IF
END-EVALUATE
END-PERFORM.
050-DSP-SFL-EXIT. EXIT.
* ---------------------------------------------------------------*
* Clear Subfile, Load Subfile and Set Indicators again. *
* ---------------------------------------------------------------*
055-DSP-SFL-RELOD.
CLOSE DB01.
OPEN I-O DB01.
PERFORM 020-CLR-SFL
THRU 020-CLR-SFL-EXIT.
PERFORM 030-LOD-SFL
THRU 030-LOD-SFL-EXIT.
PERFORM 040-SET-SFL-IND
THRU 040-SET-SFL-IND-EXIT.
055-DSP-SFL-RELOD-EXIT. EXIT.
* ---------------------------------------------------------------*
* Reset errors and message indicators, if any *
* ---------------------------------------------------------------*
060-RESET-ERROR.
SET ERROR-FLAG-OFF TO TRUE
EVALUATE TRUE
* // Reset Error of MAINSCREEN
WHEN MAIN-SCREEN
MOVE SPACES TO D1MSG OF FOOTER1-O
SET RIS1OPT-OFF TO TRUE
* // Reset Error of ADDSCREEN or COPYSCREEN
WHEN ADD-SCREEN
OR COPY-SCREEN
MOVE SPACES TO D2MSG OF FOOTER2-O
D3MSG OF FOOTER3-O
SET RID2USRPRF-OFF
RID2FILE-OFF
RID2FIELD-OFF
RID2DESC-OFF
RID2FLAG-OFF TO TRUE
* // Reset Error of EDITSCREEN
WHEN EDIT-SCREEN
MOVE SPACES TO D2MSG OF FOOTER2-O
SET RID2DESC-OFF
RID2FLAG-OFF
PRD2USRPRF-ON TO TRUE
* // Clear messages of DELETESCREEN
WHEN DELETE-SCREEN
MOVE SPACES TO D2MSG OF FOOTER2-O
END-EVALUATE.
060-RESET-ERROR-EXIT. EXIT.
* ---------------------------------------------------------------*
* Process Refresh Paragraph *
* ---------------------------------------------------------------*
070-PROCESS-REFRESH.
EVALUATE TRUE
* // Refresh MAINSCREEN
WHEN MAIN-SCREEN
MOVE SPACES TO D1MSG OF FOOTER1-O
PERFORM 060-RESET-ERROR
THRU 060-RESET-ERROR-EXIT
* // Refresh ADDSCREEN
WHEN ADD-SCREEN
MOVE SPACES TO D2MSG OF FOOTER2-O
D2USRPRF OF FILRCD-O
D2FILE OF FILRCD-O
D2FIELD OF FILRCD-O
D2DESC OF FILRCD-O
D2FLAG OF FILRCD-O
PERFORM 060-RESET-ERROR
THRU 060-RESET-ERROR-EXIT
* // Refresh EDITSCREEN
WHEN EDIT-SCREEN
MOVE SPACES TO D2MSG OF FOOTER2-O
D2DESC OF FILRCD-O
D2FLAG OF FILRCD-O
PERFORM 060-RESET-ERROR
THRU 060-RESET-ERROR-EXIT
* // Refresh COPYSCREEN
WHEN COPY-SCREEN
MOVE SPACES TO D3MSG OF FOOTER3-O
D2USRPRF OF CPYRCD-O
D2FILE OF CPYRCD-O
D2FIELD OF CPYRCD-O
D2DESC OF CPYRCD-O
D2FLAG OF CPYRCD-O
PERFORM 060-RESET-ERROR
THRU 060-RESET-ERROR-EXIT
* // Just Clear Screen
WHEN CLEAR-SCREEN
MOVE SPACES TO D2MSG OF FOOTER2-O
D2USRPRF OF FILRCD-O
D2FILE OF FILRCD-O
D2FIELD OF FILRCD-O
D2DESC OF FILRCD-O
D2FLAG OF FILRCD-O
D3MSG OF FOOTER3-O
D2USRPRF OF CPYRCD-O
D2FILE OF CPYRCD-O
D2FIELD OF CPYRCD-O
D2DESC OF CPYRCD-O
D2FLAG OF CPYRCD-O
END-EVALUATE.
070-PROCESS-REFRESH-EXIT. EXIT.
* ---------------------------------------------------------------*
* Add new record paragraph *
* ---------------------------------------------------------------*
080-ADD-NEW-RCD.
* // First, clear rest of the screen.
SET CLEAR-SCREEN TO TRUE.
PERFORM 070-PROCESS-REFRESH
THRU 070-PROCESS-REFRESH-EXIT.
* // Fill FILRCD record format for ADD-SCREEN
MOVE "ADD" TO D2MOD OF FILRCD-O.
* // Set appropriate indicators for ADD-SCREEN
SET ADD-SCREEN
PRD2USRPRF-OFF
PRD2FLAG-OFF
APPLY-ADDFMT-ON TO TRUE.
* // Display FILRCD record format until user press F12.
PERFORM UNTIL PREVIOUS-ON
* // Write FOOTER2 record format.
WRITE DSP01-REC
FROM FOOTER2-O
FORMAT IS "FOOTER2"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Write FILRCD record format.
WRITE DSP01-REC
FROM FILRCD-O
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Display FILRCD record format (ADD SCREEN).
READ DSP01
INTO FILRCD-I
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-READ
* // Reset errors and message indicators, if any.
PERFORM 060-RESET-ERROR
THRU 060-RESET-ERROR-EXIT
EVALUATE TRUE
* // When user press F12.
WHEN PREVIOUS-ON
IF PRD2USRPRF-ON AND PRD2FLAG-ON
SET PRD2USRPRF-OFF
PRD2FLAG-OFF
PREVIOUS-OFF TO TRUE
ELSE
NEXT SENTENCE
END-IF
* // When user press F5.
WHEN REFRESH-ON
SET REFRESH-OFF TO TRUE
PERFORM 070-PROCESS-REFRESH
THRU 070-PROCESS-REFRESH-EXIT
* // When user press F8.
WHEN CHANGE-ON AND PRD2USRPRF-OFF AND PRD2FLAG-OFF
SET CHANGE-OFF TO TRUE
* // Validate user entered screen values.
PERFORM 140-VALIDATE-ADDSCREEN
THRU 140-VALIDATE-ADDSCREEN-EXIT
* // If no error, write into database file.
IF ERROR-FLAG-OFF
SET PRD2USRPRF-ON
PRD2FLAG-ON TO TRUE
MOVE "Press F8 again for confirm add, else press F12."
TO D2MSG OF FOOTER2-O
END-IF
* // When user press F8.
WHEN CHANGE-ON AND PRD2USRPRF-ON AND PRD2FLAG-ON
SET CHANGE-OFF TO TRUE
* // Write into database file.
PERFORM 150-WRITE-DB01-FILE
THRU 150-WRITE-DB01-FILE-EXIT
IF ERROR-FLAG-OFF
MOVE "Record has been successfully added."
TO D1MSG OF FOOTER1-O
SET PREVIOUS-ON TO TRUE
END-IF
* // When user press ENTER.
WHEN OTHER
MOVE CORR FILRCD-I TO FILRCD-O
END-EVALUATE
END-PERFORM.
* // Reset appropriate indicators for MAIN-SCREEN.
SET MAIN-SCREEN
APPLY-ADDFMT-OFF
PRD2USRPRF-OFF
PRD2FLAG-OFF
PREVIOUS-OFF TO TRUE.
080-ADD-NEW-RCD-EXIT. EXIT.
* ---------------------------------------------------------------*
* Process ENTER Key Paragraph *
* ---------------------------------------------------------------*
090-PROCESS-ENTER.
* // Read next modified record.
READ SUBFILE DSP01 NEXT MODIFIED RECORD
INTO SFL01-I
FORMAT IS "SFL01"
AT END GO TO 090-PROCESS-ENTER-EXIT.
MOVE CORR SFL01-I TO SFL01-O.
IF S1OPT OF SFL01-O = SPACE
GO TO 090-PROCESS-ENTER-EXIT
END-IF.
EVALUATE TRUE
* // Check whether any incorrect option is not entered.
WHEN S1OPT OF SFL01-O NOT = "2" AND
S1OPT OF SFL01-O NOT = "3" AND
S1OPT OF SFL01-O NOT = "4" AND
S1OPT OF SFL01-O NOT = "5" AND
S1OPT OF SFL01-O NOT = SPACE
SET ERROR-FLAG-ON TO TRUE
SET RIS1OPT-ON TO TRUE
MOVE "Entered option is incorrect."
TO D1MSG OF FOOTER1-O
* // When user press option 2 = Edit.
WHEN S1OPT OF SFL01-O = "2"
PERFORM 100-EDIT-RCD
THRU 100-EDIT-RCD-EXIT
MOVE SPACES TO S1OPT OF SFL01-O
MOVE CORR SFL01-O TO SFL01-I
REWRITE SUBFILE DSP01-REC
FROM SFL01-O
FORMAT IS "SFL01"
INDICATORS ARE WS-INDICATORS
* // When user press option 3 = Copy.
WHEN S1OPT OF SFL01-O = "3"
PERFORM 110-COPY-RCD
THRU 110-COPY-RCD-EXIT
MOVE SPACES TO S1OPT OF SFL01-O
MOVE CORR SFL01-O TO SFL01-I
REWRITE SUBFILE DSP01-REC
FROM SFL01-O
FORMAT IS "SFL01"
INDICATORS ARE WS-INDICATORS
* // When user press option 4 = Delete.
WHEN S1OPT OF SFL01-O = "4"
PERFORM 120-DELETE-RCD
THRU 120-DELETE-RCD-EXIT
MOVE SPACES TO S1OPT OF SFL01-O
MOVE CORR SFL01-O TO SFL01-I
REWRITE SUBFILE DSP01-REC
FROM SFL01-O
FORMAT IS "SFL01"
INDICATORS ARE WS-INDICATORS
* // When user press option 5 = Display.
WHEN S1OPT OF SFL01-O = "5"
PERFORM 130-DISPLAY-RCD
THRU 130-DISPLAY-RCD-EXIT
MOVE SPACES TO S1OPT OF SFL01-O
MOVE CORR SFL01-O TO SFL01-I
REWRITE SUBFILE DSP01-REC
FROM SFL01-O
FORMAT IS "SFL01"
INDICATORS ARE WS-INDICATORS
END-EVALUATE.
090-PROCESS-ENTER-EXIT. EXIT.
* ---------------------------------------------------------------*
* Edit Existing Record Para *
* ---------------------------------------------------------------*
100-EDIT-RCD.
* // Fill FILRCD record format for EDIT-SCREEN.
MOVE "EDIT" TO D2MOD OF FILRCD-O.
MOVE S1USRPRF OF SFL01-O TO D2USRPRF OF FILRCD-O.
MOVE S1FILE OF SFL01-O TO D2FILE OF FILRCD-O.
MOVE S1FIELD OF SFL01-O TO D2FIELD OF FILRCD-O.
MOVE S1FLAG OF SFL01-O TO D2FLAG OF FILRCD-O.
MOVE S1DESC OF SFL01-O TO D2DESC OF FILRCD-O.
MOVE SPACES TO D2MSG OF FOOTER2-O.
* // Display FILRCD record format until user press F12.
SET EDIT-SCREEN
APPLY-EDTFMT-ON
PRD2USRPRF-ON
PRD2FLAG-OFF TO TRUE.
* // Display FILRCD record format until user press F12.
PERFORM UNTIL PREVIOUS-ON
* // Write FOOTER2 record format.
WRITE DSP01-REC
FROM FOOTER2-O
FORMAT IS "FOOTER2"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Write FILRCD record format.
WRITE DSP01-REC
FROM FILRCD-O
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Display FILRCD record format.
READ DSP01
INTO FILRCD-I
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-READ
* // Reset errors and message indicators, if any.
PERFORM 060-RESET-ERROR
THRU 060-RESET-ERROR-EXIT
EVALUATE TRUE
* // When user press F12.
WHEN PREVIOUS-ON
IF PRD2FLAG-ON
SET PRD2FLAG-OFF
PREVIOUS-OFF TO TRUE
ELSE
NEXT SENTENCE
END-IF
* // When user press F5.
WHEN REFRESH-ON
SET REFRESH-OFF TO TRUE
PERFORM 070-PROCESS-REFRESH
THRU 070-PROCESS-REFRESH-EXIT
* // When user press F8.
WHEN CHANGE-ON AND PRD2FLAG-OFF
SET CHANGE-OFF TO TRUE
PERFORM 141-VALIDATE-EDITSCREEN
THRU 141-VALIDATE-EDITSCREEN-EXIT
IF ERROR-FLAG-OFF
SET PRD2FLAG-ON TO TRUE
MOVE "Press F8 again for confirm edit, else press F12."
TO D2MSG OF FOOTER2-O
END-IF
* // When user press F8 for confirm edit
WHEN CHANGE-ON AND PRD2FLAG-ON
SET CHANGE-OFF TO TRUE
PERFORM 160-UPDATE-DB01-FILE
THRU 160-UPDATE-DB01-FILE-EXIT
IF ERROR-FLAG-OFF
MOVE "Record has been successfully updated."
TO D1MSG OF FOOTER1-O
SET PREVIOUS-ON TO TRUE
END-IF
* When user press ENTER.
WHEN OTHER
MOVE CORR FILRCD-I TO FILRCD-O
END-EVALUATE
END-PERFORM.
* // Reset appropriate indicators for MAIN-SCREEN.
SET MAIN-SCREEN
APPLY-EDTFMT-OFF
PRD2USRPRF-OFF
PRD2FLAG-OFF
PREVIOUS-OFF TO TRUE.
100-EDIT-RCD-EXIT. EXIT.
* ---------------------------------------------------------------*
* Copy record paragraph *
* ---------------------------------------------------------------*
110-COPY-RCD.
* // Fill CPYRCD record format to COPY-SCREEN.
MOVE "COPY" TO D3MOD OF CPYRCD-O.
MOVE S1USRPRF OF SFL01-O TO D3USRPRF OF CPYRCD-O.
MOVE S1FILE OF SFL01-O TO D3FILE OF CPYRCD-O.
MOVE S1FIELD OF SFL01-O TO D3FIELD OF CPYRCD-O.
MOVE S1FLAG OF SFL01-O TO D3FLAG OF CPYRCD-O.
MOVE S1DESC OF SFL01-O TO D3DESC OF CPYRCD-O.
* // Clear rest of the screen.
SET CLEAR-SCREEN TO TRUE.
PERFORM 070-PROCESS-REFRESH
THRU 070-PROCESS-REFRESH-EXIT.
* // Set appropriate indicators for COPY-SCREEN.
SET COPY-SCREEN
PRD2USRPRF-OFF
PRD2FLAG-OFF TO TRUE.
* // Display FILRCD record format until user press F12.
PERFORM UNTIL PREVIOUS-ON
* // Write FOOTER2 record format.
WRITE DSP01-REC
FROM FOOTER3-O
FORMAT IS "FOOTER3"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Write FILRCD record format.
WRITE DSP01-REC
FROM CPYRCD-O
FORMAT IS "CPYRCD"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Display COPY-SCREEN.
READ DSP01
INTO CPYRCD-I
FORMAT IS "CPYRCD"
INDICATORS ARE WS-INDICATORS
END-READ
* // Reset errors and message indicators, if any.
PERFORM 060-RESET-ERROR
THRU 060-RESET-ERROR-EXIT
EVALUATE TRUE
* // When user press F12.
WHEN PREVIOUS-ON
IF PRD2USRPRF-ON AND PRD2FLAG-ON
SET PRD2USRPRF-OFF
PRD2FLAG-OFF
PREVIOUS-OFF TO TRUE
ELSE
NEXT SENTENCE
END-IF
* // When user press F5.
WHEN REFRESH-ON
SET REFRESH-OFF TO TRUE
PERFORM 070-PROCESS-REFRESH
THRU 070-PROCESS-REFRESH-EXIT
* // When user press F8.
WHEN CHANGE-ON AND PRD2USRPRF-OFF AND PRD2FLAG-OFF
SET CHANGE-OFF TO TRUE
* // Validate user entered screen values.
PERFORM 142-VALIDATE-COPYSCREEN
THRU 142-VALIDATE-COPYSCREEN-EXIT
* // If no error, write into database file.
IF ERROR-FLAG-OFF
SET PRD2USRPRF-ON
PRD2FLAG-ON TO TRUE
MOVE "Press F8 again for confirm copy, else press F12."
TO D2MSG OF FOOTER2-O
END-IF
* // When user press F8.
WHEN CHANGE-ON AND PRD2USRPRF-ON AND PRD2FLAG-ON
SET CHANGE-OFF TO TRUE
* // Write into database file.
PERFORM 150-WRITE-DB01-FILE
THRU 150-WRITE-DB01-FILE-EXIT
IF ERROR-FLAG-OFF
MOVE "Record has been copied successfully."
TO D2MSG OF FOOTER2-O
SET PREVIOUS-ON TO TRUE
END-IF
* // When user press ENTER.
WHEN OTHER
MOVE CORR FILRCD-I TO FILRCD-O
END-EVALUATE
END-PERFORM.
* // Reset appropriate indicators for MAIN-SCREEN.
SET MAIN-SCREEN
PRD2USRPRF-OFF
PRD2FLAG-OFF
PREVIOUS-OFF TO TRUE.
110-COPY-RCD-EXIT. EXIT.
* ---------------------------------------------------------------*
* Delete Record Paragraph *
* ---------------------------------------------------------------*
120-DELETE-RCD.
* // Fill FILRCD record format for DELETE-SCREEN.
MOVE "DELETE" TO D2MOD OF FILRCD-O.
MOVE S1USRPRF OF SFL01-O TO D2USRPRF OF FILRCD-O.
MOVE S1FILE OF SFL01-O TO D2FILE OF FILRCD-O.
MOVE S1FIELD OF SFL01-O TO D2FIELD OF FILRCD-O.
MOVE S1FLAG OF SFL01-O TO D2FLAG OF FILRCD-O.
MOVE S1DESC OF SFL01-O TO D2DESC OF FILRCD-O.
MOVE SPACES TO D2MSG OF FOOTER2-O.
* // Set appropriate indicators for DELETE-SCREEN.
SET DELETE-SCREEN
APPLY-DLTFMT-OFF
APPLY-DSPFMT-OFF
PRD2USRPRF-ON
PRD2FLAG-ON TO TRUE.
* // Display FILRCD record format until user press F12.
PERFORM UNTIL PREVIOUS-ON
* // Write FOOTER2 record format.
WRITE DSP01-REC
FROM FOOTER2-O
FORMAT IS "FOOTER2"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Write FILRCD record format.
WRITE DSP01-REC
FROM FILRCD-O
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Display FILRCD record format.
READ DSP01
INTO FILRCD-I
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-READ
* // Clear footer messages.
PERFORM 060-RESET-ERROR
THRU 060-RESET-ERROR-EXIT
EVALUATE TRUE
* // When user press F12.
WHEN PREVIOUS-ON
IF APPLY-DLTFMT-ON
SET APPLY-DLTFMT-OFF
PREVIOUS-OFF TO TRUE
ELSE
NEXT SENTENCE
END-IF
* // When user press F8.
WHEN CHANGE-ON AND APPLY-DLTFMT-OFF
SET CHANGE-OFF
APPLY-DLTFMT-ON TO TRUE
MOVE "Press F8 again for confirm delete, else press F12."
TO D2MSG OF FOOTER2-O
* // When user press F8 for confirm delete
WHEN CHANGE-ON AND APPLY-DLTFMT-ON
SET CHANGE-OFF TO TRUE
PERFORM 170-DELETE-DB01-FILE
THRU 170-DELETE-DB01-FILE-EXIT
IF ERROR-FLAG-ON
MOVE "Record has been successfully deleted."
TO D1MSG OF FOOTER1-O
SET PREVIOUS-ON TO TRUE
END-IF
* // When user press ENTER.
WHEN OTHER
SET PREVIOUS-OFF TO TRUE
END-EVALUATE
END-PERFORM.
* // Reset appropriate indicators for MAIN-SCREEN.
SET MAIN-SCREEN
APPLY-DLTFMT-OFF
APPLY-DSPFMT-OFF
PRD2USRPRF-OFF
PRD2FLAG-OFF
PREVIOUS-OFF TO TRUE.
120-DELETE-RCD-EXIT. EXIT.
* ---------------------------------------------------------------*
* Display Record Paragraph *
* ---------------------------------------------------------------*
130-DISPLAY-RCD.
* // Fill FILRCD record format for DISPLAY-SCREEN.
MOVE "DISPLAY" TO D2MOD OF FILRCD-O.
MOVE S1USRPRF OF SFL01-O TO D2USRPRF OF FILRCD-O.
MOVE S1FILE OF SFL01-O TO D2FILE OF FILRCD-O.
MOVE S1FIELD OF SFL01-O TO D2FIELD OF FILRCD-O.
MOVE S1FLAG OF SFL01-O TO D2FLAG OF FILRCD-O.
MOVE S1DESC OF SFL01-O TO D2DESC OF FILRCD-O.
MOVE SPACES TO D2MSG OF FOOTER2-O.
* // Set appropriate indicators for DISPLAY-SCREEN.
SET DISPLAY-SCREEN
APPLY-DLTFMT-OFF
APPLY-DSPFMT-ON
PRD2USRPRF-ON
PRD2FLAG-ON TO TRUE.
* // Display FILRCD record format until user press F12.
PERFORM UNTIL PREVIOUS-ON
* // Write FOOTER2 record format.
WRITE DSP01-REC
FROM FOOTER2-O
FORMAT IS "FOOTER2"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Write FILRCD record format.
WRITE DSP01-REC
FROM FILRCD-O
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-WRITE
* // Display FILRCD record format.
READ DSP01
INTO FILRCD-I
FORMAT IS "FILRCD"
INDICATORS ARE WS-INDICATORS
END-READ
EVALUATE TRUE
* // When user press F12.
WHEN PREVIOUS-ON
NEXT SENTENCE
* // When user press ENTER.
WHEN OTHER
SET PREVIOUS-OFF TO TRUE
END-EVALUATE
END-PERFORM.
* // Reset appropriate indicators for MAIN-SCREEN.
SET MAIN-SCREEN
APPLY-DSPFMT-OFF
PRD2USRPRF-OFF
PRD2FLAG-OFF
PREVIOUS-OFF TO TRUE.
130-DISPLAY-RCD-EXIT. EXIT.
* ---------------------------------------------------------------*
* Write new record into DB01 file *
* ---------------------------------------------------------------*
150-WRITE-DB01-FILE.
* Write records coming from ADD-SCREEN
IF ADD-SCREEN
MOVE D2USRPRF OF FILRCD-O TO XXUSRPRF
MOVE D2FILE OF FILRCD-O TO XXFILE
MOVE D2FIELD OF FILRCD-O TO XXFIELD
MOVE SPACES TO XXTEXT
MOVE D2FLAG OF FILRCD-O TO XXFLAG
MOVE D2DESC OF FILRCD-O TO XXDESC
END-IF.
* Write records coming from COPY-SCREEN
IF COPY-SCREEN
MOVE D2USRPRF OF CPYRCD-O TO XXUSRPRF
MOVE D2FILE OF CPYRCD-O TO XXFILE
MOVE D2FIELD OF CPYRCD-O TO XXFIELD
MOVE SPACES TO XXTEXT
MOVE D2FLAG OF CPYRCD-O TO XXFLAG
MOVE D2DESC OF CPYRCD-O TO XXDESC
END-IF.
WRITE DB01-REC.
150-WRITE-DB01-FILE-EXIT. EXIT.
* ---------------------------------------------------------------*
* Update record of DB01 file *
* ---------------------------------------------------------------*
160-UPDATE-DB01-FILE.
MOVE D2USRPRF OF FILRCD-O TO XXUSRPRF.
MOVE D2FILE OF FILRCD-O TO XXFILE.
MOVE D2FIELD OF FILRCD-O TO XXFIELD.
START DB01 KEY = EXTERNALLY-DESCRIBED-KEY
INVALID KEY
MOVE "ERROR IN START" TO D2MSG OF FOOTER2-O
SET ERROR-FLAG-ON TO TRUE
END-START
* Read with lock, so that update record immediately
READ DB01 WITH LOCK
INVALID KEY
MOVE "ERROR IN READ" TO D2MSG OF FOOTER2-O
SET ERROR-FLAG-ON TO TRUE
END-READ
* Move screen level changes to fields
MOVE SPACES TO XXTEXT.
MOVE D2FLAG OF FILRCD-O TO XXFLAG.
MOVE D2DESC OF FILRCD-O TO XXDESC.
* Rewrite screen level changes to fields
REWRITE DB01-REC.
160-UPDATE-DB01-FILE-EXIT. EXIT.
* ---------------------------------------------------------------*
* Delete record of DB01 file *
* ---------------------------------------------------------------*
170-DELETE-DB01-FILE.
MOVE D2USRPRF OF FILRCD-O TO XXUSRPRF.
MOVE D2FILE OF FILRCD-O TO XXFILE.
MOVE D2FIELD OF FILRCD-O TO XXFIELD.
START DB01 KEY = EXTERNALLY-DESCRIBED-KEY
INVALID KEY
MOVE "ERROR IN DELETE" TO D2MSG OF FOOTER2-O
SET ERROR-FLAG-ON TO TRUE
END-START
* Read with lock, so that delete record immediately
READ DB01 WITH LOCK
INVALID KEY
MOVE "ERROR IN READ" TO D2MSG OF FOOTER2-O
SET ERROR-FLAG-ON TO TRUE
END-READ
DELETE DB01
INVALID KEY
MOVE "ERROR IN DELETE" TO D2MSG OF FOOTER2-O
SET ERROR-FLAG-ON TO TRUE
END-DELETE.
170-DELETE-DB01-FILE-EXIT. EXIT.
* ---------------------------------------------------------------*
* Close file para *
* ---------------------------------------------------------------*
999-CLOSE-PARA.
CLOSE DSP01
DB01.
999-CLOSE-PARA-EXIT. EXIT.
* ---------------------------------------------------------------*
Image Reprint Courtesy of IBM Corporation © 2025