*DECK DB$ERRE 
USETEXT CDCSCTX 
      FUNC DB$ERRE((NUM), MSGARRAY, MSGLG) U; 
      BEGIN 
 #
* *   DB$ERRE -- ERROR MESSAGE EDITOR            PAGE  1
* *   R L MCALLESTER                             DATE  06/18/80 
* *   BOB MCALLESTER - MAJOR REVISION            DATE  02/23/84 
* 
* DC  PURPOSE 
* 
*     LOOKS UP THE ERROR MESSAGE TO BE ISSUED.
*     INSERTS THE VARIABLE NAMES AS SPECIFIED BY THE INSERTION CODES. 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
# 
      ITEM NUM U;            # INTERNAL ERROR NUMBER                   #
  
      ARRAY MSGARRAY; 
        BEGIN 
        ITEM MSG C(0,0,140);           #MESSAGE FOR CDCS OUTPUT FILE# 
        ITEM PTWORD I(00,00,60);       # A WORD OF TEXT TO BE POSTED   #
        END 
  
      ITEM MSGLG I;          #ERROR MESSAGE LENGTH TO BE RETURNED    #
# 
* DC  EXIT CONDITIONS 
* 
*     MSGARRAY CONTAINS THE EDITED MESSAGE
* 
*     THE EXTERNAL ERROR NUMBER IS RETURNED AS THE VALUE OF THE FUNCTION
* 
* DC  CALLING ROUTINES
* 
*     THIS IS A GENERAL PURPOSE ROUTINE THAT IS CALLED BY MANY MODULES. 
* 
* DC  CALLED ROUTINES 
# 
      XREF FUNC CLOCK C(10); # GET CURRENT TIME                        #
      XREF FUNC DB$CDEB C(10);  # INTEGER TO DECIMAL W/ LEADING BLANKS #
      XREF FUNC DB$CDEC C(10);  # INTEGER TO DECIMAL W/ LEADING ZEROS  #
      XREF FUNC DB$COCT C(10);  # INTEGER TO OCTAL WITH LEADING ZEROS  #
      XREF PROC DB$FLOP;     # GENERATE FLOW POINT                     #
      XREF PROC DB$LINE;     # WRITE LINE TO OUTPUT FILE               #
      XREF PROC DB$PUNT;     # INTERNAL ERROR PROCESSOR                #
# 
* DC  NON-LOCAL VARIABLES 
# 
  
      XREF ITEM DB$ERDN I;   # NUMBER TO BE INSERTED AS DECIMAL STRING #
      XREF ITEM DB$ERIN C(30);  # INSERTION TEXT FOR ERROR MESSAGE     #
      XREF ITEM DB$ERLC I;   # ERROR MESSAGE LINE COUNT                #
      XREF ITEM DB$ERSO I;   # MESSAGE SEVERITY LEVEL OVERRIDE         #
      XREF ITEM ROFSW   B;   # REDUCE OUTPUT FILE  -  SWITCH           #
  
      XREF ARRAY DB$ERRM;;   #ERROR MESSAGE TEXTS#
  
  
      BASED ARRAY ERRTXT;              #STRUCTURE OF ERROR TEXT ARRAY#
        BEGIN 
        ITEM NUMBER (0,0,12);          #  INTERNAL NUMBER OF ERROR# 
        ITEM NUMBERX U(0,12,9);        #  EXTERNAL NUMBER#
        ITEM ERFLAGS U(00,21,12);      #  ERROR FLAGS                  #
                   # U(00,21,06)            ERROR LEVEL                #
                   # B(00,29,01)            IF TRUE - TO CDCS OUTPUT   #
                                       #  SEE SEVERITY OVERRIDE CODES  #
  
        ITEM CLENGTH (0,33,9);         #  CHAR LENGTH - 1 OF MESSAGE# 
        ITEM LENGTH (0,42,18);         #  LENGTH OF MESSAGE IN WORDS# 
        ITEM MSGTXT C(1,0,120);        #  ERROR MESSAGE TEXT# 
        ITEM STWORD I(01,00,60);       #  A WORD OF TEXT TO BE SCANNED #
        END 
  
  
      XREF ARRAY DB$SYMB;    # FUNCTION FLAGS ARRAY                    #
        BEGIN 
        ITEM FCFILPOS B(00,00,01);  # TRUE IF FUNCTION CHANGES FILE POS#
        END 
