*COMDECK TRNSDBI
#----------------------------------------------------------------------#
#                                                                      #
#     TRNSDBI                TRANSFORM DATABASE ITEM ENTRY             #
#                                                                      #
#     TRANSFORM CDCS DATABASE ITEM ENTRY FOUND AT CDCSDBI WITH         #
#     SUBSCHEMA WA ADDRESS DBIWADDR INTO CRM FORMAT AT CRMDBI          #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      XDEF PROC TRNSDBI;
      PROC TRNSDBI (CDCSDBI, CRMDBI, DBIWADDR); 
      BEGIN 
      ARRAY CDCSDBI;;              # CDCS DBI ENTRY                    #
      ARRAY CRMDBI;;               # CRM DBI ENTRY                     #
      ITEM DBIWADDR I;             # SUBSCHEMA WA ADDR WHERE CDCS DBI  #
                                   # ENTRY WAS READ                    #
  
      ITEM IDBI I;                 # TEMPORARY SCRATCH VARIABLE        #
      ITEM JDBI I;                 # TEMPORARY SCRATCH VARIABLE        #
      BASED ARRAY CRMNAMEA;        # NAME ARRAY OF CRM DBI ENTRY       #
        BEGIN 
        ITEM CRMNAMEW     I(0, 0,60);  # NAME OF CRM DBI               #
        END 
      BASED ARRAY OCCURRINGA;      # OCCURRING WORD OF CRM DBI ENTRY   #
        BEGIN 
        ITEM CRMDEPENDS   B(0, 1, 1);  # TRUE IF DEPENDING ON          #
        ITEM CRMAXOCR     I(0, 6,18);  # MAXIMUM OCCURRENCES           #
        ITEM CRMINOCR     I(0,24,18);  # MINIMUM OCCURRENCES           #
        ITEM CRMOCCPTR    I(0,42,18);  # ADDR OF DEPENDING ON ITEM     #
        END 
      BASED ARRAY SAMENAMEA;       # SAME NAME WORD OF CRM DBI ENTRY   #
        BEGIN 
        ITEM CRMSAMENAME  I(0, 18,18); # ADDR OF ITEM WITH SAME NAME   #
        END 
  
  
  
      P<DESATT1> = LOC(CRMDBI);    # POSITION TO CRM DBI ENTRY         #
      FOR IDBI = 0 STEP 1          # ZERO OUT FIRST FIVE WORDS         #
        UNTIL 4 
      DO
        BEGIN 
        DDWORD0[IDBI] = 0;
        END 
  
      P<SBITEMENTRY> = LOC(CDCSDBI);  # POSITION TO CDCS DBI ENTRY     #
      IF SBITMENTRY EQ SE$ITEM     # IF ITEM ENTRY                     #
      THEN
        BEGIN 
        DFORMAT = B<SBITMTYPE*3,3>TYPECVT;  # TYPE (GROUP, ELEMENTARY, #
                                            # VECTOR, ETC)             #
        DITEMLEVEL = SBITMLEVEL;   # ITEM LEVEL NUMBER                 #
        DDOMPTR = DBIWADDR - SBITMDOMADR - 1;  # DOMINANT REL POINTER  #
        DNXTPTR = SBITMNEXTP;      # NEXT RELATIVE POINTER             #
        DECNLG = SBITMNMELENC;     # NAME LENGTH IN CHARACTERS         #
        DEWNLG = SBITMNELENW;      # NAME LENGTH IN WORDS              #
        DECLASS = B<SBITMDBCLASS*3,3>CLASSCVT;  # CONVERT CLASS        #
        DEWPOS = SBITMBWP;         # BEGINNING WORD POSITION           #
        DBITPOS = SBITMBBP;        # BEGINNING BIT POSITION            #
        KEYITEM = SBITMKEYFLG;     # TRUE IF PRIMARY KEY               #
        JUSTRIGHT = SBITMJUST;     # TRUE IF JUSTIFIED RIGHT           #
        DOVERPUN = SBITMSIGNF;     # TRUE IF SIGN OVERPUNCH            #
        DALTKEYFLAG = SBITMALTKEYF;# TRUE IF ALTERNATE KEY             #
        DMAJKEYFLAG = SBITMMAJKEYF;# TRUE IF MAJOR KEY                 #
        IF SBITMACTLPT NQ 0        # IF ACTUAL DECIMAL POINT           #
        THEN
          BEGIN 
          DPOINT = TRUE;
          END 
        IDBI = SBITMPTLOC;         # DECIMAL POINT POSITION            #
        IF SBITMLFTPT EQ 0         # IF DECIMAL POINT IS RIGHT OF RIGHT#
                                   # END OF PICTURE, EXAMPLE PIC 999PP #
          AND IDBI NQ 0            # IDBI = 0 IMPLIES DECIMAL POINT IS #
                                   # AT RIGHT END OF PICTURE (99) OR   #
                                   # THERE IS NO DECIMAL POINT (XX)    #
        THEN
          BEGIN 
          IDBI = -IDBI;            # NEGATIVE MEANS POINT IS RIGHT     #
          END 
  
        DPTLOC = IDBI;
        P<SAMENAMEA> = LOC(DDATNAM);  # POSITION TO SAME NAME WORD     #
        CRMSAMENAME = 0;
        IF SBITMOCCURP NQ 0        # IF DBI ENTRY HAS OCCURRING INFO   #
        THEN
          BEGIN 
          GET (SCHEMAFIT, OCCURARRAY, DBIWADDR + SBITMOCCURP, 0, 0, 
               DFSBOCCLG * 10, RA0);  # READ OCCURRING PART OF DBI ENTY#
          P<SBITEMOCCURA> = LOC(OCCURARRAY);
                                   # POSITION TO CDCS OCCURRING ARRAY  #
          P<OCCURRINGA> = LOC(DDATNAM) + 1; 
                                   # POSITION TO CRM OCCURRING ARRAY   #
          CRMDEPENDS = SBITMDEPNDON;  # TRUE IF DEPENDING ON           #
          CRMAXOCR = SBITMHIBNDS;  # MAXIMUM OCCURRENCES               #
          CRMINOCR = SBITMLOWBNDS; # MINIMUM OCCURRENCES               #
          DIMOCC = TRUE;           # OCCURRING WORD EXISTS             #
          P<CRMNAMEA> = P<OCCURRINGA> + 1;  # POSITION TO CRM NAME     #
          END 
  
        ELSE                       # IF NO OCCURRING INFORMATION       #
          BEGIN 
          P<CRMNAMEA> = LOC(DDATNAM) + 1;  # POSITION TO CRM NAME      #
          END 
  
        GET (SCHEMAFIT, CRMNAMEA, DBIWADDR + SBITMNAMEPTR, 0 , 0, 
             SBITMNMELENC, RA0);   # COPY NAME INTO CRM DBI ENTRY      #
  
        IDBI = SBITMUSESIZE;       # INTERNAL LENGTH IN CHARACTERS     #
        DECLSLG = IDBI; 
        IF IDBI GR O"7777"
        THEN
          BEGIN 
          IDBI = O"7777"; 
          END 
  
        IF DFORMAT EQ ET$GROUP     # IF GROUP                          #
          OR DFORMAT EQ ET$RPTGROUP   # IF REPEATING GROUP             #
          OR DFORMAT EQ ET$RPTRPTGRP  # IF REPEAT GROUP IN REPEAT GROUP#
        THEN
          BEGIN 
          DPICSIZ = IDBI;          # PICTURE SIZE INCLUDING INSERTS    #
          IF IDBI GR O"3777"
          THEN
            BEGIN 
            IDBI = O"3777"; 
            END 
  
          DISPLAYSIZE = IDBI;      # PICTURE SIZE EXCLUDING INSERTS    #
          END 
  
        ELSE                       # IF ELEMENTARY ITEM OR VECTOR      #
          BEGIN 
          IDBI = SBITMIPICSIZ;     # PICTURE SIZE INCLUDING INSERTS    #
          IF DECLASS EQ DT$COMPLEX  # IF COMPLEX ITEM                  #
          THEN
            BEGIN 
            IDBI = IDBI * 2 + 1;
            END 
  
          DPICSIZ = IDBI;          # PICTURE SIZE INCLUDING INSERTS    #
          DISPLAYSIZE = SBITMXPICSIZ;  # PICTURE SIZE EXCLUDING INSERTS#
          END 
        END                        # END TRANSFORMING ITEM ENTRY       #
  
  
      ELSE                         # TRANSFORMING RECORD ENTRY         #
  
        BEGIN 
        P<SBRECENTRY> = LOC(CDCSDBI);  # POSITION TO RECORD ENTRY      #
        DFORMAT = ET$RECORD;       # RECORD ITEM                       #
        DITEMLEVEL = 1;            # ITEM LEVEL NUMBER                 #
        DDOMPTR = 0;               # DOMINANT RELATIVE POINTER         #
        DNXTPTR = SBRECNXITEMP;    # NEXT RELATIVE POINTER             #
        DECNLG = SBRECNMELENC;     # NAME LENGTH IN CHARACTERS         #
        DEWNLG = SBRECNMELENW;     # NAME LENGTH IN WORDS              #
        DECLASS = DT$CHAR;         # CLASS IS CHARACTER                #
        DEWPOS = 0;                # WORD POSITION                     #
        DBITPOS = 0;               # BIT POSITION                      #
        IDBI = SBRECLENGTH; 
        DECLSLG = IDBI;            # INTERNAL SIZE IN CHARACTERS       #
        IF IDBI GR O"7777"         # IF WONT FIT IN CRM FIELD          #
        THEN
          BEGIN 
          IDBI = O"7777"; 
          END 
  
        DPICSIZ = IDBI;            # PICTURE SIZE INCLUDING INSERTS    #
        P<SAMENAMEA> = LOC(DDATNAM);  # POSITION TO SAME NAME WORD     #
        CRMSAMENAME = SBRECSMENMEA;  # SAME NAME POINTER               #
        P<CRMNAMEA> = P<SAMENAMEA> + 1;  # POSITION TO CRM NAME        #
        GET (SCHEMAFIT, CRMNAMEA, DBIWADDR + SBRECNAMEPTR, 0, 0,
             SBRECNMELENC, RA0);   # COPY NAME INTO CRM DBI ENTRY      #
        END 
      RETURN; 
      END                          # END PROC    T R N S D B I         #
