*DECK  CUVSYN 
USETEXT TCLFN 
USETEXT TCRMDEF 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TFIT
USETEXT TOPTION 
USETEXT TREPORT 
USETEXT TSBASIC 
USETEXT TXSTD 
      PROC       CUVSYN;           # SYNTAX  ROUTINES  FOR             #
                                # -CREATE-  -USE-  -VERSION-           #
  
#----------------------------------------------------------------------#
#                                                                      #
#  THE FOLLOWING PROCS ARE XDEF"D WITHIN THIS DECK:                    #
#                                                                      #
#     ABTUSE                       ABORT THE USE IN PROGRESS           #
#     ABTVER                       ABORT THE VERSION IN PROGRESS       #
#     CHKCRCD                      *NO* IF ILLEGAL CRM/CDCS SYNTAX     #
#     CHKSBN                       *NO* IF SUB-SCHEMA NAME HAS HYPHENS #
#     CKVERDR                      CHECK TO SEE IF DIR WAS VERSION     #
#     DBVCHK                       CHECK VER. NAME AND STORE IF VALID  #
#     ENDUSEP                      LOAD THE 5-0 OVL TO CONTINUE USE    #
#     INITCRE                      INITIALIZE FOR CREATE DIRECTIVE     #
#     INITINV                      INITIALIZE FOR INVOKE DIRECTIVE     #
#     INITPFP                      INITIALIZE FOR PF PARAMETERS        #
#     INITREL                      INITIALIZE FOR RELATION NAME STR    #
#     INITUSE                      INITIALIZE FOR THE USE DIRECTIVE    #
#     INITVER                      SET UP EXIT FROM SCANPFP            #
#     PROCCY                       SAVE THE CYCLE NUMBER               #
#     PROCDFL                      SAVE THE DEFAULT USER NUMBER (NOS)  #
#     PROCID                       SAVE THE ID OF THE FILE             #
#     PROCLD                       SAVE LOW CYCLE PARAMETER            #
#     PROCM                        SAVE THE MODE R OR W (NOS)          #
#     PROCMR                       SAVE THE MR PARAMETER               #
#     PROCPN                       SAVE THE PACK NAME (NOS)            #
#     PROCPW                       SAVE THE PASS WORD                  #
#     PROCPWK                      SAVE THE PASS WORD (NOS)            #
#     PROCR                        SAVE THE *R* PARAMETER STUFF        #
#     PROCRW                       SAVE THE *RW* PARAMETER             #
#     PROCSN                       SAVE THE SET NAME                   #
#     PROCUN                       SAVE THE USER NUMBER                #
#     SAVEAREA                     SAVE THE AREA PERMANENT FILE NAME   #
#     SAVEINDX                     SAVE THE INDEX FILE NAME            #
#     SAVELIB                      SAVE THE LIBRARY  FOUND FLAG        #
#     SAVEMODF                     SAVE THE MODIFIED FOUND FLAG        #
#     SAVENAM                      SAVE THE REL OR PF NAME             #
#     SAVEREL                      SAVE THE RELATION NAME IN A STRING  #
#     SAVESBLB                     SAVE SUB-SCHEMA LIBRARY NAME        #
#     SAVESUB                      SAVE SUB-SCHEMA FILE NAME           #
#     STEMPAR                      SET AREA AS TEMPORARY               #
#     SUBONLY                      SUB-SCHEMA GIVEN ONLY               #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
      BEGIN 
  
      XREF
        BEGIN 
        ITEM  CDCSCAT B;           # TRUE IF CDCS CATALOG MODE         #
        ITEM  DBVNAME C(7);        # DATABASE VERSION NAME             #
        ITEM SM$GROUPID;           # GROUP ID OF CMM BLOCKS ALLOCATED  #
                                   # FOR THIS DIRECTIVE.               #
        ITEM  MODIFYFLAG  B;
        ITEM  PREDBVN C(7);        # PREVIOUS DATABASE VERSION NAME    #
        ITEM  TAREA1;              # POINTER TO THE AREA FDB           #
        ITEM  TAREA2;              # POINTER TO THE INDEX FDB          #
        ITEM  TAREA3;              # POINTER TO THE SUB SCHEMA FDB     #
        ITEM  TAREA4;              # POINTER TO THE RELATION STRING    #
        ITEM  TAREA4X;             # POINTER TO THIS BLOCK OF REL STNG #
        ITEM  TAREA5 I;            # POINTER TO SUBSCHEMA NAME         #
        ITEM  INDEX$PFP  B;        # PF PARAMS GIVEN WITH INDEX NAME   #
        ITEM  TRELINDX;            # INDEX TO NEXT ENTRY IN REL STNG   #
        ITEM  RA0;
        ITEM  MXTRNLG;
        ITEM  OPNCATL    B; 
        ITEM  USEDIR   B;          # TRUE IF USE  /  FALSE IF CREATE   #
        ITEM  VERDIR B;            # TRUE IF VERSION                   # CUVSYN 
  
        FUNC  CMM$ALF;
        PROC  CMM$FRF;
        PROC  CMM$FGR;             # CMM ROUTINE TO FREE GROUP ID      #
        PROC  CMOVE;
        PROC  RETURNM;
        PROC  CLOSEM; 
        PROC  OPENM;
        PROC  DIAG; 
        PROC  FREEING;
        PROC  EXIT10; 
        PROC  RECNO;
        PROC  RECYES; 
        END 
  
      XREF PROC AUTOPSY;           # CLEANUP FOR CURRENT CATALOG FILE  #
      XREF PROC OPNCAT;            # ATTEMPTS TO OPEN THE CATALOG FILE #
      XREF ITEM MIP B;             # TRUE IF MIP UPDATE MODE           #
      XREF ITEM IMFDBM B;          # TRUE IF IMF DATA BASE MODE        #
      XREF ITEM DUMMY;                                                   CUVESYN
      XREF ITEM PRIVACYKEY C(30);  # CDCS EXT SCHEMA PRIVACY KEY LIT   #
      XDEF ARRAY TEMPNAME [0:3];   # HOLDS LEFT JUST. ZERO FILLED NAME #
        BEGIN 
        ITEM TNAME U(0,0,60); 
        END 
  
      ITEM  FLAGID     B;          # FLAG FOR KEYWORD  -ID-            #
      ITEM  FLAGCY     B;          # FLAG FOR KEYWORD  -CY-            #
      ITEM FLAGLC      B;          # FLAG FOR KEYWORD *LC*             #
      ITEM  FLAGMR     B;          # FLAG FOR KEYWORD  -MR-            #
      ITEM FLAGRW      B;          # FLAG FOR KEYWORD *RW*             #
      ITEM  FLAGSN     B;          # FLAG FOR KEYWORD  -SN-            #
      ITEM  FLAGUN     B;          # FLAG FOR KEYWORD  -UN-   NOS      #
      ITEM  FLAGPWK    B;          # FLAG FOR KEYWORD  -PW-   NOS      #
      ITEM  FLAGPN     B;          # FLAG FOR KEYWORD  -PN-   NOS      #
      ITEM  FLAGR      B;          # FLAG FOR KEYWORD  -R-   NOS       #
      ITEM  UNITNO     I;          # HOLDING LOCATION FOR UNIT NUMBER  #
      ITEM  FLAGM      B;          # FLAG FOR KEYWORD  - M-   NOS      #
      ITEM  HYPHENS    B;          # HYPHENS FOUND IN THE NAME         #
      ITEM  INVOKE     B;          # TRUE IF INVOKE                    #
      ITEM  LIBFLAG    B;          # TRUE IF -LIB- CLAUSE IS SPECIFIED #
      ITEM  RC;                    # RETURN CODE FROM ATTACH           #
      ITEM  SBNHYPHEN  B;          # HYPHENS FOUND IN SUB-SCHEMA NAME  #
      ITEM  CURLENGSV I;           # SAVE AREA FOR *CURLENG*           # CUVSYN 
  
      ITEM  NALFNUM B;             # TRUE IF CHAR IS NOT A-Z,0-9       #
      ITEM  NALPHA  B;             # TRUE IF CHAR IS NOT A-Z           #
      ITEM  TCOUNT; 
      ITEM  TEMPTR; 
      ITEM  TWORDNUM; 
      ITEM  TLENGTH;
      ITEM  TBITPOS;
      ITEM  TCHAR;                 # CURRENT CHARACTER DURING MOVE     #
      ITEM  TCHARPOS I;            # LOOP INCREMENT USED IN DBVCHK     #
      ITEM  FDBINDX;               # INDEX INTO FDB AREAS              #
      ITEM  TPWCODE;               # CODE FOR THE  -PW-  PARAMETERS    #
      ITEM  VERNAME  C(7);         # TEMP. DATABASE VERSION NAME       #
  
      DEF    $ZZZZZQ3$    #O"32323232322136000000"#;
  
      BASED ARRAY  SUBSCHNAME [0:2] S(1);  # SUBSCHEMA NAME            #
        BEGIN                                                            CUVSYN 
        ITEM SBSCHNAME U(0,0,60);                                        CUVSYN 
        END                                                              CUVSYN 
                                                                         CUVSYN 
      BASED ARRAY  TFDBARAY;
        BEGIN 
            ITEM   TFDBITEM   U(0,0,60);
            ITEM   TFDBLFN    U(4,0,42);
            ITEM   TFDBPRAM   U(0,0,54);
            ITEM   TFDBCODE   U(0,54,6);
        END 
  
      BASED ARRAY   TRELARY;       # ARRAY FOR RELATION NAMES          #
        BEGIN 
        ITEM  TRELITEM  U(0,0,60);
        END 