# 
 #
*CALL DB$FUNC 
  
*CALL ERSORDCLS 
  
 #
*     CST AREA BLOCK. 
*     CST CONSTRAINT BLOCK
*     RSB CONSTRAINT BLOCK
 #
      CONTROL NOLIST; 
*CALL CSTARDCLS 
*CALL CSTRCDCLS 
*CALL CSTCNDCLS 
*CALL RSBCNDCLS 
      CONTROL LIST; 
# 
      LOCAL VARIABLES.
# 
      DEF DFHITYPE #O"22"#;  # FIRST UNUSED INSERT TYPE, R             #
  
      ITEM CHAR     I;       # A SINGLE CHARACTER STORED AS AN INTEGER #
      ITEM CLOCKP;           # PARAMETER FOR CLOCK CALL                #
      ITEM COCT3 C(10)=" ";  # SUPPLY 7 TRAILING BLANKS FOR DB$COCT.   #
      ITEM CWORK C(10)=" ";  # A CHARACTER WORK WORD                   #
      ITEM FROMINDEX;        #INDEX IN MSG TEXT#
      ITEM ICX;              # INSERT CHARACTER INDEX                  #
      ITEM INSERTING;        # THE WORD CURRENTLY BEING INSERTED       #
      ITEM IWX;              # INSERT WORD INDEX                       #
      BASED ARRAY ITEXT;     # INSERTION TEXT                          #
        BEGIN 
        ITEM ITWORD I(00,00,60);   # A WORD OF TEXT TO BE INSERTED     #
        END 
      ITEM PCX;              # POSTING CHARACTER INDEX                 #
      ITEM POSTING;          # THE WORD CURRENTLY BEING POSTED         #
      ITEM PWX;              # POSTING WORD INDEX                      #
      ITEM SCX;              # SCANNER CHARACTER INDEX                 #
      ITEM SCANNING;         # THE WORD CURRENTLY BEING SCANNED        #
      ITEM STRING C(30);     # A STRING OF CHARACTERS FOR INSERTION    #
      ITEM SWX;              # SCANNNER WORD INDEX                     #
      ITEM VARWL;            # WORD LENGTH OF VARIABLE LENGHT INSERTION#
      BASED ARRAY VAR;       # ARRAY CONTAINING VARIABLE INSERTION     #
        BEGIN 
        ITEM VWORD0 C(00,00,10);  # WORD 0                             #
        ITEM VWORD1 C(01,00,10);  # WORD 1                             #
        ITEM VWORD2 C(02,00,10);  # WORD 2                             #
        END 
      ITEM XA;               # LOCAL INDEX                             #
      ITEM XB;               # LOCAL INDEX                             #
      ITEM XNUMBER;          # LOCAL STORAGE FOR EXTERNAL NUMBER       #
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   I N S E R T .          #
  
  
 #
* 
* DC  INTERNAL PROCEDURES 
* 
* 
* D   INSERT
* 
*     ADDS TEXT FROM THE ARRAY "ITEXT" TO THE ERROR MESSAGE.
*     A BLANK OR A BINARY ZERO CHARACTER TERMINATES INSERTION.
*     IF THERE IS NO TERMINATOR CHARACTER, INSERTION IS TERMINATED
*     AFTER THIRTY CHARACTERS.
 #
      PROC INSERT;
      BEGIN 
  
      CONTROL FASTLOOP; 
      FOR IWX = 0 STEP 1 UNTIL 2
      DO
        BEGIN 
        INSERTING = ITWORD[IWX];   # GET THE NEXT INSERT WORD          #
  
        FOR ICX = 0 STEP 6 UNTIL 54 
        DO
          BEGIN 
          CHAR = B<ICX,6>INSERTING;  # GET THE NEXT INSERT CHARACTER   #
  
          IF   CHAR EQ O"55"       # INSERTION TERMINATES ON A BLANK   #
            OR CHAR EQ 0           # OR A BINARY ZERO                  #
          THEN
            BEGIN 
            IWX = 2;
            TEST IWX;              # TERMINATE THE INSERTION           #
  
            END 
          POST;                    # POST THE CHARACTER TO THE MESSAGE #
          END 
        END 
      RETURN; 
  
      END 
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   P O S T .              #
  
 #
