*DECK OSINIT                                                             FEAT157
USETEXT TAREATB 
USETEXT TCLFN 
USETEXT TCRMDEF 
USETEXT TENVIRN 
USETEXT TFIT
USETEXT TXSTD 
      PROC OSINIT;                                                       FEAT157
#                                  #                                     FEAT157
#     O S I N I T                  #                                     FEAT157
#                                  #                                     FEAT157
# THIS PROC PROVIDES THE INITIALIZATION FOR THE EXECUTION OF THE -OS-  # FEAT157
# DIRECTIVE, IT ENDS UP CALLING -OSEXEC- TO PERFORM THE EXECUTION.     #
# CALLING OSEXEC CAUSES TWO CONTROL STATEMENTS TO BE EXECUTED,         #
# THE USER-S CONTROL STATEMENT AND A CONTROL STATEMENT CAUSING         #
# QU TO BE RELOADED.  EXECUTING A CONTROL STATEMENT BREAKS A CDCS      #
# CONNECT, HENCE, IF CDCS WAS INVOKED, CDCS MUST BE TERMINATED BEFORE  #
# THE CALL TO OSEXEC AND RE-INVOKED AFTER THE CALL TO OSEXEC.          #
# AFTER OSEXEC, EXIT THROUGH STDYES (OR STDNO IF SOME ERROR OCCURRED). #
# DIAGNOSTICS ARE ISSUED FOR ANY ERROR CONDITION ENCOUNTERED. UPON     #
# RETURN FROM OSINIT, THE REMAINDER OF THE TRANSMISSION SHOULD BE      #
# SKIPPED, AS IT WAS THE TEXT OF THE CONTROL STATEMENT.                #
  
  
      BEGIN                                                              FEAT157
      DEF ERRFOUNDCODE #2#;        # CDCS ERROR HAS OCCURRED           #
      DEF INVOKEOKCODE #0#;        # INVOKE COMPLETED NORMALLY         #
      DEF RETRYCODE    #-2#;       # CDCS REQUEST NOT YET COMPLETED    #
      DEF STATBLKSZ # 11 #;        # SIZE OF CDCS STATUS BLOCK         #
  
      XREF PROC AUTOPSY;           # CLEANUP OF FILES FOR SYNTAX OVLS  #
      XREF PROC CATCHK;            # CALL PROPER CATALOG-ACCESSING PROC#
      XREF PROC CLOSEM;            # CRM ROUTINE TO CLOSE FILES        # FEAT157
      XREF PROC CMOVE;             # CHARACTER MOVE ROUTINE. USED TO   # FEAT157
                                   # TRANSFER THE CONTROL STATEMENT TO # FEAT157
                                   # ARRAY -BUFFER-.                   # FEAT157
      XREF PROC DB$CLS;            # CDCS CLOSE FILE                   #
      XREF PROC DB$DBST;           # CDCS DECLARE STATUS BLOCK LOCATION#
      XREF PROC DB$END;            # CDCS TERMINATE                    #
      XREF PROC DB$INQV;           # CDCS INVOKE FOR INTERACTIVE USERS #
      XREF PROC DB$INVV;           # CDCS INVOKE FOR BATCH USERS       #
      XREF PROC DB$PVC;            # CDCS PRIVACY (ACCESS KEY) ROUTINE #
      XREF PROC DIAG;              # PROC FOR ISSUING DIAGNOSTICS.     # FEAT157
      XREF PROC GET;               # CRM ROUTINE TO GET                # FEAT157
      XREF PROC OPNCAT;            # OPEN THE CATALOG FILE IF NOT OPEN # FEAT157
      XREF PROC OSEXEC;            # EXECUTION OF THE -OS- DIRECTIVE   # FEAT157
      XREF PROC READ;              # READ KEYBOARD INPUT               #
      XREF PROC RTNSSCM;           # RELEASE CM IF CDCS CANNOT BE      #
                                   # REINVOKED                         #
      XREF PROC WRITEBL;           # WRITE LINE TO OUTPUT              #
  
      XREF ITEM AREATBLPTR;        # POINTER TO SUBSCHEMA TABLE        #
      XREF ITEM CATBLPTR  I;       # PTR TO CATALOG ACCESS KEY TABLE   #
      XREF ITEM CATGORD I;         # AREA ORDINAL OF CATALOG FILE      #
      XREF ITEM CDCSCAT B;         # TRUE IF CDCS CATALOG MODE         #
      XREF ITEM CDCSDBM B;         # TRUE IF CDCS DATA BASE MODE       #
      XREF ITEM CDCSUP B;          # TRUE IF ACTUALLY CALLING CDCS     #
      XREF ITEM DBVNAME C(7);      # DATABASE VERSION NAME             #
      XREF ITEM INVOKED B;         # TRUE IF AN INVOKE IN EFFECT       #
      XREF ITEM RA0;               # ADDRESS OF ZERO TO END PARAM LIST # FEAT157
      XREF ITEM SBSCKSM I;         # SUBSCHEMA CHECK SUM               #
      XREF ITEM TRANSLG I;         # TRANMISSION LENGTH IN CHARS. XDEF # FEAT157
                                   # FROM SYNTAX WHERE SET.            # FEAT157
      XREF ITEM VERSBSC I;         # VERSION SUBSCHEMA TABLE           #
  
      XREF BASED ARRAY DBSTAT;     # DATA BASE STATUS BLOCK            #
        BEGIN 
        ITEM DBSERRCODE   I(00,00,60);  # CRM OR CDCS ERROR CODE       #
        ITEM DBSAUXSTAT1  I(01,00,60);  # AUXILIARY STATUS WORD 1      #
        ITEM DBSAUXSTAT2  I(02,00,60);  # AUXILIARY STATUS WORD 2      #
        ITEM DBSAUXSTAT3  I(03,00,60);  # AUXILIARY STATUS WORD 3      #
        ITEM DBSFUNCTION  C(04,00,10);  # FUNCTION IN DISPLAY CODE     #
        ITEM DBSRANKERR   I(05,00,60);  # RANK ON WHICH ERROR OCCURRED #
        ITEM DBSRANKCTLB  I(06,00,60);  # LOWEST RANK ON WHICH CONTROL #
                                        # BREAK OCCURRED               #
        ITEM DBSRANKNULL  I(07,00,60);  # LOWEST RANK FOR WHICH THERE  #
                                        # WAS A NULL RECORD            #
        ITEM DBSNAME      C(08,00,30);  # REALM OR AREA NAME ON WHICH  #
                                        # ERROR OCCURRED               #
        ITEM DBSFATALFLG  B(11,00,06);  # TRUE IF FATAL ERROR          #
        ITEM DBSMSGADDR   I(11,42,18);  # ADDR OF CDCS ERROR MSG BUFFER#
        END 
  
      BASED ARRAY ACCKEY;          # TO REFERENCE ACCESS KEY POINTED   #
        BEGIN                      # TO BY AT$ACCESS                   #
        ITEM ACC$KEY  C(00,00,30);
        END 
  
      BASED ARRAY SBSCNAMEA;;      # ARRAY FOR SUBSCHEMA NAME          #
  
      BASED ARRAY SCNAMEA;;        # ARRAY FOR SCHEMA NAME             #
  
      ARRAY BUFFER [7];            #INTERMEDIATE CONTROL CARD BUFFER   # FEAT157
        BEGIN                      # USED AS A PARAMETER IN CALLING    # FEAT157
        ITEM BUFFERC  C(0,0,10);   # -OSEXEC-.                         # FEAT157
        END                                                              FEAT157
  
      ITEM ACC$ITEM  I=0;          # ORDINAL IF TYPE ITEM              #
      ITEM ACC$INP   I=O"40";      # CODES FOR I-O OPTIONS             #
      ITEM ACC$OUTP  I=O"20"; 
      ITEM ACC$TYPE  I=1;          # TYPE OF ELEMENT KEYED - ALWAYS    #
                                   # AREA FOR NOW                      #
      ITEM CH I;                   # SCRATCH ITEM. CHARACTER POSITION  #
      ITEM CPOS I;                 # CHAR POSITION OF THE BEGINNING OF # FEAT157
                                   # THE CONTROL STATEMENT WE ARE TO   # FEAT157
                                   # PASS TO THE OPERATING SYSTEM.     # FEAT157
      ITEM DUMMY I;                # LOOP COUNTER                      #
      ITEM LENGTH I;               # CHARACTER LENGTH OF THE CONTROL   # FEAT157
                                   # STATEMENT TO BE PASSED.           # FEAT157
      ITEM RC I;                   # RETURN CODE FROM OSEXEC           # FEAT157
      ITEM RETRYANS C(1);          # Y OR N RESPONSE TO RETRY MESSAGE  #
      ITEM THISENTRY I;            # FORWARD LINK                      #
      ITEM WORD I;                 # SCRATCH VARIABLE                  #
      ITEM WD I;                   # SCRATCH ITEM. WORD POSITION       #
