*DECK DMLCMT
      PROC DMLCMT(ERRRTN);
      BEGIN 
 #
* *   DMLCMT -- COMMIT INTERFACE ROUTINE         PAGE  1
* *   H.S.WOO                                    DATE  07/30/80 
* * 
* DC  PURPOSE 
* 
*     ISSUE A COMMIT REQUEST TO CDCS. 
* 
* DC  ENTRY CONDTIONS 
* 
*  C  PARAMETERS
* 
*     ERRRTRN -- ERROR BRANCH(OPTIONAL).
* 
*  C  ASSUMPTIONS 
* 
*     COMMON BLOCK DB0000 HAS BEEN CREATED. 
* 
* DC  EXIT CONDITIONS 
* 
*     STORE ERROR STATUS IN VARIABLES DBSTAT.  CONTROL IS 
*     RETURNED TO THE APPLICATION PROGRAM.  ON ERROR, EXIT IS 
*     MADE TO THE LABEL SPECIFIED IN THE ERR PARAMETER(OPTIONAL). 
* 
* DC  CALLING ROUTINES
* 
*     DMLCMT IS CALLED FROM THE APPLICATION PROGRAM AS
*     A RESULT OF A DML COMMIT CALL STATEMENT.
* 
* DC  CALLED ROUTINES 
* 
*     DB$CMT -- CDCS COMMIT OBJECT-TIME ROUTINE.
* 
*     DMLRTRN -- RETURN ROUTINE -- SETS REGISTER TO 
*             RETURN PARAMETER. 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     DBSTAT IN COMMON BLOCK DB0000 IS MODIFIED.
* 
* DC  DESCRIPTION 
* 
*     A CALL TO DMLCMT IS GENERATED BY THE PREPROCESSOR AS
*     A RESULT OF A DML COMMIT STATEMENT.  DMLCMT ISSUES
*     THE COMMIT REQUEST TO CDCS.  IT RETURNS THE ERROR 
*     STATUS AND CONTROL TO THE APPLICATION PROGRAM.
 #
        CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#     F O R M A L    P A R A M E T E R S   D E C L A R A T I O N S     #
#                                                                      #
        ITEM ERRRTN  I;            # (FTN5)ERROR PARAMETER (OPTIONAL)  #
                                   # DO NOT REFERENCE,MAY BE ABSENT    #
#                                                                      #
#     X R E F      D E C L A R A T I O N S                             #
#                                                                      #
        XREF PROC DB$CMT;          # CDCS COMMIT INTERFACE ROUTINE     #
        XREF PROC DMLRTRN;         # SET REGISTER RETURN ROUTINE       #
#                                                                      #
#     C O M M O N   B L O C K    D E C L A R A T I O N                 #
#     F O R    F O R T R A N                                           #
#                                                                      #
        COMMON DB0000;
*CALL DB0DCLS 
#                                                                      #
#**********************************************************************#
#                                                                      #
                                   #---L O C A L    I T E M S----------#
        ITEM RTNPARM  I;           # RETURN PARAMETER                  #
        CONTROL EJECT;
        CONTROL DISJOINT; 
  
#     E X E C U T A B L E    C O D E    B E G I N S    H E R E         #
  
        DB$CMT(RTNPARM);           # CALL CDCS COMMIT INTERFACE ROUTINE#
          DBSTAT = RTNPARM;        # STORE ERROR INFORMATION IN DBSTAT #
        IF RTNPARM NQ 0            # CDCS/CRM ERROR                    #
        THEN
          BEGIN 
          RTNPARM = 1;             # RESET RTNPARM                     #
          END 
        DMLRTRN(RTNPARM);          # SET RETURN REGISTER ROUTINE       #
        RETURN; 
      END 
      TERM