* 
* 
* D   POST
* 
*     ADD THE CHARACTER THAT IS CONTAINED IN THE INTEGER VARIABLE "CHAR"
*     TO THE MESSAGE THAT IS BEING ASSEMBLED. 
 #
      PROC POST;
      BEGIN 
      B<PCX,6>POSTING = CHAR; 
      PCX = PCX +6; 
      IF PCX GR 54
      THEN
        BEGIN 
        PTWORD[PWX] = POSTING;
        PWX = PWX +1; 
        PCX = 0;
        POSTING = 0;
        END 
      RETURN; 
  
      END 
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   S C A N .              #
  
 #
* 
* 
* D   SCAN
* 
*     GET THE NEXT CHARACTER FROM THE SELECTED MESSAGE TEXT.
*     LEAVE THAT CHARACTER IN THE VARIABLE "CHAR".
 #
      PROC SCAN;
      BEGIN 
      CHAR = B<SCX,6>SCANNING;
      SCX = SCX +6; 
      IF SCX GR 54
      THEN
        BEGIN 
        SWX = SWX +1; 
        SCX = 0;
        SCANNING = STWORD[SWX]; 
        END 
      RETURN; 
  
      END 
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   U N P O S T .          #
  
 #
* 
* 
* D   UNPOST
* 
*     DELETE THE CHARACTER THAT WAS ADDED BY THE LAST POST. 
 #
      PROC UNPOST;
      BEGIN 
      PCX = PCX -6; 
      IF PCX LS 0 
      THEN
        BEGIN 
        PWX = PWX -1; 
        PCX = 54; 
        POSTING = PTWORD[PWX];
        END 
      RETURN; 
  
      END 
  
  
  
#     B E G I N   D B $ E R R E   E X E C U T A B L E   C O D E .      #
  
  
      CONTROL IFGR DFFLOP,0;
        ITEM ERREFLOP C(10) = "ERRE000   "; 
        C<4,3>ERREFLOP = DB$CDEC(NUM,3);
        DB$FLOP(ERREFLOP);   # ERRE FLOW POINT CONTAINING ERROR NUMBER #
      CONTROL ENDIF;
  
 #
* 
* DC  DESCRIPTION 
* 
*     FIND ERROR IN ERROR TABLE.
 #
      P<ERRTXT> = LOC(DB$ERRM); 
      CONTROL FASTLOOP; 
      FOR FROMINDEX=FROMINDEX WHILE NUMBER[0] NQ 0 DO 
        BEGIN 
        IF NUM EQ NUMBER[0] THEN
          GOTO FOUNDERROR;
        P<ERRTXT> = LOC(ERRTXT)+LENGTH[0];
        END 
 #
*     ERROR NUMBER NOT IN TABLE, CDCS INTERNAL ERROR.  PUNT = 1.
 #
      DB$PUNT("DB$ERRE  1");
  
  
  
 FOUNDERROR:  
 #
* 
*     THE ERROR MESSAGE DEFINITION HAS BEEN FOUND.
*     IF AN ERROR SEVERITY LEVEL OVERRIDE IS SPECIFIED, IT IS USED, 
*     ELSE THE SEVERITY LEVEL IS TAKEN FROM THE MESSAGE DEFINITION. 
*     IF THE SPECIFIED OVERRIDE LEVEL IS "INFORMATIONAL", THE 
*     EXTERNAL NUMBER IS SET TO ZERO. 
*     SET ERROR FIELDS IN RCB.
*     (DONE HERE BECAUSE ERROR FIELD IS OVERWRITTEN FOR CRM ERRORS.)
 #
      XNUMBER = NUMBERX[0]; 
      IF DB$ERSO EQ 0 
      THEN
        BEGIN 
        DB$ERSO = ERFLAGS[0]; 
        END 
      ELSE
        BEGIN 
        IF DB$ERSO EQ DFERSOI 
        THEN
          BEGIN 
          XNUMBER = 0;
          END 
        END 
      RCIRRC[0] = B<48,6>DB$ERSO; 
      RCPKERR[0] = XNUMBER; 
 #
*     INITIALIZE VARIABLES FOR THE POST AND SCAN PROCEDURES.
*     POSTING IS INITIALIZED AT CHARACTER 22, SCANNING AT ZERO. 
 #
      PCX = 12;                    # -POST- CHARACTER INDEX, CHAR 2    #
      PWX = 2;                     # -POST- WORD INDEX, WORD 2         #
      C<0,10>POSTING = " ";        # CURRENT -POST- WORD               #
  
      SCX = 0;                     # -SCAN- CHARACTER INDEX            #
      SWX = 0;                     # -SCAN- WORD INDEX                 #
      SCANNING = STWORD[0];        # CURRENT -SCAN- WORD               #
 #
