*DECK OVLSUBS 
USETEXT CCTTEXT 
USETEXT DBTEXT
PROC  OVLSUBS ; 
BEGIN 
           #THREE SUBROUTINES WHICH CAN ONLY BE USED WITH THE#
           #REST OF THE DDL PROCESS  #
CONTROL NOLIST; 
*CALL DEBUGVARS 
*CALL,DBSAT 
*CALL GETSET
*CALL TABLNAMES 
*CALL,FDLT
CONTROL IFNQ CB5$CDCS,"NO"; 
   XDEF PROC DDSUBSC; 
   XDEF PROC DDSSFDL; 
   XDEF PROC DDSELEC; 
CONTROL IFEQ CB5$CDCS,"CDCS2";
   XDEF PROC BUILDSAT;
CONTROL FI; 
  
          XREF ITEM SUBFAIL I;  #COMMUNICATION FLAG WITH S-SCANNER# 
          $BEGIN
            XREF ITEM DDLDEBUG B;  #DDL DEBUG#
          $END
          ITEM  I  ;  # LOCAL LOOP COUNTER #
     XREF FUNC LJZF C(30) ;  #LEFT JUSTIFY ZERO FILL #
          ITEM J;  #LOCAL LOOP COUNTER# 
          ITEM FDLTFLAG;     #NON-ZERO INDICATES FDLT PROCESSING# 
          ITEM FDLTIX;       #INDEX IN FDLT#
          ITEM TEMP;         #-FDLTAREAOP- FIELD# 
          ITEM TEMP1;        #ACCUMULATION OF AREA USAGE BITS#
          XREF BEGIN
                 ITEM CLALINE I; # LINE NO OF FIRST CHAR IN TOKEN#
                 ITEM CLACOLUMN I; # CHAR NO  FOR CLALINE # 
                 ITEM SELAREANAME C(30); # NAME OF SELECTED AREA #
                  END  # OF VARIABLES WHICH ARE COMMON WITH SSCANER#
          XREF ITEM USEDDL B ; # SET IF "SUB-SCHEMA" HAS BEEN # 
                              # USED AND THE LIBRARY IS AVALIABLE # 
# 
# 
   PROC DDSUBSC;
   BEGIN
         # THIS PROCEDURE IS CALLED FROM SSCANNER WHEN #
         # A "SUB-SCHEMA IS"  PHRASE IS FOUND.         #
         #  IT IS REQUIRED TO OPEN THE SPECIFIED LIBRARY# 
         # AND SET A FLAG IF THE LIBRARYIS FOUND.      #
  
  
          $BEGIN
            IF DDLDEBUG THEN DEBUGON
          $END
             IF CCTSUBPROGR THEN  #WARN OF FDL REQUIREMENT WITH MAIN
                                   COMPILATION# 
               INTERCEPTOR(CLACOLUMN,CLALINE,215,0);
             IF NOT CCTDPARAM THEN  #NO CONTROL CARD D PARAMETER# 
             BEGIN
               SUBFAIL = 1;  #INDICATE ERROR# 
               INTERCEPTOR(CLACOLUMN,CLALINE,214,0);
               RETURN;
             END