CONTROL EJECT;                                                          008900
#----------------------------------------------------------------------#009000
      PROC  ATTS;                  # ALLOCATE TAREA TABLES             #009100
      BEGIN                                                             009200
      TAREA1 = CMM$ALF (FDBSIZE, 0, 0);  # AREA OR CATALOG FILE        #009300
      TAREA2 = CMM$ALF (FDBSIZE, 0, 0);  # INDEX FILE                  #009400
      TAREA3 = CMM$ALF (FDBSIZE, 0, 0);  # SUBSCHEMA LIB FILE          #009500
      TAREA5 = CMM$ALF (3, 0, 0);        # SUBSCHEMA NAME              #009600
      RETURN;                                                           009700
      END                                                               009800
                                                                        009900
                                                                        010000
                                                                        010100
#----------------------------------------------------------------------#010200
# PROCEDURE TO FREE AREA TABLES AND REMOVE AREA                        #
# ITEMS FROM DEFINE CHAIN                                              #
  
      PROC FTTS ((ABT));
      BEGIN                                                             010400
      ITEM  ABT U;                 # IF NZ, FREE TABLES IN ANY CASE    #010500
      ITEM DUMMY1       I;         # FOR LOOP COUNTER                  #
      ITEM LASTENTRY    I;         # PREVIOUS ENTRY                    #
      ITEM NEXT         I;         # NEXT ENTRY                        #
      ITEM THISENTRY    I;         # WORKED ON ENTRY                   #
  
      # REMOVE ALL AREA ITEMS FROM DEFINE CHAIN                        #
      P<DESATT1> = DEFLIST;        # START OF CHAIN                    #
      THISENTRY = DEFLIST;         # SAVE WORKED ON ENTRY              #
      LASTENTRY = 0;               # NO PREVIOUS ENTRY AS YET          #
      FOR DUMMY1 = 1 STEP 1        # STEP THRU CHAIN                   #
        WHILE THISENTRY NQ 0
      DO
        BEGIN 
        NEXT = DABSPTR; 
        IF C<0>DDATNAM EQ ","      # SEE IF AREA ITEM                  #
        THEN
          BEGIN 
          IF LASTENTRY EQ 0        # IF THIS IS FIRST ENTRY            #
          THEN
            BEGIN 
            DEFLIST = NEXT;        # JUST RESET POINTER                #
            END 
          ELSE
            BEGIN 
            P<DESATT1> = LASTENTRY;  # REMOVE FROM CHAIN               #
            DABSPTR = NEXT; 
            LASTENTRY = THISENTRY;
            END 
          END                      # END FOUND AREA ITEM               #
          ELSE
            BEGIN 
            LASTENTRY = THISENTRY;  # SAVE BACKWARD PTR                #
            END 
        THISENTRY = DABSPTR;       # POINT TO NEXT ENTRY               #
        P<DESATT1> = THISENTRY; 
        END                        # END FOR LOOP                      #
  
                                                                        010600
      P<TFDBARAY> = TAREA1;        # --TAREA1--                        #010700
      IF TAREA1 NQ 0                                                    010800
        AND (TFDBITEM[0] EQ 0                                           010900
        OR ABT NQ 0)                                                    011000
      THEN                                                              011100
        BEGIN                                                           011200
        CMM$FRF (TAREA1);                                               011300
        TAREA1 = 0;                                                     011400
        END                                                             011500
                                                                        011600
      P<TFDBARAY> = TAREA2;        # --TAREA2--                        #011700
      IF TAREA2 NQ 0                                                    011800
        AND (TFDBITEM[0] EQ 0                                           011900
        OR ABT NQ 0)                                                    012000
      THEN                                                              012100
        BEGIN                                                           012200
        CMM$FRF (TAREA2);                                               012300
        TAREA2 = 0;                                                     012400
        END                                                             012500
                                                                        012600
      P<TFDBARAY> = TAREA3;        # --TAREA3--                        #012700
      IF TAREA3 NQ 0                                                    012800
        AND (TFDBITEM[0] EQ 0                                           012900
        OR ABT NQ 0)                                                    013000
      THEN                                                              013100
        BEGIN                                                           013200
        CMM$FRF (TAREA3);                                               013300
        TAREA3 = 0;                                                     013400
        END                                                             013500
                                                                        013600
      P<TFDBARAY> = TAREA5;        # --TAREA5--                        #013700
      IF TAREA5 NQ 0                                                    013800
        AND (TFDBITEM[0] EQ 0                                           013900
        OR ABT NQ 0)                                                    014000
      THEN                                                              014100
        BEGIN                                                           014200
        CMM$FRF (TAREA5);                                               014300
        TAREA5 = 0;                                                     014400
        END                                                             014500
                                                                        014600
      RETURN;                                                           014700
      END                                                               014800
                                                                        014900
                                                                        015000
                                                                        015100
#----------------------------------------------------------------------#015200
  
      XDEF PROC CHKCRCD;           # *NO* IF ILLEGAL CRM/CDCS SYNTAX   #
      PROC CHKCRCD; 
      BEGIN 
      IF PRIVACYKEY NQ " "         # IF PRIVACY KEY HAS BEEN GIVEN     #
      THEN
        BEGIN 
        DIAG (537);                # -KEY- OPTION ILLEGAL WHEN ENTERING#
                                   # CRM/CDCS DATA BASE MODE           #
        STDNO;                     # ERROR RETURN                      #
        END 
  
      STDYES;                      # GOOD RETURN                       #
      END 
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     D B V C H K                                                      #
#                                                                      #
#     *DBVCHK VALIDATES THE DATABASE VERSION NAME GIVEN AS INPUT       #
#     BY THE -CREATE-, -INVOKE-, OR -VERSION- DIRECTIVE.               #
#     DBVNAME IS PRESET BY THE INITIALIZATION ROUTINES OF              #
#     -CREATE-,-INVOKE-, AND -VERSION-.                                #
#     DBVCHK CHECKS TO SEE THE NAME IS A MAXIMUM OF 7 CHAR,            #
#     CONSISTING OF A-Z, 0-9, ONLY.  IF IN CDCS CATALOG                #
#     MODE AND PROCESSING -CREATE- OR -INVOKE-, THE NAME               #
#     GIVEN MUST BE THE CURRENT NAME SET BY THE PREVIOUS               #
#     -VERSION- STATEMENT.  IF ALL TESTS ARE PASSED, THE NAME          #
#     IS SET INTO DBVNAME.                                             #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC DBVCHK; 
      PROC DBVCHK;
      BEGIN 
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
  
      VERNAME = ICW[0];            # SET CURRENT WORD TO VER.NAME      #
  
      NALPHA = FALSE;              # ASSUME CHAR IS NOT A-Z            #
      IF C<0,1>VERNAME LS "A"      # TEST LEADING CHAR                 #
        OR C<0,1>VERNAME GR "Z" 
      THEN
        BEGIN 
        NALPHA = TRUE;             # INDICATE CHAR IS NOT A-Z          #
        END 
  
      NALFNUM = FALSE;             # ASSUME CHAR IS NOT A-Z,0-9        #
      FOR TCHARPOS = 1 STEP 1      # START AT THE SECOND CHARACTER     #
        UNTIL 6                    # AND CHECK EACH CHARACTER          #
      DO
        BEGIN 
        IF C<TCHARPOS,1>VERNAME EQ " "  # IF FIND A BLANK              #
        THEN                       # NO MORE CHARS IN NAME             #
          BEGIN 
          TCHARPOS = 6;            # TERMINATE LOOP                    #
          END 
        ELSE
          BEGIN 
          IF C<TCHARPOS,1>VERNAME LS "A"
            OR C<TCHARPOS,1>VERNAME GR "9"
          THEN
            BEGIN 
            NALFNUM = TRUE;        # INDICATE CHAR IS NOT ALPHANUMERIC #
            END 
          END 
        END 
  
      IF NALFNUM                   # CHARS MUST BE ALPHANUMERIC        #
        OR NALPHA                  # FIRST CHAR MUST BE A-Z            #
        OR CURLENG GR 7            # LENGTH MUST BE 7 OR LESS          #
      THEN
        BEGIN 
        DIAG (415);                # INVALID VERSION NAME              #
        STDNO;                     # RETURN                            #
        END 
  
      IF CDCSCAT                   # IF IN CDCS CATALOG MODE           #
        AND  NOT VERDIR            # AND -INVOKE- OR -CREATE-          #
        AND VERNAME NQ DBVNAME     # INPUT NAME ISNT SAME AS CURRENT   #
      THEN
        BEGIN 
        DIAG (416);                # INVALID VERSION NAME              #
        STDNO;                     # RETURN                            #
        END 
  
      DBVNAME = VERNAME;           # ALL VALIDITY TESTS PASSED         #
  
      END                          # PROC *DBVCHK*                     #
  
      CONTROL EJECT;
  
  