CONTROL EJECT;                                                          017300
#----------------------------------------------------------------------#017400
#                                                                      #017500
#     D I A G 9 0 4                                                    #017600
#                                                                      #017700
#     THIS PROC ISSUES DIAG 904, GETTING THE PARAMETERS FOR THE        #017800
#     MESSAGE FROM THE CDCS STATUS BLOCK:                              #017900
#                                                                      #018000
#           CRM/CDCS ERROR -X- FILE/RELATION -Y- FUNCTION -Z-          #018100
#                                                                      #018200
#     IF -X- IS A CDCS ERROR, THE CDCS MESSAGE TEXT IS ALSO            #018300
#     WRITTEN OUT.                                                     #018400
#                                                                      #018500
#----------------------------------------------------------------------#018800
                                                                        018900
      PROC  DIAG904;                                                    019000
      BEGIN                                                             019100
      ITEM  CHAR I;                # CHARACTER POSITION                #019200
      ITEM  LOOPCON B;             # LOOP CONTROL                      #019300
      ITEM  RC I;                  # RETURN CODE                       #019400
      ITEM  WD I;                  # WORD POSITION                     #019500
                                                                        019600
      BASED ARRAY  ERRMSG;         # ARRAY TO HOLD ERROR MESSAGE       #019700
        BEGIN                                                           019800
        ITEM  MSGW          U(00,00,60);                                019900
        END                                                             020000
                                                                        020100
                                   # ISSUE THE DIAG 904                #020200
      DIAG (904, DBSERRCODE, SBSCNAMEA, "INVOKE");
      IF DBSERRCODE[0] GQ CDCSERRCODE                                   020400
      THEN                         # CDCS ERROR, PRINT ERROR TEXT      #020500
        BEGIN                                                           020600
        P<ERRMSG> = DBSMSGADDR[0]; # POSITION TO ERROR TEXT            #020700
        C<0,2>MSGW[0] = " ";       # CARRIAGE CONTROL                  #020800
        LOOPCON = TRUE;                                                 020900
        FOR WD = 0 STEP 1          # SCAN ERROR TEXT FOR TRAILING ZERO #021000
          WHILE LOOPCON                                                 021100
        DO                                                              021200
          BEGIN                                                         021300
          FOR CHAR = 0 STEP 1      # SCAN 1 WORD                       #021400
            UNTIL 9                                                     021500
          DO                                                            021600
            BEGIN                                                       021700
            IF B<CHAR*6,6>MSGW[WD] EQ 0                                 021800
            THEN                   # IF TRAILING ZERO                  #021900
              BEGIN                                                     022000
              LOOPCON = FALSE;     # ZERO FOUND, TERMINATE LOOP        #022100
              TEST WD;                                                  022200
              END                                                       022300
            END                                                         022400
          END                                                           022500
                                                                        022600
                                   # PRINT ERROR TEXT                  #022700
        WRITEBL (ERRMSG, ((WD - 1) * 10) + CHAR, RC);                   022800
        END                                                             022900
                                                                        023000
      RETURN;                      # ALL DONE                          #023100
      END                                                               023200
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     O S A C C                                                        #
#                                                                      #
#     AFTER QU HAS BEEN LOADED FOLLOWING EXECUTION OF AN *OS* DIRECTIVE#
#     AND CDCS HAS BEEN RE-INVOKED (IF IN CDCS MODE), *OSACC* IS       #
#     CALLED TO RESET ANY ACCESS KEYS WHICH HAD PREVIOUSLY EXISTED.    #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC OSACC; 
      BEGIN 
      IF CATBLPTR NQ 0             # IF CATALOG FILE EXISTS            #
      THEN
      BEGIN 
      P<CATABLE> = CATBLPTR;       # POSN TO CATALOG ACCESS KEY TABLE  #
      IF CAT$INPKEY                # IF CATALOG KEYED ON INPUT         #
      THEN                         # RESET IT                          #
        BEGIN 
        DB$PVC (CAT$KEYIN, ACC$TYPE, CATGORD, ACC$ITEM, ACC$INP); 
        END 
  
      IF CAT$OUTPKEY               # IF CATALOG KEYED ON OUTPUT        #
      THEN
        BEGIN                      # RESET OUTPUT ACCESS KEY           #
        DB$PVC (CAT$KEYOUT, ACC$TYPE, CATGORD, ACC$ITEM, ACC$OUTP); 
        END 
      END 
  
      IF AREATBLPTR EQ 0           # IF NO AREA IN USE                 #
      THEN
        BEGIN 
        RETURN;                    # DON-T CHECK FOR ACCESS KEY        #
        END 
  
      P<AREA$TABLE> = AREATBLPTR;  # POSITION TO AREA TABLE            #
      FOR DUMMY = DUMMY            # RETURN IS ONLY WAY OUT OF LOOP    #
      DO
        BEGIN 
        IF AT$FORWARD EQ 0         # IF NO MORE ENTRIES IN AREA TABLE  #
        THEN
          BEGIN 
          RETURN;                  # FINISHED RESETTING ACCESS KEYS    #
          END 
  
        P<AREA$TABLE> = AT$FORWARD;  # LOOK AT NEXT AREA               #
        IF AT$INPUTKEY             # IF AREA WAS KEYED ON INPUT        #
        THEN
          BEGIN 
          P<ACCKEY> = AT$ACCESS;   # RESET INPUT ACCESS KEY            #
          DB$PVC (ACC$KEY, ACC$TYPE, AT$AREAORD, ACC$ITEM, ACC$INP);
          END 
  
        IF AT$OUTPUTKEY            # IF AREA WAS KEYED ON OUTPUT       #
        THEN
          BEGIN 
          P<ACCKEY> = AT$ACCESS + 3;   # RESET OUTPUT ACCESS KEY       #
          DB$PVC (ACC$KEY, ACC$TYPE, AT$AREAORD, ACC$ITEM, ACC$OUTP); 
          END 
        END                        # *DUMMY* LOOP                      #
      END                          # PROC *OSACC*                      #
