*DECK DMLLCKP 
      PROC DMLLCKP(FIT,REALMNM1,REALMNM2,REALMNM3,TYPID,ERRRTN);
        BEGIN 
 #
* *   DMLLCKP - LOCK TYPE INTERFACE ROUTINE      PAGE  1
* 
* *   H.S.WOO                                     DATE 07/30/80 
* DC  PURPOSE 
* 
*     ISSUE A LOCK TYPE REQUEST TO CDCS.
* 
* DC  ENTRY CONDITIONS
* 
*  C  PARAMETERS
* 
*     FITLIST  --  FIT FOR REALM TO BE LOCKED.
* 
*     REALMNAME  --  NAME OF REALM TO BE LOCKED.
* 
*     TYPID  --  MODE IN WHICH LOCK SHOULD BE PERFORMED.
* 
*     ERRRTN  --  ERROR BRANCH. 
* 
*  C  ASSUMPTIONS 
* 
*     COMMON BLOCK DB0000 HAS BEEN CREATED. 
* 
* DC  EXIT CONDITIONS 
* 
*     UPON RETURN FROM CDCS, ERROR STATUS IS STORED IN
*     DBSTAT AND IN DBSXXXX. DBREALM IS SET TO THE NAME OF THE
*     REALM IN THE DML STATEMENT. 
*     CONTROL IS RETURNED TO THE APPLICATION PROGRAM. ON
*     ERROR, EXIT IS MADE TO THE LABEL SPECIFIED IN THE ERRRTN
*     PARAMETER(OPTIONAL).
* 
* DC  CALLING ROUTINES
* 
*     DMLLCK IS CALLED FROM THE APPLICATION PROGRAM AS
*     THE RESULT OF A DML LOCK CALL STATEMENT.
* 
* DC  CALLED ROUTINES 
* 
*     DB$LKAR  --  CDCS LOCK TYPE OBJECT-TIME ROUTINE.
* 
*     DMLRTRN  --  RETURN ROUTINE -- SETS REGISTER TO RETURN
*              PARAMETER. 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     VARIABLES IN DB0000 WHICH ARE MODIFIED ARE: 
*     DBSTAT,DBREALM. 
* 
* DC  DESCRIPTION 
* 
*     A CALL TO DMLCKP IS GENERATED BY THE PREPROCESSOR AS A
*     RESULT OF AN ALTERNATE DML LOCK CALL WITH TYPE
*     PARAMETER.  DMLCKP ISSUES THE LOCK REQUEST TO CDCS. 
*     IT THEN 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    D E C L A R A T I O N S      #
#                                                                      #
        DEF  FITSIZE     #35#;     # SIZE OF FIT                       #
        ARRAY FIT;
*CALL FITDCLS 
        ITEM REALMNM1 C(10);       #                                   #
        ITEM REALMNM2 C(10);       # R E A L M     N A M E             #
        ITEM REALMNM3 C(10);       #                                   #
        ITEM REALMNAME C(30); 
        ITEM TYPID      C(10);     # LOCK TYPE PARAMETER               #
        ITEM ERRRTN     I;         # (FTN5)ERROR PARAMETER(OPTIONAL)   #
                                   # DO NOT REFERENCE,MAY BE ABSENT    #
#                                                                      #
#     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 
#                                                                      #
#     X R E F    D E C L A R A T I O N S                               #
#                                                                      #
        XREF PROC DB$LKAR;         # CDCS LOCK TYPE INTERFACE ROUTINE  #
        XREF PROC DMLRTRN;         # SET RETURN REGISTER ROUTINE       #
#                                                                      #
#**********************************************************************#
                                   #---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         #
  
        P<REALMBLOCK>=LOC(FIT)-4;  # SET UP POINTER TO REALMBLOCK      #
        P<DBTXXXX>=LOC(FIT)+FITSIZE; # SET UP POINTER TO SAVE AREA     #
        C<0,10>REALMNAME = REALMNM1;
        C<10,10>REALMNAME = REALMNM2; 
        C<20,10>REALMNAME = REALMNM3; 
        DB$LKAR(REALMNAME,TYPID,RTNPARM);  # CALL CDCS LOCK TYPE       #
                                           # INTERFACE ROUTINE         #
                                     # ROUTINE                         #
        FITES[0] = RTNPARM;                # SET ERROR STATUS FIELD    #
        DBSTAT=FITES[0];           # STORE ERROR INFORMATION IN DBSTAT #
        DBSXXXX[0] = FITES[0];     # STORE ERROR STATUS IN SAVE AREA   #
        DBREALM= DBRXXXX;          # STORE REALM NAME IN ERROR IN      #
                                   # DBREALM(COMMON BLOCK)             #
        IF FITES[0] NQ 0           # CDCS/CRM ERROR                    #
        THEN
          BEGIN 
          RTNPARM=1;               # SET RTNPARM TO 1                  #
          END 
        DMLRTRN(RTNPARM);          # SET RETURN REGISTER ROUTINE       #
        RTNPARM = 0;               # RESET RTNPARM                     #
      RETURN; 
      END 
      TERM
