*DECK DMLRDK                                                            000340
      PROC DMLRDK (FIT,REALMORD,KEYORD,RECORDORD,RELCODE,               000350
                   KL,KT,RKW,RKP,KEYNAME,ERRRTRN);
      BEGIN                                                             000370
 #
* *   DMLRDK - READ RANDOM INTERFACE ROUTINE
*     R. E. FOX                                      10/14/77 
* 
* DC  PURPOSE 
* 
*     ISSUE A READ RANDOM 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  --    APPLICATION PROGRAM FIT FOR REALM TO BE READ 
* 
*     REALMORD  -- ORDINAL OF THE REALM TO BE READ
* 
*     KEYORD --  KEY ORDINAL OF THE USER-SPECIFIED KEY
* 
*     RECORDORD  --  RECORD ORDINAL 
* 
*     RELCODE  --  CRM CODE FOR RELATIONAL OPERATOR 
*                  1 FOR EQ, 3 FOR GE, 6 FOR GT 
* 
*     KL     --  KEY LENGTH 
* 
*     KT     --  KEY TYPE 
* 
*     RKW     --  RKW FIELD IN FIT
* 
*     RKP     --  RKP FIELD IN FIT
* 
*     KEYNAME  --  KEY NAMED IN READ STATEMENT
* 
*     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
* 
* 
* 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
* 
*     DMLRDK IS CALLED FROM THE APPLICATION PROGRAM 
*     AS A RESULT OF A DML READ RANDOM STATEMENT. 
* 
* DC  CALLED ROUTINES 
* 
*     DB$RD2  --     CDCS READ RANDOM INTERFACE ROUTINE 
*     DB$STR  --     CDCS START INTERFACE ROUTINE 
*     DB$RD1  --     CDCS READ SEQUENTIAL INTERFACE ROUTINE 
*     DMLRTRN --      RETURN ROUTINE--SETS REGISTER TO RETURN PARAMETER 
* 
* DC  NON-LOCAL VARIABLES 
* 
*     VARIABLES IN DB0000 WHICH ARE MODIFIED ARE: 
*     DBSTAT, DBSXXXX, DBREALM
*     RELEVANT FIT FIELDS ARE RESTORED TO THEIR SAVE AREA VALUES
*     OR SET TO VALUES PASSED AS PARAMETERS.
* 
* DC  DESCRIPTION 
* 
*     A CALL TO DMLRDK IS GENERATED BY THE PREPASS AS 
*     A RESULT OF A DML READ RANDOM STATEMENT.
*     THE RECORD ORDINAL AND KEY ORDINAL ARE PACKED INTO A
*     ONE WORD PARAMETER FOR CDCS.  THE FIT FIELDS PASSED AS PARAMETERS 
*     ARE STORED IN THE FIT AND OTHER RELEVANT FIT FIELDS ARE RESTORED
*     TO THEIR SAVE AREA VALUES.  IF THE RELATIONAL OPERATOR IS OTHER 
*     THAN EQUAL, A START AND A SEQUENTIAL READ ARE PERFORMED.
*     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;                                                    000380
      CONTROL DISJOINT;                                                 000390
      CONTROL INERT;                                                    000400
                                                                        000410
                                        #-------------DEFS-------------#
  
      DEF FITSIZE     #35#;             # SIZE OF FIT IN WORDS         #
                                                                        000440
# THE FOLLOWING ARE PARAMETERS FROM THE CALLING SEQUENCE               #000450
                                                                        000460
      ARRAY FIT;                 # FIT FOR REALM                       #000470
*CALL FITDCLS                                                           000480
                                                                        000490
      ITEM REALMORD;             # REALM ORDINAL                       #000500
      ITEM KEYORD;               # KEY ORDINAL                         #000510
      ITEM RECORDORD;            # RECORD ORDINAL                      #000520
      ITEM RELCODE;              # CODE FOR RELATIONAL OPERATOR        #000530
                                 # 1 FOR EQ, 3 FOR GE, 6 FOR GT        #000540
      ITEM KL;                   # KEY LENGTH                          #000550
      ITEM KT;                   # KEY TYPE                            #000560
      ITEM RKW;                  # RKW FIELD IN FIT                    #000570
      ITEM RKP;                  # RKP FIELD IN FIT                    #000580
      ITEM KEYNAME;              # KEY NAMED IN READ STATEMENT         #000650
      ITEM ERRRTRN;              # ERROR RETURN PARAMETER              #
                                 # WARNING: DO NOT REFERENCE           #
                                                                        000590
                                 # PARM TO PASS TO CDCS                #000600
      ARRAY PARM3[0] S(1);                                              000130
        BEGIN                                                           000620
          ITEM P3WORD U(0,0,60); # ENTIRE PARAMETER                    #
          ITEM RORD U(0,36,12);  # RECORD ORDINAL                      #
          ITEM KORD U(0,48,12);  # KEY ORDINAL                         #
        END                                                             000650
                                                                        000660