*     BLANK FILL MESSAGE BUFFER.
 #
      MSG[0] = " "; 
 #
*     PUT ERROR NUMBER IN MESSAGE.
 #
      IF XNUMBER NQ 0 THEN
        BEGIN 
        C<2,3>POSTING = DB$COCT(XNUMBER,3); 
        C<5,1>POSTING = "-";
        PCX = 36;                  # ADVANCE TO CHARACTER 6            #
        END 
 #
*     TRANSFER ERROR TEXT FROM TABLE TO MSG BUFFER WHILE
*       ADDING INSERTS. 
 #
      CONTROL FASTLOOP; 
      FOR FROMINDEX=0 STEP 1 UNTIL CLENGTH[0] DO
        BEGIN 
 #
*         INSERT CHARACTERS INTO TARGET MESSAGE IF NOT INSERTION. 
 #
        SCAN; 
        IF CHAR NQ O"70"           # IF NOT AN INSERTION CHARACTER "'" #
        THEN
          BEGIN 
          POST; 
          END 
        ELSE
          BEGIN 
          FROMINDEX = FROMINDEX+1;
          SCAN;                    # PLACE THE INSERTION TYPE INTO CHAR#
          IF CHAR LS 0
            OR CHAR GR DFHITYPE 
          THEN
            BEGIN 
            CHAR = DFHITYPE;
            END 
  
          SWITCH ITYPE TYPEERR, TYPEA, TYPEB, TYPEC,
            TYPED, TYPEE, TYPEF, TYPEG, 
            TYPEH, TYPEI, TYPEJ, TYPEK, 
            TYPEL, TYPEM, TYPEN, TYPEO, 
            TYPEP, TYPEQ, TYPEERR;
  
          GOTO ITYPE[CHAR];        # MAKE THE INSERTION                #
  
  
 #
*         IF "A" TYPE INSERTION THEN
*             INSERT SCHEMA NAME FROM INVOKE IR IN RCB. 
 #
 TYPEA: 
          P<ITEXT> = LOC(RCINSCNM[0]);
          GOTO INSERTIT;
 #
*         IF "B" TYPE INSERTION THEN
*             INSERT SUB-SCHEMA NAME FROM INVOKE IR IN RCB. 
 #
 TYPEB: 
          P<ITEXT> = LOC(RCINSBNM[0]);
          GOTO INSERTIT;
 #
*         IF "C" TYPE INSERTION THEN
*             INSERT AREA NAME FROM CST AREA WORK BLOCK.
*             (RSB AREA BLOCK BASED ARRAY MUST REFERENCE AREA)
 #
 TYPEC: 
          IF P<CSFIXED> LQ 0
            OR P<RSARBLK> LQ 0
          THEN
            BEGIN 
            STRING = "*UNIDENTIFIED*";
            GOTO INSERTSTR; 
            END 
          P<CSAREBLK> = LOC(CSFIXED) + RSARCSTP[0]; 
          VARWL = CSANAMLW[0];
          P<VAR> = LOC(CSANAME[0]); 
          GOTO INSERTVAR; 
 #
*         IF "D" TYPE INSERTION THEN
*             PUT CRM NUMBER INTO ERROR FIELD IN RCB IR PACKET. 
*             INSERT CRM ERROR NUMBER FROM UFT. 
 #
 TYPED: 
          RCPKERR[0] = FPFITES[0];
          C<0,3>COCT3 = DB$COCT(FPFITES[0],3);
          P<ITEXT> = LOC(COCT3);
          GOTO INSERTIT;
 #
*         IF "E" TYPE INSERTION THEN
*             INSERT ATTACH STATUS IN OCTAL DISPLAY.
 #
 TYPEE: 
          C<0,3>COCT3 = DB$COCT(ABS(ATTACHSTATUS),3); 
          P<ITEXT> = LOC(COCT3);
          GOTO INSERTIT;
 #
*         IF "F" TYPE INSERTION THEN
*             INSERT DB PROC NAME.
 #
 TYPEF: 
          C<0,10>STRING = C<0,7>APDBPNAM[APLX]; 
          GOTO INSERTSTR; 
 #
