*COMDECK OLDGOVL
_$J+? 
_ 
*********************************************************************** 
*                                                                     * 
*  COPYRIGHT CONTROL DATA CORPORATION 1975, 1976, 1977, 1978, 1979,   * 
*  1980, 1981, 1982, 1983, 1984, 1985.                                * 
*                                                                     * 
*                         VERSION 1.1                                 * 
*                                                                     * 
*********************************************************************** 
? 
         _#ON LINE DIAGNOSTICS OVERLAY ERROR CODES# 
       $0 = TEST COMPLETE 
       $1 = UNSOLICITED INPUT DETECTED
       $2 = UNSOLICITED OUTPUT DATA DEMAND
       $3 = INPUT LOOP ERROR
       $4 = OUTPUT LOOP ERROR 
       $5 = PARITY ERROR
       $6 = FRAMING ERROR 
       $7 = DATA TRANSFER OVERRUN 
       $8 = NEXT CHARACTER NOT AVAILABLE
       $9 = NO STATUS AFTER STATUS REQUEST
       $A = UNSOLICITED CLA STATUS
       $B = CLA STATUS NOT CLEARED AFTER ISON SENT
       $C = NO STATUS AFTER RTS 
       $D = NO CTS (CLEAR TO SEND) AFTER RTS
       $E = NO STATUS AFTER DTR 
       $F = NO DSR (DATA SET READY) AFTER DTR 
      $10 = NO SQD (SIGNAL QUALITY DETECT) AFTER DTR
      $11 = NO RI (RING) AFTER DTR
      $12 = NO STATUS AFTER SRTS
      $13 = NO SRLSD AFTER SRTS 
      $14 = NO CLA STATUS AFTER LM
      $15 = NO DCD AFTER LM 
      $16 = UNSOLICITED STATUS AFTER OM 
      $17 = NO STATUS OR IMP OP AFTER TB (TERMINAL BUSY)
      $18 = NO STATUS AFTER NSYN (NEW SYNCH)
      $19 = IMP OP OF DCD,RI,OR QM AFTER NSYN 
      $1A = NO RING AFTER RTS 
      $1B = UNSOLICITED STATUS AFTER LM 
      $1C = INPUT DATA TIMEOUT DURING DATA VERIFY TEST
      $1D = UNSOL STATUS DURING DATA VERIFICATION TEST (DVT)
      $1E = NO CRCS STATUS RECEIVED DURING DVT OF SDLC CLA
      $1F = DVT FAILED SYNC EVEN PARITY 
      $20 = DVT FAILED SYNC ODD PARITY
      $21 = DVT FAILED SYNC NO PARITY 
      $22 = DVT FAILED SDLC 
      $23 = DVT FAILED SDLC 
      $24 = DVT FAILED SDLC 
      $25 = DVT FAILED ASYNC  40    BAUD EVEN  1 SB 
      $26 = DVT FAILED ASYNC  85.4  BAUD ODD   2 SB 
      $27 = DVT FAILED ASYNC  100   BAUD NO    1 SB 
      $28 = DVT FAILED ASYNC  110   BAUD EVEN  2 SB 
      $29 = DVT FAILED ASYNC  120   BAUD ODD   1 SB 
      $2A = DVT FAILED ASYNC  133.3 BAUD NO    1 SB 
      $2B = DVT FAILED ASYNC  150   BAUD EVEN  1 SB 
      $2C = DVT FAILED ASYNC  300   BAUD ODD   1 SB 
      $2D = DVT FAILED ASYNC  600   BAUD NO    1 SB 
      $2E = DVT FAILED ASYNC  800   BAUD EVEN  1 SB 
      $2F = DVT FAILED ASYNC 1050   BAUD ODD   1 SB 
      $30 = DVT FAILED ASYNC 1200   BAUD NO    1 SB 
      $31 = DVT FAILED ASYNC 1600   BAUD EVEN  1 SB 
      $32 = DVT FAILED ASYNC 1600   BAUD ODD   1 SB 
      $33 = DVT FAILED ASYNC 2400   BAUD NO    1 SB 
      $34 = DVT FAILED ASYNC 2400   BAUD EVEN  1 SB 
      $35 = DVT FAILED ASYNC 4800   BAUD ODD   1 SB 
      $36 = DVT FAILED ASYNC 9600   BAUD NO    1 SB 
      $37 = DVT FAILED ASYNC 9600   BAUD EVEN  1 SB 
      $38 = MULTIPLEX SUBSYSTEM BUFFER THRESHOLD DETECTED              ?