# THE FOLLOWING DESCRIBES THE COMMON BLOCK CREATED IN THE FORTRAN      #000670
# PROGRAM                                                              #000680
                                                                        000690
      COMMON DB0000;                                                    000700
*CALL DB0DCLS                                                           000710
                                 #-----------------XREFS---------------#
      XREF                                                              000730
        BEGIN                                                           000740
          PROC DB$RD2;           # READ RANDOM INTERFACE RTN           #000750
          PROC DB$STR;           # START INTERFACE ROUTINE             #000640
          PROC DB$RD1;           # READ SEQUENTIAL INTERFACE ROUTINE   #000650
          PROC DMLRTRN;          # SET RETURN REGISTER ROUTINE         #
        END                                                             000760
  
                                        #----------LOCAL ITEMS---------#
  
      ITEM RTNPARM;                     # RETURN PARAMETER - DMLRTRN   #
  
      CONTROL EJECT;                                                    000770
                                                                        000780
# SET UP POINTER TO REALMBLOCK AND SAVE AREA                           #000530
      P<REALMBLOCK> = LOC(FIT) - 4;                                     000800
      P<DBTXXXX> = LOC(FIT) + FITSIZE;                                  000550
                                                                        000820
# SET UP PARM 3 FOR CDCS                                               #000830
      P3WORD[0] = 0;             # ZERO FILL                           #
      RORD[0] = RECORDORD;                                              000840
      KORD[0] = KEYORD;                                                 000850
                                                                        000860
# FILL IN FIT FIELDS FROM PARAMTERS                                    #000870
      FITREL[0] = RELCODE;       # RELATIONAL OPERATOR CODE            #000880
      FITKL[0] = KL;                                                    000890
      FITKT[0] = KT;                                                    000900
      FITRKW[0] = RKW;                                                  000910
      FITRKP[0] = RKP;                                                  000920
      FITKP[0] = RKP; 
      FITKA[0] = LOC(KEYNAME);                                          000670
                                                                        000930
# FILL IN FIT FIELDS FROM INVOKE SAVE AREA                             #000940
# FILL IN KA, KP, WSA, MRL       #                                      000950
      FITWSA[0] = DBWSA[0];                                             000980
      FITMRL[0] = DBMRL[0];                                             000990
      FITRL[0] = DBMRL[0];                                              000610
                                                                        001000
#  IF RELATIONAL OPERATOR IS OTHER THAN EQUAL, A START AND A           #000670
#  SEQUENTIAL READ ARE PERFORMED                                       #000680
                                                                        000690
      IF RELCODE NQ 1                                                   000700
      THEN                                                              000710
        BEGIN                                                           000720
                                 # CALL START ROUTINE                  #000730
          DB$STR(FIT,            # FIT PASSED FROM FORTRAN PROGRAM     #000740
                 REALMORD,       # REALM ORDINAL                       #000750
                 PARM3);         # RECORD ORDINAL AND KEY ORDINAL      #000760
          IF FITES[0] EQ 0                                              000770
          THEN                                                          000780
            BEGIN                                                       000790
                                 # CALL SEQUENTIAL READ ROUTINE        #000800
              DB$RD1(FIT,REALMORD);                                     000810
            END                                                         000820
          GOTO ERRSTAT;                                                 000830
        END                                                             000840
# PERFORM READ CALL TO CDCS                                            #001010
      DB$RD2 (FIT,               # FIT PASSED FROM FORTRAN PRGM        #001020
              REALMORD,          # REALM ORDINAL                       #001030
              PARM3);            # RECORD ORDINAL AND KEY ORDINAL      #001040
                                                                        001050
# RETURN STATUS OF IO REQUEST                                          #001060
ERRSTAT:                                                                000860
      DBSTAT = FITES[0];                                                001070
      DBSXXXX = FITES[0];                                               000570
      DBREALM = DBRXXXX;                                                000580
                                                                        001100
# 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                                    #
  
      RETURN;                                                           001110
      END                                                               001120
TERM                                                                    001130