CONTROL EJECT;
      BEGIN   # DECISION SECTION #                                       FEAT157
      IF RECORDFLAG                # IF RECORDING                      #
      THEN
        BEGIN 
        STDYES;                    # ASSUME A SUCCESSFUL *OS* DIRECTIVE#
        END 
  
      IF BATCHMD                   # IF RUNNING IN BATCH MODE          #
      THEN
        BEGIN                                                            FEAT157
        DIAG(294);                 #-OS- NOT ALLOWED IN BATCH MODE.    # OSINIT 
        STDNO;                     # ERROR RETURN                      #
        END                                                              FEAT157
      ELSE                                                               FEAT157
        BEGIN                                                            FEAT157
        IF NEXLENG EQ 0 THEN       # IF ONLY -OS- IN TRANSMISSION      # FEAT157
          BEGIN                                                          FEAT157
          DIAG(295);               #THE -OS- DIRECTIVE EXPECTS A C/S   # OSINIT 
          STDNO;                   # ERROR RETURN                      #
          END                                                            FEAT157
        ELSE                                                             FEAT157
          BEGIN                                                          FEAT157
          CPOS = CT100 + LEXPTR - NEXLENG - 1;                           FEAT157
  
              # THE FOLLOWING LINES OF CODE ARE A KLUGE. LEXSCAN GIVES #
              # DIFFERENT VALUES OF LEXPTR DEPENDING ON WHETHER THE    #
              # CHAR FOLLOWING THE CONTROL STATEMENT VERB IS A PAREN-  #
              # THESIS. IF IT IS, -CPOS- GETS CALCULATED ONE CHAR TOO  #
              # SMALL. THIS KLUGE CHECKS THE CHAR AT CPOS TO SEE IF IT #
              # IS A COMMA OR BLANK, AND INCREMENTS CPOS IF IT IS.     #
              # LEADING BLANKS AND COMMAS ARE SUPPOSED TO BE IGNORED.  #
  
          WD = CPOS / 10;          # WORD POS OF CHAR AT CPOS          #
          CH = CPOS - WD * 10;     # CHAR POS OF CPOS IN WORD WD       #
          IF C<CH,1>INWORD[WD] EQ " " OR
             C<CH,1>INWORD[WD] EQ ","  THEN 
            BEGIN 
            CPOS = CPOS + 1;       # SKIP OVER LEADING SEPARATOR       #
            END 
  
                # END OF KLUGE FOR LEXSCAN.........                    #
  
          LENGTH = TRANSLG - CPOS;     # LENGTH OF THE CONTROL STMT.   # FEAT157
          IF LENGTH GR 79 THEN     # IF CONTROL STMT TOO LONG          # FEAT157
            BEGIN                                                        FEAT157
            DIAG(296);             #CONTROL STATMNT MUST BE LQ 79 CHAR # OSINIT 
            STDNO;                 # ERROR RETURN                      #
            END                                                          FEAT157
          ELSE                                                           FEAT157
            BEGIN                                                        FEAT157
            AUTOPSY;               # CLEAN UP FILES FOR SYNTAX OVL     #
            IF INVOKED             # IF CDCS INVOKED                   #
            THEN
              BEGIN 
              IF CDCSCAT           # IF CDCS CATALOG                   #
              THEN
                BEGIN 
                P<FIT> = LOC(CATAFIT);  # POSITION TO CATALOG FIT      #
                IF FITOC EQ OC$OPEN  # IF CATALOG OPEN                 #
                THEN
                  BEGIN 