#----------------------------------------------------------------------#
      XDEF PROC  INITUSE; 
      PROC       INITUSE;          # INITIALIZATION FOR -USE- DIRECTIVE#
  
        BEGIN 
                                   # SET UP THE FLAGS FOR USE IN THE   #
                                   # USE PROCESSING                    #
        USEDIR     = TRUE;         # USE DIRECTIVE                     #
        VERDIR     = FALSE; 
        INVOKE     = FALSE; 
        MODIFYFLAG = FALSE;        # MODIFY KEYWORD FOUND FLAG         #
  
        RECYES;                    # RETURN TO STDYES IF RECORDING     #
        PREDBVN = DBVNAME;         # SAVE DATABASE VERSION NAME        #
        IF NOT CDCSCAT             # IF NOT IN CDCS CATALOG MODE       #
        THEN
          BEGIN 
          DBVNAME = "MASTER";      # SET VERSION NAME TO ITS DEFAULT   #
          END                      # ELSE DBVNAME STAYS AS IT IS       #
        ATTS;                      # ALLOCATE TAREA TABLES             #015400
        STDYES;                    # RETURN   INITIALIZATION IS DONE   #
        END 
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  INITINV; 
      PROC       INITINV;          # INITIALIZATION FOR -INV- DIRECTIVE#
  
        BEGIN 
                                   # SET UP THE FLAGS FOR USE IN THE   #
                                   # USE PROCESSING                    #
        USEDIR     = TRUE;         # USE DIRECTIVE                     #
        INVOKE     = TRUE;         # TO DIFFERENTIATE BETWEEN THE USE  #
                                   # AND THE INVOKE DIRECTIVE          #
        VERDIR     = FALSE; 
        MODIFYFLAG = FALSE;        # MODIFY KEYWORD FOUND FLAG         #
        LIBFLAG = FALSE;
        RECYES;                    # RETURN TO STDYES IF RECORDING     #
        PREDBVN = DBVNAME;         # SAVE DATABASE VERSION NAME        #
        IF NOT CDCSCAT             # IF NOT IN CDCS CATALOG MODE       #
        THEN
          BEGIN 
          DBVNAME = "MASTER";      # SET VERSION NAME TO ITS DEFAULT   #
          END                      # ELSE DBVNAME STAYS AS IT IS       #
        ATTS;                      # ALLOCATE TAREA TABLES             #
        STDYES;                    # RETURN   INITIALIZATION IS DONE   #
        END 
  
  
  
