*DECK DA$NMSB 
  PROC DE$NMSB; 
    BEGIN 
      DEF SBPTR #0#;
      ITEM J; 
      ARRAY BEGINZERO [0];
        ITEM ZEROOUT U(0,0,60); 
      ITEM I; 
      ITEM K; 
      ITEM RECLISTLNG;
      ITEM RECLISTPTR;
      ITEM RECWA; 
      ITEM NEXTWSA; 
      ITEM RECFLAG; 
      ITEM AREAPTR; 
      ITEM RWRDS; 
      ITEM AWRDS; 
      XREF
      BEGIN 
      BASED ARRAY DE$DIT [24] S(1);    # DIRECTORY INFORMATION TABLE   #
        BEGIN 
*CALL DITCOMSB
        END 
      END 
      BASED ARRAY RECENTRYLIST [3] S(1);
        BEGIN 
*CALL SBRHDDCLS 
*CALL SBIHDDCLS 
        END 
      XREF
      BEGIN 
      ARRAY DE$ARL [100] S(1);
        BEGIN 
*CALL SBRLMLST
        END 
      END 
      ARRAY RECORDLIST [100] S(1);
        BEGIN 
*CALL SBRECLST
        END 
      ARRAY ENDZERO;; 
      XDEF
        BEGIN 
          PROC DE$ERR;
          PROC DE$ARSB; 
          PROC DE$RCSB; 
          PROC DE$NXSB; 
          PROC DE$GTSB; 
        END 
      XREF
        BEGIN 
          PROC DE$OPEN; 
          PROC DE$GET;
          PROC DE$READ; 
          ITEM DE$ARLA;      # WORD ADDRESS OF REALM LIST # 
          ITEM DE$ARLL;      # LENGTH OF REALM LIST # 
          ITEM DE$PTR;       # DIRECTORY POINTER #
        END 
      J = LOC(ENDZERO) - LOC(BEGINZERO);
      FOR I = 0 STEP 1 UNTIL J-1 DO 
        ZEROOUT[I] = 0; 
  PROC DE$ARSB(AREANAME,AREAWSA,AREAWDS); 
    BEGIN 
      ARRAY AREANAME [2] S(1);
        BEGIN 
        ITEM AREANME U(0,0,60); 
        ITEM AREANME30 C(0,0,30); 
        END 
      ARRAY AREAWSA [0];; 
      ITEM AREAWDS; 
      ITEM TEMPWDS = 0; 
      DASTATE[SBPTR] = 0; 
      IF DAPART[SBPTR] EQ 1 THEN
        BEGIN 
          IF AREANME30[SBPTR] EQ REALMLSTNM30[AREAPTR] THEN 
                BEGIN 
                  DE$PTR = DE$PTR + TEMPWDS;
                  TEMPWDS = TEMPWDS + AREAWDS;
                  IF TEMPWDS GQ REALMENTRYLG[AREAPTR] THEN
                    DAPART[SBPTR] = 0;
                  AWRDS = AREAWDS;
                  DE$GET(LOC(AREAWSA),AWRDS,DE$PTR);
                  RETURN; 
                END 
        END 
      DAENTAD[SBPTR] = 0; 
      DAPART[SBPTR] = 0;
      DANWRDS[SBPTR] = 0; 
      K = DE$ARLL;
      J = DE$ARLA;
      FOR J = J WHILE K GR 0 DO    # SEARCH REALM LIST FOR REALM PASSED#
        BEGIN                      # IN CALL.                          #
          DE$READ(DE$ARL, K, J, 0); 
          FOR I = 0 STEP 4 UNTIL 99 DO
            BEGIN 
            IF AREANME30[SBPTR] EQ REALMLSTNM30[I] THEN 
              BEGIN 
                IF REALMRECLIST[I] EQ 0 THEN
                  BEGIN            # RELATION ENTRY # 
                    DE$PTR = RELATIONADR[I] + SBCWSBADDR[SBPTR];
                    DAENTAD[SBPTR] = RELATIONADR[I];
                    DASTATE[SBPTR] = 3; 
                  END 
                ELSE               # AREA ENTRY # 
                  BEGIN 
                    DE$PTR = REALMADR[I] + SBCWSBADDR[SBPTR]; 
                    DAENTAD[SBPTR] = REALMADR[I]; 
                  END 
                IF REALMENTRYLG[I] GR AREAWDS THEN
                  BEGIN 
                    DAPART[SBPTR] = 1;   # SET PARTIAL READ FLAG.      #
                    TEMPWDS = AREAWDS;
                  END 
                AWRDS = AREAWDS;
                DE$GET(LOC(AREAWSA),AWRDS,DE$PTR);
                RETURN; 
              END 
            END 
          END 
      DASTATE[SBPTR] = 1; 
      RETURN; 
    END 
  PROC DE$RCSB(AREANAME,RECWSA,RECLGTH);
    BEGIN 
      ARRAY AREANAME[2] S(1); 
        BEGIN 
        ITEM AREANME U(0,0,60); 
        ITEM AREANME30 C(0,0,30); 
        END 
      ARRAY RECWSA [0];;
      ITEM RECLGTH; 
      RWRDS = RECLGTH;
      P<RECENTRYLIST> = LOC(RECWSA);
      RECLISTPTR = 0; 
      DASTATE[SBPTR] = 0; 
      RECFLAG = 0;
      DAPART[SBPTR] = 0;
      K = DE$ARLL;
      J = DE$ARLA;
      FOR J = J WHILE K NQ 0 DO    # SEARCH REALM LIST FOR REALM       #
        BEGIN                      # PASSED IN CALL                    #
          DE$READ(DE$ARL, K, J, 0); 
          FOR I = 0 STEP 4 UNTIL 99 DO
            BEGIN 
              IF AREANME30[0] EQ REALMLSTNM30[I] THEN 
                BEGIN 
                  RECLISTLNG = REALMRECLEN[I];
                  DE$PTR = REALMRECLIST[I] + DE$ARLA; 
                  DE$GET(LOC(RECORDLIST),RECLISTLNG,DE$PTR);
                  RECWA = RECLISTLADR[SBPTR]; 
                  RECLISTPTR = RECLISTPTR + 1;
                  DAENTAD[SBPTR] = RECWA; 
                  DE$PTR = RECWA + SBCWSBADDR[SBPTR]; 
                  DE$GET(LOC(RECENTRYLIST),RWRDS,DE$PTR); 
                  IF SBRECNXRECP[SBPTR] GR RECLGTH THEN 
                    BEGIN 
                      DAPART[SBPTR] = 1;
                      IF SBRECNXITEMP[SBPTR] GR RECLGTH THEN
                        BEGIN 
                        DANWRDS[SBPTR] = RECLGTH; 
                        RETURN; 
                        END 
                       ELSE 
                        BEGIN 
                          K = SBRECNXITEMP[SBPTR];
    DARC1:  
                          J = K + SBITMNEXTP[K];
                          IF K EQ J OR J GQ RECLGTH THEN
                            BEGIN 
                              DANWRDS[SBPTR] = K; 
                              NEXTWSA = RECWA + K;
                              IF RECLISTLADR[RECLISTPTR] NQ 0 THEN
                                DASTATE[SBPTR] = 2; 
                              RETURN; 
                            END 
                          K = J;
                          GOTO DARC1; 
                        END 
                    END 
                   ELSE 
                    BEGIN 
                      DANWRDS[SBPTR] = SBRECNXRECP[SBPTR];
                      NEXTWSA = RECLISTLADR[RECLISTPTR];
                      RECLISTPTR = RECLISTPTR + 1;
                      RECFLAG = 1;
                      IF NEXTWSA NQ 0 THEN
                        DASTATE[SBPTR] = 2; 
                      RETURN; 
                    END 
                END 
            END 
        END 
      DASTATE[SBPTR] = 1; 
      RETURN; 
    END 
  PROC DE$ERR;
    BEGIN 
      XREF ARRAY DE$FTSB [0] S(1);
        ITEM FTSBIRS U(13,33,9);
        IF FTSBIRS[0] EQ O"143" THEN
        RETURN; 
      DASTATE[SBPTR] = 1; 
      RETURN; 
    END 
  PROC DE$NXSB(NXTWSA,RECLGTH); 
    BEGIN 
      ARRAY NXTWSA [0];;
      ITEM RECLGTH; 
      IF DASTATE[SBPTR] EQ 1 THEN 
        DASTATE[SBPTR] = 0; 
      P<RECENTRYLIST> = LOC(NXTWSA);
      RWRDS = RECLGTH;
       RECWA = NEXTWSA ;
      DE$PTR = NEXTWSA + SBCWSBADDR[SBPTR]; 
      DE$GET(LOC(RECENTRYLIST),RECLGTH,DE$PTR); 
      IF RECFLAG EQ 1 THEN
        BEGIN 
          DAENTAD[SBPTR] = NEXTWSA; 
          IF SBRECNXRECP[SBPTR] GR RECLGTH THEN 
            BEGIN 
              RECFLAG = 0;
              DAPART[SBPTR] = 1;
              IF SBRECNXITEMP[SBPTR] GR RECLGTH THEN
               BEGIN
                DANWRDS[SBPTR] = RECLGTH; 
                NEXTWSA = RECWA + SBRECNXITEMP[SBPTR];
                RETURN; 
               END
               ELSE 
                  K = SBRECNXITEMP[SBPTR];
    DANXT1: 
                  J =     K + SBITMNEXTP[K];
                  IF J EQ K OR J GR RECLGTH THEN
                    BEGIN 
                      DANWRDS[SBPTR] = K; 
                      NEXTWSA = RECWA + K;
                      GOTO DANXT3;
                    END 
                  K = J;
                  GOTO DANXT1;
            END 
          DANWRDS[SBPTR] = SBRECNXRECP[SBPTR];
          DAPART[SBPTR] = 0;
          IF RECLISTPTR EQ RECLISTLNG THEN
            NEXTWSA = 0;
          ELSE
            BEGIN 
              NEXTWSA = RECLISTLADR[RECLISTPTR];
              RECLISTPTR = RECLISTPTR + 1;
            END 
        END 
       ELSE 
        BEGIN 
          K = SBITMNEXTP[SBPTR];
          IF K EQ 0 THEN
            BEGIN 
              IF SBITMENTRYL[SBPTR] GR RECLGTH THEN 
                DANWRDS[SBPTR] = RECLGTH; 
               ELSE 
                DANWRDS[SBPTR] = SBITMENTRYL[SBPTR];
              GOTO DANXT4;
            END 
    DANXT2: 
          IF SBITMNEXTP[K] EQ 0 THEN
            BEGIN 
              J = K + SBITMENTRYL[K]; 
              IF K + 5 GR RECLGTH THEN
                GOTO DANXT5;
              IF J LQ RECLGTH THEN
               BEGIN
                DANWRDS[SBPTR] = RECLGTH; 
                GOTO DANXT4;
               END
    DANXT5: 
                DANWRDS[SBPTR] = K; 
                NEXTWSA = RECWA + K;
                RETURN; 
            END 
           J = K + SBITMNEXTP[K]; 
          IF J GR RECLGTH THEN
            BEGIN 
                  DANWRDS[SBPTR] = K; 
                  NEXTWSA = RECWA+K;
                  GOTO DANXT3;
            END 
          IF J EQ RECLGTH THEN
            BEGIN 
                  DANWRDS[SBPTR] = J; 
                  IF SBITMNEXTP[K] EQ 0 THEN
               BEGIN
    DANXT4: 
                RECFLAG = 1;
                DAPART[SBPTR] = 0;
                IF RECLISTPTR EQ RECLISTLNG THEN
                  NEXTWSA = 0;
                ELSE
                  BEGIN 
                    NEXTWSA = RECLISTLADR[RECLISTPTR];
                    RECLISTPTR = RECLISTPTR + 1;
                  END 
                GOTO DANXT3;
               END
              NEXTWSA = RECWA + J;
            END 
           ELSE 
            BEGIN 
               K = J; 
               GOTO DANXT2; 
            END 
        END 
    DANXT3: 
      IF NEXTWSA EQ 0 THEN
        BEGIN 
          DAPART[SBPTR] = 0;
          RECFLAG = 0;
          DASTATE[SBPTR] = 0; 
        END 
      RETURN; 
    END 
  PROC DE$GTSB(GETWSA,GETWRDS,GETWA); 
    BEGIN 
      ARRAY GETWSA [0];;
      ITEM GETWRDS; 
      ITEM GETWA; 
      DASTATE[SBPTR] = 0; 
      AWRDS = GETWRDS;
      DE$PTR = GETWA + SBCWSBADDR[SBPTR]; 
      DE$GET(LOC(GETWSA),AWRDS,DE$PTR); 
      RETURN; 
    END 
   END
  TERM; 
