READ MORE THAN DATABASE THROUGH EASYTRIEVE

//FILEOUT DD DSN=T54V01H.VS1Z.SPA5.REPT,
// DISP=(,CATLG,CATLG),
// DCB=(LRECL=80,RECFM=FB,BLKSIZE=27920),
// UNIT=SYSPD,SPACE=(CYL,(50,5),RLSE)
//SYSOUT DD SYSOUT=*
//SYSIN DD *
*-----------------------------------------------*
* DATA DIVISION SECTION *
*-----------------------------------------------*
FILE HV01BPAA DLI(HV01BPAA 1)
PCB-DBD-NAME 1 8 A
PCB-SEGMENT-LEVEL 9 2 A
PCB-STATUS-CODE 11 2 A
PCB-PROC-OPTION 13 4 A
PCB-RESERVE-DLI 17 4 B
PCB-SEGMENT-NAME 21 8 A
PCB-LENGTH-KEY-FB 29 4 B
PCB-NUM-SENS-SEGMENT 33 4 B
PCB-KEY-FB-AREA 37 24 A

*-----------------------------------------------*
* I/O AREAS *
*-----------------------------------------------*
%HV010IA1
%HV010IA3
%HV010IA5

*-----------------------------------------------*
* SSA-SPA1 *
*-----------------------------------------------*
SSA-HV01SPA1 W 35 A VALUE 'HV01SPA1'
SSA-HV01SPA1-IND SSA-HV01SPA1 +08 1 A VALUE '*'
SSA-HV01SPA1-CC1 SSA-HV01SPA1 +09 1 A VALUE '-'
SSA-HV01SPA1-CC2 SSA-HV01SPA1 +10 1 A VALUE '-'
SSA-HV01SPA1-CC3 SSA-HV01SPA1 +11 1 A VALUE '-'
SSA-HV01SPA1-CC4 SSA-HV01SPA1 +12 1 A VALUE '-'
SSA-HV01SPA1-CC5 SSA-HV01SPA1 +13 1 A VALUE '-'
SSA-HV01SPA1-CC6 SSA-HV01SPA1 +14 1 A VALUE '-'
SSA-HV01SPA1-CC7 SSA-HV01SPA1 +15 1 A VALUE '-'
SSA-HV01SPA1-CC8 SSA-HV01SPA1 +16 1 A VALUE '-'
SSA-HV01SPA1-LPA SSA-HV01SPA1 +17 1 A VALUE '('
SSA-HV01SPA1-NME SSA-HV01SPA1 +18 8 A VALUE 'KV01SPA1'
SSA-HV01SPA1-OPR SSA-HV01SPA1 +26 2 A VALUE '= '
SSA-HV01SPA1-KEY SSA-HV01SPA1 +28 6 A
SSA-HV01SPA1-RPA SSA-HV01SPA1 +34 1 A VALUE ')'
*-----------------------------------------------*
SSA-HV01SPA3-UNQUAL W 09 A VALUE 'HV01SPA3 '
*-----------------------------------------------*
SSA-HV01SPA5-UNQUAL W 11 A VALUE 'HV01SPA5*D '
*-----------------------------------------------*
* INPUT/OUTPUT FILES *
*-----------------------------------------------*
FILE FILEOUT
OUT-REC 01 080 A
OUT-ACCT 01 07 N
OUT-VEH 09 05 A
OUT-BAND-CNT 15 03 N
*-----------------------------------------------*
* WORKING STORAGE SECTION *
*-----------------------------------------------*
FUNCTION W 4 A
SSA-COUNT W 4 B VALUE 1
STATUS-SPA3 W 2 A VALUE ' '
STATUS-SPA5 W 2 A VALUE ' '
WS-INV-VEH W 2 A VALUE ' '
WS-BAND-CNT W 2 N VALUE 0
WS-CNT W 3 N VALUE 0
*-----------------------------------------------*
* PROCEDURE DIVISION SECTION *
*-----------------------------------------------*
JOB INPUT (HV01BPAA)
RETRIEVE HV01BPAA +
SELECT (HV01SPA1 ID 'A1')
IF PATH-ID = 'A1'
WS-CNT = WS-CNT + 1
STATUS-SPA3 = ' '
DO UNTIL STATUS-SPA3 = 'GE'
PERFORM READ-SPA3
END-DO
END-IF
*-----------------------------------------------*
READ-SPA3. PROC
*-----------------------------------------------*
FUNCTION = 'GNP '
SSA-COUNT = 2
SSA-HV01SPA1-KEY = KV01SPA1
DLI HV01BPAA HV01SPA3 FUNCTION +
SSANO SSA-COUNT +
SSA (SSA-HV01SPA1 +
SSA-HV01SPA3-UNQUAL)
STATUS-SPA3 = PCB-STATUS-CODE
IF STATUS-SPA3 = ' '
WS-INV-VEH = CINVSVHC-INV-VEH
IF WS-INV-VEH = 'FB'
WS-BAND-CNT = 0
DO UNTIL STATUS-SPA5 = 'GE'
PERFORM READ-SPA5
END-DO
ELSE
GO TO JOB
END-IF
END-IF
END-PROC.
*-----------------------------------------------*
READ-SPA5. PROC
*-----------------------------------------------*
FUNCTION = 'GNP '
SSA-COUNT = 3
SSA-HV01SPA1-KEY = KV01SPA1
DLI HV01BPAA HV01SPA5 FUNCTION +
SSANO SSA-COUNT +
SSA (SSA-HV01SPA1 +
SSA-HV01SPA3-UNQUAL +
SSA-HV01SPA5-UNQUAL)
STATUS-SPA5 = PCB-STATUS-CODE
IF STATUS-SPA5 = ' '
WS-BAND-CNT = WS-BAND-CNT + 1
END-IF
IF WS-BAND-CNT > 50
OUT-ACCT = ZPRTPACT-PART-ACCT-NO
OUT-VEH = CINVSVHC-INV-VEH
OUT-BAND-CNT = WS-BAND-CNT
PUT FILEOUT
END-IF
END-PROC.
/*