#----------------------------------------------------------------------#
      XDEF PROC  INITCRE; 
      PROC       INITCRE;          # INITIALIZATION FOR -CREATE-       #
        BEGIN 
        USEDIR     = FALSE;        # SET UP THE FLAGS FOR CREATE       #
        VERDIR     = FALSE; 
        MODIFYFLAG = FALSE; 
        LIBFLAG    = FALSE; 
        RECYES;                    # RETURN TO STDYES IF RECORDING     #
        PREDBVN = DBVNAME;         # SAVE DATABASE VERSION NAME        #
        IF NOT CDCSCAT             # IF NOT IN CDCS CATALOG MODE       #
        THEN
          BEGIN 
          DBVNAME = "MASTER";      # SET VERSION NAME TO ITS DEFAULT   #
          END                      # ELSE DBVNAME STAYS AS IT IS       #
        ATTS;                      # ALLOCATE TAREA TABLES             #015600
        STDYES;                    # RETURN TO THE YES SIDE            #
        END 
  
  
  
      #----------------------------------------------------------------#
  
      XDEF PROC  ENDUSEP; 
      PROC       ENDUSEP;          # THIS PROC WILL LOAD THE 5,0       #
                                   # OVERLAY WHICH WILL CONTINUE       #
                                   # THE PROCESSING OF THE -CREATE-    #
                                   # AND THE -USE-                     #
  
        BEGIN 
        RECYES;                    # RETURN TO STDYES IF RECORDING     #
        IF IMFDBM                  # IF IMF JUST INVOKED               #
        THEN
          BEGIN 
          FTTS (1);                # FREE ALL TAREA TABLES             #
          INDEX = 3;               # MOVE TABLES DOWN FOR IMF          #
          END 
  
        ELSE                       # IF CRM OR CDCS INVOKE             #
          BEGIN 
          FTTS (0);                # FREE UNUSED TAREA TABLES          #
          INDEX = 1;               # EXECUTE *USECRM* OR *USECDCS*     #
          END 
  
        OLDKEY = KEYAREA[0];
        PRIMARY = 5;               # THE 5-0 OVERLAY                   #
        EXIT10;                    # GO DO IT  NEVER TO RETURN         #
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  ABTUSE;
      PROC       ABTUSE;           # THIS PROC WILL ABORT THE  -USE-   #
                                   # DIRECTIVE, AND RETURN CORE        #
        BEGIN 
        DIAG (869);                # ISSUE FATAL DIAGNOSTIC            #008000
        FTTS (1);                  # FREE ALL TAREA TABLES             #016000
        STDNO;                     # RETURN TO THE NO SIDE             #
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  SUBONLY; 
      PROC       SUBONLY;          # ONLY THE SUB-SCHEMA WAS GIVEN     #
  
        BEGIN 
        RECYES;                    # RETURN TO STDYES IF RECORDING     #
        CMM$FRF (TAREA3);          # RETURN THE UNUSED CORE            #
        TAREA3  = TAREA1;          # SET TO POINT TO SUB-SCHEMA FDB    #
        TAREA1  = 0;               # ZERO OUT THE OLD POINTER          #
        P<TFDBARAY> = TAREA3;      # MOVE NAME TO TAREA5, SINCE IT     #
        P<SUBSCHNAME> = TAREA5;    # IS ALSO THE SUBSCHEMA NAME        #
        FOR TCOUNT = 0 STEP 1 
          UNTIL 2 
        DO
          BEGIN 
          SBSCHNAME[TCOUNT] = TFDBITEM[TCOUNT]; 
          END 
  
        STDYES;                    # RETURN TO THE YES SIDE            #
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  SAVENAM; 
      PROC       SAVENAM;          # SAVE THE NAME OF THE AREA OR      #
                                   # RELATION                          #
  
        BEGIN 
                                   # THE NAME IS IN THE ARRAY  ICW     #
                                   # CHECK THE NAME FOR HYPHENS AND    #
                                   # MOVE IT INTO THE TEMP NAME ARRAY  #
        FOR TCOUNT = 0  STEP 1  UNTIL 3  DO 
          BEGIN 
          TNAME[TCOUNT] = 0;       # ZERO OUT THE AREA                 #
          END 
        HYPHENS  = FALSE;          # SET TO NO HYPHENS                 #
        SBNHYPHEN = FALSE;         # SET TO NO HYPHENS IN SUB-SCH NAME #
  
                                   # NOW MOVE THE CHARACTER STRING     #
                                   # CHARACTERS WILL BE CHECKED FOR    #
                                   # THE HYPHEN CODE.                  #
                                   # MOVING WILL STOP ON THE FIRST     #
                                   # BLANK CHARACTER                   #
        CURLENGSV = CURLENG;       # SAVE *CURLENG* IN CASE ERROR      # CUVSYN 
  
        FOR TWORDNUM = 0  STEP 1   DO 
          BEGIN 
          FOR TBITPOS = 0  STEP 6  UNTIL 54   DO
            BEGIN 
                                   # FETCH ONE CHARACTER               #
            TCHAR = B<TBITPOS,6>ICWI[TWORDNUM]; 
  
                                   # TEST TO SEE IF IT IS A BLANK      #
                                   # IF SO RETURN TO THE YES SIDE      #
            IF TCHAR  EQ  O"55"  THEN 
              BEGIN 
              STDYES;              # RETURN TO THE YES SIDE            #
              END 
  
                                   # TEST TO SEE IF HYPHEN             #
            IF TCHAR  EQ  O"46"   THEN
              BEGIN 
              HYPHENS = TRUE; 
              END 
  
                                   # PLACE THE CHARACTER IN THE TEMP   #
                                   # AREA FOR BULIDING THE NAME.       #
            B<TBITPOS,6>TNAME[TWORDNUM] = TCHAR;
  
            END 
          END 
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  STEMPAR; 
      PROC       STEMPAR;          # NO PERMANENT FILES PARANETERS     #
                                   # FOUND FOR THE AREA FILE.          #
                                   # THE NAME SAVED CAN BE EATHER A    #
                                   # TEMPORARY AREA NAME OR RELATION   #
  
        BEGIN 
        RECYES;                    # RETURN TO STDYES IF RECORDING     # CUVSYN 
  
        P<TFDBARAY> = TAREA1;      # SET UP TO MOVE THE NAME INTO      #
                                   # THE FIRST  TEMPORARY AREA FOR     #
                                   # HOLDING THE PARAMETERS            #
        FOR TCOUNT = 0  STEP 1  UNTIL 3  DO 
          BEGIN 
          TFDBITEM[TCOUNT] =  TNAME[TCOUNT];
          END 
        STDYES;                    # RETURN TO YES SIDE                # CUVSYN 
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  SAVEMODF;
      PROC       SAVEMODF;         # PROCESS THE -MODIFIED- DIRECTIVE  #
  
        BEGIN 
        MODIFYFLAG = TRUE;         # SET THE MODIFY FLAG               #
        STDYES; 
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  SAVEAREA;
      PROC       SAVEAREA;         # SAVE THE AREA FILE NAME           #
                                   # IT MUST BE A VALID FILE NAME      #
  
        BEGIN 
                                   # IF THE NAME HAS HYPHENS THEN      #
        IF  HYPHENS  THEN          # IT IS NOT A VALID PF NAME         #
          BEGIN 
          RESTCURW;                # RESTORE *CURWORD*                 # CUVSYN 
          DIAG(20);                # ILLEGAL FILE NAME                 #
          STDNO;
          END 
        IF NOT VERDIR              # IF NOT VERSION                    #
        THEN
          BEGIN 
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          END 
  
  
                                   # SET UP TO MOVE THE NAME TO THE    #
                                   # CORRECT TEMPORARY AREA FOR        #
                                   # HOLDING THE PERMANENT FILE PRAMS  #
                                   # ALSO MOVE THE BASED ARRAY TO THE  #
                                   # CORRECT POSITION FOR SCANPFP      #
        P<TFDBARAY> = TAREA1;      # POSITION THE ARRAY TO AREA FILE   #
        FOR TCOUNT = 0  STEP 1  UNTIL 3  DO 
          BEGIN 
          TFDBITEM[TCOUNT] =  TNAME[TCOUNT];
          END 
                                   # ALSO MOVE THE FIRST SEVEN CHARS   #
                                   # TO THE LFN  FIELD                 #
        IF  VERDIR  THEN           # CURRENT DIRECTIVE -VERSION-       #
          BEGIN 
          TFDBITEM[4] = $ZZZZZQ3$;  # YES,  USER CATALOG LFN           #
          END 
        ELSE
          BEGIN 
                                   # -CREATE- OR -USE- DIRECTIVE       #
          B<0,42>TFDBITEM[4] = B<0,42>TNAME[0]; 
          END 
        STDYES; 
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  SAVEINDX;
      PROC       SAVEINDX;         # SAVE THE INDEX FILE NAME          #
                                   # IT MUST BE A VALID FILE NAME      #
  
        BEGIN 
                                   # IF THE NAME HAS HYPHENS THEN      #
        IF  HYPHENS  THEN          # IT IS NOT A VALID PF NAME         #
          BEGIN 
          DIAG(20);                # ILLEGAL FILE NAME                 #
          STDNO;
          END 
  
        RECYES;                    # RETURN TO STDYES IF RECORDING     #
                                   # SET UP TO MOVE THE NAME TO THE    #
                                   # CORRECT TEMPORARY AREA FOR        #
                                   # HOLDING THE PERMANENT FILE PRAMS  #
                                   # ALSO MOVE THE BASED ARRAY TO THE  #
                                   # CORRECT POSITION FOR SCANPFP      #
        P<TFDBARAY> = TAREA2;      # POSITION THE ARRAY TO AREA FILE   #
        FOR TCOUNT = 0  STEP 1  UNTIL 3  DO 
          BEGIN 
          TFDBITEM[TCOUNT] =  TNAME[TCOUNT];
          END 
                                   # ALSO MOVE THE FIRST SEVEN CHARS   #
                                   # TO THE LFN  FIELD                 #
        B<0,42>TFDBITEM[4] = B<0,42>TNAME[0]; 
        IF INW[0] EQ "(" THEN      # IF PF PARAMS ARE GIVEN . . .      #
          BEGIN 
          INDEX$PFP = TRUE;        # INDEX PARAMS EXIST                #
          END 
        ELSE
          BEGIN 
          INDEX$PFP = FALSE;       # INDEX PARAMS DONT EXIST           #
          END 
        STDYES; 
        END 
                                                                         CUVSYN 
                                                                         CUVSYN 
                                                                         CUVSYN 
