USING INPUT FILE READ MULTIPLE DATABASE THROUGH EASYTRIEVE

//FILEIN DD DSN=T54V01H.VSRJ.FB003.SSN,
// DISP=SHR
//FILEOUT DD DSN=T54V01H.VSRJ.WITHZE.MIX,
// DISP=(,CATLG,CATLG),
// DCB=(LRECL=100,RECFM=FB,BLKSIZE=0),
// UNIT=SYSPD,SPACE=(CYL,(100,10),RLSE)
//SYSOUT DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSPRINT 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
%HV010IA1
%HV010IA3
%HV010IAI
%HV010IA4

*-----------------------------------------------*
* SSA-QUAL *
*-----------------------------------------------*
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 W 34 A VALUE 'HV01SPA3'
SSA-HV01SPA3-IND SSA-HV01SPA3 +08 1 A VALUE '*'
SSA-HV01SPA3-CC1 SSA-HV01SPA3 +09 1 A VALUE '-'
SSA-HV01SPA3-CC2 SSA-HV01SPA3 +10 1 A VALUE '-'
SSA-HV01SPA3-CC3 SSA-HV01SPA3 +11 1 A VALUE '-'
SSA-HV01SPA3-CC4 SSA-HV01SPA3 +12 1 A VALUE '-'
SSA-HV01SPA3-CC5 SSA-HV01SPA3 +13 1 A VALUE '-'
SSA-HV01SPA3-CC6 SSA-HV01SPA3 +14 1 A VALUE '-'
SSA-HV01SPA3-CC7 SSA-HV01SPA3 +15 1 A VALUE '-'
SSA-HV01SPA3-CC8 SSA-HV01SPA3 +16 1 A VALUE '-'
SSA-HV01SPA3-LPA SSA-HV01SPA3 +17 1 A VALUE '('
SSA-HV01SPA3-NME SSA-HV01SPA3 +18 8 A VALUE 'KV01SPA3'
SSA-HV01SPA3-OPR SSA-HV01SPA3 +26 2 A VALUE '= '
SSA-HV01SPA3-KEY SSA-HV01SPA3 +28 5 A
SSA-HV01SPA3-RPA SSA-HV01SPA3 +33 1 A VALUE ')'

SSA-HV01SPA4 W 33 A VALUE 'HV01SPA4'
SSA-HV01SPA4-IND SSA-HV01SPA4 +08 1 A VALUE '*'
SSA-HV01SPA4-CC1 SSA-HV01SPA4 +09 1 A VALUE '-'
SSA-HV01SPA4-CC2 SSA-HV01SPA4 +10 1 A VALUE '-'
SSA-HV01SPA4-CC3 SSA-HV01SPA4 +11 1 A VALUE '-'
SSA-HV01SPA4-CC4 SSA-HV01SPA4 +12 1 A VALUE '-'
SSA-HV01SPA4-CC5 SSA-HV01SPA4 +13 1 A VALUE '-'
SSA-HV01SPA4-CC6 SSA-HV01SPA4 +14 1 A VALUE '-'
SSA-HV01SPA4-CC7 SSA-HV01SPA4 +15 1 A VALUE '-'
SSA-HV01SPA4-CC8 SSA-HV01SPA4 +16 1 A VALUE '-'
SSA-HV01SPA4-LPA SSA-HV01SPA4 +17 1 A VALUE ' '
SSA-HV01SPA4-NME SSA-HV01SPA4 +18 8 A VALUE 'KV01SPA4'
SSA-HV01SPA4-OPR SSA-HV01SPA4 +26 2 A VALUE '= '
SSA-HV01SPA4-KEY SSA-HV01SPA4 +28 4 A
SSA-HV01SPA4-RPA SSA-HV01SPA4 +32 1 A VALUE ')'

SPA1-STATUS-CODE W 2 A VALUE ' '
SPA3-STATUS-CODE W 2 A VALUE ' '
SPAI-STATUS-CODE W 2 A VALUE ' '
SPA4-STATUS-CODE W 2 A VALUE ' '
SPA1-REPLACE-CODE W 2 A VALUE ' '
SPA3-REPLACE-CODE W 2 A VALUE ' '
SPAI-REPLACE-CODE W 2 A VALUE ' '
SPA4-REPL-CODE W 2 A VALUE ' '

SSA-HV01SPA3-UNQUAL W 09 A VALUE 'HV01SPA3 '

MIX-EFFDT W 7 N
PYMNT-STR W 2 A
MIX-ALLOC W 5 N 2

SSA-COUNT W 4 B VALUE 1
CTR W 6 N
FUNCTION W 4 A
COUNTER W 4 N
OUTPUT-WRITTEN W 1 A