*         IF "G" TYPE INSERTION THEN
*             INSERT FDL ERROR CODE FROM APL ENTRY. 
 #
 TYPEG: 
          C<0,3>COCT3 = DB$COCT(APWORD1[APLX],3); 
          P<ITEXT> = LOC(COCT3);
          GOTO INSERTIT;
 #
*         IF "H" TYPE INSERTION THEN
*             INSERT RECORD NAME FROM CST RECORD WORK BLOCK 
*             (RSB RECORD CONTROL BLOCK POINTER MUST BE SET)
 #
 TYPEH: 
          P<CSRECBLK> = LOC(CSFIXED) + RSRCCSTP[0]; 
          VARWL = CSRNAMLW[0];
          P<VAR> = LOC(CSRNAME[0]); 
          GOTO INSERTVAR; 
 #
*         IF "I" TYPE INSERTION THEN
*             INSERT SCHEMA NAME FROM SAL.
 #
 TYPEI: 
          P<ITEXT> = LOC(SASCNAME[SALX]); 
          GOTO INSERTIT;
 #
*         IF "J" TYPE INSERTION THEN
*             INSERT FUNCTION CODE NAME.
 #
 TYPEJ: 
          VARWL = 1;
          P<VAR> = LOC(FUNCODE[RCFUNC[0]]); 
          GOTO INSERTVAR; 
 #
*         IF "K" TYPE INSERTION THEN
*             INSERT CONSTRAINT NAME FROM CST WORK BLOCK. 
 #
 TYPEK: 
          P<RSCONBLK> = LOC(RSB) + RSFCONPT[0] +
                            (RSFCCORD[0] -1) * DFCONCON;
          P<CSCONBLK> = LOC(CSFIXED) + RSCNCSTP[0]; 
          VARWL = CSCNAMLW[0];
          P<VAR> = LOC(CSCNAME[0]); 
          GOTO INSERTVAR; 
 #
*         IF "L" TYPE INSERTION THEN
*             CREATE A DECIMAL CHARACTER STRING FROM THE INTEGER
*             IN DB$ERDN. 
 #
 TYPEL: 
          CWORK = " ";
          C<0,6>CWORK = DB$CDEB(DB$ERDN,6); 
          XB = 5; 
          CONTROL SLOWLOOP; 
          FOR XA = 0 STEP 1 UNTIL 5 
          DO
            BEGIN 
            IF C<XA,1>CWORK NQ " "
            THEN
              BEGIN 
              XB = XA;
              XA = 5; 
              END 
            END 
          C<0,10>STRING = C<XB,10-XB>CWORK; 
          GOTO INSERTSTR; 
 #
*         IF "M" TYPE INSERTION THEN
*             INSERT USER ID THAT WAS PASSED IN INVOKE. 
 #
 TYPEM: 
          VARWL = 1;
          P<VAR> = LOC(TQPRNAME[0]);
          GOTO INSERTVAR; 
 #
*         IF "N" TYPE INSERTION THEN
*           IF VERSION IS NOT MASTER THEN 
*             INSERT REQUESTED VERSION NAME FROM RSB (FIXED). 
*           (IF VERSION IS MASTER THEN NO INSERTION.) 
 #
 TYPEN: 
          IF P<RSB> GR 0
            AND RSFVENAME[0] NQ DFMASTER
          THEN                     # IF VERSION NAME IS NOT MASTER...  #
            BEGIN                  # INSERT VERSION NAME IN PARENTHESES#
            C<0,1>STRING = "("; 
            C<1,9>STRING = RSFVENAME[0];
            P<ITEXT> = LOC(STRING); 
            INSERT; 
            C<0,10>STRING = ")";
            GOTO INSERTSTR; 
  
            END 
          ELSE
            BEGIN 
            UNPOST;                # ERASE THE BLANK IN THE MESSAGE.   #
            TEST FROMINDEX; 
  
            END 
 #
*         IF "P" TYPE INSERTION THEN
*           INSERT REQUESTED VERSION NAME FROM RSB (FIXED). 
 #
 TYPEP: 
          C<0,10>STRING = RCPVENAM[0];
          GOTO INSERTSTR; 
 #
*         IF "Q" TYPE INSERTION THEN
*           INSERT TEXT FROM DB$ERIN. 
 #
 TYPEQ: 
          P<ITEXT> = LOC(DB$ERIN);
          GOTO INSERTIT;
 #
