* Copyright © Oracle Corporation 1995.  All Rights Reserved. 
IDENTIFICATION DIVISION.
PROGRAM-ID.   SALARY.
*
*	Loads Salary_History Relation to new PERSONNEL database
*
*
AUTHOR.   DWT.
INSTALLATION.                                                            
                                                                         
ENVIRONMENT DIVISION.

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

FILE SECTION.

FD SHIST-FILE                                                             
LABEL RECORDS ARE STANDARD                                               
RECORD CONTAINS 65 CHARACTERS.

01  SHIST-REC.
	02 SAL-ID		PIC X(5).
	02 FIL			PIC X(3).
	02 SAL-AMOUNT		PIC X(5).
	02 FIL			PIC X(3).
	02 SAL-START-DATE	PIC X(23).
	02 FIL			PIC X(3).
	02 SAL-END-DATE		PIC X(23).

WORKING-STORAGE SECTION.

01 WS-SAL			PIC X(5).
01 WS-SAL-AMOUNT REDEFINES WS-SAL	PIC S9(5).
01 WS-SALARY			PIC S9(5) USAGE IS COMP.
01 BINARY-START-DATE		PIC S9(11)V9(7) COMP.
01 BINARY-END-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 via the filename

&RDB& 	INVOKE DATABASE FILENAME 'PERSONNEL'

PROCEDURE DIVISION.

*	Program NEWSAL reads new salary history and stores data 
*	in the SALARY_HISTORY Relation of new PERSONNEL database

START-UP.

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

	DISPLAY "Program: Loading SALARY_HISTORY ".

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

	.

*	Start Program: SALARY

MAIN-LINE.

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

999-EOJ.

*	End of Program: SALARY

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

&RDB& 	COMMIT

	CLOSE SHIST-FILE.

	STOP RUN.

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

LOAD.
	PERFORM READ-SHIST THRU READ-SHIST-EXIT.
	PERFORM DATE-FIX THRU DATE-FIX-EXIT.
	PERFORM STORE-SHIST THRU STORE-SHIST-EXIT.
	PERFORM CLEAR-IT THRU CLEAR-IT-EXIT.
LOAD-EXIT.
	EXIT.

READ-SHIST.
	READ SHIST-FILE AT END SET END-OF-FILE TO TRUE
		GO TO LOAD-EXIT.
	MOVE SAL-AMOUNT TO WS-SAL.
	MOVE WS-SAL-AMOUNT TO WS-SALARY.

READ-SHIST-EXIT.
	EXIT.


DATE-FIX.

*  Convert date to binary
*  Call System Services and pass SAL-START-DATE
*  returning BINARY-START-DATE

	CALL "SYS$BINTIM" USING BY DESCRIPTOR SAL-START-DATE
				BY REFERENCE BINARY-START-DATE
				GIVING RETURN-VALUE.

*  SAL-START-DATE =		Date passed to $BINTIM format: DD-MMM-YYYY
*  BINARY-START-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.

	CALL "SYS$BINTIM" USING BY DESCRIPTOR SAL-END-DATE
				BY REFERENCE BINARY-END-DATE
				GIVING RETURN-VALUE.

*  SAL-END-DATE =		Date passed to $BINTIM format: DD-MMM-YYYY
*  BINARY-END-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-FIX-EXIT.
	EXIT.

STORE-SHIST.

*  Store record in SALARY_HISTORY relation

&RDB& 	STORE SH IN SALARY_HISTORY
&RDB&        USING 
&RDB&		SH.EMPLOYEE_ID 		= SAL-ID;
&RDB&		SH.SALARY_START 	= BINARY-START-DATE;
&RDB&		SH.SALARY_END 		= BINARY-END-DATE;
&RDB&		SH.SALARY_AMOUNT 	= WS-SALARY;
&RDB&	END_STORE
	.

STORE-SHIST-EXIT.
	EXIT.

CLEAR-IT.

*	Clear out input record area  before next read

	MOVE SPACES TO WS-SAL.
	MOVE SPACES TO SHIST-REC.

CLEAR-IT-EXIT.
	EXIT.