_**********************************************************************?
_    ASCII TO HEX NUMBER CONVERSION                                    ?
_**********************************************************************?
_$R-,G-,I-                              LEVEL 1, INTERRUPTABLE         ?
FUNCTION  ASCHEX (X:CHAR):B04BITS;          _CONVERT ASCII NUM TO HEX  ?
BEGIN 
  IF ((ORD(X) - ORD(#0#))\ 0)&((ORD(X) - ORD(#0#)) @ 9) 
  THEN ASCHEX := ORD(X) - ORD(#0#)
  ELSE
   IF (ORD(X)-ORD(#A#)\0)&((ORD(X)-ORD(#A#))@5) 
   THEN ASCHEX:=ORD(X)-ORD(#A#)+10
   ELSE                                     _NOT HEX CHARACTER         ?
    BEGIN                                   _SET ERROR FLAG            ?
      KQERROR:=TRUE;
      ASCHEX:=$F;                           _SET VALUE TO F            ?
    END;
END;
_ 
************************************************************************
*        ABORT ALL DIAGNOSTICS ACTIVITY FOR A GIVEN DIAGNOSTICS        *
*        OPERATOR ORDINAL (DO) OR ABORT ALL DIAGNOSTICS ACTIVITY       *
*        FOR ALL DOP,S.                                                *
************************************************************************
? 
_$R-,G-,I-                                  INTERRUPTABLE              ?
PROCEDURE PDOTERM (VQDO : CHAR; VQALL : BOOLEAN); 
  
  
VAR 
I : INTEGER;                                _ LINE NUMBER INDEX        ?
KQLCBP : BZLCBP;                            _ DIAG. CONTROL BLOCK PTR  ?
  
BEGIN 
  I := $100;                                _ START SCAN LINE ONE      ?
  
  REPEAT
    PBLCBP (I , KQLCBP);                    _ GET LCB ADDRESS          ?
    IF KQLCBP " NIL                         _ IF NOT LAST LINE         ?
    THEN
      IF KQLCBP'.BZDIAG                     _ IF DIAGNOSTICS RUNNING   ?
      THEN
        WITH KQLCBP'.BZTCBP'.BZDCB DO 
        IF (NZDO = VQDO) ! (VQALL )         _ IF CORRECT DO OR ALL     ?
        THEN
          NZABORT := TRUE;                  _ SET ABORT DIAG FLAG      ?
    I := I + $100;                          _ GET NEXT LCB             ?
  UNTIL KQLCBP = NIL;                       _ LCB OUT OF RANGE         ?
END; _ PDOTERM ?
_**********************************************************************?
_*       SUBR PDCOMD - ISSUE COMMAND TO COMMAND DRIVER                *?
_**********************************************************************?
_$R-,G-,I-                              LEVEL 1, INTERRUPTABLE         ?
PROCEDURE PDCOMD(TCOMD : B08BITS);     _PROCEDURE TO ISSUE COMMANDS    ?
VAR PKT : NKINCOM;                                                       DG1
BEGIN 
  WITH KQLOCLCB'.BZTCBPTR'.BZDCB DO                                      DG1
  BEGIN                                                                  DG1
    PKT.NKCMD := NKSPECIAL;                 _ACCESS MUX TABLE COMMAND  ? DG1
    PKT.NKWD1.BAINT := 0;                   _SUB-COMMAND               ? DG1
    PKT.NKWD2.BAINT := $BFBF;               _SYNC/NON RS232 MASK       ? DG1
    PKT.NKWD3.BAINT := NZCTYP;              _CLA TYPE                  ? DG1
    IF NZCTYP \ N0SDLC                      _ IS CLA SDLC OR HDLC      ?
    THEN PKT.NKWD2.BAINT := $AFBF;          _SDLC MASK                 ? DG1
    IF NZCTYP = N0ASYNC                                                  DG1
    THEN PKT.NKWD2.BAINT := $FFBF;          _ASYNC MASK                ? DG1
    PBCOIN(PKT);                       _UPDATE LINE TYPE TABLE         ?
    NZCMD := TCOMD;                    _SET COMMAND IN CMD PACKET      ?
    PBCOIN(NZDPAK);                    _ISSUE COMMAND                  ?
    NZINTAR[3] := 0;                   _CLEAR WORD 3 IN CMD PACKET     ?
    NZINTAR[4] := 0;                   _CLEAR WORD 4 IN CMD PACKET     ?
    NZINTAR[5] := 0;                   _CLEAR WORD 5 IN CMD PACKET     ?
    NZINTAR[6] := 0;                   _CLEAR WORD 6 IN CMD PACKET     ?
    NZINTAR[7] := 0;                   _CLEAR WORD 7 IN CMD PACKET     ?
    NZINTAR[8] := 0;                   _CLEAR WORD 8 IN CMD PACKET     ?
  END;                                 _END WITH                       ?
END;                                   _END PDCOMD                     ?
_**********************************************************************?
_*       SUBR PDEXT1 - SET UP DATA BUFFER AND PASS TO SVM             *?
_**********************************************************************?
_$R-,I-,G-                              LEVEL 1, INTERRUPTABLE         ?
PROCEDURE PDEXT1;                      _SET OVERLAY DATA BUFFER RESP   ?
VAR 
  J0DIGPO  :  J0ML5;
  J0DIGER  :  J0ML7;
  KQSVB : B0BUFPTR;                    _STORE BUFFER POINTER HERE      ?
   I   : INTEGER; 
   ERR : BOOLEAN;                      _ TEMPORARY VAR                 ?
VALUE 
  J0DIGPO = (#PORT ]#); 
  J0DIGER = (# ERROR ]#); 
BEGIN                                  _AND PASS IT ON TO SERVICE MOD  ?
  PDEXIT;                              _CLEAN UP, RELEASE DCB          ?
  IF NOT KQABORT                       _IF NOT ABORT ALL               ?
  THEN                                 _OUTPUT RESPONSE                ?
  BEGIN 
    KQSVB := PBGET1BF(BEDBSIZE);       _GET A DATA BUFFER              ?
    WITH KQSVB' DO                     _WITH BUFFER POINTER            ?
    BEGIN                              _SET UP DATA BUFFER             ?
     BFTEXT         := TRUE;           _SET TEXT FLAG                  ?
     BFDATAC[PFC]   := CHR(D8OLD);     _SET PRIMARY FUNCTION CODE      ?
     BFDATAC[SFC]   := KQSFC;          _SET SFC  (UNSOLICITED)         ?
     BFDATAC[SFC +1]:= KQDO;           _SET DIAGNOSTIC ORDINAL         ?
     BFDATAC[CN]    := CHR(0);         _SET CONNECTION NUMBER          ?
     BFDATAC[BTPT]  := CHR(HTCMD);     _SET BLOCK TYPE                 ?
     BFDATAC[DN]    := KQSN;           _STORE DESTINATION NODE         ?
     BFDATAC[SN]    := CHR(CKLOCNODE); _STORE SOURCE NODE              ?
                                            _STORE SUBTEST NUMBER      ?
    PBTOAH(KQSUBT.BAHEX, KQSVB, DN+22,DN+26); 
                                       _STORE ERROR CODE               ?
    PBTOAH(RCODE.BAHEX, KQSVB, DN+19,DN+23);
                                       _STORE PORT NUMBER              ?
    PBTOAH(LNNO.BAHEX, KQSVB, DN+12,DN+16); 
                                       _STORE ERROR LABEL              ?
    PBLOAD(KQSVB, J0DIGER, DN+14,DN+20);
                                       _STORE PORT LABEL               ?
    PBLOAD(KQSVB, J0DIGPO, DN+7,DN+11); 
                                       _STORE EXPECTED DATA            ?
    PBTOAH(KQEXPDA.BAHEX, KQSVB, DN+27,DN+31);
                                       _STORE RECEIVED DATA            ?
    PBTOAH(KQACTDA.BAHEX, KQSVB, DN+32,DN+36);
    BFFCD := DN;                       _SET BFFCD TO DN                ?
    BFLCD := DN + 35;                  _SET LCD TO END OF RESPONSE     ?
  
     IF KQSFC = CHR(D9DT)              _IF REQUEST IS FROM USER        ?
     THEN                              _SEND MESSAGE TO BIP            ?
       PBSWLE(KQSVB)
     ELSE                              _IF REQUEST IS FROM CONSOLE     ?
       BEGIN
       BFFCD := DN+7;                  _START OF DISPLAY TEXT          ?
       BFFORMAT := FALSE; 
*IF DEF,CONSOLE 
       JCOPSLRP.JCBUFSIZE := BEDBSIZE;
       JCOPSLRP.JCPOINTER := KQSVB; 
       PBIOSERV(JCOPSLRP,ERR);         _SEND MESSAGE TO CONSOLE        ?
*ENDIF
       END; 
    END;
  END;
END;                                   _END PDEXT1                     ?
_**********************************************************************?
_*       SUBR PDEXIT - CLEAN UP LCB/RELEASE DCB                       *?
_**********************************************************************?
_$R-,G-,I-                              LEVEL 1, INTERRUPTABLE         ?
PROCEDURE PDEXIT;                      _CLEAN UP LCB AND RELEASE DCB   ?
VAR KQSVB : B0BUFPTR;                  _TEMPORARY BZTCBPTR FIELD       ?
BEGIN 
  WITH KQLOCLCB',                      _WITH LCB                       ?
       BZTCBPTR'.BZDCB DO              _WITH DCB                       ?
  BEGIN 
    KQSFC:= NZSFC;                     _GET SECONDARY FOUNCTION CODE   ?
    KQABORT := NZABORT;                _SAVE ABORT FLAG                ?
    LNNO.BALBYT := NZPORT;             _GET PORT NUMBER                ?
    NZDPAK.NKRELBFS := TRUE;           _SET RELEASE INPUT BUFFERS      ?
    PDCOMD(NKENDIN);                   _END INPUT COMMAND              ?
    PDCOMD(NKDISL);                    _ISSUE DISABLE LINE COMMAND     ?
    NZDPAK.NKLTYP := N0LDIAG;          _SET LINE TYPE TO DIAG IN CMDPKT?
    PDCOMD(NKCLRL);                    _ISSUE CLEAR LINE COMMAND       ?
    BZLNSPD := NZLNSPD;                _RESTORE LCB LINE SPEED         ?
    BZTIPTYPE := NZTIPTYPE;            _RESTORE TIP TYPE               ?
    KQSVB := NZSVDTCB;                 _REMEMBER OLD BZTCBPTR          ?
    PBREL1BF(BZTCBPTR,BEDBSIZE);       _RELEAE DIAG CONTROL BLOCK      ?
    BZTCBPTR := KQSVB;                 _RESTORE BZTCBPTR IN LCB        ?
    PBLLRMOV(LNNO.BALINO);             _UNCHAIN FROM ACTIVE LCBS       ?
    BZDIAG  := FALSE;                  _RESET DIAG IN PROGRESS FLAG    ?
  END;                                 _END WITH                       ?
END;                                   _END PDEXIT                     ?
_$J+? 
_***********************************************************************
************************************************************************
**                                                                    **
**             P D S T T R  -  START/TERMINATE PROCESSOR              **
**                                                                    **
************************************************************************
************************************************************************
*                                                                      *
** OVERVIEW -                                                         **
*         PDSTTR IS CALLED BY THE SERVICE MODULE WHEN A START DIAGNOS- *
*         TICS OR TERMINATE DIAGNOSTICS COMMAND IS ENTERED VIA THE HOST*
*         OR LOCAL COMMUNICATIONS CONSOLE.  PDSTTR VALIDATES THE COM-  *
*         MAND PARAMETERS AND MAKES A WORKLIST ENTRY TO THE MAIN ON-   *
*         LINE DIAGNOSTIC PROGRAM.                                     *
*                                                                      *
** INPUTS -                                                           **
*         INPUT CONSISTS OF A START DIAGNOSTICS COMMAND SERVICE MES-   *
*         SAGE OR A TERMINATE DIAGNOSTICS COMMAND SERVICE MESSAGE.     *
*         THE CALLING SEQUENCE IS:                                     *
*           PDSTTR                                                     *
*         WITH B1BUFF POINTING DATA BUFFER                             *
*                                                                      *
** OUTPUTS -                                                          **
*         IF APPLICABLE, MESSAGE SET UP IN THE DATA BUFFER AND A WORK- *
*         LIST ENTRY TO THE MAIN ON-LINE DIAGNOSTIC PROGRAM.           *
*                                                                      *
** EXTERNAL SUBROUTINES USED -                                        **
*           - PBBFAVAIL : CHECK BUFFER AVAILABILITY                    *
*           - PBGET1BF  : GET A BUFFER                                 *
*           - PBLCBP    : LOCATE LCB                                   *
*           - PBLSPUT   : MAKE WORKLIST ENTRY                          *
*           - PBLOAD    : LOAD A CANNED MESSAGE                        *
*           - PBTOAH    : CONVERT TO ASCII HEX                         *
*           - PBREL1BF  : RELEASE A BUFFER                             *
*                                                                      *
** NOTES -                                                            **
*                                                                      *
************************************************************************
***********************************************************************?
_$R-,G-,I-                              LEVEL 1, INTERRUPTABLE         ?
PROCEDURE PDSTTR; 
CONST 
  DIAGST = 1;                          _DIAGNOSTICS STARTED            ?
  INVLNO = 2;                          _INVALID LINE NUMBER            ?
  INVCLA = 3;                          _INVALID CLA TYPE               ?
  INVTMD = 4;                          _INVALID TEST MODE              ?
  LNOTSR = 5;                          _LINE NOT OUT OF SERVICE        ?
  TSTINP = 6;                          _TEST IN PROGRESS               ?
  BFRTHR = 7;                          _BUFFER THRESHOLD REACHED       ?
  INVMCL = 8;                          _INVALID MODEM CLASS            ?
  DGNINP = 9;                          _DIAG NOT IN PROGRESS           ?
  INVDO  = 10;                         _INVALID DIAGNOSTIC ORDINAL     ?
  KQDIAG = A0WK1;                      _CONTINUE DIAG WORKCODE         ?
TYPE
  CANMSG = ARRAY[1..27] OF INTEGER; 
VAR 
  NZMSG  : CANMSG;                     _CANNED OUTPUT MESSAGE          ?
  CANPTR : 'CANMSG; 
    _# ARRAY OF CANNED RESPONSES TO DIAGNOSTICS #?
  J0DIGRS : ARRAY [0..10] OF J0ML13;   _CANNED MESSAGES                ?
  J0DIGPO : J0ML5;
  I, J : INTEGER;                      _INDEXES                        ?
  KQERR : BOOLEAN;                     _BUFFER AVAILABILITY FLAG       ?
  KQSVB : B0BUFPTR;                    _STORE BUFFER POINTER HERE      ?
  CLATYP : B04BITS;                    _CLA TYPE                       ?
  KQTMP,                               _TEMPORARY : SAVE SFC OR COMMA  ?
  KQTMO : CHAR;                        _SAVE TEST MODE                 ?
  CLAMCL,                              _MODEM CLASS IN HEX             ?
  KQPORT : B0OVERLAY;                  _PORT NUMBER IN ASCII           ?
  KQLOAD : BOOLEAN;                    _NOT FIRST CALL FLAG            ?
VALUE 
  KQLOAD = FALSE;                      _SET FOR INITIAL CALL           ?
_?
_  CANNED OUTPUT MESSAGES                                              ?
_?
NZMSG = ($0F08, $9900, $0000, $0000, $55AA, $33CC, $0FF0, $FF00, $0000, 
         $1004, $9900, $1616, $1616, $55AA, $33CC, $0FF0, $FF00, $7F7F, 
         $1008, $9900, $0000, $0000, $55AA, $33CC, $0FF0, $FF00, $0000);
J0DIGRS = (# TEST CMPL- OK#,
           # STARTED      #,
           # INV PORT     #,
           # INV CLA TYPE #,
           # INV TEST MODE#,
           # NOT DISABLED #,
           # TEST IN PROC.#,
           # LOW BUFFERS  #,
           # INV MODEM CLS#,
           # NOT IN PROC. #,
           # INVALID USER #); 
J0DIGPO = (#PORT ]#); 
_***********************************************************************
* SAVE INFO FROM DATA BUFFER                                           *
***********************************************************************?
BEGIN 
WITH B1BUFF' DO                             _WITH DATA BUFFER POINTER  ?
 BEGIN
 KQSFC := BFDATAC[SFC];                     _ SAVE SFC                 ?
 KQDO := BFDATAC[SFC + 1];                  _GET DIAGNOSTIC ORDINAL    ?
 IF KQSFC = CHR(D9TM) 
 THEN 
  PDOTERM (KQDO,FALSE)                      _TERMINATE ALL FOR DO      ?
 ELSE 
  IF (KQSFC = CHR(D9DT)) ! (KQSFC = CHR(D9NP))
  THEN
    BEGIN 
    IF NOT KQLOAD THEN
      BEGIN                                 _THIS IS FIRST TIME CALLED ?
      KQLOAD := TRUE; 
      CANPTR := PBGET1BF(BETPSIZE);         _GET 32 WORD BUFFER        ?
      KQMSGPTR[0] := CANPTR;                _PROVIDING A SEPARATE      ?
      KQMSGPTR[1] := CANPTR + 9;            _POINTER TO EACH MESSAGE   ?
      KQMSGPTR[2] := CANPTR + 18; 
      CANPTR' := NZMSG;                     _COPY MESSAGES TO BUFFER   ?
      END;
    KQSN := BFDATAC[SN];                    _SAVE SOURCE NODE          ?
     KQTMO := BFDATAC[SFC + 2];             _SAVE TEST COMMAND         ?
    RCODE.BAINT := INVTMD;                  _PRIME RESPONSE CODE       ?
    FOR I := (DN + 7) TO BFLCD DO           _SEARCH FOR COMMA          ?
     BEGIN
      KQTMP   := BFDATAC[I];
      IF   KQTMP = #,# THEN                 _IF A COMMA IS FOUND       ?
      BEGIN 
       J := I;
       I := BFLCD;
       KQERROR:=FALSE;                      _CLEAR ERROR FLAG          ?
       KQPORT.BALCHAR:=BFDATAC[J+1];        _SAVE PORT NO. IN ASCII    ?
       KQPORT.BARCHAR:=BFDATAC[J+2];
       RCODE.BAINT := INVLNO;                         _PRIME RESPONSE  ?
       LNNO.BAHEX.B0H1 := ASCHEX(BFDATAC [J + 1]);
       LNNO.BAHEX.B0H2 := ASCHEX(BFDATAC [J + 2]);
       PBLCBP(LNNO.BAINT,KQLOCLCB);         _GET LCB ADDRESS FROM LINE ?
       IF (NIL"KQLOCLB)&(LNNO.BALBYT"0)&    _CHECK VALID LINE NUMBER   ?
          (KQERROR=FALSE) THEN
       BEGIN
        WITH KQLOCLCB' DO              _WITH LCB                       ?
        BEGIN 
          IF (KQTMO=#I#)!(KQTMO=#E#)!(KQTMO=#M#) THEN _IF COMD IS START?
_***********************************************************************
* START DIAGNOSTIC PROCESSING                                          *
***********************************************************************?
          BEGIN 
            RCODE.BAINT := INVCLA;                    _PRIME RESPONSE  ?
            CLATYP := ASCHEX(BFDATAC [J + 4]);
            IF (CLATYP@KQCALW)&(KQERROR=FALSE) THEN   _IF VALID CLA TYP?
            BEGIN 
              RCODE.BAINT := INVMCL;                  _PRIME RESPONSE  ?
                                                      _TEST MODEM CLASS?
              CLAMCL.BAHEX.B0H3 := ASCHEX(BFDATAC [J + 6]); 
                                                      _TEST MODEM CLASS?
              CLAMCL.BAHEX.B0H4 := ASCHEX(BFDATAC [J + 7]); 
              IF (CLAMCL.BAINT@KQMMC)&                _IF VALID MODEM C?
                 (KQERROR=FALSE) THEN 
              BEGIN 
                RCODE.BAINT := TSTINP;                _PRIME RESPONSE  ?
                IF BZDIAG = FALSE THEN                _TEST IN PROCESS ?
                BEGIN 
                  RCODE.BAINT := LNOTSR;              _PRIME RESPONSE  ?
                  IF BZCNFST = C7DISABLED THEN   _TEST FOR LINE OUT    ?
                  BEGIN                          _OF SERVICE           ?
                    BZDIAG := TRUE; 
                    PBLLENTB(LNNO.BALINO);       _SET IN ACTIVE LCB    ?
                    BZLINO := LNNO.BALINO;       _PLACE PORT NUMBER IN ?
                                                 _LCB                  ?
                    BZTAPEX := FALSE;            _CLEAR TIMAL APPEND FG?
                    BZTOUTPUT := FALSE;          _CLEAR TERM OUTPUT FG ?
                    BZTINPUT := FALSE;           _CLEAR TERM INPUT FLAG?
                    RCODE.BAINT := BFRTHR;            _PRIME RESPONSE  ?
                    KQERR := PBNBFAVAIL (4,B0THCT); 
                                                 _CHECK BUFFER AVAIL   ?
                    IF KQERR THEN                _IF BUFFER AVAILABLE  ?
                    BEGIN 
                      KQSVB := BZTCBPTR;         _REMEMBER OLD BZTCBPTR?
                      BZTCBPTR := 
                        PBGET1BF(BEDBSIZE);      _GET A DIAG CTL BLOCK ?
                      WITH BZTCBPTR'.BZDCB DO    _WITH DCB POINTER     ?
                      BEGIN 
                       FOR J := 1 TO KQDCBSIZE DO 
                         NZINTAR[J] := 0;        _CLEAR DCB            ?
                      _IF KQTMO = #I# THEN?      _SET TEST MODE        ?
                        _NZMODE := 0;?
                       IF KQTMO = #E# THEN
                         NZMODE := 2; 
                       IF KQTMO = #M# THEN
                         NZMODE := 1; 
                       NZSVDTCB := KQSVB;        _STORE OLD BZTCBPTR   ?
                       NZDO := KQDO;             _SAVE DIAG. ORDINAL   ?
                       NZLNSPD := BZLNSPD;       _SAVE LCB LINE SPEED  ?
                       BZLNSPD := N0DIAG;        _SET NICTCT INDEX     ?
                                                 _IN LCB               ?
                       NZTIPTYPE := BZTIPTYPE;   _SAVE CURRENT TIP TYPE?
                       BZTIPTYPE := N0OLDIAG;    _SET TIPTYPE IN LCB   ?
                       NZSFC := KQSFC;           _ SAVE SFC            ?
                       NZCTYP := CLATYP;         _SET CLA TYPE         ?
                       NZLINO := LNNO.BALINO;    _SET LINE NUMBER      ?
                       RCODE.BAINT := DIAGST;    _SET DIAG STARTED     ?
                       INSERT($100,NZCTYP,       _PUT CLA TYPE         ?
                         NZTMCT.BAINT);          _INTO SE]WORD         ?
                       INSERT(1,NZMODE,          _PUT TEST MODE        ?
                         NZTMCT.BAINT);          _INTO SETWORD         ?
                        NZDCNS := 1;   _SET NICICT RANGE FROM 1        ?
                        NZDCNF := 3;             _ TO 3                ?
                        NZMSGX := 1;        _SET TO CANNED MSG TYPE 1  ?
                        IF NZCTYP = N0ASYNC THEN      _IF ASYNC CLA    ?
                        BEGIN 
                         NZDCNS := 7;       _SET NICTCT RANGE FROM 7   ?
                         IF NZMODE = 1 THEN  _CHECK MODEM LBT SET      ?
                         BEGIN              _TEST FOR SPEED ABOVE 300  ?
                          NZDCNF := CLAMCL.BARBYT + 7;_TOP TEST SPEED  ?
                          IF CLAMCL.BARBYT > 7_TEST SPEED > 300 BPS    ?
                           THEN NZDCNS := NZDCNF;_TEST TEST SPEED ONLY ?
                         END
                         ELSE NZDCNF := $19;
                         NZMSGX := 0;       _SET TO CANNED MSG TYPE 0  ?
                        END;                _END ASYNC                 ?
                        IF NZCTYPE \ N0SDLC _ IF SDLC OR HDLC          ?
                        THEN
                        BEGIN 
                         NZDCNS := 4;       _SET NICTCT RANGE FROM 4   ?
                         NZDCNF := 6;       _ TO 6                     ?
                         NZMSGX := 2;       _SET TO CANNED MSG TYPE 2  ?
                        END;                _END SDLC                  ?
                      END;                  _END WITH BZDCB            ?
                      WITH BWWLENTRY        _WITH WORKLIST ENTRY       ?
                       [OPS].CMSMLEY DO 
                      BEGIN 
                       CMWKCODE := KQDIAG;  _SET CONTINUE DIAG WORKCOD ?
                       CMLINO := LNNO.BALINO;    _SET LINE NUMBER      ?
                       PBLSPUT(BWWLENTRY[OPS],BYWLCB[B0DGWL]);
                                            _SEND TO SERVICE MODULE    ?
                      END;                  _END WITH                  ?
                    END                     _END IF BUFFER AVAIL       ?
                    ELSE                    _ELSE                      ?
                    BEGIN 
                      BZDIAG := FALSE;      _CLEAR DIAG IN PROCESS FLAG?
                    END;
                  END;                      _END IF LINE OUT OF SERVICE?
                END;                        _END IF NOT BZDIAG         ?
              END;                          _END IF VALID MODEM CLASS  ?
            END;                            _END IF VALID CLA TYPE     ?
          END                               _END IF CMD CODE OF START  ?
_***********************************************************************
* TERMINATE DIAGNOSTIC PROCESSING                                      *
***********************************************************************?
          ELSE                              _TERMINATE THE DIAGNOSTIC  ?
          BEGIN 
           RCODE.BAINT := INVTMD;           _PRIME RESPONSE CODE       ?
           IF KQTMO =#T# THEN               _IF TERMINATE COMMAND      ?
            BEGIN 
            RCODE.BAINT := DGNINP;          _PRIME RESPONSE CODE       ?
            IF BZDIAG 
            THEN
            RCODE.BAINT := INVDO;      _SET INVALID DIAGNOSTIC ORDINAL ?
            IF BZTCBP'.BZDCB.NZDO      _IF CORRECT DIAGNOSTIC ORDINAL  ?
               = KQDO 
            THEN
            BEGIN 
              BZTCBPTR'.BZDCB.NZTERM:=TRUE;      _SET DIAG TERM FLAG   ?
              RCODE.BAINT := 0;             _SET TEST COMP RESPONSE    ?
            END;                            _END IF BZDIAG             ?
           END;                             _END IF TERMINATE COMMAND  ?
          END;                              _END ELSE                  ?
        END;                                _END WITH LCB              ?
       END;                                 _END IF LNNO               ?
      END;                                  _IF A COMMA IS PRESENT     ?
    END;                                    _END SEARCH FOR COMMA      ?
_***********************************************************************
* BUILD WORKLIST TO START OR TERMINATE DIAGNOSTICS                     *
***********************************************************************?
    BFTEXT := TRUE;                    _SET TEXT FLAG                  ?
                                       _STORE PORT LABLE               ?
    PBLOAD(B1BUFF,J0DIGPO,DN+7,DN+11);
    BFDATAC[DN+12] := KQPORT.BALCHAR;  _STORE THE PORT NUMPER         ? 
    BFDATAC[DN+13] := KQPORT.BARCHAR;  _STORE THE PORT NUMBER          ?
    PBLOAD(B1BUFF,J0DIGRS[RCODE.BAINT],_STORE THE RESPONSE             ?
           DN+14,DN+27);
    IF KQSFC = CHR(D9NP)               _IF REQUEST IS FROM CONSOLE     ?
    THEN
      BEGIN                            _SEND RESPONSE TO CONSOLE       ?
      BFFCD := DN+6;
      BFFORMAT := FALSE;
*IF DEF,CONSOLE 
      JCOPSLRP.JCBUFSIZE := BEDBSIZE; 
      JCOPSLRP.JCPOINTER := B1BUFF; 
      PBIOSERV(JCOPSLRP,KQERR); 
*ENDIF
      END;
    END;  _IF KQSFC ? 
 END;     _WITH B1BUFF' ? 
END;                                   _END PDSTTR                     ?
_$I-,R-,G- ?
_$J+? 
_***********************************************************************
************************************************************************
**                                                                    **
**             O L D I A G - ON-LINE DIAGNOSTICS                      **
**                                                                    **
************************************************************************
************************************************************************
*                                                                      *
** OVERVIEW -                                                          *
*         THE ON-LINE DIAGNOSTIC IS A SET OF OVERLAY PROGRAMS WHOSE    *
*         PURPOSE IS TO ISOLATE LINE PROBLEMS BY EXECUTING BASIC CLA   *
*         AND MODEM LOOPBACK TESTS.  THE DIAGNOSTIC RUNS WITHOUT       *
*         IMPACTING SERVICES TO THE OTHER LINES IN THE SYSTEM.         *
*                                                                      *
** INPUTS -                                                            *
*         WORKLIST SERVICE MESSAGES SERVE AS INPUTS TO OLDIAG.  THE    *
*         WORKCODES RECOGNIZED ARE A0STATUS(STATUS HANDLER),  A0DIAG   *
*         (DIAGNOSTIC CONTROL), A0TIMEOUT (TIMER), AND MMHARDER (HARD  *
*         ERROR HANDLER).                                              *
*                                                                      *
** OUTPUTS -                                                           *
*         OLDIAG OUTPUTS WORKLIST AND SERVICE MESSAGES TO REPORT       *
*         DIAGNOSTICS STARTED OR TERMINATED AND ERRORS.                *
*                                                                      *
** EXTERNAL SUBROUTINES USED -                                         *
*         PBGETLIST     - OBTAIN WORKLIST ENTRY                        *
*         PBPUTLIST     - PASS WORKLIST ENTRIES                        *
*         PBBFAVAIL     - DETERMINE BUFFER AVAILABILITY                *
*         PBCOIN        - INITIATE COMMAND                             *
*         PBGET1BF      - GET A BUFFER                                 *
*         PBREL1BF      - RELEASE A BUFFER                             *
*                                                                      *
** NOTES -                                                             *
*                                                                      *
************************************************************************
***********************************************************************?
PROCEDURE OLDIAG; 
LABEL 999;                             _EXIT TO MONITOR                ?
CONST 
  KQDIAG   = A0WK1;                    _CONTINUE DIAG PROCESSING       ?
  KQINP    = A0WK2;                    _GOOD INPUT DATA RECEIVED       ?
  KQCRCER  = A0WK3;                    _BAD CRC RECEIVED ON SDLC CLA   ?
  KQMUXBF  = A0WK4;                    _MUX BUFFER THRESHOLD DETECTED  ?
  KQMOD3  = 8;                         _MODE 3 - INTERNAL DATA TEST    ?
  KQNOCMD = $20;
  KQCMDTST = $21; 
    _# ARRAY SIZES #? 
  KQENTS = 63;
  KQENT1 = 7; 
  KQENT2 = 12;
  KQENT3 = 36;
  KQENT4 = 5; 
TYPE
   N0INBUF  ='NEINBUF;                _ CANNED INPUT POINTER           ?
      NZDSIZ = 0..2;
      SYRESAD= ARRAY[1..$19] OF NZDSIZ; 
      SYDIGCT = PACKED RECORD CASE DIAGCT : INTEGER OF
            1:(NIWD0,                  _ WORD 0 (UNIVERSAL)            ?
               NIWD1:B0OVERLAY;)       _ WORD 1 (UNIVERSAL)            ?
             2:(DIATCT:NICTCY;         _ LINE SPEED                    ?
                NEPARY:B02BITS;        _ PARITY                        ?
                NECHLEN:B02BITS;       _ CHARACTER LENGTH              ?
                NESP2   :B04BITS;      _ SPARE                         ?
                NESYCAR:B08BITS);      _ SYNC CHARACTER                ?
             3:(NEDM1   :B013BITS;     _ DUMMY                         ?
                NEXCNT  :B03BITS);     _ TRANSMISSION COUNTS (SDLC)    ?
             END; 
      SYDGCT = ARRAY[1..$19] OF SYDIGCT;
_?
      NEDATA = RECORD CASE NEX : INTEGER OF  _CANNED COMPARE MSG TYPE  ?
             1:(NEWD1,
                NEWD2,
                NEWD3,
                NEWD4:INTEGER); 
             2:(NECHR:ARRAY [0..3] OF INTEGER); 
             END; 
_?
      NEINBUF = PACKED RECORD         _ CANNED OUTPUT + INPUT MSG TYPE ?
                NEDISPL:INTEGER;
                NEFLAGS:B0FLAGS;
                NEDAT :NEDATA;
              END;
  _?
            _#OLDGOVL CONTROL TABLE ENTRY#? 
       KXCTRL = PACKED RECORD 
                  KQMSTS:B0OVERLAY; 
                  KQCMMD,              _ COMMAND                       ?
                  KQCMPR,              _ COMMAND PARAMS TBL IX         ?
                  KQCLNY,              _ ERROR CK TBL IX               ?
                  KQCLMR,              _ CLA FLAG CK TBL IX            ?
                  KQCHTR:B08BITS;      _ CHAR XMS TBL MOD TBL IX       ?
                  CASE KQTG:INTEGER OF _ IF CMD = CONTROL THEN         ?
                    1:(KQF1:BOOLEAN;   _ THIS FIELD CONTAINS           ?
                       KQF2:B07BITS);  _ FIRST FUNCTION                ?
                    2:(KQFNCT:B08BITS); 
                END;
  _?
            _#COMMAND PARAMETERS TABLE#?
       KXCMD1 = PACKED RECORD 
                  CASE KQTG1:INTEGER OF 
                    1:(KQFNC1,         _ SET/RESET FUNCTION FLAG       ?
                       KQFNC2,         _ + FUNCTION FOR CNTRL COMMAND  ?
                       KQFNC3,
                        KQFNC4:B08BITS);
                    2:(KQSR1:BOOLEAN; 
                       KQFN1:B07BITS; 
                       KQSR2:BOOLEAN; 
                       KQFN2:B07BITS; 
                       KQSR3:BOOLEAN; 
                       KQFN3:B07BITS; 
                       KQSR4:BOOLEAN; 
                       KQFN4:B07BITS);
                    3:(KQCMP1,
                       KQCMP2:INTEGER); 
               END; 
  _?
            _#RESPONSE TABLES ENTRY DEFINITIONS#? 
       KXRSPT = PACKED RECORD 
                  KQCKWT:B08BITS;      _ WHAT TO CHECK                 ?
                  KQRESP:B08BITS;      _ RESPONSE                      ?
                END;
       KXRSP2 = PACKED RECORD 
                  KQCKFL : B02BITS; 
                  KQNMBR : B03BITS; 
                  KQFLAG:B04BITS;      _ WHICH FLAG TO CHECK           ?
                  KQRSPN:B07BITS;      _ RESP IF CK FAILS              ?
                    END;
  _?
VAR 
      NQDBGI : INTEGER;                     _ WORK LIST SAVE INDEX     ?
      NQDBGA : ARRAY [0..19] OF MMEVENT;    _ WORK LIST SAVE AREA      ?
_?
          _#ARRAY OF DIAGNOSTIC TRANSMISSION CHARACTERISTICS#?
     NDIAGCT : SYDGCT;
_?
          _#ARRAY OF CANNED RESPONSE COMPARE DATA ADDRESSES#? 
     NDRESAD : SYRESAD; 
_?
          _#CANNED COMPARE DATA BLOCKS#?
     NZDATA : ARRAY[0..2] OF NEDATA;
_?
          _#OLDGOVL TABLE ARRAYS#?
     KQCNTRTBL:ARRAY[0..KQENTS] OF KXCTRL;  _CONTROL TABLE             ?
     KQCMDPARM:ARRAY[1..KQENT1] OF KXCMD1;  _CMD PARAMS                ?
     KQRSPTABL:ARRAY[1..KQENT2] OF KXRSPT;  _RESP. TBL 1               ?
     KQRSP2TBL:ARRAY[1..KQENT3] OF KXRSP2;  _RESP. TBL 2               ?
     KQCHRXMST:ARRAY[1..KQENT4] OF SYDIGCT; 
     KQLTYP   :ARRAY[0..4] OF INTEGER;      _LINE TYPES FOR ENABLE     ?
  KQTMP   : B0OVERLAY;                 _TEMPORARY VAR                  ?
  PBSLJ   : BOOLEAN;                   _SETTING OF SELECTIVE SKIP SW   ?
  KQINBUF : N0INBUF;                   _INPUT BUFFER                   ?
  NNBR    : INTEGER;
  K,L     : INTEGER;
  KQI     : INTEGER;
  KQTIME  : B08BITS;                   _TIME OUT VALUE                 ?
  KQTMCT  : B0OVERLAY;                 _CLA TYPE AND TEST MODE         ?
  PKT : NKINCOM;                                                         DG1
VALUE 
  
  NQDBGA = (#COPYRIGHT CONTROL DATA CORP. 1975, 1985#); 
_?
_ CHARACTER TRANSMISSION CHARACTERISTICS MODIFICATION TABLE VALUES     ?
_?
NDIAGCT = ($0000,$9096,                _SYNC  ,EVEN ,8BIT              ?
           $0000,$1016,                _  *   ,ODD  ,  *               ?
           $0000,$7016,                _  *   ,NOPAR,  *               ?
           $0007,$0000,                _SDLC     -     *               ?
           $0007,$0000,                _  *      -     *               ?
           $0007,$0000,                _  *      -     *               ?
           $2080,$9000,                _ASYNC ,EVEN ,8BIT, 1SB,40  BAUD?
           $9241,$1000,                _  *   ,ODD  ,  * , 2SB,85.4  * ?
           $8A20,$7000,                _  *   ,NOPAR,  * , 1SB,100   * ?
           $AAA1,$9000,                _  *   ,EVEN ,  * , 2SB,110   * ?
           $9A60,$1000,                _  *   ,ODD  ,  * , 1SB,120   * ?
           $BAE0,$7000,                _  *   ,NOPAR,  * , 1SB,133.3 * ?
           $8610,$9000,                _  *   ,EVEN ,  * , 1SB,150   * ?
           $8E30,$1000,                _  *   ,ODD  ,  * , 1SB,300   * ?
           $9E70,$7000,                _  *   ,NOPAR,  * , 1SB,600   * ?
           $4920,$9000,                _  *   ,EVEN ,  * , 1SB,800   * ?
           $79E0,$1000,                _  *   ,ODD  ,  * , 1SB,1050  * ?
           $4510,$7000,                _  *   ,NOPAR,  * , 1SB,1200  * ?
           $5550,$9000,                _  *   ,EVEN ,  * , 1SB,1600  * ?
           $5550,$1000,                _  *   ,ODD  ,  * , 1SB,1600  * ?
           $4D30,$7000,                _  *   ,NOPAR,  * , 1SB,2400  * ?
           $4D30,$9000,                _  *   ,EVEN ,  * , 1SB,2400  * ?
           $5D70,$1000,                _  *   ,ODD  ,  * , 1SB,4800  * ?
           $7DF0,$7000,                _  *   ,NOPAR,  * , 1SB,9600  * ?
           $7DF0,$9000);               _  *   ,EVEN ,  * , 1SB,9600  * ?
_?
_  CANNED OUTPUT MESSAGE POINTER INDICES                               ?
_?
NDRESAD = ( 1, 2, 1, 1, 1, 1, 0, 0, 1, 0, 
            0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 
            1, 0, 0, 1, 0); 
_?
_  CANNED RESPONSE COMPARE DATA                                        ?
_?
NZDATA =($552A, $334C, $0F70, $7F00,
         $55AA, $33CC, $0FF0, $FF00,
         $D52A, $B34C, $8F70, $7F80); 
_?
_*************************************************
*                                                *
*     KQCNTRTBL (CONTROL TABLE PARAMS) VALUES    *
*                                                *
*************************************************?
  
KQCNTRTBL=($1F0F,  _ ALL MODES, ALL CLA TYPES                          ?
           $0D01,  _   NKCLRL (MODEM TEST),    1 (CMD PARAMS)          ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $0D00,  _   NKCLRL (CLEAR CLA),     0 (NO CMD PARAMS)       ?
           $0100,  _   1 (RESP CKS),           0 (SPEC TBL CKS)        ?
           $0000,  _   0 (NO CHX TBL MODS),    N/A                     ?
  
           $1701,  _ MODE 0,  ALL CLA TYPES EXCEPT 3                   ?
           $0E01,  _   NKCONTROL (CONTROL),    1 (CMD PARAMS)          ?
           $0200,  _   2 (RESP CKS),           0 (NO SPC CKS)          ?
           $0087,  _   0 (NO CHX MODS),        TRUE, N0ION (INPUT ON)  ?
  
           $0805,  _ MODES 0,2,  CLA TYPE 3 ONLY                       ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0100,  _   1 (RESP CKS),           0 (NO SPEC CKS)         ?
           $008E,  _   0 (NO CHX MODS),        TRUE, N0LBT (LOOPBACK)  ?
  
           $0805,  _ MODES 0,2,  CLA TYPE 3 ONLY                       ?
           $0E07,  _   NKCONTROL (CONTROL),    7 (CMD PARAMS)          ?
           $0200,  _   2 (RESP CKS),           0 (NO SPEC CKS)         ?
           $0087,  _   0 (NO CHX MODS),        TRUE, N0ION (INPUT ON)  ?
  
           $1F04,  _ MODE 2,  ALL CLA TYPES                            ?
           $0E02,  _   NKCONTROL (CONTROL),    2 (CMD PARAMS)          ?
           $0200,  _   2 (RESP CKS),           0 (NO SPEC CKS)         ?
           $0087,  _   0 (NO CHX TBL MODS),    TRUE, N0ION (INPUT ON)  ?
  
           $1F05,  _ MODE 0, 2,  ALL CLA TYPES                         ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0207,  _   2 (RESP CKS),           7 (SPEC CKS)            ?
           $008A,  _   0 (CHX TBL MODS),   TRUE, N0ISR (INP SUP REPORT)?
  
           $1F05,  _ MODES 0,2,  ALL CLA TYPES                         ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0100,  _   1 (RESP CKS),           0 (NO SPEC CKS)         ?
           $0087,  _   0 (NO CHX MODS),        TRUE, N0ION (INPUT ON)  ?
  
           $0D05,  _ MODE 0, 2,  CLA TYPES 0, 2, 3                     ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (CMD PARAMS)          ?
           $0100,  _   1 (RESP CKS),           0 (SPC CKS)             ?
           $0081,  _   0 (NO CHX MODS),       TRUE, NORTS (REQ TO SEND)?
  
           $0D05,  _ MODES 0, 2,  CLA TYPES 0, 2, 3                    ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (CMD PARAMS)          ?
           $0308,  _   3 (RESP CKS),           8 (SPEC CKS)            ?
           $008A,  _   (NO CHX MODS),      TRUE, N0ISR (INP SUP REPORT)?
  
           $0205,  _ MODES 0, 2,  CLA TYPE 1                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0308,  _   3 (RESP CKS),           8 (SPEC CKS)            ?
           $0081,  _   0 (NO CHX MODS),       TRUE, N0RTS (REQ TO SEND)?
  
           $0D05,  _ MODES 0, 2,  CLA TYPES 0, 2, 3                    ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0100,  _   1 (RESP CKS),           0 (NO SPECIAL CHECK)    ?
           $0001,  _   0 (NO CHX MODS),      FALSE, N0RTS (REQ TO SEND)?
  
           $0D05,  _ MODES 0, 2,  CLA TYPES 0, 2, 3                    ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0309,  _   3 (RESP CKS),           9 (SPC CKS)             ?
           $008A,  _   0 (NO CHX TBL MODS),   TRUE, N0ISR (INP SUP REP)?
  
           $0205,  _ MODES 0, 2,  CLA TYPE 1                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0309,  _   3 (RESP CKS),           9 (SPEC CKS)            ?
           $0001,  _   0 (NO CHX MODS),      FALSE, N0RTS (REQ TO SEND)?
  
           $0205,  _ MODES 0, 2,  CLA TYPE 1                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0100,  _   1 (RESP CKS),           0 (SPC CKS)             ?
           $0100,  _   1 (CHX TBL MODS),       0 (DEF CHX CHRCTSTCS)   ?
  
           $0205,  _ MODES 0, 2,  CLA TYPE 1                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0100,  _   1 (RESP CKS),           0 (SPEC CKS)            ?
           $0200,  _   2 (CHX TBL MODS),       0 (DEF CHX CHRCTRSTCS)  ?
  
           $0D05,  _ MODES 0, 2,  CLA TYPES 0, 2, 3                    ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0100,  _   1 (RSP CKS),            0 (SPEC CKS)            ?
           $0300,  _   3 (CHX TBL MODS),       0 (DEF CHX CHRCTRSTCS)  ?
  
           $1F05,  _ MODES 0, 2, ALL CLA TYPES                         ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (CMD PARAMS)          ?
           $0100,  _   1 (RESP CKS),           0 (NO SPEC CKS)         ?
           $0007,  _   0 (NO CHX MODS),        FALSE, N0ION (INPUT ON) ?
  
           $1E05,  _ NODES 0, 2,  CLA TYPES 1, 2, 3, 4                 ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (CMD PARAMS)          ?
           $040B,  _   4 (RSP CKS),            11 (SPC CKS)            ?
           $0085,  _   0 (NO CHK TBL MODS), TRUE,N0DTR(DATA TERM READY)?
  
           $0105,  _ MODES 0, 2,  CLA TYPES 0, 3                       ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (CMD PARAMS)          ?
           $040A,  _   4 (RESP CKS),           10 (SPC CKS)            ?
           $0085,  _   0 (NO CHX MODS),   TRUE, N0DTR (DATA TERM READY)?
  
           $0105,  _ MODES 0, 2,  CLA TYPES 0, 3                       ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (CMD PARAMS)          ?
           $040C,  _   4 (RESP CKS),           12 (SPC CKS)            ?
           $0005,  _   0 (NO CHX MODS),  FASLE, N0DTR (DATA TERM READY)?
  
           $1E05,  _ MODES 0, 2,  CLA TYPES 1, 2, 3, 4                 ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $040E,  _   4 (RESP CKS),           14 (SPEC CKS)           ?
           $0005,  _   0 (NO CHX MODS),  FALSE, N0DTR (DATA TERM READY)?
  
           $0205,  _ NODE 0, 2,  CLA TYPE 1                            ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $050F,  _   5 (RESP CKS),           15 (SPC CKS)            ?
           $0082,  _   0(NO CHX MODS), TRUE,N0SRTS(SECNDRY REQ TO SEND)?
  
           $0205,  _ MODES 0, 2,  CLA TYPE 1                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0510,  _   5 (RESP CKS),           16 (SPC CKS)            ?
           $0002,  _   0(NO CHX MODS),FASLE,N0SRTS RECNDRY REQ TO SEND)?
  
           $0201,  _ MODE 0, 2,  CLA TYPE 1                            ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (CMD PARAMS)          ?
           $0711,  _   7 (RESP CKS),           17 (SPC CKS)            ?
           $0084,  _   0 (NO CHX MODS),        TRUE, N0LM (LOCAL MODE) ?
  
           $0204,  _ MODE 2,  CLA TYPE 1                               ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0600,  _   6 (RSP TBL CKS),        0 (SPC CKS)             ?
           $0084,  _   0 (NO CHX MODS),        TRUE, N0LM (LOCAL MODE) ?
  
           $0201,  _ MODE 0,  CLA TYPE 1                               ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0700,  _   7 (RSP TBL CKS),        0 (SPC CKS)             ?
           $0004,  _   0 (NO CHX MODS),        FALSE, N0LM (LOCAL MODE)?
  
           $0204,  _ MODE 2,   CLA TYPE 1                              ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0600,  _   6 (RESP CKS),           0 (NO SPC CKS)          ?
           $0004,  _   0 (NO CHX MODS),        FALSE, N0LM (LOCAL MODE)?
  
           $0205,  _ MODES 0, 2,  CLA TYPE 1                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (CMD PARAMS)          ?
           $0800,  _   8 (RESP CKS),           0 (NO SPC CKS)          ?
           $0083,  _   0 (NO CHX MODS),     TRUE, M0OM (ORIGINATE MODE)?
  
           $0205,  _ MODES 0, 2,  CLA TYPE 1                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (CMD PARAMS)          ?
           $0800,  _   8 (RESP CKS),           0 (NO SPC CKS)          ?
           $0003,  _   0 (NO CHX MODS),    FALSE, M0OM (ORIGINATE MODE)?
  
           $0205,  _ MODES 0, 2,  CLA TYPE 1                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0100,  _   1 (RSP CKS),            0 (NO SPEC CKS)         ?
           $0086,  _   0 (CHX MODS),         TRUE, N0TB (TERMINAL BUSY)?
  
           $0205,  _ MODES 0, 2,  CLA TYPE 1                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0912,  _   9 (RESP TBL),           18 (SPC CKS)            ?
           $0006,  _   0 (NO CHX MODS),     FALSE, N0TB (TERMINAL BUSY)?
  
           $1D05,  _ MODES 0, 2,  CLA TYPES 0, 2, 3, 4                 ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0100,  _   1 (RESP CKS),           0 (NO SPC CKS)          ?
           $0400,  _   4 (CHX MODS),           0 (DEF CHX CHRCTRSTCS)  ?
  
           $0105,  _ MODES 0, 2,  CLA TYPE 0                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0A13,  _   10 (RESP CKS),          19 (SPC CKS)            ?
           $0084,  _   0 (NO CHX MODS),        TRUE, N0NSYN (NEW SYNCH)?
  
           $0405,  _ MODES 0, 2,  CLA TYPE 2                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0714,  _   7 (RSP CKS),            20 (SPEC CKS)           ?
           $0084,  _   0 (NO CHX MODS),        TRUE, N0NSYN (NEW SYNCH)?
  
           $0405,  _ MODES 0, 2,  CLA TYPE 2                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0A16,  _   10 (RSP CKS),           22 (SPEC CKS)           ?
           $0004,  _   0 (NO CHX MODS),       FALSE, N0NSYN (NEW SYNCH)?
  
           $0105,  _ MODES 0,2,  CLA TYPE 0                            ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0A17,  _   10 (RSP CKS),           23 (SPEC CKS)           ?
           $0004,  _   0 (NO CHX MODS),       FALSE, N0NSYN (NEW SYNCH)?
  
           $0801,  _ MODE 0,  CLA TYPE 3                               ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0A1B,  _   10 (RSP CKS),           27 (SPC CKS)            ?
           $0084,  _   0 (NO CHX MODS),        TRUE, N0NSYN (NEW SYNCH)?
  
           $0801,  _ MODE 0,  CLA TYPE 3                               ?
           $2000,  _   KQNOCMD (KQNOTEST),     0 (NO CMD PARAMS)       ?
           $0B1D,  _   11 (RSP CKS),           29 (SPC CKS)            ?
           $0000,  _   0 (NO CHX MODS),        N/A                     ?
  
           $1005,  _ MODES 0, 2,  CLA TYPE 4                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0A1F,  _   10 (RSP CKS),           31 (SPEC CKS)           ?
           $0084,  _   0 (NO CHX MODS),        TRUE, N0NSYN (LT ON)    ?
  
           $1005,  _ MODES 0, 2,  CLA TYPE 4                           ?
           $0E03,  _   NKCONTROL (CONTROL),    3 (ISR ALSO)            ?
           $0A23,  _   10 (RESP CKS),          35 (STATUS)             ?
           $0084,  _   N/A,                 TRUE, N0NSYN (ISR+LT AGAIN)?
  
           $1005,  _ MODES 0, 2,  CLA TYPE 4                           ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0A21,  _   10 (RSP CKS),           33 (SPEC CKS)           ?
           $0004,  _   0 (NO CHX CKS),         FALSE, N0NSYN (LT OFF)  ?
  
           $1F05,  _ MODES 0, 2,  ALL CLA TYPES                        ?
           $0E03,  _   NKCONTROL (CONTROL),    3 (CMD PARAMS)          ?
           $0000,  _   N/A,                    N/A                     ?
           $0081,  _   0 (NO CHX MODS),        TRUE, N0RTS (RTS)       ?
  
           $1F05,  _ MODES 0, 2,  ALL CLA TYPES                        ?
           $0E03,  _   NKCONTROL (CONTROL),    3 (CMD PARAMS)          ?
           $0219,  _   2 (RSP CKS),            25 (SPC CKS)            ?
           $008A,  _   0 (NO CHX MODS),       TRUE, N0ISR (INP SUP RES)?
  
           $1F05,  _ MODES 0, 2,  ALL CLA TYPES                        ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0000,  _   N/A,                    0 (NO SPECIAL CHECK)    ?
           $0001,  _   0 (NO CHX MODS),      FALSE, N0RTS (REQ TO SEND)?
  
           $1F05,  _ MODES 0, 2,  ALL CLA TYPES                        ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0309,  _   3 (RESP CKS),           9 (SPC CKS)             ?
           $008A,  _   NO CHX MODS,           TRUE, N0ISR (INP SUP RES)?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $2000,  _   KQNOCMD (NO COMMAND),   0 (NO CMD PARAMS)       ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   0 (NO CHX MODS),        N/A                     ?
  
           $1F05,  _ MODES 0, 2,  ALL CLA TYPES                        ?
           $0D00,  _   NKCLRL (CLEAR CLA),     0 (CMD PARAMS)          ?
           $0100,  _   1 (RSP CKS),            0 (SPC CKS)             ?
           $0000,  _   0 (NO CHX MODS),        N/A                     ?
  
           $1F09,  _ MODES 0, 3,  ALL CLA TYPES                        ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0100,  _   1 (RSP CKS),            0 (NO SPC CKS)          ?
           $008E,  _   0 (NO CHX MODS),     TRUE, N0LBT (LOOPBACK TEST)?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $0400,  _   NKINIL (INITIALIZE LINE), N/A                   ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
  
           $070F,  _ ALL MODES,  CLA TYPES 1, 2, 3                     ?
           $0500,  _   NKENBL (ENABLE LINE),   N/A                     ?
           $0201,  _   2 (RESP CKS),           1 (SPEC CHECKS OLE ETC) ?
           $0000,  _   N/A,                    N/A                     ?
  
           $1805,  _ MODES 0, 2,  CLA TYPES 3, 4                       ?
           $0506,  _   NKENBL (ENABLE LINE),   6 (CMD PARAMS)          ?
           $0201,  _   2 (CHECK STATUS),       1 (SPEC CHECKS OLE ETC) ?
           $0000,  _   N/A,                    N/A                     ?
  
           $180A,  _ MODES 1, 3,  CLA TYPES 3, 4                       ?
           $0506,  _   NKENBL (ENABLE LINE),   6 (CMD PARAMS)          ?
           $0201,  _   2 (CHECK STATUS),       1 (SPEC CHECKS OLE ETC) ?
           $0000,  _   N/A,                    N/A                     ?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $2000,  _   KQNOCMD (NO COMMAND),   N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $2000,  _   KQNOCMC (NO COMMAND),   N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $2000,  _   KQNOCMD (NO COMMAND),   N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO CMD PARAMS)       ?
           $0208,  _   2 (RESP CKS),           8 (SPEC CKS)            ?
           $008A,  _   0 (NO CHX MODS),       TRUE, N0ISR (INP SUP REP)?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $2000,  _   KQNOCMD (NO COMMAND),   N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
  
           $1F02,  _ MODE 1,  ALL CLA TYPES                            ?
           $0E00,  _   NKCONTROL (CONTROL),    0 (NO COMMAND PARAMS)   ?
           $0311,  _   3 (RESP CKS),           17 (SPECIAL CKS - DCD)  ?
           $008A,  _   N/A,                   TRUE, N0ISR (INP SUP REP)?
  
           $1A0F,  _ ALL MODES,  CLA TYPES 1, 3, 4                     ?
           $0604,  _   NKINPT (INPUT),         4 (NKISTAI=2)           ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
  
           $050F,  _ ALL MODES,  CLA TYPES 0, 2                        ?
           $0605,  _   NKINPT (INPUT),         5 (CMD PARAMS=3)        ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $2100,  _   KQCMDTST (MODEM TEST),  N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $0A00,  _   NKENDIN (END INPUT),    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
  
           $1F0F,  _ ALL MODES,  ALL CLA TYPES                         ?
           $0C00,  _   NKDISL (DISABLE LINE),  N/A                     ?
           $0000,  _   N/A,                    N/A                     ?
           $0000); _   N/A,                    NA/                     ?
  
_**************************************************** 
*                                                   * 
*    KQCMDPARM (COMMAND PARAMETERS TABLE) VALUES    * 
*                                                   * 
****************************************************? 
KQCMDPARM=($8B8A, $8E00,     _ SET ISON,  SET ISR,  SET LBT,  N/A      ?
           $8B8A, $0000,     _ SET ISON,  SET ISR,  N/A    ,  N/A      ?
           $8A00, $0000,     _ SET ISR ,  N/A    ,  N/A    ,  N/A      ?
           $0004, $0000,     _ NKISTAI ASYNC, SDLC                     ?
           $0006, $0000,     _ NKISTAI SYNC                            ?
           $0000, $8000,     _ NKUOPI FOR SDLC                         ?
           $8B8A, $0000);    _ SET ISON,  SET ISR,  N/A    ,  N/A      ?
  
_****************************************** 
*                                         * 
*    KQRSPTABL (RESPONSE TABLE) VALUES    * 
*                                         * 
******************************************? 
KQRSPTABL=($000A,            _TIMEOUT EXPECTED,   UNSOL CLA STATUS     ?
           $0109,            _CLA STATUS EXPECTED, NO CLA STATUS       ?
           $010C,            _CLA STATUS EXPECTED, NO STATUS AFTER RTS ?
           $010E,            _CLA STATUS EXPEDTED, NO STATUS AFTER DTR ?
           $0112,            _CLA STATUS EXPECTED, NO STATUS AFTER SRTS?
           $001B,            _TIMEOUT EXPECTED, UNSOLICITED STATUS A/L ?
           $0114,            _CLA STATUS EXPECTED, NO STATUS AFTER LM  ?
           $0016,            _TIMEOUT EXPECTED,  UNSOL STATUS AFTER OM ?
           $0117,            _CLA STATUS EXPECTED, NO STAT OR IMP OP TB?
           $0118,            _CLA STATUS EXPECTED, NO STATUS AFTER NSYN?
           $011D);           _CLA STATUS EXPECTED, STAT NOT CLRED A NSY?
  
_******************************************** 
*                                           * 
*    KQRSP2TBL (RESPONSE TABLE 2) VALUES    * 
*                                           * 
********************************************? 
                   _2/KQCKFL, 3/KQNMBR, 4/KQFLAG, 7/KQRSPN             ?
KQRSP2TBL=($2C83,  _0(SET), 5, 9(INPUT LOOP), 3                        ?
           $0404,  _0(SET), N/A, 8(OUTPUT LOOP), 4                     ?
           $0385,  _0(SET), N/A, 7(PARITY ERROR), 5                    ?
           $0286,  _0(SET), N/A, 5(FRAMING ERROR), 6                   ?
           $0307,  _0(SET), N/A, 6(DATA TRANSFER OVERRUN), 7           ?
           $0208,  _0(SET), N/A, 4(NXT CHR NOT AVLBL), 8               ?
           $800B,  _2(ANY SET), N/A, N/A, B(STAT NOT CLR AFTER ISON)   ?
           $478D,  _1(NOT SET), N/A, F(CLEAR TO SND),D(NO CTS AFTR RTS)?
           $078D,  _0(SET), N/A, F(CLEAR TO SND), D(NO CTS AFTER RTS)  ?
           $4D10,  _1(NOT SET),1,A(SIGNL QUALITY DET), 10(NO SQD A DTR)?
           $470F,  _1(NOT SET),N/A,E(DATA SET READY),F(NO DSR AFTR DTR)?
           $1510,  _0(SET),2,A(SIGNL QUALITY DTECT),10(NO SQD AFTR DTR)?
           $4611,  _1(NOT SET), N/A, C(RING), 11(NO RING AFTR RTS)     ?
           $070F,  _0(SET), N/A, E(DATA SET READY), F(NO DSR AFTR DTR) ?
           $4593,  _1,N/A,B(SEC RCVD LINE SIG DET),13(NO SRLSD A. SRTS)?
           $0593,  _0,N/A,B(REC RCVD LINE SIG DET),13(NO SRLSD A. SRTS)?
           $4695,  _1(NOT SET),N/A,D(DATA CARRIER DET),15(NO DCD A. LM)?
           $4617,  _1(NOT SET), N/A, C(RING), 17(NO STAT, IMP OP AFTER)?
           $5599,  _1(N SET),2,B(ORIG MODE),19(IMP OF OF DCD,RI,OM,SQD)?
           $5E99,  _1,1,D(DATA CARRIER DET),19(IMP OP OF DCD,RI,OM,SQD)?
           $0619,  _0(SET), N/A, C(RING), 19(IMP OP OF DCD,RI,OM,SQD)  ?
           $5619,  _0(NOT SET), 2, C(RING), 19(IMP OP OF RI AFTER NSYN)?
           $0E99,  _0,1,D(DATA CARRIER DET),19(IMP OP OF DCD AFTR NSYN)?
           $0599,  _0(SET), N/A,B(ORIG MODE),19(IMP OP OF OM AFTR NSYN)?
           $4F8D,  _1(NOT SET), 1, F(CLEAR TO SND), D(NO CTS AFTR RTS) ?
           $061A,  _0(SET), N/A, C(RING), 1A(NO RING AFTER RTS)        ?
           $4E99,  _1(NOT SET), 1,D(ORIG MODE),19(NO OM AFTR NSYN-SDLC)?
           $4599,  _1, N/A,B(SIG QUALITY DET),19(NO SQD AFTR NSYN-SDLC)?
           $0E99,  _0(SET), 1, D(DATA CARRIER DET),19(NO DCD AFTR NSYN)?
           $0599,  _0(SET), N/A,B(SIG QUALITY DET),19(NO SQD AFTR NSYN)?
           $4E99,  _1(NOT SET), 1, D, 19                               ?
           $4619,  _1(NOT SET), N/A, C, 19                             ?
           $0E99,  _0(SET), 1, D, 19                                   ?
           $0619,  _0(SET), N/A, C, 19                                 ?
           $4E99,  _1(NOT SET), 1, D(DCD STILL ON), 19(NO DCD)         ?
           $0619); _0(SET), N/A, C(NO RING), 19(RI DI NOT DROP)        ?
  
_****************************************************** 
*                                                     * 
*    KQCHRXMST (CHAR TRANSMISSION TABLE) VALUES       * 
*                                                     * 
******************************************************? 
KQCHRXMST = ($FFF0, $0000, $FFF0, $7000, $0000, $7000, $0000, $7016); 
  
_************************************** 
*                                     * 
*    LINE TYPES FOR CLA TYPES         * 
*                                     * 
**************************************? 
KQLTYP = (1, 4, 1, $A, $A); 
  
_**********************************************************************?
_*       S U B R   T O   C H E C K   S T A T U S                      *?
_**********************************************************************?
PROCEDURE PDCKSTAT;                    _CHECK CLA STATUS               ?
PROCEDURE SETABORT; 
BEGIN 
  KQLOCLCB'.BZTCBPTR'.BZDCB.NZABORT := TRUE;_EXIT                      ?
  KQI := NNBR;
END;
_?
BEGIN 
  NNBR := KQRSP2TBL[KQI].KQNMBR + KQI; _SET NUMBER OF TESTS TO CHECK   ?
      WITH BWWLENTRY[OPS].B0EWLQ,           _WITH OVERFLOW RESP TABLE  ?
           KQLOCLCB'.BZTCBPTR'.BZDCB DO     _ WITH DCB                 ?
  BEGIN 
    REPEAT                             _START LOOP                     ?
      WITH KQRSP2TBL[KQI] DO           _WITH OVERFLOW RESPONSE TABLE   ?
      BEGIN 
        RCODE.BAINT := KQRSPN;         _SET RESPONSE CODE              ?
        K     := KQFLAG;               _SET STAT COND TO CHECK FOR     ?
        KQACTDA := MMWD2 ;                  _SAVE ACTUAL STATUS        ?
        IF (NZCTYP = N0SYNC) !              _IF CLA TYPE               ?
           (NZCTYP = N0NORS232)             _IS SYNC (2560)            ?
          THEN
            MMWD2.BABOOL.B0B0 := FALSE      _RESET BUFFERED ID BIT     ?
          ELSE                              _FOR ALL OTHER TYPES       ?
            MMWD2.BABOOL.B0B10 := FALSE;    _RESET BUFFERED ID BIT     ?
        KQTMP.BAINT := 0;              _CLEAR RECEIVING VARIABLE       ?
        INSERT(1,K,KQTMP.BAINT);       _SET BIT TO CHECK FOR           ?
        KQEXPDA := KQTMP;              _SAVE STATUS CONDITION TESTED   ?
        CASE KQCKFL OF                 _SELECT TEST TO CHECK           ?
_                                                                      ?
        0:  
        IF (KQTMP.BASET @ MMWD2.BASET) _CHECK FLAG SET                 ?
          THEN SETABORT;                    _ EXIT WHEN FLAG SET       ?
_                                                                      ?
        1:  
        IF NOT (KQTMP.BASET @ MMWD2.BASET)_CHECK FLAG NOT SET          ?
          THEN SETABORT;                    _ EXIT WHEN FLAG NOT SET   ?
_                                                                      ?
        2:  
        IF MMWD2.BASET " [ ]           _CHECK STATUS FOR ANY FLAG SET  ?
          THEN SETABORT;                    _ EXIT WHEN ANY FLAG SET   ?
        END;                           _END CASE                       ?
      END;                             _END WITH KQRSP2TBL             ?
      KQI := KQI + 1;                  _BUMP POINTER                   ?
    UNTIL KQI = NNBR + 1;              _UNTIL ALL TESTS HAVE BEEN CHKED?
  END;                                 _END WITH SIT                   ?
END;                                   _END PDCKSTAT                   ?
_**********************************************************************?
_*       SUBROUTINES TO SAVE RETURN ADDRESS AND TO RETURN             *?
_**********************************************************************?
PROCEDURE PTSV1LCB;                    _SAVE RETURN ADDRESS            ?
  BEGIN 
  RETADR(KQLOCLCB'.BZRET1ADDR);        _SAVE RETURN ADDRESS IN LCB     ?
  GOTO EXIT 999;
  END;  _END OF PTSV1LCB ?
PROCEDURE PTRT1LCB;                    _RETURN TO SAVED ADDRESS        ?
  BEGIN 
  RETURN(KQLOCLCB'.BZRET1ADDR);        _RE-ENTER OLDIAG AT SAVED ADDR  ?
  END;  _END OF PTRT1LCB ?
_**********************************************************************?
_*       BEGIN MAIN DIAGNOSTIC PROCESSING                             *?
_**********************************************************************?
BEGIN                                  _BEGIN MAIN PROGRAM             ?
  NQDBGA [NQDBGI] := BWWLENTRY [OPS].B0EWLQ;_ SAVE WORK ENTRY FOR DEBUG?
  NQDBGI          := (NQDBGI + 1) MOD 20;   _ UPDATE SAVE INDEX        ?
  PBLCBP(BWWLENTRY[OPS].B0EWLQ.MMLINO,KQLOCLCB);
                                       _GET LCB ADDRESS                ?
  WITH KQLOCLCB',                      _WITH LINE CONTROL BLOCK        ?
       BZTCBPTR'.BZDCB,                _WITH DIAGNOSTIC CONTROL BLOCK  ?
       BWWLENTRY[OPS].B0EWLQ DO        _WITH WORKLIST ENTRY            ?
  BEGIN 
  IF BZDIAG THEN                       _IF DIAGNOSTIC IN PROCESS       ?
  CASE MMWKCOD  OF
_**********************************************************************?
_*       TIMEOUT                                                      *?
_**********************************************************************?
    A0TIMEOUT:  
      IF NZTSTYP=0 THEN                _COMMAND TEST TIMEOUT           ?
      BEGIN                            _BEGIN CMDTST                   ?
       KQACTDA.BAINT := $FFFF;         _FFFF = NO STATUS RECEIVED      ?
       IF NZPAS1 THEN K:=0 ELSE        _IF FIRST PASS, SET K=0 ELSE    ?
       K := KQCNTRTBL[NZIX].KQCLNY;    _SET RESPONSE TABLE INDEX       ?
       IF K = 0 THEN                   _IF RESPONSE IS NOT TO BE CHECKD?
         PTRT1LCB                      _THEN RETURN TO MAIN LOOP       ?
       ELSE                            _ELSE                           ?
        WITH KQRSPTBL[K] DO            _WITH RESPONSE TABLE            ?
        BEGIN 
          RCODE.BAINT := KQRESP;       _SET UP RESPONSE CODE           ?
          IF KQCKWT=0 THEN             _IF TIMEOUT EXPECTED THEN       ?
            PTRT1LCB                   _RETURN TO MAIN PROCESSING      ?
          ELSE                         _ELSE EXIT TO ERROR ROUTINE     ?
            PDEXT1; 
        END;                           _END WITH, END IF K " 0         ?
      END                              _END COMMAND TEST TIMEOUT       ?
      ELSE                             _ELSE INPUT DATA TIMEOUT        ?
      BEGIN                            _BEGIN VERIFICATION FOR TIMEOUT ?
        RCODE.BAINT := $1C;            _SET RESPONSE CODE              ?
        PDEXT1;                        _EXIT                           ?
      END;                             _END A0TIMEOUT                  ?
_**********************************************************************?
_*       STATUS                                                       *?
_**********************************************************************?
    MMCLAS: 
      IF NZTSTYP=0 THEN                _COMMAND TEST STATUS            ?
      BEGIN                            _BEGIN CMDTST                   ?
      IF NZPAS1 THEN                   _IF FIRST PASS, THEN RETURN     ?
       PTRT1LCB                        _TO MAIN LOOP                   ?
      ELSE
       BEGIN
       K := KQCNTRTBL[NZIX].KQCLNY;    _SET RESPONSE TABLE INDEX       ?
       IF K = 0 THEN                   _IF RESPONSE IS NOT TO BE CHECKD?
         PTRT1LCB                      _THEN RETURN TO MAIN LOOP       ?
       ELSE                            _ELSE                           ?
        WITH KQRSPTBL[K] DO            _WITH RESPONSE TABLE            ?
        BEGIN 
          RCODE.BAINT := KQRESP;       _SET UP RESPONSE CODE           ?
          IF KQCKWT=1 THEN             _IF STATUS EXPECTED THEN        ?
            BEGIN 
              KQI := 1;                _SET INDEX                      ?
              PDCKSTAT;                _CK FOR ILE,OLE,PES,FES,DTO     ?
              IF KQCNTRTBL[NZIX].KQCLMR_CK SPECIAL CKS FLAG SET        ?
                " 0 
              THEN
              BEGIN                    _DO SPECIAL CKS ON STATUS       ?
                KQI := KQCNTRTBL[NZIX]._SET TEST INDEX                 ?
                  KQCLMR; 
                PDCKSTAT;              _CHECK STATUS                   ?
              END;
              PTRT1LCB;                _RETURN TO MAIN PROCESSING      ?
          END 
          ELSE                         _ELSE EXIT TO ERROR ROUTINE     ?
            PDEXT1;                    _EXIT                           ?
        END;                           _END WITH, END IF K " 0         ?
       END;                            _END ELSE TO IF NZPAS1          ?
      END                              _END COMMAND TEST STATUS        ?
      ELSE                             _ELSE DVT STATUS                ?
      BEGIN                            _UNSOL STATUS DURING DVT        ?
        BLTIMTBL'[MMPORT].BLTIME := 0; _SET TIMER OFF                  ?
        RCODE.BAINT := $1D;            _SET RESPONSE CODE              ?
        KQEXPDA.BAINT := $FFFF;        _FFFF FOR NONE EXPECTED DATA    ?
        KQACTDA := BWWLENTRY[OPS].B0EWLQ.MMWD2;  _SAVE ACTUAL STATE    ?
        PDEXT1;                        _EXIT                           ?
      END;                             _END MMCLAS                     ?
_**********************************************************************?
_*       DATA VERIFICATION - INPUT RECEIVED                           *?
_**********************************************************************?
    KQINP:  
    BEGIN 
     BLTIMTBL'[MMPORT].BLTIME := 0;    _SET TIMER OFF                  ?
     KQINBUF := MMIBP;                 _SET INPUT BUFFER POINTER       ?
     RCODE.BAINT := 0;                 _CLEAR ERROR CODE               ?
     IF NZPAS1 = FALSE THEN            _IF NOT FIRST PASS CHECK DATA   ?
      FOR L := 0 TO 3 DO               _CHECK RECEIVED DATA PACKET     ?
      BEGIN 
        KQACTDA.BAINT := KQINBUF'.NEDAT.NECHR[L]; _SAVE RECEIVED DATA  ?
        KQEXPDA.BAINT := NZDATA[NDRESAD[NZDCN1]].NECHR[L];
                                       _SAVE EXPECTED DATA             ?
        IF KQACTDA " KQEXPDA THEN      _IF THE EXPECTED DATA DOES NOT  ?
        BEGIN                          _EQUAL RECEIVED DATA THEN       ?
          RCODE.BAINT := NZDCN1 + $1E; _SET RESPONSE CODE              ?
          L := 3;                      _BUMP COUNTER TO END OF LOOP    ?
        END; _IF? 
      END; _FOR, IF?
     PBRELZRO(MMIBP,BEDBSIZE);         _RELEASE BUFFER IF PRESENT      ?
     PTRT1LCB;                         _RETURN TO MAIN PROCESSING      ?
    END;                               _END KQINP                      ?
_**********************************************************************?
_*       MULTIPLEX SUBSYSTEM BUFFER THRESHOLD DETECTED                *?
_**********************************************************************?
    KQMUXBF:  
    BEGIN 
      BLTIMTBL'[MMPORT].BLTIME := 0;   _SET TIMER OFF                  ?
      RCODE.BAINT := $38;              _SET RESPONSE CODE              ?
      PDEXT1;                          _EXIT                           ?
    END;                               _END KQMUXBF                    ?
_**********************************************************************?
_$       DATA VERIFICATION - BAD CRC ON SDLC                          $?
_**********************************************************************?
    KQCRCER:  
    BEGIN 
      BLTIMTBL'[MMPORT].BLTIME := 0;   _SET TIMER OFF                  ?
      RCODE.BAINT := $1E;              _SET RESPONSE CODE              ?
      PBRELZRO(MMIBP,BEDBSIZE);        _RELEASE BUFFER IF PRESENT      ?
      PTRT1LCB;                        _RETURN TO MAIN PROCESSING      ?
   END;                                _END KQCRCER                    ?
_**********************************************************************?
_*       HARDERROR                                                    *?
_**********************************************************************?
    MMUNSIN:  
    BEGIN 
      RCODE.BAINT := 1;                _SET RESPONSE CODE              ?
      PDEXT1;                          _EXIT                           ?
    END;                               _END MMUNSIN                    ?
_**********************************************************************?
_*        MAIN BODY OF OLDIAG                                          ?
_**********************************************************************?
    KQDIAG:                            _CONTINUE DIAGNOSTIC PROCESSING ?
    BEGIN 
      NZPAS1 := TRUE;                  _SET FIRST PASS FLAG            ?
      RCODE.BAINT := 0;                _RESET ERROR CODE               ?
      REPEAT                           _MAIN DIAGNOSTIC LOOP           ?
        NZISON := TRUE;                _SET FLAG IN DCB                ?
        NZIX   := 0;                   _CLEAR INDEX INTO CONTROL TABLE ?
        WHILE NZIX @ KQENTS DO         _INDEX @ NO OF TABLE ENTRYS     ?
        BEGIN 
         WITH KQCNTRTBL[NZIX],         _WITH CONTROL TABLE ENTRY       ?
              NJTECT[N0TDIAG] DO       _WITH NJTEXT TABLE ENTRY        ?
          BEGIN 
          KQTMCT := NZTMCT;            _GET CLA TYPE AND TEST MODE     ?
          IF NZPAS1 THEN               _IF 1ST PASS THEN TEST INTERNAL ?
            KQTMCT.BARBYT := KQMOD3;   _DATA ONLY                      ?
          IF (KQTMCT.BASET @ KQMSTS.BASET)  _CHECK MODE/CLA TYPE       ?
          THEN
          BEGIN                        _PROCESS IF MODE/CLA TYPE MATCH ?
            NZWAIT := TRUE;            _SET WAIT FLAG                  ?
            KQTIME := 2;               _SET TIMEOUT PERIOD             ?
            CASE KQCMMD OF             _CASE ON COMMAND                ?
_ 
                                                                       ?
_                   ***********************************                ?
_                  *INITIALIZE, DISABLE             *                  ?
_                   ***********************************                ?
            NKINIL,                    _INITIALIZE COMMAND             ?
            NKDISL:                    _DISABLE LINE                   ?
            BEGIN 
              NZWAIT        := FALSE;  _RESET WAIT FLAG                ?
              NZDPAK.NKLTYP := N0LDIAG;_SET LINE TYPE IN COMMAND PACKET?
            END;                       _END INIL, ENDIN, DISL          ?
_ 
                                                                       ?
_                  **********************************                  ?
_                  *END INPUT                       *                  ?
_                  **********************************                  ?
           NKENDIN: 
           BEGIN
             NZWAIT := FALSE;          _RESET WAIT FLAG                ?
             NZDPAK.NKRELBFS := TRUE;  _SET RELEASE INPUT BUFFERS      ?
           END; 
_                   ***********************************                ?
_                   *CLEAR LINE                       *                ?
_                   ***********************************                ?
            NKCLRL:                    _CLEAR COMMAND                  ?
              NZDPAK.NKLTYP := N0LDIAG;_SET LINE TYPE IN COMMAND PACKET?
_ 
                                                                       ?
_                   ***********************************                ?
_                   *ENABLE LINE                      *                ?
_                   ***********************************                ?
            NKENBL:                    _ENABLE COMMAND                 ?
            BEGIN 
             NZD0R := N0TDIAG;         _SET TERMINAL CLASS             ?
              KQTIME:= 3;              _SET TIMEOUT PERIOD             ?
              IF KQCMPR " 0            _CHECK IF MORE COMMAND PARAMS   ?
              THEN
                NZDPAK.NKWD2.BAINT :=  _SET COMMAND PACKET WITH PARAM  ?
                  KQCMDPARM[KQCMPR].KQCMP1; 
                NZDPAK.NKWD3.BAINT :=  _SET COMMAND PACKET WITH PARAM  ?
                  KQCMDPARM[KQCMPR].KQCMP2; 
            END;                       _END ENABLE                     ?
_ 
                                                                       ?
_                   ***********************************                ?
_                   *CONTROL                          *                ?
_                   ***********************************                ?
            NKCONTROL:                 _CONTROL COMMAND                ?
            BEGIN 
              NZFNC1 := KQFNCT;        _SET COMMAND PACKET FUNCTION 1  ?
              IF KQCMPR " 0            _CHECK IF MORE COMMAND PARAMS   ?
              THEN
              BEGIN 
                WITH KQCMDPARM[KQCMPR] DO_WITH CMDPARM TABLE           ?
                BEGIN 
                  NZFNC2 := KQFNC1;    _SET COMMAND PACKET FUNCTION 2  ?
                  NZFNC3 := KQFNC2;    _SET COMMAND PACKET FUNCTION 3  ?
                  NZFNC4 := KQFNC3;    _SET COMMAND PACKET FUNCTION 4  ?
                  NZFNC5 := KQFNC4;    _SET COMMAND PACKET FUNCTION 5  ?
                END;                   _END WITH                       ?
              END;                     _END IF                         ?
              IF NZISON                _CHECK STATUS REQUEST FLAG      ?
              THEN
              BEGIN 
                PKT.NKCMD := NKSPECIAL;     _ACCESS MUX TABLE COMMAND  ? DG1
                PKT.NKWD1.BAINT := 1;       _SUB-COMMAND               ? DG1
                PKT.NKWD2.BAINT := NZPORT;  _PORT                      ? DG1
                PBCOIN(PKT);                _SET ISON IN PORT TABLE    ?
                NZDPAK.NKTCLS:=0;      _SET TRANS KEY IN COMMAND PACKET?
                NZISON := FALSE;       _RESET STATUS REQUEST FLAG      ?
              END;                     _END IF                         ?
              IF KQCHTR " 0            _CHECK FOR CHAR TRANS MODIFICAT ?
              THEN
              BEGIN 
                NZD0R := N0TDIAG;           _SET TERMINAL CLASS        ?
                NJPARITY :=                 _STORE PARITY IN TERM CLASS?
                  KQCHRXMST[KQCHTR].NEPARY; 
                NJCHLEN :=                  _STORE CHARACTER LENGTH    ?
                  KQCHRXMST[KQCHTR].NECHLEN;
                NJSYNC :=                   _STORE SYNC CHAR           ?
                  KQCHRXMST[KQCHTR].NESYCAR;
                PKT.NKCMD := NKSPECIAL;     _ACCESS MUX TABLE COMMAND  ? DG1
                PKT.NKWD1.BAINT := 2;       _SUB-COMMAND               ? DG1
                PKT.NKWD2.BACTCT :=         _CHAR XMISSION CHRTERISTIC ? DG1
                  KQCHRXMST[KQCHTR].DIATCT;                              DG1
                PBCOIN(PKT);                _UPDATE NICTCT             ?
              END;                     _END IF                         ?
            END;                       _END CONTROL                    ?
_ 
                                                                       ?
_                   ***********************************                ?
_                   *INPUT                            *                ?
_                   ***********************************                ?
            NKINPT:                    _INPUT COMMAND                  ?
            BEGIN 
              NZDPAK.NKISTAI :=        _SET INPUT STATE IN CMD PACKET  ?
                KQCMDPARM[KQCMPR].KQCMP1; 
              NZWAIT := FALSE;         _WAIT NOT REQUIRED              ?
            END;                       _END INPUT                      ?
_ 
                                                                       ?
_                   ***********************************                ?
_                   *NO COMMAND                       *                ?
_                   ***********************************                ?
            KQNOCMD:                   _NO COMMAND                     ?
            KQTIME := 3;               _SET TIMEOUT PERIOD             ?
_ 
                                                                       ?
_                   ***********************************                ?
_                   *DATA VERIFICATION TEST           *                ?
_                   ***********************************                ?
            KQCMDTST:                  _MODEM LOOPBACK TEST            ?
            BEGIN 
              NZDCN1 := NZDCNS;        _INITIALIZE LOOP COUNTER        ?
              WHILE NZDCN1 @ NZDCNF DO _COUNTER @ LOOP FINAL COUNT     ?
              BEGIN 
                PKT.NKCMD := NKSPECIAL;     _ACCESS MUX TABLE COMMAND  ? DG1
                PKT.NKWD1.BAINT := 2;       _SUB-COMMAND               ? DG1
                PKT.NKWD2.BACTCT :=         _CHAR XMISSION CHRTERISTIC ? DG1
                  NDIAGCT[NZDCN1].DIATCT;                                DG1
                PBCOIN(PKT);                _UPDATE NICTCT             ?
                KQSUBT.BARBYT := NZDCN1;    _SAVE DATA INDEX           ?
                NZD0R := N0TDIAG;           _SET TERMINAL CLASS        ?
                NJPARITY :=                 _STORE PARITY IN TERM CLASS?
                  NDIAGCT[NZDCN1].NEPARY; 
                NJCHLEN :=                  _STORE CHARACTER LENGTH    ?
                  NDIAGCT[NZDCN1].NECHLEN;
                NJSYNC :=                   _STORE SYNC CHAR           ?
                  NDIAGCT[NZDCN1].NESYCAR;
                PDCOMD(NKCONTROL);          _ISSUE CONTROL COMMAND     ?
                NZOBP := KQMSGPTR[NZMSGX];  _SET OUTPUT MSG ADDRESS    ?
                PDCOMD(NKDOUT);             _ISSUE OUTPUT COMMAND      ?
                NZTSTYP := 1;               _SET SUBCODE TO DATA VERIFY?
                BLTIMTBL'[MMPORT].          _START TIMER               ?
                  BLTIME := 40; 
                PTSV1LCB;                   _SAVE RETURN ADDRESS       ?
_                                                                      ?
_              *****     RETURN HERE FOR VERTST PROCESSING    *****    ?
_                                                                      ?
                IF RCODE.BAINT " 0 THEN     _CHECK RESPONSE CODE FOR ER?
                BEGIN 
                  NZABORT := TRUE;          _SET ERROR EXIT FLAG       ?
                  NZDCN1  := NZDCNF + 1;    _ BUMP COUNTER TO END      ?
                END 
                ELSE
                BEGIN 
                NZDCN1 := NZDCN1 + 1;       _UPDATE LOOP COUNTER       ?
                IF  NOT NZPAS1  THEN        _IF NOT PASS 1             ?
                  IF NZDCN1 > NZDCNF  THEN  _IF AT END OF LOOP         ?
                    BEGIN 
                    INST($0A01,             _SET A REG = TRUE          ?
                         $0181,             _SKIP IF SELEC SKIP SW SET ?
                         $0844,             _SET A REG = FALSE         ?
                         $6400,PBSLJ);      _SAVE A REG AT PBSLJ       ?
                    IF  PBSLJ  THEN         _IF PBSLJ IS TURE          ?
                      NZDCN1 := NZDCNS;     _RESET LOOP COUNTER        ?
                    END;
                END; _ ELSE ? 
              END;                          _END WHILE                 ?
            END;                       _END CASES OF KQCMDTST          ?
            END;                       _END CASES OF KQCMMD            ?
_**********************************************************************?
_*       CONTINUE MAIN PROGRAM                                        *?
_**********************************************************************?
            IF KQCMDTST " KQCMMD       _SKIP IF KQCMDTEST              ?
            THEN
            BEGIN 
              IF KQNOCMD " KQCMMD      _SKIP IF KQNOCMD                ?
              THEN
                PDCOMD(KQCMMD);        _ISSUE COMMAND                  ?
              IF NKENBLE = KQCMMD 
              THEN
                NAPORT'[NZPORT].NALCBP'.NCARRY[16]
                 := KQLTYP[NZCTYP];    _PLACE LINE TYPE IN MUX LCB     ?
              IF NZWAIT                _CK WAIT FLAG ON                ?
              THEN
              BEGIN 
                NZTSTYP := 0;          _SET SUBCODE TO COMMAND TEST    ?
                KQSUBT.BARBYT := NZIX; _SAVE CONTROL TABLE NUMBER      ?
                BLTIMTBL'[MMPORT].          _START TIMER               ?
                    BLTIME := KQTIME;       _                          ?
                PTSV1LCB;                   _SAVE RETURN ADDRESS       ?
                IF KQCMMD = KQNOCMD THEN     _EXPIRE TIMER ON NOCMD    ?
                  WHILE BLTIMTBL'[MMPORT].  _KEEP RETURNING HERE       ?
                    BLTIME " 0 DO           _UNTIL THE TIMER HAS       ?
                    PTSV1LCB;               _EXPIRED                   ?
              END;                     _END IF NZWAIT                  ?
            END;                       _END IF KQCMDTST                ?
          END;                         _END IF NZMDCL                  ?
        END;                           _END KQCNTRTBL                  ?
         IF NZABORT ! NZTERM           _IF ANY ABORT FLAGS             ?
         THEN 
          NZIX := KQENTS;              _JUMP TO END                    ?
        NZIX := NZIX + 1;              _UPDATE INDEX INTO CONTROL TABLE?
      END;                             _END WHILE NZIX                 ?
      NZPAS1 := FALSE;                 _CLEAR FIRST PASS FLAG          ?
       UNTIL NZABORT ! NZTERM;         _REPEAT UNTIL ANY ABORT FLAGS   ?
      IF NZABORT THEN                  _IF NZABORT THEN                ?
        PDEXT1                         _TAKE ERROR EXIT                ?
      ELSE                             _OTHERWISE                      ?
        BEGIN 
        PDEXIT;                        _CLEAN UP LCB/DCB               ?
        END;
    END;                               _END KQDIAG                     ?
   END;                                _END CASE MMWKCOD OF            ?
  END;                                 _END WITH                       ?
999:  
END;                                   _END OLDIAG                     ?