IF CDCSUP THEN
                  DB$CLS (FIT, CATGORD);  # CDCS CLOSE CATALOG FILE    #
                  FITOC = OC$CLOSED;  # MARK FILE CLOSED               #
                  END 
                END 
  
              IF CDCSDBM           # IF CDCS DATA BASE MODE            #
              THEN
                BEGIN 
                P<AREA$TABLE> = AREATBLPTR;  # POSITION TO SUBSCHEMA TB#
                THISENTRY = AT$FORWARD;  # ADDRESS OF 1ST AREA TABLE   #
                FOR DUMMY = 0      # LOOP THROUGH ALL AREAS            #
                  WHILE THISENTRY NQ 0
                DO
                  BEGIN 
                  P<AREA$TABLE> = THISENTRY;  # POSITION TO AREA TABLE #
                  THISENTRY = AT$FORWARD;  # ADDR OF NEXT AREA TABLE   #
                  P<FIT> = LOC(AT$AFITPOS);  # POSITION TO AREA FIT    #
                  IF FITOC EQ OC$OPEN  # IF AREA FILE OPEN             #
                  THEN
                    BEGIN 
IF CDCSUP THEN
                    DB$CLS (FIT, AT$AREAORD);  # CDCS CLOSE AREA FILE  #
                    FITOC = OC$CLOSED;  # MARK FILE CLOSED             #
                    END 
                  END 
                END 
  