#----------------------------------------------------------------------# CUVSYN 
                                                                         CUVSYN 
      XDEF PROC  SAVESBLB;                                               CUVSYN 
      PROC       SAVESBLB;         # SAVE SUBSCHEMA LIBRARY NAME       # CUVSYN 
                                   # MOVE SUBSCHEMA NAME INTO TAREA5   # CUVSYN 
                                                                         CUVSYN 
      BEGIN                                                              CUVSYN 
      IF HYPHENS                   # IF NAME HAS HYPHENS, THEN IT IS   #
      THEN                         # NOT A VALID PF NAME               #
        BEGIN 
        RESTCURW;                  # RESTORE *CURWORD*                 #
        DIAG (20);                 # ILLEGAL PF NAME                   #
        STDNO;
        END 
  
      RECYES;                      # RETURN TO STDYES IF RECORDING     # CUVSYN 
      P<TFDBARAY> = TAREA3;        # SUBSCHEMA FDB ARRAY               # CUVSYN 
      FOR TCOUNT = 0 STEP 1        # MOVE SUBSCH LIB NAME INTO FDB     #
        UNTIL 2 
      DO
        BEGIN 
        TFDBITEM[TCOUNT] = TNAME[TCOUNT]; 
        END 
  
      TFDBLFN[0] = B<0,42>TNAME[0];  # PUT SUBSCH LIB NAME IN LFN FIELD# CUVSYN 
      STDYES;                                                            CUVSYN 
      END                                                                CUVSYN 
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  SAVESUB; 
      PROC       SAVESUB;          # SAVE THE SUB-SCHEMA FILE NAME     #
                                   # IT MUST BE A VALID FILE NAME      #
  
        BEGIN 
        IF HYPHENS THEN            # THE USE DIRECTIVE CANNOT BE USED  #
          BEGIN                    # IF THE SUBSCHEMA NAME DIFFERS FROM#
          IF USEDIR                # THE LIBRARY NAME.  THEREFORE, SUB-#
          AND NOT INVOKE          # SCHEMA CANNOT HAVE EMBEDDED HYPHENS#
          THEN
            BEGIN 
            RESTCURW;              # RESTORE *CURWORD*                 #
            DIAG(20);              # INVALID PERMANENT FILE NAME       #
            STDNO;
            END 
          ELSE
            BEGIN 
            SBNHYPHEN = TRUE;      # SUB-SCHEMA NAME HAS EMBEDDED *-*  #
            END 
  
          END 
  
        RECYES;                    # RETURN TO STDYES IF RECORDING     #
        P<TFDBARAY> = TAREA3;      # MOVE NAME TO TAREA3 FOR           #
                                   # SUBSCHEMA LIBRARY NAME            #
        P<SUBSCHNAME> = TAREA5;    # MOVE NAME TO TAREA5 FOR           #
                                   # SUBSCHEMA NAME                    #
        FOR TCOUNT = 0 STEP 1 
          UNTIL 2 
        DO
          BEGIN 
          TFDBITEM[TCOUNT] = TNAME[TCOUNT]; 
          SBSCHNAME[TCOUNT] = TNAME[TCOUNT];
          END 
  
        TFDBITEM[3] = 0;           # ALL DMS NAMES ARE 30 CHARS OR LESS#
                                   # ALSO MOVE THE FIRST SEVEN CHARS   #
                                   # TO THE LFN  FIELD                 #
        B<0,42>TFDBITEM[4] = B<0,42>TNAME[0]; 
        STDYES; 
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC CHKSBN; 
      PROC      CHKSBN;            # SUB-SCHEMA NAME CAN HAVE EMBEDDED #
                                   # HYPHENS IF IT IS LISTED IN THE    #
                                   # -LIB- CLAUSE, ELSE IT IS INVALID  #
  
        BEGIN 
        RECYES; 
        IF (NOT LIBFLAG) AND       # -LIB- CLAUSE IS NOT SPECIFIED    # 
           (SBNHYPHEN)             # AND NAME HAS EMBEDDED HYPHENS    # 
        THEN
          BEGIN 
          RESTCURW; 
          DIAG(20); 
          STDNO;
          END 
  
        STDYES; 
        END 
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC SAVELIB;
      PROC      SAVELIB;           # PROCESS THE -LIB- DIRECTIVE       #
  
        BEGIN 
        RECYES; 
        LIBFLAG = TRUE; 
        STDYES; 
        END 
  
  
                                                                         CUVSYN 
                                                                         CUVSYN 
                                                                         CUVSYN 
#----------------------------------------------------------------------# CUVSYN 
                                                                         CUVSYN 
      PROC RESTCURW;               # RESTORE *CURWORD*, *CURLENG*,     # CUVSYN 
                                   # AND *CURLENW* FROM THE ARRAY      # CUVSYN 
                                   # *TEMPNAME*                        # CUVSYN 
                                                                         CUVSYN 
      BEGIN                                                              CUVSYN 
      CURLENW = (CURLENGSV + 9) / 10;  # RESTORE *CURLENW*             # CUVSYN 
      CURLENG = CURLENGSV;           # RESTORE *CURLENG*               # CUVSYN 
      FOR TCOUNT = 0 STEP 1                                              CUVSYN 
      UNTIL 3                                                            CUVSYN 
      DO                                                                 CUVSYN 
        BEGIN                                                            CUVSYN 
        ICWI[TCOUNT] = TNAME[TCOUNT];                                    CUVSYN 
        END                                                              CUVSYN 
                                                                         CUVSYN 
      RETURN;                                                            CUVSYN 
      END                                                                CUVSYN 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  INITREL; 
      PROC       INITREL;          # INITIALIZATION FOR A RELATION     #
                                   # NAME LIST                         #
  
        BEGIN 
        RECYES;                    # RETURN TO STDYES IF RECORDING     #
                                   # GIVE BACK THE CORE FOR THE        #
                                   # AREA AND INDEX  FDB(S)            #
        CMM$FRF (TAREA1); 
        TAREA1 = 0; 
        CMM$FRF (TAREA2); 
        TAREA2 = 0; 
  
                                   # GET SPACE FOR THE LIST OF UP TO   #
                                   # 10 NAMES AND 1 POINTER TO THE NEXT#
                                   # LIST OF TEN NAMES IF NECESSARY    #
        TAREA4  = CMM$ALF (41,0,0); 
        TAREA4X = TAREA4;          # SET UP THE CURRENT LIST POINTER   #
        TRELINDX = 0;              # SET UP THE INDEX TO THE LIST      #
        STDYES; 
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC  SAVEREL; 
      PROC       SAVEREL;          # PLACE THE NAME IN THE TNAME INTO  #
                                   # THE ARRAY FOR SAVING RELATION     #
                                   # NAME LISTS.                       #
  
        BEGIN 
        RECYES;                    # RETURN TO STDYES IF RECORDING     #
        P<TRELARY> = TAREA4X;      # POSITION TO THE CURRENT LIST      #
        FOR TCOUNT = 0  STEP 1  UNTIL 3  DO 
          BEGIN 
          TRELITEM[TRELINDX+TCOUNT] = TNAME[TCOUNT];
          END 
                                   # UPDATE THE POINTER TO THE LIST    #
                                   # NEXT ENTRY POSITION               #
        TRELINDX = TRELINDX + 4;   # EACH ENTRY IS 4 WORDS LONG        #
                                   # TEST FOR THE END OF THIS BLOCK    #
        IF TRELINDX  EQ  40  THEN 
          BEGIN 
                                   # THIS BLOCK IS FULL.  LINK TO NEXT #
                                   # BLOCK                             #
          TRELITEM[TRELINDX] = CMM$ALF (41,0,0);   # GET NEXT BLOCK    #
  
          TAREA4X = TRELITEM[TRELINDX];  # POINT TO THIS BLOCK         #
                                         # AS THE CURRENT ONE          #
          TRELINDX = 0;            # RESET THE INDEX VALUE             #
          END 
  
        STDYES; 
        END 
  
  
  
      #----------------------------------------------------------------#
  
      XDEF PROC  CKVERDR; 
      PROC       CKVERDR;          # THIS PROC WILL CHECK TO SEE IF    #
                                   # SCANPFP WAS CALLED BY VERSION     #
  
        BEGIN 
        IF  VERDIR   THEN 
          BEGIN 
          STDYES;                  # YES CREATE DIRECTIVE ACTIVE       #
          END 
        ELSE
          BEGIN 
          STDNO;                   # NO  CREATE DIRECTIVE NOT ACTIVE   #
          END 
        END 
 CONTROL EJECT; 
      #----------------------------------------------------------------#
  
      XDEF PROC  INITPFP; 
      PROC       INITPFP;          # INITIALIZATION FOR THE SCAN OF    #
                                   # PERMANENT FILE PARAMETERS         #
  
        BEGIN 
CONTROL IFEQ  OS$NAME,SCOPE;
        FLAGID  =  FALSE;          # SET THE FLAGS TO BE USED AS A     #
        FLAGCY  =  FALSE;          # DUPLICATE CHECK                   #
        FLAGLC = FALSE; 
        FLAGMR  =  FALSE; 
        FLAGRW = FALSE; 
        FLAGSN  =  FALSE; 
        FDBINDX  =  5;             # SET INTEX TO START OF PF PARAMS   #
        TPWCODE =O"20";            # SET PASS WORD CODE TO 1ST ONE     #
CONTROL ENDIF;
  
  
CONTROL IFEQ  OS$NAME,NOS;
        FLAGUN  =  FALSE; 
        FLAGPWK =  FALSE; 
        FLAGPN  =  FALSE; 
        FLAGM   =  FALSE; 
        FLAGR = FALSE;
CONTROL ENDIF;
  
        STDYES; 
        END 
  
  
  
