*DECK OPNCAT
USETEXT TCLFN 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TFIT
USETEXT TXSTD 
      PROC OPNCAT(P$FIT, PD, ORC);
#----------------------------------------------------------------------#
#                                                                      #
#      THIS ROUTINE OPENS THE SPECIFIED CATALOG FILE, DOING ONLY THE   #
# WORK THAT IS NECESSARY. THE RULES COVERING HOW THIS PROC IS CALLED   #
# ARE GIVEN IN THE IMS.                                                #
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
      ITEM AFANSWER  C(1);         # ANSWER TO WHETHER TO ACCEPT       #
                                   # UPDATED UNCLOSED FILE             #
      ITEM P$FIT        I;         # PARAMETER FIT                     #
      ITEM PD           I;         # REQUESTED PROCESSING DIRECTION    #
      ITEM ORC          I;         # OPNCAT RETURN CODE                #
                                   #   0 - SUCCESSFUL OPEN             #
                                   #   1 - ATTEMPT TO READ A NONEXIST- #
                                   #       ANT DEFAULT CATALOG.        #
                                   #   2 - CRM OR OTHER ERROR          #
  
  
  
  
  
      XREF ITEM AFPROCESSED B;     # TRUE IF UPDATED UNCLOSED FILE IS  #
                                   # ACCEPTABLE                        #
      XREF ITEM CDCSCAT  B;        # TRUE IF IN CDCS CATALOG MODE      #
      XREF ITEM DEFCAT       B;    # TRUE IF DEFAULT CATALOG EXISTS    #
      XREF ITEM FORTCOL      I;    # FORTRAN COLLATING SEQUENCE        #
      XREF ITEM IPROCESSED  B;     # FALSE IF INTERACTIVE              #
      ITEM LASTREC      C(20) = "0999999999";  # RECORD IMAGE OF THE   #
                                               # LAST RECORD OF ZZZZZQ2#
      XREF ITEM MODCAT       B;    # TRUE IF CATALOG FILE WAS MODIFIED #
                                   # SINCE LAST CLOSE                  #
      XREF ITEM MXTRNLG      I;    # MAXIMUM TRANSMISSION LENGTH       #
      XREF ITEM RA0          I;    # LOCATION OF ZERO FOR PARAM LISTS  #
      ITEM CMODE  B;               # TRUE IF CATALOG IS CDCS MODE      #
      ITEM TCOUNT       I;         #                                   #
      ITEM TEMP         I;         # DUMMY VARIABLE FOR *READ* CALL    #
      ITEM TEMPTR       I;         # TEMP PTR TO QUIWSA, KEYWSA        #
  
  
      XREF PROC CATCHK;            # CALL PROPER CATALOG-ACCESSING PROC#
      XREF PROC CLOSEM;            # CRM ROUTINE TO CLOSE A FILE       #
      XREF PROC CMOVE;             # CHARACTER MOVE ROUTINE            #
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC MESSAGE TO USER  #
      XREF PROC OPENM;             # CRM ROUTINE TO OPEN A FILE        #
      XREF PROC PUT;               # CRM ROUTINE TO INSERT A RECORD    #
      XREF PROC READ;              # READ A TRANSMISSION FROM INPUT    #
      XREF PROC REQPF;             # DOES REQUEST,FIT,*PF,SN. (NOS/BE) #
      XREF PROC RETURNM;           # CRM RETURN OF FILE                #
  
      DEF UPDATED    # O"52" #;    # CRM ERROR CODE INDICATING FILE NOT#
                                   # CLOSED SINCE LAST UPDATE          #
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     C R E A C A T                                                    #
#                                                                      #
# DOES THE INITIALIZATION OF THE DEFAULT CATALOG FILE, ZZZZZQ2. THE    #
# FILE IS REQUESTED TO RESIDE ON A *PF DEVICE (NOS/BE ONLY) AFTER THE  #
# LFN HAS BEEN RETURNED (IN CASE ANOTHER EXISTED). THEN THE FILE IS    #
# OPENED *NEW*, AND A RECORD IS INSERTED THAT WILL OCCUR AS THE LAST   #
# RECORD IN THE CATALOG FILE. THIS RECORD HAS A SESSION NAME OF 999999 #
# AND A TRANSMISSION ID OF 999. THUS, A KEY OF 0999999999. THIS IS FOL-#
# LOWED BY 10 CHARACTERS OF BLANKS.  IF THE OPEN OF THE FILE FAILS DUE #
# LACK OF CRM ORG=NEW CODE, WE SWITCH TO ORG=OLD AND TRY AGAIN.        #
  
      PROC CREACAT(P$FIT, CRC); 
      BEGIN 
      ITEM P$FIT        I;         # PARAMETER FIT                     #
      ITEM CRC          I;         # CREACAT RETURN CODE               #
                                   #   0 - SUCCESSFUL OPEN             #
                                   #   2 - CRM OR OTHER ERROR          #
  
  
  
  
  
      P<FIT> = LOC(P$FIT);         # POSITION TO PARAMETER FIT         #
      FITMRL = MXTRNLG + 10;       # MRL IS TL PLUS 10 CHAR KEY        #
      RETURNM(FIT, RA0);           # RETURN ANY EXISTING LFN           #
      REQPF(FIT, ORC);             # REQUEST,FITLFN,*PF,SN. (NOS/BE)   #
      CRC = 0;                     # ASSUME SUCCESSFUL OPEN            #
      FITDCT = LOC(FORTCOL);       # SELECT FORTRAN COLLATING SEQ.     #
      FITON = TRUE;                # TRUE THIS IS OPEN NEW             #
      FITORG = TRUE;               # TRY FOR *ORG=NEW* CATALOG         #
      FITPD = PD$IO;               # WILL OPEN FOR I/O                 #
      OPENM(FIT, RA0);             # INITIAL OPEN ON DEFAULT CATALOG   #
      FITON = FALSE;               # CLEAR *OPEN,NEW* INDICATOR        #
      IF FITES EQ CAPNOTLOADED     # IF ORG = NEW NOT AVAILABLE        #
      THEN
        BEGIN 
        FITON = TRUE;              # TRUE THIS IS OPEN,NEW             #
        FITORG = FALSE;            # FORCE ORG = OLD                   #
        OPENM(FIT, RA0);           # TRY TO OPEN AGAIN                 #
        FITON = FALSE;             # CLEAR *OPEN,NEW* INDICATOR        #
        IF FITES NQ 0              # IF ANY CRM ERROR                  #
        THEN
          BEGIN 
          DIAG(105, FITES, C<0,7>FITLFN);  # DIAGNOSE CRM ERROR CODE   #
          CRC = 2;                 # RETURN CODE - CRM ERROR           #
          RETURN; 
          END 
  
        CLOSEM(FIT, RA0);          # TO GET OUT OF CREATION MODE       #
        OPENM(FIT, RA0);           # OPEN FOR REAL THIS TIME           #
        END 
  
      IF FITES NQ 0                # IF ANY CRM ERROR                  #
      THEN
        BEGIN 
        DIAG(105, FITES, C<0,7>FITLFN);  # DIAGNOSE CRM ERROR          #
        CRC = 2;                   # RETURN CODE - CRM ERROR           #
        RETURN; 
        END 
  
      PUT(FIT, LASTREC, 20, LASTREC, RA0);  # PUT THE LAST RECORD      #
      IF FITES NQ 0                # IF ANY CRM ERROR                  #
      THEN
        BEGIN 
        DIAG(105, FITES, C<0,7>FITLFN);  # DIAGNOSE CRM ERROR          #
        CRC = 2;                   # RETURN CODE - CRM ERROR           #
        RETURN; 
        END 
  
      DEFCAT = TRUE;               # DEFAULT CATALOG INITIALIZED       #
      MODCAT = TRUE;               # CATALOG FILE WAS MODIFIED         #
      RETURN; 
      END 
  
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     HERE BEGINS THE CODE OF    O P N C A T                           #
  
  
      BEGIN 
      ORC = 0;                     # ASSUME GOOD OPEN                  #
      P<FIT> = LOC(P$FIT);         # POSITION TO THE PASSED FIT        #
  
      IF C<0,7>FITLFN EQ "ZZZZZQ2"   # IF ACCESSING DEFAULT CATALOG    #
      THEN
        BEGIN 
        CMODE = FALSE;             # CATALOG FILE IS CRM               #
        END 
      ELSE                         # IF VERSION CATALOG                #
        BEGIN 
        CMODE = CDCSCAT;           # ITS MODE IS IN *CDCSCAT*          #
        END 
  
      IF FITOC EQ OC$OPEN          # IF FILE IS ALREADY OPEN           #
        AND FITPD EQ PD$IO         # AND THE PD IS THE MAXIMUM         #
      THEN
        BEGIN 
        RETURN;                    # GOOD RETURN - ALREADY HAVE IT     #
        END 
  
      IF FITOC EQ OC$OPEN          # IF FILE IS ALREADY OPEN           #
        AND FITPD NQ PD            # AND WITH THE WRONG PD             #
      THEN
        BEGIN 
        CATCHK (CLOSE, P<FIT>, CMODE);   # CLOSE TO RELEASE CRM MODULES#
        END 
  
      IF FITOC EQ OC$OPEN          # IF FIT ALREADY OPEN               #
      THEN
        BEGIN 
        RETURN;                    # GOOD RETURN - ALREADY HAVE IT     #
        END 
  
      IF FITOC EQ OC$CLOSED        # IF FILE CLOSED (ERGO IT WAS OPEN) #
      THEN
        BEGIN 
        IF FITORG                  # IF ORG = NEW CATALOG FILE         #
        THEN
          BEGIN 
          FITPD = PD$IO;           # ALWAYS REQUEST I/O AS PD          #
          END 
  
        ELSE
          BEGIN 
          FITPD = PD;              # STORE REQUESTED PD                #
          END 
  
        CATCHK (OPEN, P<FIT>, CMODE);  # OPEN WITH REQUESTED PD        #
  
        IF FITES EQ UPDATED        # FILE NOT CLOSED SINCE LAST UPDATE #
        THEN
          BEGIN 
          DIAG (821, FITLFNC);     # INFORM THAT ERROR OCCURRED        #
          IF AFPROCESSED           # USER CHOSE TO ACCEPT FILE         #
          THEN
            BEGIN 
            DIAG (1017);           # INFORM THAT FILE ACCEPTED         #
            FITES = 0;             # OVERRIDE THE ERROR                #
            END 
          ELSE
            BEGIN 
            IF NOT IPROCESSED      # IF INTERACTIVE AND *AF* NOT CHOSEN#
            THEN
              BEGIN 
              DIAG (1016);         # ASK IF SHOULD ACCEPT FILE         #
              READ (AFANSWER, TEMP, 1, TEMP); 
              IF AFANSWER EQ "Y"   # IF ANSWER IS YES                  #
              THEN
                BEGIN 
                FITES = 0;         # CLEAR THE ERROR                   #
                END                # OTHERWISE WILL BE PROCESSED AS    #
              END                  # ANY OTHER ERROR                   #
            END 
          END 
  
        IF FITES NQ 0              # IF SOME CRM ERROR                 #
        THEN
          BEGIN 
          IF FITES NQ UPDATED      # DIAG FOR 52B ALREADY GIVEN        #
          THEN
            BEGIN 
            DIAG (105, FITES, FITLFNC);  # DIAGNOSE CRM ERROR CODE     #
            END 
          ORC = 2;                 # RETURN CODE - CRM ERROR           #
          END 
  
        RETURN; 
        END 
  
      IF NOT DEFCAT                # IF DEFAULT CATALOG UNINITIALIZED  #
      THEN
        BEGIN 
        IF C<0,7>FITLFN EQ "ZZZZZQ2"  # IF DEFAULT CATALOG TO BE OPENED#
        THEN
          BEGIN 
          IF PD EQ PD$INPUT        # IF OPENING TO READ                #
          THEN
            BEGIN 
            ORC = 1;               # ATTEMPT TO READ DEFAULT CATALOG   #
                                   # THAT DOES NOT YET EXIST.          #
            RETURN; 
            END 
  
          CREACAT(FIT, ORC);       # CREATE THE DEFAULT CATALOG        #
          IF ORC NQ 0              # IF SOME ERROR PREVENTED OPENING   #
          THEN
            BEGIN 
            ORC = 2;               # RETURN CODE - SOME ERROR          #
            END 
  
          RETURN; 
          END 
        END 
  
      FITFO = FOIS;                # FORCE FO = IS                     #
      IF NOT CMODE                 # IF IN CRM CATALOG MODE            #
       THEN 
        BEGIN 
        FITMRL = 0;                # FORCE MRL TO ZERO SO CRM WILL     #
                                   # RETURN THE MRL AS READ FROM FSTT  #
        END 
      IF FITORG                    # IF ORG = NEW                      #
      THEN
        BEGIN 
        FITPD=PD$IO;               # ALWAYS REQUEST I/O FOR ORG = NEW  #
        END 
      ELSE
        BEGIN 
        FITPD = PD;                # STORE REQUESTED PD                #
        END 
      CATCHK (OPEN, P<FIT>, CMODE);  # OPEN WITH REQUESTED PD          #
      IF FITES EQ CAPNOTLOADED     # IF NO CRM CAPSULE FOR ORG = NEW   #
        OR FITES EQ FSTTREADERR    # OR ERR IN READING FSTT. THIS COULD#
                                   # BE AN ORG=OLD CATALOG FILE        #
      THEN
        BEGIN 
        FITFNF = FALSE;            # CLEAR FATAL ERROR FLAG            #
        FITORG = FALSE;            # FORCE ORG = OLD                   #
        FITPD = PD;                # STORE REQUESTED PD                #
        CATCHK (OPEN, P<FIT>, CMODE);  # TRY AGAIN                     #
        END 
  
      IF FITES EQ UPDATED          # FILE NOT CLOSED SINCE LAST UPDATE #
      THEN
        BEGIN 
        DIAG (821, FITLFNC);       # INFORM THAT ERROR OCCURRED        #
        IF AFPROCESSED             # USER CHOSE TO ACCEPT FILE         #
        THEN
          BEGIN 
          DIAG (1017);             # INFORM THAT FILE ACCEPTED         #
          FITES = 0;               # OVERRIDE THE ERROR                #
          END 
        ELSE
          BEGIN 
          IF NOT IPROCESSED        # IF INTERACTIVE AND *AF* NOT CHOSEN#
          THEN
            BEGIN 
            DIAG (1016);           # ASK IF SHOULD ACCEPT FILE         #
            READ (AFANSWER, TEMP, 1, TEMP); 
            IF AFANSWER EQ "Y"     # IF ANSWER IS YES                  #
            THEN
              BEGIN 
              FITES = 0;           # CLEAR THE ERROR                   #
              END                  # OTHERWISE WILL BE PROCESSED AS    #
            END                    # ANY OTHER ERROR                   #
          END 
        END 
  
      IF FITES EQ 0                # IF NO CRM ERROR                   #
      THEN
        BEGIN 
        IF C<0,7>FITLFN NQ "ZZZZZQ2"  # IF NOT DEFAULT CATALOG         #
        THEN
          BEGIN 
          VERSTL = FITMRL - 10;    # TL OF VERSION CATALOG FILE        #
          END 
  
        IF VERSTL  GR  MAXTL  THEN # IF TOO LARGE FOR CURRENT BUFFER   #
          BEGIN 
                                   # GET THE CORE FOR THE NEW BUFFER   #
          TEMPTR = CMM$ALF(VERSTL / 10 + 5, FIXED$LWA, 0);
          P<QUIWSA> = TEMPTR;      # COPY THE CURRENT BUFFER           #
          CMOVE (KEYWSA, 0, MAXTL, QUIWSA, 0);
          TCOUNT = P<KEYWSA>;      # LOCATION OF OLD BUFFER            #
          CMM$FRF (TCOUNT);        # RETURN OLD BUFFER                 #
          P<KEYWSA> = TEMPTR;      # KEYWSA IS AT FRONT OF BUFFER      #
          P<QUIWSA> = TEMPTR + 1;  # NEW BUFFER                        #
          MAXTL = VERSTL;          # NEW BUFFER CAN HOLD THE NEW TL    #
          END 
        END 
  
      ELSE
        BEGIN 
        IF FITES NQ UPDATED        # DIAG FOR 52B ALREADY GIVEN        #
        THEN
          BEGIN 
          DIAG (105, FITES, FITLFNC);  # DIAGNOSE CRM ERROR CODE       #
          END 
        ORC = 2;                   # RETURN CODE - CRM ERROR           #
        END 
  
      RETURN; 
      END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
      END 
      TERM