IF CDCSUP THEN
              DB$END;              # CDCS TERMINATE                    #
              END 
  
            CMOVE(QUIWSA, CPOS, LENGTH, BUFFER, 0);  #MOVE IT.         # OSINIT 
            OSEXEC(BUFFER, LENGTH, RC);  #ISSUE THE CNTRL STAT         # OSINIT 
            IF INVOKED             # IF CDCS HAD BEEN INVOKED          #
            THEN
              BEGIN 
              IF CDCSDBM           # IF CDCS DATA BASE MODE            #
              THEN
                BEGIN 
                P<AREA$TABLE> = AREATBLPTR;  # SUBSCHEMA TABLE         #
                END 
  
              ELSE
                BEGIN 
                P<AREA$TABLE> = VERSBSC;  # SUBSCHEMA TABLE            #
                END 
  
                                   # POSITION TO SUBSCHEMA NAME        #
              P<SBSCNAMEA> = P<AREA$TABLE> + AT$SBSCNAME; 
              P<SCNAMEA> = P<AREA$TABLE> + AT$SCNAME;  # SCHEMA NAME   #
              IF TERMINAL NQ 0     # IF INTERACTIVE USER               #
              THEN
                BEGIN 
                RC = RETRYCODE;    # SET LOOP CONTROL                  #
                FOR DUMMY = DUMMY 
                  WHILE RC EQ RETRYCODE 
                DO
                BEGIN 
                                   # ISSUE CDCS INTERACTIVE INVOKE     #
