* Copyright © Oracle Corporation 1995.  All Rights Reserved. 
IDENTIFICATION DIVISION.
PROGRAM-ID.   EMPLOYEES.                                      
*
*	Loads EMPLOYEES relation in PERSONNEL database
*	
AUTHOR.   DWT.
INSTALLATION.                                                            
                                                                         
ENVIRONMENT DIVISION.

CONFIGURATION SECTION.
SOURCE-COMPUTER. VAX-11.                                                 
OBJECT-COMPUTER. VAX-11.                                                 
INPUT-OUTPUT SECTION.
FILE-CONTROL.
                                                                         
        SELECT EMP-FILE  ASSIGN TO "rdm$demo:EMPLOYEES.DAT"
        ORGANIZATION IS SEQUENTIAL                                       
        ACCESS MODE IS SEQUENTIAL                                        
        .

DATA DIVISION.

FILE SECTION.

FD EMP-FILE                                                             
LABEL RECORDS ARE STANDARD                                               
RECORD CONTAINS 137  CHARACTERS.

01  EMP-REC.
	02 IN-EMP-ID		PIC X(5).
	02 FIL			PIC X(3).
	02 IN-L-NAME		PIC X(14).
	02 FIL			PIC X(3).
	02 IN-F-NAME		PIC X(10).
	02 FIL			PIC X(3).
	02 IN-M-INIT		PIC X.
	02 FIL			PIC X(3).
	02 IN-ADDRESS-1		PIC X(25).
	02 FIL			PIC X(3).
	02 IN-CITY		PIC X(20).
	02 FIL			PIC X(3).
	02 IN-STATE		PIC X(2).
	02 FIL			PIC X(3).
	02 IN-POSTAL_CODE	PIC X(5).
	02 FIL			PIC X(3).
	02 ASCII-BIRTH-DATE	PIC X(23).
	02 FIL			PIC X(3).
	02 IN-SEX		PIC X.
	02 FIL			PIC X(3).
	02 IN-STATUS		PIC X.

WORKING-STORAGE SECTION.

01 BINARY-BIRTH-DATE		PIC S9(11)V9(7) COMP.
01 RETURN-VALUE			PIC S9(9) COMP VALUE 999999999.
01 STAT	                        PIC S9(9) USAGE IS COMP.
01 FLAGS			PIC X.
	88 END-OF-FILE		VALUE "Y".
	88 NOT-END-OF-FILE	VALUE "N".

*	Invoke the database

&RDB& 	INVOKE DATABASE FILENAME 'PERSONNEL'

PROCEDURE DIVISION.

*	Program EMPLOYEES reads new Employee data and STORES it
*	in the Employees Relation of PERSONNEL database

START-UP.

	SET NOT-END-OF-FILE TO TRUE.
	OPEN INPUT EMP-FILE .

&RDB& 	START_TRANSACTION READ_WRITE RESERVING EMPLOYEES 
&RDB&	FOR EXCLUSIVE WRITE

	DISPLAY "Program: Loading EMPLOYEES ".

*	Start Program: EMPLOYEES

MAIN-LINE.

	PERFORM LOAD THRU LOAD-EXIT UNTIL END-OF-FILE.

999-EOJ.

*	End of Program: EMPLOYEES

	DISPLAY "Program: EMPLOYEES Loaded. Normal End-of-Job"

&RDB& 	COMMIT

	CLOSE EMP-FILE.

	STOP RUN.

*****************************************************************
*                    <<< Subroutines >>>                        *
*****************************************************************

LOAD.

	PERFORM READ-EMP THRU READ-EMP-EXIT.
	PERFORM DATE-CONVRT THRU DATE-CONVRT-EXIT.
	PERFORM STORE-EMPLOYEE THRU STORE-EMPLOYEE-EXIT.
	PERFORM CLEAR-IT THRU CLEAR-IT-EXIT.

LOAD-EXIT.
	EXIT.

READ-EMP.

	READ EMP-FILE AT END SET END-OF-FILE TO TRUE
		GO TO LOAD-EXIT.

READ-EMP-EXIT.
	EXIT.

DATE-CONVRT.
	
*	Read BIRTHDAY as NN-MMM-YYYY and pass to System Services
*	returning binary date value passed to Oracle Rdb as quadword


*
*  Call System Services and pass ASCII-BIRTH-DATE
*  returning BINARY-QUAD-DATE-1
*
	CALL "SYS$BINTIM" USING BY DESCRIPTOR ASCII-BIRTH-DATE
				BY REFERENCE BINARY-BIRTH-DATE
				GIVING RETURN-VALUE.
*
*  ASCII-BIRTH-DATE =		Date passed to $BINTIM format: DD-MMM-YYYY
*  BINARY-BIRTH-DATE =		Binary date value returned by $BINTIM
*  RETURN-VALUE =		Return status of call

*  Check success of call

	IF RETURN-VALUE IS FAILURE
	  THEN
	     CALL "LIB$STOP" USING BY VALUE RETURN-VALUE.

DATE-CONVRT-EXIT.
    EXIT.

STORE-EMPLOYEE.




*	STORE Routine

&RDB& 	STORE E IN EMPLOYEES 
&RDB&        USING 
&RDB&	  E.EMPLOYEE_ID		= IN-EMP-ID;
&RDB&     E.LAST_NAME		= IN-L-NAME;
&RDB&     E.FIRST_NAME		= IN-F-NAME;
&RDB&     E.MIDDLE_INITIAL	= IN-M-INIT;
&RDB&     E.ADDRESS_DATA_1	= IN-ADDRESS-1;
&RDB&     E.CITY		= IN-CITY;
&RDB&     E.STATE		= IN-STATE;
&RDB&     E.POSTAL_CODE		= IN-POSTAL_CODE;
&RDB&     E.SEX			= IN-SEX;
&RDB&     E.BIRTHDAY		= BINARY-BIRTH-DATE;
&RDB&	  E.STATUS_CODE		= IN-STATUS;
&RDB&	END_STORE

	.

STORE-EMPLOYEE-EXIT.
	EXIT.


CLEAR-IT.

*	Clear input record area before next read

	MOVE SPACES TO EMP-REC.

CLEAR-IT-EXIT.
	EXIT.