#----------------------------------------------------------------------#
  
      PROC CHKHYPHENS;             # CHECKS FOR ANY HYPHENS IN THE     #
                                   # FIRST TEN CHARS OF CURWORD (UP TO #
                                   # THE LENGTH OF THE TOKEN. IT IS    #
                                   # ASSUMED THAT CURLENG LQ 10). IF A #
                                   # HYPHEN IS FOUND, ITEM *HYPHENS*   #
                                   # IS SET TO TRUE, ELSE FALSE.       #
  
      BEGIN 
      HYPHENS = FALSE;             # ASSUME NO EMBEDDED HYPHENS        #
      FOR TCOUNT = 0 STEP 1        # FOR EACH CHAR POSITION            #
        UNTIL CURLENG - 1          # UP TO THE LENGTH OF CURWORD (IT   #
                                   # IS ASSUMED THAT CURLENG LQ 10).   #
      DO
        BEGIN 
        IF C<TCOUNT, 1>ICW[0] EQ "-"  # IF FOUND A HYPHEN              #
        THEN
          BEGIN 
          HYPHENS = TRUE;          # EMBEDDED HYPHENS DO EXIST         #
          RETURN; 
          END 
        END 
  
      RETURN; 
      END 
  
  
  
      #----------------------------------------------------------------#
  
      XDEF PROC  PROCID;
      PROC       PROCID;           # THIS PROC WILL CHECK AND STORE    #
                                   # THE  -ID-  PARAMETER              #
  
        BEGIN 
CONTROL IFEQ  OS$NAME,SCOPE;
                                   # TEST TO SEE IF DUPLICATE KEYWORD  #
        IF FLAGID  THEN 
          BEGIN 
          DIAG(304);               # THE  -ID-  KEYWORD WAS FOUND AGAIN#
          STDNO;
          END 
  
                                   # TEST TO SEE IF THE ID IS TOO LONG #
        IF CURLENG  GR  9  THEN 
          BEGIN 
          DIAG(185);
          STDNO;
          END 
  
        CHKHYPHENS;                # CHECK FOR HYPHENS IN CURWORD      #
        IF HYPHENS                 # IF EMBEDDED HYPHENS EXISTED       #
        THEN
          BEGIN 
          DIAG(215, "ID");         # DIAGNOSE HYPHENS ILLEGAL IN PARAM #
          STDNO;                   # BAD RETURN                        #
          END 
  
                                   # SO FAR THE ID IS VALID            #
        FLAGID = TRUE;             # *ID* HAS BEEN PROCESSED           #
        TFDBITEM[FDBINDX] = O"14"; # SET IN THE  -ID-  CODE            #
                                   # MOVE IN THE PARAMETER             #
        C<9 - CURLENG,CURLENG>TFDBITEM[FDBINDX] = C<0,CURLENG>ICW[0]; 
        ADDFDBINDX;                # INCREASE THE INDEX VALUE AND CHECK#
  
        STDYES; 
CONTROL ENDIF;
  
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC   PROCUN; 
      PROC        PROCUN;          # THIS PROC WILL CHECK AND STORE    #
                                   # THE  -UN- PARAMETER FOR NOS       #
  
        BEGIN 
  
CONTROL IFEQ  OS$NAME,NOS;
        IF FLAGUN  THEN            # TEST TO SEE IF DUPLICATE KEYWORD  #
          BEGIN 
          DIAG (304);              # THE  -UN-  KEYWORD WAS FOUND AGAIN#
          STDNO;                   # RETURN TO THE NO SIDE             #
          END 
  
        IF CURLENG  GR  7  THEN    # IS THE NAME TOO LONG              #
          BEGIN 
          DIAG (247);              # YES, NAME IS TOO LONG             #
          STDNO;                   # RETURN TO THE NO SIDE             #
          END 
        CHKHYPHENS;                # CHECK FOR HYPHENS IN CURWORD      #
        IF HYPHENS                 # IF EMBEDDED HYPHENS EXISTED       #
        THEN
          BEGIN 
          DIAG(215, "UN");         # DIAGNOSE HYPHENS ILLEGAL IN PARAM #
          STDNO;                   # BAD RETURN                        #
          END 
  
  
                                   # VALID SO SAVE THE CHAR STRING     #
        FLAGUN = TRUE;             # *UN* HAS BEEN PROCESSED           #
        TFDBITEM[5] = O"14";       # STORE PF ID CODE FOR UN PARAMETER #
        C<0,CURLENG>TFDBITEM[5] = C<0,CURLENG>ICW[0]; 
        STDYES;                    # RETURN TO THE YES SIDE            #
CONTROL ENDIF;
  
        END 
  
  
  
      #----------------------------------------------------------------#
  
      XDEF PROC  PROCCY;
      PROC       PROCCY;           # THIS PROC WILL CHECK AND STORE    #
                                   # THE  -CY-  PARAMETER              #
        BEGIN 
  
CONTROL IFEQ  OS$NAME,SCOPE;
  
                                   # TEST TO SEE IF DUPLICATE KEYWORD  #
        IF FLAGCY  THEN 
          BEGIN 
          DIAG(304);               # THE  -CY-  KEYWORD WAS FOUND AGAIN#
          STDNO;
          END 
  
                                   # CHECK TO SEE IF VALID CY NUMBER   #
        IF ICW[5]  GR  999  THEN   # NOTE CELL 5 HAS BINARY CY NUMBER  #
          BEGIN 
          DIAG(186);
          STDNO;
          END 
  
                                   # VALID TO HERE,  STORE THE CY NUM  #
        FLAGCY = TRUE;             # *CY* HAS BEEN PROCESSED           #
        TFDBITEM[FDBINDX] = O"03";  # SET IN THE CODE FOR CY           #
        B<0,54>TFDBITEM[FDBINDX] = ICW[5];
        ADDFDBINDX;                # INCREASE THE INDEX VALUE AND CHECK#
  
        STDYES; 
CONTROL ENDIF;
  
        END 
  
  
  
      #----------------------------------------------------------------#
  
      XDEF PROC  PROCPW;
      PROC       PROCPW;           # THIS PROC WILL CHECK AND STORE    #
                                   # THE  -PW-  PARAMETERS UP TO  5    #
  
        BEGIN 
CONTROL IFEQ  OS$NAME,SCOPE;
  
                                   # TEST TO SEE IF THERE IS ROOM FOR  #
                                   # ANOTHER PW PARAMETER              #
        IF TPWCODE  GR  O"24"  THEN 
          BEGIN 
          DIAG(145);
          STDNO;
          END 
  
                                   # TEST FOR PASS WORD TOO LONG       #
        IF CURLENG  GR  9  THEN 
          BEGIN 
          DIAG(145);
          STDNO;
          END 
  
        CHKHYPHENS;                # CHECK FOR HYPHENS IN CURWORD      #
        IF HYPHENS                 # IF EMBEDDED HYPHENS EXISTED       #
        THEN
          BEGIN 
          DIAG(215, "PW");         # DIAGNOSE HYPHENS ILLEGAL IN PARAM #
          STDNO;                   # BAD RETURN                        #
          END 
  
                                   # SO FAR VALID,  STORE IT AWAY      #
      TFDBITEM[FDBINDX] = TPWCODE;  # SET IN THE PW CODE FIRST         #
        TPWCODE = TPWCODE + 1;     # UPDATE THE PASS WORD CODE         #
                                   # MOVE IN THE PASS WORD PARAMETER   #
        C<9-CURLENG,CURLENG>TFDBITEM[FDBINDX] = C<0,CURLENG>ICW[0]; 
        ADDFDBINDX;                # INCREASE AND TEST THE INDEX       #
  
        STDYES; 
CONTROL ENDIF;
  
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC   PROCPWK;
      PROC        PROCPWK;         # THIS PROC WILL CHECK AND STORE    #
                                   # THE  -PW-  PARAMETER FOR NOS      #
        BEGIN 
  
