*
* This program demonstrates the calls necessary for RMS transactions.
* It is only an example of use and does not implement complete error 
* handling.
*
IDENTIFICATION DIVISION.
PROGRAM-ID. RMSJNL_EXAMPLE.

ENVIRONMENT DIVISION.
*
* Structure used for both the checking and savings account files.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
    SELECT CHECKING-ACCOUNT-FILE
	ASSIGN TO "RMSJNL$CHECKING.IDX"
	ORGANIZATION IS INDEXED
	ACCESS MODE IS DYNAMIC
	RECORD KEY IS CHECKING-ACCOUNT-NUMBER.
    SELECT SAVINGS-ACCOUNT-FILE
	ASSIGN TO "RMSJNL$SAVINGS.IDX"
	ORGANIZATION IS INDEXED
	ACCESS MODE IS DYNAMIC
	RECORD KEY IS SAVINGS-ACCOUNT-NUMBER.

DATA DIVISION.
FILE SECTION.
FD CHECKING-ACCOUNT-FILE.
01 CHECKING-ACCOUNT-RECORD.
    02 CHECKING-ACCOUNT-NUMBER
	PICTURE 9(9)
	USAGE IS DISPLAY.
    02 CHECKING-ACCOUNT-BALANCE
	PICTURE S9(7)V99
	USAGE IS DISPLAY.
FD SAVINGS-ACCOUNT-FILE.
01 SAVINGS-ACCOUNT-RECORD.
    02 SAVINGS-ACCOUNT-NUMBER
	PICTURE 9(9)
	USAGE IS DISPLAY.
    02 SAVINGS-ACCOUNT-BALANCE
	PICTURE S9(7)V99
	USAGE IS DISPLAY.
WORKING-STORAGE SECTION.
01 EDITED-CHECKING-ACCOUNT-BALANCE
    PICTURE $$,$$$,$$$.99-
    USAGE IS DISPLAY.
01 EDITED-SAVINGS-ACCOUNT-BALANCE
    PICTURE $$,$$$,$$$.99-
    USAGE IS DISPLAY.
01 TID
    PICTURE X(16)
    USAGE IS DISPLAY.
01 IOSB.
    02 IOSB-STATUS
        PICTURE S9(4)
        USAGE IS COMP.
    02 IOSB-COUNT
        PICTURE S9(4)
        USAGE IS COMP.
    02 IOSB-DEV-INFO
        PICTURE S9(9)
        USAGE IS COMP.
01 RETURN-STATUS
    PICTURE S9(9)
    USAGE IS COMP.
01 DELAY
    USAGE IS COMP-1
    VALUE IS 5.0.
01 EFN
    PICTURE 9(9)
    USAGE IS COMP
    VALUE IS 7.

PROCEDURE DIVISION.
MAIN SECTION.
*
* Open the checking and savings account files.
*
OPEN-FILES.
    OPEN I-O CHECKING-ACCOUNT-FILE.
    OPEN I-O SAVINGS-ACCOUNT-FILE.
*
* Start a transaction to initialize savings and checking account files. 
* Note that any I/O errors in this transaction will be ignored.  The
* checking and savings account will be initialized to $100 for account
* "000001234".
*
INITIALIZE-ACCOUNTS.
    CALL "SYS$START_TRANSW" USING BY VALUE EFN
				  BY VALUE 0
				  BY REFERENCE IOSB
				  BY VALUE 0
				  BY VALUE 0
				  BY REFERENCE TID
	GIVING RETURN-STATUS.     
    IF RETURN-STATUS IS FAILURE
	DISPLAY "Cannot start the transaction to initialize accounts."
	STOP RUN
	END-IF.
    IF IOSB-STATUS IS FAILURE
	DISPLAY "Can't start the transaction to initialize accounts."
	STOP RUN
	END-IF.
*
*   Put $100 dollars in the checking account of "000001234"
*
    MOVE 1234 TO CHECKING-ACCOUNT-NUMBER.
    MOVE 100.00 TO CHECKING-ACCOUNT-BALANCE.
    WRITE CHECKING-ACCOUNT-RECORD
	INVALID KEY
	    DISPLAY "Checking account already exists."
	END-WRITE.
    MOVE 1234 TO SAVINGS-ACCOUNT-NUMBER.
    MOVE 100.00 TO SAVINGS-ACCOUNT-BALANCE.
*
*   Put $100 dollars in the savings account of "000001234"
*
    WRITE SAVINGS-ACCOUNT-RECORD
	INVALID KEY
	    DISPLAY "Savings account already exists."
	END-WRITE.
*
*   End the transaction to initialize the checking and savings accounts
*
    CALL "SYS$END_TRANSW" USING BY VALUE EFN
				BY VALUE 0
				BY REFERENCE IOSB
				BY VALUE 0
				BY VALUE 0
				BY REFERENCE TID
	GIVING RETURN-STATUS.
    IF RETURN-STATUS IS FAILURE
	DISPLAY "Cannot end the transaction to initialize accounts."
	STOP RUN
	END-IF.
    IF IOSB-STATUS IS FAILURE
	DISPLAY "Can't end the transaction to initialize accounts."
	STOP RUN
	END-IF.
