*DECK DMLDEL                                                            000740
      PROC DMLDEL (FIT,NEXT,REALMORD,PKORD,ERRRTRN);
  BEGIN                                                                 000760
 #
* *   DMLDEL - DELETE INTERFACE ROUTINE 
*     R. E. FOX                                      9/19/77
* 
* DC  PURPOSE 
* 
*     ISSUE A DELETE REQUEST TO CDCS AND
*     CHECK FOR AN ERROR CONDITION UPON RETURNING FROM CDCS.
*     ON ERROR, CAUSES A BRANCH TO AN ALTERNATE RETURN IN THE 
*     APPLICATION PROGRAM IF SPECIFIED, ELSE, RETURNS NORMALLY. 
*     RETURN THE FIT STATUS FIELD TO THE APPLICATION PROGRAM
* 
* DC  ENTRY CONDITIONS
* 
* DC  PARAMETERS
* 
*     FIT  --  FIT OF REALM IN WHICH RECORD IS TO BE DELETED
* 
*     NEXT --  NEXT FLAG (UNUSED PARAMETER, ALWAYS ZERO)
* 
*     REALMORD  --  ORDINAL OF REALM IN WHICH RECORD IS TO BE DELETED 
* 
*     PKORD  --  ORDINAL OF PRIMARY KEY OF REALM
* 
*     ERRRTRN  --  (OPTIONAL) ALTERNATE RETURN ON ERROR (FTN 5 ONLY)
*                  WARNING:  DO NOT REFERENCE - MAY NOT BE PRESENT
* 
* 
* DC  ASSUMPTIONS 
* 
*     COMMON BLOCK DB0000 HAS BEEN GENERATED AND INITIALIZED
*     FIT SAVE AREA FIELDS ARE INITIALIZED
* 
* 
* DC  EXIT CONDITIONS 
* 
*     UPON RETURN FROM CDCS, THE FIT ES FIELD IS STORED 
*     IN DBSTAT AND IN DBSXXXX AND DBREALM IS SET TO THE
*     NAME OF THE REALM IN THE DML STATEMENT. 
*     CONTROL IS RETURNED TO THE APPLICATION PROGRAM. 
*     THE RETURN POINT CAN BE ALTERED GIVEN AN *ON ERROR* 
*     LABEL AND THE DETECTION OF AN ERROR (FTN 5 ONLY). 
* 
* DC  CALLING ROUTINES
* 
*     DMLDEL IS CALLED FROM THE APPLICATION PROGRAM 
*     AS A RESULT OF A DML DELETE STATEMENT.
* 
* DC  CALLED ROUTINES 
* 
*     DB$DEL  --     CDCS DELETE INTERFACE ROUTINE
* 
*     DMLRTRN  --  RETURN ROUTINE--SETS REGISTER TO RETURN PARAMETER
* 
* DC  NON-LOCAL VARIABLES 
* 
*     VARIABLES IN DB0000 WHICH ARE MODIFIED ARE: 
*     DBSTAT, DBSXXXX, DBREALM
* 
* DC  DESCRIPTION 
* 
*     A CALL TO DMLDEL IS GENERATED BY THE PREPASS AS 
*     A RESULT OF A DML DELETE STATEMENT.  DMLDEL RESTORES THE
*     FOLLOWING FIELDS IN THE APPROPRIATE FIT FROM THE FIT SAVE AREA: 
*     MRL, RKW, RKP, KP, KL, KA, AND KT.
*     DMLDEL ISSUES THE DELETE
*     REQUEST TO CDCS, RETURNS THE FIT STATUS FIELDS TO THE APPLICATION 
*     PROGRAM, AND RETURNS CONTROL TO THE APPLICATION PROGRAM.
*     WITH FORTRAN 5, AN ALTERNATE RETURN CAN BE SPECIFIED.  IF AN
*     ERROR IS DETECTED, CONTROL IS PASSED TO THE SPECIFIED LABEL 
*     IN THE APPLICATION PROGRAM. 
* 
 #
      CONTROL EJECT;                                                    000770
      CONTROL DISJOINT;                                                 000780
      CONTROL INERT;                                                    000790
                                                                        000800
                                        #-------------DEFS-------------#
  
      DEF FITSIZE     #35#;             # SIZE OF FIT IN WORDS         #000830
                                                                        000840