RECLISTR = 0; 
AREALISTPTR = 1;
RECLISTPTR =1;
RECINAREA =0; 
BUFPTR = 0; 
             CCTSSNAME[0] = LJZF(CCTSSNAME[0],30);
          IF CCTSSLIB[0] EQ 0 
            THEN C<0,7>CCTSSLIB[0] = C<0,7>CCTSSNAME[0];
           # SUB-SCHEMA AND LIBRARY HAVE THE SAME NAME #
            # IF THE LIBRARY IS NOT GIVEN               # 
          DA$OPSB(CCTSSLIB[0],CCTSSNAME[0],DIT,BUFFERX,BFS);  #OPEN SS# 
          OV$($SET$,"DASTATEOPSB",DASTATE)
          IF DASTATE NQ 0 THEN  #ERROR IN OPENING SUBSCHEMA#
          BEGIN 
            SUBFAIL = 1;     #INDICATE ERROR# 
            INTERCEPTOR(CLACOLUMN,CLALINE,203,0); 
            RETURN; 
          END 
          IF SBCWVERSION NQ DDLVERSION
          THENB("WRONG DDL VERSION SS") 
            SUBFAIL = 1;     #INDICATE ERROR# 
            INTERCEPTOR(CLACOLUMN,CLALINE,216,0); 
            RETURN; 
          ENDIF 
         CONTROL IFEQ CB5$CDCS,"CDCS2"; 
          CCTSCHNAME[0] = LJZF(SBCWSCHNAM30[1]);  #SAVE SCHEMA NAME#
         CONTROL FI;
          SETI("FDLTFLAG",FDLTFLAG,0)  #FLAG FOR -DDSELEC-# 
           RETURN;
  
  
   END
  
   PROC DDSELEC;
   BEGIN
         # THIS PROCEDURE IS CALLED FROM SSCANNER WHEN  # 
         # A "SELECT " PHRASE IS FOUND AND THE FILE MAY BE# 
         # A DDL FILE.# 
         # THE SUB-SCHEMA IS EXAMINED AND IF THE FILENAME#
         # IS FOUND THEN AN ENTRY IS MADE IN THE "SAT" #
         # TABLE FOR LATER USE. # 
         # THIS PROCEDURE IS ALSO CALLED FOLLOWING A -READ- STATEMENT 
           TO VERIFY IF THE FILE-NAME ENCOUNTERED IS IN ACTUALITY A 
           SS RELATION-NAME.# 
         # THIS PROCEDURE IS ALSO CALLED FROM PROC DDSSFDL (BELOW) WHILE
           PROCESSING FDLT INFORMATION.#
  
          OV$($SET$,"SELAREANAME",SELAREANAME)
          SETO("SELAREANAME",SELAREANAME,LJZF(SELAREANAME,30))
  
DAPART = 0;   #CLEAR IN CASE LAST DA$ARSB CALL NOT COMPLETE#
          DA$ARSB(SELAREANAME,ARA,ARASIZE);  #READ AREA/RELATION ENTRY# 
  
          OV$($SET$,"DASTATEARSB",DASTATE)
          OV$($SET$,"SUBFAIL",SUBFAIL)
          IF SUBFAIL NQ DASTATE THEN  #CANNOT FIND AREA/RELATION IN SS# 
            RETURN; 
          #AREA/RELATION NAME IS VALID.  BUILD THE SAT (SELECTED AREA 
           TABLE) ENTRY, FIRST CHECKING IF THE AREA/RELATION IS ALREADY 
           REPRESENTED, AND IF THE SAT HAS SPACE.#
          IF SUBFAIL EQ 0 
          THENB("AREA") 
            SETO("AREA AREALIST PTR",I,SBARORDINAL[1])
            FOR J=1 STEP 1 UNTIL SSNUMAREAS DO
            BEGIN 
              OV$($SET$,"J",J)
              IF $G(SATPTR,SAT$,J) EQ I THEN  #AREA ALREADY -SELECT-ED# 
              BEGIN 
                IF FDLTFLAG NQ 0
                THENB("FDLT-DEFINED AREA")
                  $S(SATFDL,SAT$,J,1);  #AREA (ALSO) DEFINED IN FDLT# 
                  AREABITS;             #AREA USAGE BITS FROM FDLT# 
                  $S(SATFDLBITS,SAT$,J,TEMP1);
                  RETURN; 
                ELSEB("AREA SELECTED TWICE")
                INTERCEPTOR(CLACOLUMN,CLALINE,205,0); 
                RETURN; 
                ENDIF 
              END 
            END 
            IF FDLTFLAG NQ 0
            THENB("FDLT-DEFINED AREA NOT SELECTED") 
              INTERCEPTOR(CLACOLUMN,CLALINE,213,0); 
              RETURN; 
            ENDIF 
            IF SAT$PTR GR SATIXMAX THEN  #SAT OVERFLOW# 
            BEGIN 
              INTERCEPTOR(CLACOLUMN,CLALINE,206,0); 
              RETURN; 
            END 
                             #BUILD THE SAT ENTRY#
            IV$($SET$,"SATPTR",I) 
            $S(SATPTR,SAT$,SAT$PTR,I);
            IV$($SET$,"SATLINE",CLALINE)
            $S(SATLINE,SAT$,SAT$PTR,CLALINE); 
            IV$($SET$,"SATCOL",CLACOLUMN) 
            $S(SATCOL,SAT$,SAT$PTR,CLACOLUMN);
            SETI("SSNUMAREAS",SSNUMAREAS,SAT$PTR) 
            SETI("SAT$PTR",SAT$PTR,SAT$PTR+1) 
          ELSEB("RELATION") 
            SETO("RSTWORD0",RSTWORD0[1],SBARWORD0[1]) 
            SETO("SAT ORDINAL",I,SSNUMAREAS+RSTRELORD[1])  #ORDINAL OF
                                                  RELATION ENTRY IN SAT#
            IF I GR SATIXMAX THEN  #SAT OVERFLOW# 
            BEGIN 
              INTERCEPTOR(CLACOLUMN,CLALINE,206,0); 
              RETURN; 
            END 
            IF FDLTFLAG EQ 0
            THENB("RELATION USED IN PROGRAM") 
              $S(SATRELUFLAG,SAT$,I,1); 
            ELSEB("FDL-DEFINED RELATION") 
              $S(SATFDL,SAT$,I,1);
            ENDIF 
            IV$($SET$,"SATLINE",CLALINE)
            $S(SATLINE,SAT$,I,CLALINE); 
            IV$($SET$,"SATCOL",CLACOLUMN) 
            $S(SATCOL,SAT$,I,CLACOLUMN);
          ENDIF 
          RETURN;     # TO SSCANNER#
   END