*         PUNT = 2 IF ILLEGAL INSERTION TYPE. 
 #
 TYPEO: 
 TYPEERR: 
          DB$PUNT("DB$ERRE  2");
  
  
  
 #
*         INSERT A VARLIABLE LENGTH STRING. 
*         THE STRING TO BE INSERTED IS CONTAINED IN THE BASE ARRAY
*         "VAR".
*         THE NUMBER OF WORDS USED TO CONTAIN THE STRING IS IN "VARWL". 
*         THE STRING IS TERMINATED BY A BLANK OR A BINARY ZERO CHARACTER
*         OR AT THE END OF THE WORDS THAT CONTAIN IT. 
 #
 INSERTVAR: 
          C<00,10>STRING = VWORD0[0];  # INSERT FIRST WORD             #
          C<10,10>STRING = " ";        # PAD THE OTHER TWO WORDS       #
          C<20,10>STRING = " "; 
          IF VARWL GR 1 
          THEN
            BEGIN 
            C<10,10>STRING = VWORD1[0];  # INSERT THE SECOND WORD      #
            IF VARWL GR 2 
            THEN
              BEGIN 
              C<20,10>STRING = VWORD2[0];  # INSERT THE THIRD WORD     #
              END 
            END 
 #
*         THE INSERTION STRING IS LOCATED IN THE VARIABLE "STRING". 
*         SET THE INSERTION TEXT BASED ARRAY POINTER. 
 #
 INSERTSTR: 
          P<ITEXT> = LOC(STRING); 
 #
*         CALL "INSERT" TO INSERT THE STRING. 
 #
 INSERTIT:  
          INSERT; 
          P<ITEXT> = DFNPTR;
          P<VAR> = DFNPTR;
          END 
        END 
 #
*     ADD THE FINAL POSTING WORD TO THE MESSAGE.
*     SET LENGTH OF ERROR MESSAGE.
 #
      PTWORD[PWX] = POSTING;
      IF PCX EQ 54                 # IF ONLY ONE ZERO BYTE AT END      #
      THEN
        BEGIN 
        PTWORD[PWX +1] = 0;        # ADD A ZERO WORD                   #
        END 
      MSGLG = (10*PWX) + (PCX/6) -20; 
 #
*     LIST THE MESSAGE ON THE CDCS OUTPUT FILE IF THE AUTHOR SO DESIRED.
 #
      IF B<56,1>DB$ERSO EQ 1
                             # SUPPRESS INVOKE MESSAGES IF ROFSW IS SET#
        AND NOT ( ROFSW 
          AND ( NUM EQ 49 
            OR  NUM EQ 50 
            OR  NUM EQ 93 
            OR  NUM EQ 94 ))
      THEN
        BEGIN 
        DB$ERLC = DB$ERLC +1;  # INCREMENT ERROR LINE COUNT            #
        IF B<24,18>TQRUID[0] NQ 0 
        THEN
          BEGIN              # NOS/BE                                  #
          IF TQTASK[0] EQ 0 
          THEN
            BEGIN 
            C<13,7>MSG[0] = C<0,7>TQRUID[0];
            END 
          ELSE
            BEGIN 
            C<12,2>MSG[0] = C<5,2>TQRUID[0];
            C<14,6>MSG[0] = DB$COCT(B<6,18>TQTASK[0],6);
            END 
          END 
        ELSE
          BEGIN              # NOS                                     #
          IF TQTASK[0] EQ 0 
          THEN
            BEGIN 
            C<15,4>MSG[0] = C<0,4>TQRUID[0];
            END 
          ELSE
            BEGIN 
            C<12,2>MSG[0] = C<2,2>TQRUID[0];
            C<14,1>MSG[0] = B<0,3>TQTASK[0] + O"33";
            C<15,5>MSG[0] = DB$COCT(B<9,15>TQTASK[0],5);
            END 
          END 
        C<0,10>MSG[0] = CLOCK(CLOCKP);
        DB$LINE(MSGARRAY,MSGLG +20);
        END 
 #
*     CLEAR THE SEVERITY LEVEL OVERRIDE.
 #
      DB$ERSO = 0;
 #
*     RETURN THE EXTERNAL ERROR NUMBER
 #
      DB$ERRE = XNUMBER;
  
      END 
  
      TERM
