*DECK DMLDIAG                                                           000280
PROC DMLDIAG;                                                           000290
  BEGIN                                                                 000300
    ENTRY PROC DIAGDL(DIAGNBR);                                         000310
      XREF                                                              000320
        BEGIN                                                           000330
          ITEM BLKLINE;          # ADDR TO PICK UP SOURCE LINE TO PRINT#000340
          ARRAY DIAG100 [0];     # DIAGNOSTIC MSG PTR IN DMLDIAGM      #000350
            ITEM DMSGPTR U(0,0,60);                                     000360
                                                                        000370
          ARRAY DIAGPTR [0];     # DIAGNOSTIC MSGS IN DMLDIAGM         #000380
            ITEM MSGPTR U(0,0,60);                                      000390
                                                                        000400
          ITEM ERRCNTR;          # COUNT OF DIAGNOSTICS                #000410
          ITEM ETLEVEL U;        # ERROR TERMINATE LEVEL - POSSIBLE    #000420
                                 # VALUES ARE 0, 1 FOR T, 2 FOR W,     #000430
                                 # 3 FOR F, OR 4 FOR C                 #000440
          ITEM ABORTFLAG;        # SET TO 1 WHEN ERROR OCCURS WITH A   #000450
                                 # SEVERITY EQUAL TO OR GREATER THAN   #000460
                                 # THE USER-SPECIFIED ET LEVEL         #000470
          PROC DDLPRNT;          # PRINT ROUTINE                       #000480
        END                                                             000490
                                                                        000500
                                 # PARAMETERS                          #000510
      ITEM DIAGNBR;              # DIAGNOSTIC NUMBER                   #000520
                                                                        000530
                                 # LOCAL VARIABLES                     #000540
      ITEM ERRORTYPE;            # SEVERITY OF DIAG BEING ISSUED       #000550
      ITEM DPTR;                 # SUBSCRIPT IN THE DIAG MSGS          #000560
      ITEM MSGADDR;              # ADDRESS OF DIAGNOSTIC TEXT          #000570
      ITEM LENGTH;               # LENGTH OF DIAGNOSTIC TEXT           #000580
      ITEM I;                    # TEMP                                #000590
                                                                        000600
      BASED ARRAY DIAGNBRSTD [0];                                       000610
        ITEM DIAGSTDNBR U(0,0,60);                                      000620
      BASED ARRAY PARM [0];;                                            000630
      CONTROL EJECT;                                                    000640
CONTDIAG:                                                               000650
      ERRCNTR = ERRCNTR + 1;                                            000660
      DPTR = (DIAGNBR-100) / 2;  # GET SUBSCRIPT OF MSG PTR WORD       #000670
                                                                        000680
      IF B<59,1>DIAGNBR EQ 1     # CHECK IF EVEN OR ODD DIAG NUMBER    #000690
      THEN                       # IF ODD, ADDR OF MSG IS IN 2ND HALF  #000700
        BEGIN                    # OF THE MSG PTR WORD                 #000710
          MSGADDR = B<42,18>MSGPTR[DPTR];                               000720
          LENGTH = B<34,8>MSGPTR[DPTR];                                 000730
          ERRORTYPE = B<30,4>MSGPTR[DPTR];                              000740
        END                                                             000750
      ELSE                                                              000760
        BEGIN                    # EVEN NUMBER - 1ST HALF OF WORD      #000770
          MSGADDR = B<12,18>MSGPTR[DPTR];                               000780
          LENGTH = B<4,8>MSGPTR[DPTR];                                  000790
          ERRORTYPE = B<0,4>MSGPTR[DPTR];                               000800
        END                                                             000810
      P<PARM> = MSGADDR;                                                000820
      IF ETLEVEL EQ 0            # DONT ABORT ON ANY ERROR             #000830
      THEN                                                              000840
        GOTO PRINT;                                                     000850
      IF ERRORTYPE GQ ETLEVEL                                           000860
      THEN                                                              000870
        ABORTFLAG = 1;                                                  000880
PRINT:                                                                  000890
      DDLPRNT(PARM,LENGTH);      # PRINT DIAGNOSTIC                    #000910
      RETURN;                                                           000920
                                                                        000930
ENTRY PROC DIAGSTD(DIAGNBR);                                            000940
      P<DIAGNBRSTD> = LOC(DIAGNBR);                                     000950
      DIAGNBR = DIAGSTDNBR[0];                                          000960
      GOTO CONTDIAG;                                                    000970
  END                                                                   000980
TERM;                                                                   000990