CONTROL IFEQ  OS$NAME,NOS;
        IF FLAGPWK  THEN           # TEST TO SEE IF DUPLICATE KEYWORD  #
          BEGIN 
          DIAG (304);              # THE  -PW-  WAS FOUND AGAIN        #
          STDNO;                   # RETURN TO THE NO SIDE             #
          END 
  
        IF CURLENG  GR  7  THEN    # IS THE NAME TOO LONG              #
          BEGIN 
          DIAG (248);              # YES, TOO LONG                     #
          STDNO;                   # RETURN TO THE NO SIDE             #
          END 
  
        CHKHYPHENS;                # CHECK FOR HYPHENS IN CURWORD      #
        IF HYPHENS                 # IF EMBEDDED HYPHENS EXISTED       #
        THEN
          BEGIN 
          DIAG(215, "PW");         # DIAGNOSE HYPHENS ILLEGAL IN PARAM #
          STDNO;                   # BAD RETURN                        #
          END 
  
                                   # VALID SO SAVE THE CHAR STRING     #
        FLAGPWK = TRUE;            # NOS *PW* HAS BEEN PROCESSED       #
        TFDBITEM[6] = O"20";       # STORE PF ID CODE FOR PW PARAMETER #
        C<0,CURLENG>TFDBITEM[6] = C<0,CURLENG>ICW[0]; 
        STDYES; 
  
CONTROL ENDIF;
  
        END 
  
  
  
      #----------------------------------------------------------------#
  
      XDEF PROC  PROCSN;
      PROC       PROCSN;           # THIS PROC WILL CHECK AND STORE    #
                                   # THE  -SN-  PARAMETER              #
  
        BEGIN 
  
CONTROL IFEQ  OS$NAME,SCOPE;
                                   # TEST TO SEE IF DUPLICATE KEYWORD  #
        IF FLAGSN  THEN 
          BEGIN 
          DIAG(304);
          STDNO;
          END 
  
                                   # CHECK TO SEE IF THE NAME TOO LONG #
        IF CURLENG GR 7 
        THEN
          BEGIN 
          DIAG(250);
          STDNO;
          END 
  
        CHKHYPHENS;                # CHECK FOR HYPHENS IN CURWORD      #
        IF HYPHENS                 # IF EMBEDDED HYPHENS EXISTED       #
        THEN
          BEGIN 
          DIAG(215, "SN");         # DIAGNOSE HYPHENS ILLEGAL IN PARAM #
          STDNO;                   # BAD RETURN                        #
          END 
  
        FLAGSN = TRUE;             # *SN* HAS BEEN PROCESSED           #
                                   # SO FAR  VALID  STORE IT           #
        TFDBITEM[FDBINDX] = O"40"; # SET THE  -SN-  CODE               #
        C<0,CURLENG>TFDBITEM[FDBINDX] = C<0,CURLENG>ICW[0]; 
        ADDFDBINDX;                # INCREASE AND CHECK THE INDEX      #
  
        STDYES; 
CONTROL ENDIF;
  
        END 
  
  
  
      #----------------------------------------------------------------#
  
      XDEF PROC  PROCR; 
      PROC       PROCR;            # THIS PROC WILL CHECK AND STORE    #
                                   # THE  -R-  PARAMETER               #
  
        BEGIN 
CONTROL IFEQ  OS$NAME,NOS;
  
        IF FLAGR                   # TEST TO SEE IF DUPLICATE KEYWORD  #
        THEN
          BEGIN 
          DIAG  (304);             # THE  -R-  PARAMETER FOUND AGAIN   #
          STDNO;                   # RETURN TO THE NO SIDE             #
          END 
  
        IF CURLENG GR 3 
          OR CURLENG LS 2 
        THEN
          BEGIN                    # *R* PARAM MUST BE 2 OR 3 CHARS    #
          DIAG(292);               # INVALID DEVICE SPECIFICATION      #
          STDNO;
          END 
  
        CHKHYPHENS;                # CHECK FOR HYPHENS IN CURWORD      #
        IF HYPHENS                 # IF EMBEDDED HYPHENS EXISTED       #
        THEN
          BEGIN 
          DIAG(215, "R ");         # DIAGNOSE HYPHENS ILLEGAL IN PARAM #
          STDNO;                   # BAD RETURN                        #
          END 
  
        UNITNO = 0;                # PRESET UNIT NUMBER                #
        IF CURLENG EQ 3 
        THEN
          BEGIN 
          UNITNO  = B<12,6>ICWI[0] - O"33" ; # CONVERT TO OCTAL        #
          IF UNITNO LQ 0
            OR UNITNO GR 8         # IF INVALID UNIT NUMBER            #
          THEN
            BEGIN 
            DIAG(292);             # INVALID DEVICE SPECIFICATION      #
            STDNO;                 # BAD RETURN                        #
            END 
          END 
  
        FLAGR  = TRUE;
        TFDBCODE[9] = O"41";       # SAVE CODE FOR *R* IN FDB          #
        B<0,12>TFDBPRAM[9] = B<0,12>ICWI[0] ; 
        B<12,6>TFDBPRAM[9] = UNITNO ; 
        ADDFDBINDX; 
        STDYES; 
  
CONTROL ENDIF;
  
        END 
#----------------------------------------------------------------------#
  
      XDEF PROC   PROCPN; 
      PROC        PROCPN;          # THIS PROC WILL CHECK AND STORE    #
                                   # THE  -PN-  PARAMETER FOR NOS      #
        BEGIN 
  
CONTROL IFEQ  OS$NAME,NOS;
        IF FLAGPN  THEN            # TEST TO SEE IF DUPLICATE KEYWORD  #
          BEGIN 
          DIAG (304);              # THE  -PN-  PARAMETER FOUND AGAIN  #
          STDNO;                   # RETURN TO THE NO SIDE             #
          END 
  
        IF CURLENG  GR  7  THEN    # IS THE NAME TOO LONG              #
          BEGIN 
          DIAG (291);              # YES, NAME IS TOO LONG             #
          STDNO;
          END 
        CHKHYPHENS;                # CHECK FOR HYPHENS IN CURWORD      #
        IF HYPHENS                 # IF EMBEDDED HYPHENS EXISTED       #
        THEN
          BEGIN 
          DIAG(215, "PN");         # DIAGNOSE HYPHENS ILLEGAL IN PARAM #
          STDNO;                   # BAD RETURN                        #
          END 
  
        FLAGPN = TRUE;             # *PN* HAS BEEN PROCESSED           #
                                   # VALID SO SAVE THE CHAR STRING     #
        TFDBITEM[8] = O"40";       # STORE PF ID CODE FOR PN PARAMETER #
        C<0,CURLENG>TFDBITEM[8] = C<0,CURLENG>ICW[0]; 
        STDYES; 
CONTROL ENDIF;
  
        END 
  
  
  
      #----------------------------------------------------------------#
  
      XDEF PROC  PROCMR;
      PROC       PROCMR;           # THIS PROC WILL CHECK AND STORE    #
                                   # THE  -MR-  PARAMETER              #
  
        BEGIN 
CONTROL IFEQ  OS$NAME,SCOPE;
  
                                   # TEST TO SEE IF DUPLICATE KEYWORD  #
        IF FLAGMR  THEN 
          BEGIN 
          DIAG(304);               # THE -MR- KEYWORD WAS FOUND AGAIN#
          STDNO;
          END 
  
        FLAGMR = TRUE;             # THIS IS THE FIRST TIME,  SET FLAG #
        TFDBITEM[FDBINDX] = O"11"; # SET THE  -MR-  CODE IN THE FDB    #
        C<9-CURLENG,CURLENG>TFDBITEM[FDBINDX] = C<0,CURLENG>ICW[0]; 
        ADDFDBINDX;                # INCREASE AND CHECK THE INDEX      #
        STDYES; 
CONTROL ENDIF;
  
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC   PROCM;
      PROC        PROCM;           # THIS PROC WILL CHECK AND STORE    #
                                   # THE  -M-  PARAMETER FOR NOS       #
        BEGIN 
  