FILE FILEIN
IN-REC 01 134 A
I1-ACCT 01 07 N
I1-VEH 13 05 A
I1-MIX-FB003 27 05 N 2
I1-MIX-FB001 66 05 N 2
I1-PART-SSN 84 09 N
FILE FILEOUT
O1-OUT-REC 01 80 A
O1-ACCT 01 07 N
O1-SSN 09 09 N
O1-PRO-DATE 19 07 N
O1-PRO-TIME 27 10 N
O1-EFF-DATE 38 07 N
O1-VEH-CODE 46 05 A
O1-NEW-PCT 52 05 N 2
O1-OPR-ID 58 07 A

CTR1 W 8 N 0
DTR1 W 8 N 0
ETR1 W 8 N 0
FTR1 W 8 N 0
*-----------------------------------------------*
* WORKIN STORAGE SECTION *
*-----------------------------------------------*
WS-PRO-DATE W 07 N VALUE 2110511
WS-PRO-TIME W 10 N VALUE 0000131737
WS-EFF-DATE W 07 N VALUE 2110511
WS-OPR-ID W 07 A VALUE 'FNDSUBY'
WS-SPA1-KEY W 6 A
W-PROC-COMP WS-SPA1-KEY 2 N VALUE 54
W-PART-ACCT-NO WS-SPA1-KEY +2 4 P 00

WS-SPA3-KEY W 5 A
WS-INV-VEH W 5 A
WS-INV-C W 5 A

WS-VEHICLE W 5 A
WS-VEH-PART1 WS-VEHICLE 1 A
WS-VEH-PART2 WS-VEHICLE +1 4 A
*-----------------------------------------------*
* PROCEDURE DIVISION SECTION *
*-----------------------------------------------*
JOB INPUT (FILEIN)

W-PART-ACCT-NO = I1-ACCT
SSA-HV01SPA1-KEY = WS-SPA1-KEY

SSA-COUNT = 1
FUNCTION = 'GU '

SPA1-STATUS-CODE = ' '
SPA4-STATUS-CODE = ' '

DLI HV01BPAA HV01SPA1 FUNCTION +
SSANO SSA-COUNT +
SSA (SSA-HV01SPA1)

SPA1-STATUS-CODE = PCB-STATUS-CODE
IF SPA1-STATUS-CODE = ' '
SPA3-STATUS-CODE = ' '
DO WHILE SPA3-STATUS-CODE = ' '
PERFORM GETNEXT-SPA3
END-DO
ELSE
DISPLAY 'A1 GET FAILED:' SPA1-STATUS-CODE
END-IF

*-----------------------------------------------*
GETNEXT-SPA3. PROC
*-----------------------------------------------*

SSA-COUNT = 2
FUNCTION = 'GNP'

DLI HV01BPAA HV01SPA3 FUNCTION +
SSANO SSA-COUNT +
SSA (SSA-HV01SPA1 +
SSA-HV01SPA3-UNQUAL)

SPA3-STATUS-CODE = PCB-STATUS-CODE
IF SPA3-STATUS-CODE = ' '
WS-INV-VEH = CINVSVHC-INV-VEH
PERFORM READ-SPA4
IF SPA4-STATUS-CODE = ' '
O1-ACCT = I1-ACCT
O1-SSN = I1-PART-SSN
O1-PRO-DATE = WS-PRO-DATE
O1-PRO-TIME = WS-PRO-TIME
O1-EFF-DATE = WS-EFF-DATE
O1-VEH-CODE = WS-INV-VEH
O1-NEW-PCT = MIX-ALLOC
O1-OPR-ID = WS-OPR-ID
PUT FILEOUT
MIX-ALLOC = 0
ELSE
IF SPA4-STATUS-CODE = 'GE'
DISPLAY 'FB001 NOT FOUND ' I1-ACCT
END-IF
END-IF
ELSE
DISPLAY 'A3 GET FAILED:' SPA3-STATUS-CODE
END-IF
END-PROC.
*-----------------------------------------------*
READ-SPA4. PROC
*-----------------------------------------------*
OUTPUT-WRITTEN = 'N'
FUNCTION = 'GNP '
SSA-HV01SPA3-KEY = WS-INV-VEH
SSA-COUNT = 3
SSA-HV01SPA4-IND = ' '
DLI HV01BPAA HV01SPA4 FUNCTION +
SSANO SSA-COUNT +
SSA (SSA-HV01SPA1 +
SSA-HV01SPA3 +
SSA-HV01SPA4)
SPA4-STATUS-CODE = PCB-STATUS-CODE

IF SPA4-STATUS-CODE = ' '
IF WS-INV-VEH = 'FB001'
MIX-ALLOC = (PCTMXPCT-CTMX-PCT + I1-MIX-FB003)
ELSE
IF WS-INV-VEH = 'FB003'
MIX-ALLOC = 0
ELSE
IF PCTMXPCT-CTMX-PCT > 0
MIX-ALLOC = PCTMXPCT-CTMX-PCT
DISPLAY 'OTHERVH' PCTMXPCT-CTMX-PCT
END-IF
END-IF
END-IF
END-IF

END-PROC.