# THE FOLLOWING ARE PARAMETERS FROM THE "DELETE " CALLING SEQUENCE     #000850
                                                                        000860
      ARRAY FIT;                 # USER FIT                            #000870
*CALL FITDCLS                                                           000880
                                                                        000890
      ITEM NEXT;                        # NEXT FLAG                    #000900
      ITEM REALMORD;                        # REALM  ORDINAL           #000910
      ITEM PKORD;                       # PRIMARY KEY ORDINAL          #000920
      ITEM ERRRTRN;                     # ERROR RETURN PARAMETER       #
                                        # WARNING: DO NOT REFERENCE    #
                                                                        000930
# PRIMARY/ALTERNATE KEY ORDINAL PARAMETER TO PASS TO CDCS              #
  
      ARRAY PARM4 [0:0] S(1); 
        BEGIN 
          ITEM P4WORD U(0,0,60); # ENTIRE PARAMETER                    #
          ITEM RORD U(0,36,12);  # RECORD ORDINAL                      #
          ITEM KORD U(0,48,12);  # KEY ORDINAL                         #
        END 
  
# THE FOLLOWING DESCRIBES THE COMMON BLOCK CREATED IN THE FORTRAN      #000940
#     PROGRAM                                                          #000950
                                                                        000960
      COMMON DB0000;                                                    000970
*CALL DB0DCLS                                                           000980
                                                                        000990
                                        #------------XREFS-------------#
  
      XREF
        BEGIN 
        PROC DB$DEL;                    # DELETE INTERFACE ROUTINE     #
        PROC DMLRTRN;                   # SET RETURN REGISTER ROUTINE  #
        END 
  
                                        #----------LOCAL ITEMS---------#
  
      ITEM RTNPARM;                     # RETURN PARAMETER - DMLRTRN   #
  
      CONTROL EJECT;                                                    001070
                                                                        001080
# SET UP POINTER TO REALMBLOCK   #                                      001090
                                                                        001100
      P<REALMBLOCK> = LOC(FIT) - 4;                                     001110
      P<DBTXXXX> = LOC(FIT) + FITSIZE;                                  000170
                                                                        001120
# PICK UP      KA, KP, KL, AND KT FIELDS FROM                          #001130
# SAVE AREA CREATED BY INVOKE. PUT THESE VALUES IN FIT.                #001140
      FITKA[0] = DBKA[0];                                               001150
      FITKEYFIELDS[0] = DBKEYFIELDS[0];                                 000270
      FITMRL[0] = DBMRL[0];                                             000280
      FITRL [0] = DBMRL[0];                                             000290
      FITKT[0] = DBKT[0];                                               001180
                                                                        001190
# SET UP PRIMARY/ALTERNATE KEY ORDINAL PARAMETER                       #
  
      P4WORD[0] = 0;             # ZERO FILL                           #
                                 # RECORD ORDINAL                      #
      RORD[0] = REALMORD;        # NOTE: SAME AS AREA ORDINAL--USE THAT#
      KORD[0] = PKORD;           # KEY ORDINAL                         #
  
# PERFORM DELETE  CALL, PASSING FIT, NEXT FLAG, REALM  ORDINAL,        #001200
# AND PRIMARY/ALTERNATE KEY PARAMETER                                  #
  
      DB$DEL(FIT,NEXT,REALMORD,PARM4);
                                                                        001240
# RETURN ERROR STATUS FIELD OF FIT                                     #001250
                                                                        001260
      DBSTAT = FITES[0];                                                001270
      DBSXXXX = FITES[0];                                               000350
      DBREALM = DBRXXXX;                                                000360
  
# CHECK ERROR STATUS ON CDCS CALL                                      #
  
      IF (FITES[0] NQ 0)                # IF CDCS/CRM ERROR OCCURRED   #
      THEN
        RTNPARM = 1;                    # SET THE RETURN PARAMETER TO 1#
      ELSE                              #             ELSE             #
        RTNPARM = 0;                    # SET THE RETURN PARAMETER TO 0#
  
# SET THE RETURN REGISTER                                              #
  
      DMLRTRN(RTNPARM); 
  
# RETURN TO THE APPLICATION PROGRAM                                    #
                                                                        001300
      RETURN;                                                           001310
      END                                                               001320
TERM                                                                    001330