CONTROL IFEQ  OS$NAME,NOS;
  
        IF FLAGM  THEN             # TEST TO SEE IF DUPLICATE KEYWORD  #
          BEGIN 
          DIAG (304);              # THE  -M- WAS FOUND AGAIN          #
          STDNO;                   # RETURN TO THE NO SIDE             #
          END 
  
        FLAGM  = TRUE;             # FIRST TIME,  SET THE FLAG         #
        TPWCODE = 0;
        IF ICW[0]  EQ  "W"  THEN   # LOOK FOR WRITE MODE               #
          BEGIN 
          TPWCODE = O"40";         # FOUND WRITE MODE                  #
          END 
  
        IF ICW[0]  EQ  "R"  THEN   # LOOK FOR READ MODE                #
          BEGIN 
          TPWCODE = O"41";         # FOUND READ MODE                   #
          END 
  
        IF ICW[0]  EQ  "M"  THEN   # LOOK FOR MODIFY                   #
          BEGIN 
          TPWCODE = O"45";         # FOUND MODIFY MODE                 #
          END 
  
        IF ICW[0]  EQ  "RM"  THEN  # LOOK FOR READ MODIFY              #
          BEGIN 
          TPWCODE = O"46";         # FOUND READ MODIFY MODE            #
          END 
  
        IF ICW[0]  EQ  "RA"        # LOOK FOR READ APPEND              # QU30283
        THEN                                                             QU30283
          BEGIN                                                          QU30283
          TPWCODE = O"47";         # FOUND READ APPEND MODE            # QU30283
          END                                                            QU30283
                                                                         QU30283
        IF TPWCODE  EQ  0  THEN    # DID WE FIND A VALID  -R- -W-      #
          BEGIN 
          DIAG (303);              # ILLEGAL PARAMETER FOR *M* KEYWORD #
          STDNO;                   # RETURN TO THE NO SIDE             #
          END 
  
        TFDBITEM[7] = O"30";       # STORE PF ID CODE FOR M  PARAMETER #
        TFDBPRAM[7] = TPWCODE;     # STORE -M- PARAMETER               #
        STDYES;                    # RETURN TO THE YES SIDE            #
CONTROL ENDIF;
  
        END 
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C L C                                                      #
#                                                                      #
#     THIS PROCEDURE PROCESSES THE LOW-CYCLE PARAMETER (LC).           #
  
      XDEF PROC PROCLC; 
      PROC PROCLC;
      BEGIN 
CONTROL IFEQ OS$NAME,SCOPE; 
  
      IF FLAGLC                    # IF *LC* ALREADY PROCESSED         #
      THEN
        BEGIN 
        DIAG(304);                 # DIAGNOSE DUPLICATE PF PARAMETER   #
        STDNO;                     # BAD RETURN                        #
        END 
  
      FLAGLC = TRUE;               # FLAG *LC* AS PROCESSED            #
      TFDBCODE[FDBINDX] = O"31";   # CODE FOR *LC* IN FDB              #
      TFDBPRAM[FDBINDX] = ICWI[5];  # INSERT SPECIFIED INTEGER VALUE   #
      ADDFDBINDX;                  # INCREMENT *FDBINDEX*              #
      STDYES; 
CONTROL ENDIF;
  
      END 
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C R W                                                      #
#                                                                      #
#     THIS PROCEDURE PROCESSES THE *RW* PARAMETER                      #
  
      XDEF PROC PROCRW; 
      PROC PROCRW;
      BEGIN 
CONTROL IFEQ OS$NAME,SCOPE; 
  
      IF FLAGRW                    # IF *RW* ALREADY PROCESSED         #
      THEN
        BEGIN 
        DIAG(304);                 # DIAGNOSE DUPLICATE PF PARAMETER   #
        STDNO;                     # BAD RETURN                        #
        END 
  
      FLAGRW = TRUE;               # FLAG *RW* AS PROCESSED            #
      TFDBCODE[FDBINDX] = O"33";   # CODE FOR *RW* IN FDB              #
      TFDBPRAM[FDBINDX] = ICWI[5];  # INSERT SPECIFIED INTEGER VALUE   #
      ADDFDBINDX;                  # INCREMENT *FDBINDX*               #
      STDYES; 
CONTROL ENDIF;
  
      END 
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C D F L                                                    #
#                                                                      #
# THIS PROC IS INVOKED WHEN NO PF PARAMETER IS GIVEN FOR NOS.  BY      #
# DEFAULT, WE PRETEND THE USER SPECIFIED "M=R".  THE USER"S USER       #
# NUMBER WILL BE USED BY DEFAULT SINCE "UN" WAS NOT SPECIFIED.         #
  
      XDEF PROC PROCDFL;
      PROC      PROCDFL;           # PROCESS DEFAULT PF PARAMETER CASE #
      BEGIN 
  
 CONTROL IFEQ OS$NAME,NOS;
  
      TFDBPRAM[7] = O"41";         # INDICATE READ MODE IN FDB         #
      STDYES;                      # RETURN TO YES SIDE                #
  
 CONTROL ENDIF; 
  
      END   # PROCDFL # 
  
  
  
  
      #----------------------------------------------------------------#
  
      PROC       ADDFDBINDX;       # PROC TO INCREASE THE INDEX INTO   #
                                   # THE FDB AREA.  IF TOO MANY        #
                                   # PERMANENT FILE PRAMETERS ARE      #
                                   # FOUNT THE USE WILL BE ABORTED     #
  
        BEGIN 
        FDBINDX = FDBINDX +1; 
        IF FDBINDX  GR  15  THEN
        IF FDBINDX GQ FDBSIZE - 1  # IF WOULD USE LAST TWO WORDS (SAVED#
                                   # FOR USE BY ATTACHF).              #
        THEN
          BEGIN 
          DIAG(187);
          STDNO;
          END 
        END 
 CONTROL EJECT; 
#----------------------------------------------------------------------#
  
      XDEF PROC  INITVER; 
      PROC       INITVER;          # INITIALIZE FOR -VERSION- DIRECTIVE#
  
        BEGIN 
        CURREPT = " ";             # CLEAR CURRENT REPORT NAME         #
        VERDIR  = TRUE;            # -VERSION- DIRECTIVE CURRENT ONE   #
        MODIFYFLAG = FALSE;                                             016300
        LIBFLAG    = FALSE; 
        PREDBVN = DBVNAME;         # SAVE DATABASE VERSION NAME        #
        DBVNAME = "MASTER";        # DBVNAME ALWAYS SET TO DEFAULT     #
        ATTS;                      # ALLOCATE TAREA TABLES             #016400
        STDYES;                    # INITIALIZATION IS DONE            #
        END 
  
  
  
#----------------------------------------------------------------------#
  
      PROC        CLOSECAT; 
        BEGIN 
        AUTOPSY;                   # CALL 1,0 CATALOG FILE CLEANUP     #
        IF PFCATAL  THEN           # IS THE CATALOG FILE PERMANENT     #
          BEGIN 
          RETURNM (CATAFIT, RA0);  # RETURN THE FILE                   #
          PFCATAL  = FALSE;        # FILE NOT PERMANENT                #
          END 
  
        P<FIT> = LOC(CATAFIT);                                           CUVESYN
        FITES = 0;                                                       CUVESYN
        FITFNF = FALSE;            # CLEAR OUTSTANDING FATAL ERROR FLAG#
        FITOC = 0;                                                       CUVESYN
        FITPD = 0;                                                       CUVESYN
        FITBN = 0;                                                       CUVESYN
        FITFP = 0;                                                       CUVESYN
        FITLOP = 0;                                                      CUVESYN
        FITCDT = 0;                #JUST CLEARED FOR SUPERSTITION      # CUVESYN
        FITDCT = 0;                                                      CUVESYN
        FITHRL = 0;                                                      CUVESYN
        RETURN; 
        END 
  
  
  
#----------------------------------------------------------------------#
  
      XDEF PROC   ABTVER; 
      PROC        ABTVER; 
  
        BEGIN 
        CLOSECAT;                  # CLOSE/RETURN CURRENT CATALOG      #
        DIAG (914); 
        PFCATAL     = FALSE;       # DEFAULT CATALOG IN EFFECT         #
        PERMI       = TRUE;        # HAVE PERMISSIONS ON DEFAULT CATALG#
        VERSTL      = MXTRNLG;     # DEFAULT TL OF CATALOG FILE        #
        P<FIT> = LOC(CATAFIT);                                           CUVESYN
        C<0,7>FITLFN = "ZZZZZQ2";  #DEFAULT CATALOG LFN                # CUVESYN
        FITOC = 0;                 #SET TO FILE NEVER OPENED           # CUVESYN
        FITES = 0;                 #CLEAR THE ERROR FIELD              # CUVESYN
        FTTS (1);                  # FREE ALL TAREA TABLES             #016700
        STDNO;                     # RETURN TO THE -NO- SIDE           #016800
        END 
  
  
*CALL  ATTACHF
*CALL  PFDIAG 
      END 
      TERM