*
* Transfer $10.00 from checking to savings under a transaction.
* Note that the transaction is aborted if any I/O errors are 
* encountered.
*
TRANSFER-FUNDS.
    CALL "SYS$START_TRANSW" USING BY VALUE EFN
				  BY VALUE 0
				  BY REFERENCE IOSB
				  BY VALUE 0
				  BY VALUE 0
				  BY REFERENCE TID
	GIVING RETURN-STATUS.

    IF RETURN-STATUS IS FAILURE
	DISPLAY "Cannot start the transaction to transfer funds."
	STOP RUN
	END-IF.
    IF IOSB-STATUS IS FAILURE
	DISPLAY "Can't start the transaction to transfer funds."
	STOP RUN
	END-IF.
*
* Read the checking account record for "000001234".  Abort the transaction
* if the operation is not successful.
*
    MOVE 1234 TO CHECKING-ACCOUNT-NUMBER.
    READ CHECKING-ACCOUNT-FILE RECORD
	INVALID KEY
	    DISPLAY "Cannot read checking account balance."
	    CALL "SYS$ABORT_TRANSW" USING BY VALUE EFN
					  BY VALUE 0
					  BY REFERENCE IOSB
					  BY VALUE 0
					  BY VALUE 0
					  BY REFERENCE TID
	    STOP RUN
	END-READ.
*
* Subtract $10 from the checking account balance.
*
    SUBTRACT 10.00 FROM CHECKING-ACCOUNT-BALANCE.
    MOVE CHECKING-ACCOUNT-BALANCE TO EDITED-CHECKING-ACCOUNT-BALANCE.
*
* Update the checking account file reflecting the new balance.  Abort the 
* transaction if the update is not successful.
*
    REWRITE CHECKING-ACCOUNT-RECORD
	INVALID KEY
	    DISPLAY "Cannot update the checking account balance."
	    CALL "SYS$ABORT_TRANSW" USING BY VALUE EFN
					  BY VALUE 0
					  BY REFERENCE IOSB
					  BY VALUE 0
					  BY VALUE 0
					  BY REFERENCE TID
	    STOP RUN
	END-REWRITE.

    DISPLAY "Pausing for five seconds.".
    CALL "LIB$WAIT" USING BY REFERENCE DELAY.
*
* Read the savings account record for "000001234". Abort the transaction
* if the operation is not successful.
*
    MOVE 1234 TO SAVINGS-ACCOUNT-NUMBER.
    READ SAVINGS-ACCOUNT-FILE RECORD
	INVALID KEY
	    DISPLAY "Cannot read the savings account balance."
	    CALL "SYS$ABORT_TRANSW" USING BY VALUE EFN
					  BY VALUE 0
					  BY REFERENCE IOSB
					  BY VALUE 0
					  BY VALUE 0
					  BY REFERENCE TID
	    STOP RUN
	END-READ.
*
* Add $10 to the savings account.
*
    ADD 10.00 TO SAVINGS-ACCOUNT-BALANCE.
    MOVE SAVINGS-ACCOUNT-BALANCE TO EDITED-SAVINGS-ACCOUNT-BALANCE.
*
* Update the savings account file reflecting the new balance.  Abort the 
* transaction if the update is not successful.
*
    REWRITE SAVINGS-ACCOUNT-RECORD
	INVALID KEY
	    DISPLAY "Cannot update the savings account balance."
	    CALL "SYS$ABORT_TRANSW" USING BY VALUE EFN
					  BY VALUE 0
					  BY REFERENCE IOSB
					  BY VALUE 0
					  BY VALUE 0
					  BY REFERENCE TID
	    STOP RUN
	END-REWRITE.
*
* End the transaction.
*
    CALL "SYS$END_TRANSW" USING BY VALUE EFN
				BY VALUE 0
				BY REFERENCE IOSB
				BY VALUE 0
				BY VALUE 0
				BY REFERENCE TID
	GIVING RETURN-STATUS.
    IF RETURN-STATUS IS FAILURE
	DISPLAY "Cannot end the transaction to transfer funds."
	STOP RUN
	END-IF.
    IF IOSB-STATUS IS FAILURE
	DISPLAY "Can't end the transaction to transfer funds."
	STOP RUN
	END-IF.
*
* Display the new balances.
*
DISPLAY-BALANCES.
    DISPLAY "Checking account balance is "
	EDITED-CHECKING-ACCOUNT-BALANCE.
    DISPLAY "Savings account balance is  "
	EDITED-SAVINGS-ACCOUNT-BALANCE.
*
* Close the checking and savings account files.
*
CLOSE-FILES.
    CLOSE CHECKING-ACCOUNT-FILE.
    CLOSE SAVINGS-ACCOUNT-FILE.
    STOP RUN.
END PROGRAM RMSJNL_EXAMPLE.