CONTROL IFEQ CB5$CDCS,"CDCS2";
  
  
PROC BUILDSAT;
# 
INPUT -- SELAREANAME, AREA/RELATION NAME
  
DOES -- SCANS THE EXISTING SAT LOOKING FOR AN ENTRY WITH THE SAME 
        SUB-SCHEMA AREA ORDINAL AS THE ORDINAL FOR SELAREANAME. 
        IF FOUND, IT SIMPLY RETURNS.  IF NOT, AN SAT ENTRY IS BUILT 
        FOR THE NEW AREA. 
  
OUTPUT (COMMUNICATION WITH CDCSSELECTS IN INTERPRE) -- SUBFAIL, 
       -1 WHEN NO SAT BUILT, 0 WHEN SAT BUILT, +1 WHEN ERROR
# 
BEGIN 
OV$($SET$,"SELAREANAME",SELAREANAME)
  
DAPART = 0;   #CLEAR IN CASE LAST DE$ARSB CALL NOT COMPLETE#
DE$ARSB(SELAREANAME,ARA,ARASIZE);   #READ AREA/RELATION ENTRY#
OV$($SET$,"DASTATEARSB",DASTATE)
#SINCE WE KNOW NAME WILL BE FOUND, DASTATE SHOULD ALWAYS BE 0#
  
IF DASTATE NQ 0 
   THEN 
      BEGIN 
      INTERCEPTOR(CLACOLUMN,CLALINE,207,0); 
      SUBFAIL = 1;
      RETURN; 
      END 
  
#CHECK IF SAT ENTRY FOR THIS AREA ALREADY EXISTS.  IF SO, RETURN.#
SUBFAIL = -1; 
SETO("AREA AREALIST PTR",I,SBARORDINAL[1])
FOR J = 1 STEP 1 UNTIL SSNUMAREAS DO
   BEGIN
   OV$($SET$,"J",J) 
   IF $G(SATPTR,SAT$,J) EQ I THEN RETURN; 
   END
  
#CHECK FOR SAT OVERFLOW#
IF SAT$PTR GR SATIXMAX
   THEN      #SAT OVERFLOW# 
      BEGIN 
      SUBFAIL = 1;
      INTERCEPTOR(CLACOLUMN,CLALINE,206,0); 
      RETURN; 
      END 
  
#BUILD THE SAT ENTRY# 
SUBFAIL = 0;
IV$($SET$,"SATPTR",I) 
$S(SATPTR,SAT$,SAT$PTR,I);
IV$($SET$,"SATLINE",CLALINE)
$S(SATLINE,SAT$,SAT$PTR,CLALINE); 
IV$($SET$,"SATCOL",CLACOLUMN) 
$S(SATCOL,SAT$,SAT$PTR,CLACOLUMN);
SETI("SSNUMAREAS",SSNUMAREAS,SAT$PTR) 
SETI("SAT$PTR",SAT$PTR,SAT$PTR+1) 
  
