*DECK CBDIAG                                                            016130
  PROC CBDIAG;                                                          016140
    BEGIN                                                               016150
      XREF                                                              016160
        BEGIN                                                           016170
          ITEM NBRLINE;   # DISPLAY CODED SOURCE LINE NUMBER.          #016180
            ITEM BLKLINE;    # ADDRESS TO PICK UP SOURCE INFO FOR PRNT #
          PROC DDLPRNT;   # PRINTS FIXED LENGTH DIAGNOSTICS.           #016190
          PROC DDLERR;   # PROCESS VARIABLE DIAGNOSTICS.               #016200
          PROC INCRLNE;                # PRCOEDURE THAT INCREMENTS THE# 
                                       # SOURCE LINE NUMBER.          # 
          ITEM ERRCNTR;                                                 016210
            ITEM NOLIST;     # LIST OPTION---1 = NO LIST, 0 = LIST.    #
          ITEM NEXLENG; 
          ITEM NEXLENW; 
          ITEM LINEFLG;                # TRUE = SOURCE LINE COUNTER   # 
                                       #        SHOULD BE INCREMENTED.# 
          ITEM ABORTFLAG;              # SET WHEN A SUB-SCHEMA IS NOT  #
                                       # TO BE CREATED.                #
          ITEM TRVERR;             # SET IN THE EVENT OF TRIVIAL ERRORS#
          ARRAY NEXWORD [3] S(1); 
            ITEM NEXWRD U(0,0,60);
          PROC SNATCHO;                                                 016220
          PROC SNATCHF;                                                 016230
        END                                                             016240
  ENTRY PROC DIAGDL(DIAGNBR);                                           016250
      ITEM I; 
      ITEM J; 
      ITEM K; 
      ITEM DIAGNBR;                                                     016260
      ITEM DPTR;    # SUBSCRIPT IN THE DIAG MSGS.                      #016270
      ITEM ERRORTYPE;                                                   016280
      ITEM P1;     # FIRST PARAMETER PASSED TO THE PRINT ROUTINE.      #016290
      ITEM P2;     # SECOND PARAMETER PASSED TO THE PRINT ROUTINE.     #016300
      ARRAY ERRORCNTR [7];   # ERROR TYPE COUNTER.                     #016310
        ITEM ERRCNT I(0,0,60);                                          016320
      XREF ARRAY D100 [0];  # POINTS TO THE DIAGNOSTIC MSGS.          # 
        ITEM DMSGPTR U(0,0,60);                                         016340
      XREF ARRAY DIAGPTR [0];  # DIAGNOSTICS MSGS.                     #016350
        ITEM MSGPTR U(0,0,60);                                          016360
      BASED ARRAY RA [0];                                               016370
        ITEM RELADR U(0,0,60);                                          016380
      BASED ARRAY DIAGNBRSTD [0];                                       016390
        ITEM DIAGSTDNBR U(0,0,60);                                      016400
      BASED ARRAY PARM [0];;                                            016410
  CONTDIAG:                                                             016420
      P<RA> = 0;                                                        016430
      IF DIAGNBR NQ 200 THEN
        ABORTFLAG = 1;
      ERRCNTR = ERRCNTR + 1;                                            016440
      DPTR = (DIAGNBR-100) / 2;                                         016500
      IF B<59,1>DIAGNBR EQ 1 THEN   # CHECK IF EVEN OR ODD DIAG NUMBER.#016510
        BEGIN      # GET THE WORD ADDRESS OF THE DIAG MSG FROM THE 2ND #016520
          P1 = B<42,18>MSGPTR[DPTR]; # HALF OF THE MSG PTR WRD.      #  016530
          P2 = B<34,8>MSGPTR[DPTR]; # GET THE LENGTH OF THE DIAG.    #  016540
          ERRORTYPE = B<30,4>MSGPTR[DPTR]; # GET THE ERROR TYPE.       #
        END                                                             016560
      ELSE                                                              016570
        BEGIN      # GET THE WRD ADDR OF THE DIAG MSG FROM THE FIRST   #016580
          P1 = B<12,18>MSGPTR[DPTR]; #HALF OF THE MSG PTR WORD.#        016590
          P2 = B<4,8>MSGPTR[DPTR];   # GET THE LENGTH OF THE DIAG.     #
          ERRORTYPE = B<0,4>MSGPTR[DPTR];  # GET THE ERROR TYPE.       #
        END                                                             016620
      ERRCNT[ERRORTYPE] = ERRCNT[ERRORTYPE] + 1; # INCREMENT ERR CNTR. #016630
      IF ERRORTYPE EQ 7 THEN       #IF TRIVIAL ERROR# 
        TRVERR = 1;          #SET TRIVIAL ERROR FLAG# 
      RELADR[P1+1] = NBRLINE;  # STORE DISPLAY CODED LINE NBR IN DIAG. #016640
          P<PARM> = P1;                                                 016650
      IF DIAGNBR EQ 145 THEN
        BEGIN 
          K = NEXLENG;
          J = NEXLENW;
          FOR I=0 STEP 1 UNTIL 2 DO 
            BEGIN 
              IF J GR 0 THEN
                RELADR[P1 + 3 + I] = NEXWRD[I]; 
               ELSE 
                RELADR[P1 + 3 + I] = O"55555555555555555555"; 
              J = J - 1;
              K = K - 10; 
              IF J GR 0 AND K LS 0 THEN 
                BEGIN 
                  K = 6 * (-K); 
                  B<60-K,K>RELADR[P1 + 3 + I] = O"55555555555555555555";
                END 
            END 
        END 
      IF NOLIST EQ 1 THEN     # IF THE NO LIST OPTION IS ON, THEN      #
        DDLPRNT( BLKLINE, 120 ); # PRINT SOURCE LINE THIS DIAGNOSTIC   #
                                   # PERTAINS TO.                      #
      DDLPRNT(PARM,P2);                                                 016660
      RETURN;                                                           016670
  ENTRY PROC DIAGSTD(DIAGNBR);                                          016680
      P<DIAGNBRSTD> = LOC(DIAGNBR);                                     016690
      DIAGNBR = DIAGSTDNBR[0];                                          016700
      IF LINEFLG EQ 1 THEN  # CHECK IF THE LINE FLAG IS ON. IF SO CALL# 
        BEGIN # INCRLNE (IN CTLIO) TO INCREMENT THE SOURCE LINE COUNTR# 
          LINEFLG = 0; # SO THE CORRECT LINE NUMBER FOR THE FIRST     # 
          INCRLNE; # SOURCE WORD OF RECORD WILL BE CORRECT.           # 
        END 
      GOTO CONTDIAG;                                                    016710
    END                                                                 016720
  TERM;                                                                 016730