IF CDCSUP THEN
                  DB$INQV ( SBSCNAMEA, SCNAMEA, USERID, 
                            SBSCKSM, DBSTAT, DBVNAME, 0); 
                  IF DBSERRCODE EQ PFWAITAREA 
                    OR DBSERRCODE EQ PFWAITPRLIB
                    OR DBSERRCODE EQ WAITMEMORY 
                  THEN             # CDCS PASSED BACK A RETURN         #
                                   # CODE TO INDICATE THAT IT COULD NOT#
                                   # COMPLETE THE REQUEST BECAUSE THERE#
                                   # IS SOMETHING IT HAS TO WAIT FOR.  #
                                   # QU NOW ASKS THE INTERACTIVE USER  #
                                   # IF HE WANTS QU TO TRY THE         #
                                   # REQUEST AGAIN OR TO ABORT THE     #
                                   # INVOKE                            #
                    BEGIN 
                    DIAG904;       # ISSUE DIAG 904                    #
                    DBSERRCODE = 0;  # CLEAR ERROR FIELD               #
                    DIAG (1018);   # REQUEST -Y- OR -N-                #
                    READ (RETRYANS, WORD, 1, RC); 
                    IF RETRYANS EQ "Y"
                    THEN
                      BEGIN 
                      RC = RETRYCODE;  # INDICATE ANOTHER TRY IN ORDER #
                      TEST DUMMY;  # START LOOP AGAIN                  #
                      END 
  
                    ELSE           # USER INDICATED NO                 #
                      BEGIN 
                      RC = ERRFOUNDCODE;  # INDICATE ERROR OCCURRED    #
                      DBSERRCODE = 0;  # CLEAR ERROR FIELD             #
                      TEST DUMMY;  # GO ON TO ABORT INVOKE             #
                      END 
                    END 
  
                  IF DBSERRCODE NQ 0  # IF SOME OTHER ERROR            #
                  THEN
                    BEGIN 
                    IF DBSERRCODE EQ CDCSUNAVAIL
                    THEN           # CDCS NOT AVAILABLE                #
                      BEGIN 
                                   # ISSUE DIAG WITH SUBSCHEMA NAME    #
                      DIAG (904, DBSERRCODE, SBSCNAMEA, "INVOKE");
                                   # PUT OUT OUR OWN MESSAGE           #
                      WRITEBL (" CDCS NOT AVAILABLE", 19, WORD);
                      END 
  
                    ELSE           # ANY OTHER CDCS ERROR              #
                      BEGIN 
                      DIAG904;     # ISSUE DIAG 904                    #
                      END 
  
                    RC = ERRFOUNDCODE;  # INDICATE ERROR OCCURRED      #
                    DBSERRCODE = 0;  # CLEAR ERROR FIELD               #
                    TEST DUMMY;    # GO ON TO ABORT INVOKE             #
                    END 
  
                  RC = INVOKEOKCODE;  # INDICATE ERROR-FREE            #
                  END 
  
                IF RC NQ INVOKEOKCODE 
                THEN               # IF ERROR ON -INVOKE-              #
                  BEGIN 
                  RTNSSCM;         # RELEASE CM                        #
                  STDNO;           # ERROR EXIT                        #
                  END 
                END 
  
              ELSE                 # NON-INTERACTIVE QU SESSION        #
                BEGIN 
                                   # ISSUE NORMAL -INVOKE-             #
IF CDCSUP THEN
                DB$INVV ( SBSCNAMEA,SCNAMEA,USERID, 
                          SBSCKSM, DBVNAME, 0 );
                END 
IF CDCSUP THEN
            DB$DBST (DBSTAT, STATBLKSZ);  # REDECLARE STATUS BLOCK LOC #
              END 
  
            OSACC;                 # RESET ANY PREVIOUS ACCESS KEYS    #
            P<FIT> = LOC(CATAFIT);  # POSITION TO CATALOG FILE"S FIT   #
            IF PERFLG              # IF DOING A *PERFORM*              #
              AND FITOC NQ OC$OPEN  # AND FILE WAS NOT LEFT OPEN       #
            THEN
              BEGIN 
              OPNCAT(CATAFIT, PD$INPUT, CH);  # OPEN THE CATALOG FILE  #
                                   # REPOSITION TO THE *OS* TRANSMISSN #
              CATCHK (CGET, LOC(CATAFIT), CDCSCAT); 
              END 
  
            IF RC NQ 0             # IF CONTROL STATEMENT WASNT ACCEPTD#
            THEN
              BEGIN                                                      FEAT157
              DIAG(306, NEXWORD);  # DIAGNOSE CONTROL STMT NOT ACCEPTED# FEAT157
              STDNO;               # ERROR RETURN                      #
              END                                                        FEAT157
            END                                                          FEAT157
          END                                                            FEAT157
        END                                                              FEAT157
      END     # DECISION SECTION #                                       FEAT157
      STDYES;                      # SUCCESSFUL *OS* DIRECTIVE         #
      END                                                                FEAT157
      TERM                                                               FEAT157