RETURN; 
END 
CONTROL FI; 
# 
# 
   PROC DDSSFDL;
   BEGIN
         #THIS PROCEDURE IS CALLED FROM -DDLSS- IMMEDIATELY BEFORE ITS
          "NORMAL" PROCESSING OF RELATIONS. 
          SAT INFORMATION IS ENTERED FOR EACH CDCS I/O FILE REPRESENTED 
          IN THE FDLT, AND FOR EACH RELATION.#
  
          IF CCTFDLCDCS 
          THENB("FDL SS INFORMATION") 
            SETI("FDLTFLAG",FDLTFLAG,1)  #FLAG FOR -DDSELEC-# 
            SETI("SUBFAIL",SUBFAIL,0)    #SAME# 
            FOR FDLTIX = 1 STEP 1 UNTIL CCTFDLTLEN DO 
            BEGIN 
              IV$($SET$,"FDLTIX",FDLTIX)
              IF $G(FDLTENTTYPE,TABLETYPE"FDLT$",FDLTIX) EQ 
                FDLTENTVAL"AREADECL"
              THENB("AREA DECLARATION") 
                SETC("SELAREANAME",SELAREANAME,$G(FDLTAREANAME, 
                     TABLETYPE"FDLT$",FDLTIX))
                DDSELEC;
                IF SUBFAIL NQ DASTATE 
                THENB("AREA NOT IN SS") 
                  INTERCEPTOR(253,0,211,0);  #253 INDICATES SS-RELATED
                                              ERROR#
                ENDIF 
              ENDIF 
            END 
            SETI("SUBFAIL",SUBFAIL,3)  #FLAG FOR -DDSELEC-# 
            FOR FDLTIX = 1 STEP 1 UNTIL CCTFDLTLEN DO 
            BEGIN 
              IV$($SET$,"FDLTIX",FDLTIX)
              IF $G(FDLTENTTYPE,TABLETYPE"FDLT$",FDLTIX) EQ 
                FDLTENTVAL"RELDECL" 
              THENB("RELATION DECLARATION") 
                SETC("SELAREANAME",SELAREANAME,$G(FDLTRELNAME,
                     TABLETYPE"FDLT$",FDLTIX))
                DDSELEC;
                IF SUBFAIL NQ DASTATE 
                THENB("RELATION NOT IN SS") 
                  INTERCEPTOR(253,0,212,0);  #253 INDICATES SS-RELATED
                                              ERROR#
                ENDIF 
              ENDIF 
            END 
          ENDIF 
          SETI("FDLTFLAG",FDLTFLAG,0) 
          RETURN; 
   END
# 
# 
   PROC AREABITS; 
   BEGIN
         #THIS PROCEDURE REORDERS THE -FDLTAREAOP- BITS INTO CDCS 
          AREA USAGE TABLE ORDER INTO -TEMP1- FOR SUBSEQUENT PLACEMENT
          INTO THE SAT -SATFDLBITS- ENTRY.# 
  
          ARRAY AREABITS [1:NBRUSEOPS] S(1);  #BIT POSITION IN CDCS AREA
                                               USAGE LIST WORD# 
            ITEM OP U = [1,2,0,5,6,3,4];  #CLOSE-1, DELETE-2, OPEN-0, 
                                           READ-5, REWRITE-6, START-3,
                                           WRITE-4# 
          ITEM IX S:FDLTAOVAL;
          SETO("TEMP",TEMP,$G(FDLTAREAOP,TABLETYPE"FDLT$",FDLTIX))
          SETO("TEMP1",TEMP1,0) 
          FOR IX = S"CLOSE" STEP 1 UNTIL S"WRITE" 
          DO
          BEGIN 
            IF B<IX+40,1>TEMP EQ 1
            THENB("OPERATION USED") 
              B<OP[IX]+52,1>TEMP1 = 1;  #RIGHT JUSTIFY IN -TEMP1-#
              OV$($SET$,"AREA BITS",TEMP1)
            ENDIF 
          END 
   END
CONTROL FI; 
END 
TERM
