*DECK DIAGXEQ 
USETEXT TENVIRN 
      PROC DIAGXEQ; 
      BEGIN 
      XREF FUNC BINDEC C(10);      # BINARY TO DECIMAL CONVERSION      #
      XREF FUNC CHKCUR B;          # DETERMINE IF CURWORD IS SATISFIED #
      XREF FUNC CHKNEX B;          # DETERMINE IF NEXWORD IS SATISFIED #
      XREF PROC CMOVE;             # CHARACTER MOVE ROUTINE            #
      XREF ITEM CURLENG;           # CURRENT TOKEN LENGTH              #
      XREF ARRAY CURWORD;          # CURRENT TOKEN FROM DIRECTIVE SCAN #
        BEGIN 
        ITEM  ICW C(0,0,10);
        END 
      XREF ITEM DIAGN;             # DIAGNOSTIC NUMBER                 #
      XREF ITEM DIAGPTR;           # POINTER TO TEXT OF DIAGNOSTIC     #
      XREF FUNC DIAPARM;           # RETURN NEXT DIAGNOSTIC PARAMETER  #
      XREF ITEM HELPFLG;           # 0 IF DIAGNOSTIC TEXT              #
      XREF ITEM LINES;             # NUMBER OF LINES ON TERMINAL       # QU3A335
      XREF ITEM NEXLENG;           # NEXT TOKEN LENGTH                 #
      XREF BASED ARRAY KEYWSA[0] S(1);  # HOLDS CURRENT SESS. NAME AND #
                                        # XMISSION-ID DURING A PERFORM #
        BEGIN 
        ITEM KEYAREA  C(0,0,10);
        END 
      XREF ARRAY NEXWORD;          # NEXT TOKEN FROM DIRECTIVE SCAN    #
        BEGIN 
        ITEM INW C(0,0,10); 
        END 
      XREF PROC WRITE;             # WRITE A LINE                      #
      XREF PROC WRITEBL;           # WRITE A LINE AND CHECK LINE COUNT # QU3A335
      ITEM A I;                    # SCRATCH CELL                      #
      ITEM B I;                    # WORD POSITION FOR CHAR FETCH      #
      ITEM C I;                    # SCRATCH FOR SPECIAL CHARACTER     #
      ITEM D I;                    # DESTINATION CHARACTER NUMBER      #
      ITEM DLG;                    # LENGTH OF NEW STRING TO ADD TO MSG#
      ITEM DONE B;                 # FOR LOOP CONTROL VARIABLE         #
      ITEM DUMMY I;                # DUMMY FOR LOOP VARIABLE           #
      ITEM FROMC I;                # SOURCE CHARACTER NUMBER           #
      ITEM I I;                    # CHARACTER POINTER FOR KEYAREA     #
      ITEM J I;                    # CHARACTER POINTER FOR DIAGM       #
      ITEM K I;                    # WORD POINTER FOR DIAGM            #
      ITEM MSG1 C(62) = 
        " THERE EXISTS NO *HELP* TEXT FOR THIS DIRECTIVE OR DIAGNOSTIC."
        ; 
      ITEM MSG2 C(27) = 
        " (***) UNKNOWN DIAG NUMBER.";
      ITEM MSG3 C(37) = 
        " INTERNAL ERROR PROCESSING DIAG ****.";
      ITEM TC I;                   # CHAR NUMBER DURING CHAR FETCH     #
      BASED ARRAY DIAGTP[0:0] S(1);  # FWA OF DIAGNOSTIC/HELP TEXT     #
        BEGIN 
        ITEM DIAGTEXT C(0,0,10);
        END 
      BASED ARRAY PARM;            # FWA OF CHARACTER MOVE DESTINATION #
        BEGIN 
        ITEM INSRT1 C(0,0,10);
        END 
      ARRAY DIAGMES [0:11] S(1);   # MESSAGE BUILT INTO THIS ARRAY     #
        BEGIN 
        ITEM DIAGM C(0,0,10); 
        END 
      ARRAY FA [0:1] S(1);         # FWA OF STRING TO BE ADDED TO MSG  #
        BEGIN 
        ITEM DICWORD C(0,0,10); 
        END 
#----------------------------------------------------------------------#
#                                                                      #
#     G E T A                                                          #
#                                                                      #
# THIS PROC RETURNS THE NEXT CHARACTER FROM THE SOURCE STRING.         #
#----------------------------------------------------------------------#
      PROC GETA;
      BEGIN 
      B = FROMC / 10; 
      TC = FROMC - 10 * B;
      FROMC = FROMC + 1;
      A = C<TC,1>DIAGTEXT[B];      # GET THE NEXT CHARACTER            #
      RETURN; 
      END 
#----------------------------------------------------------------------#
#                                                                      #
#     G E T S P C                                                      #
#                                                                      #
# THIS PROC TRANSFERS CHARACTERS FROM THE SOURCE STRING TO THE         #
# DESTINATION STRING UNTIL AN END OF LINE OR <X> IS ENCOUNTERED.       #
# IF WE ARE IN HELP TEXT MODE THEN WE IGNORE ANY OCCURENCE OF <X>      #
# AND TERMINATE ONLY ON AN END OF LINE.                                #
#     EXIT (A) = SPECIAL CHARACTER X WHERE <X> WAS ENCOUNTERED IN THE  #
#          TEXT OR 0 IF THE END OF LINE WAS ENCOUNTERED.               #
#----------------------------------------------------------------------#
      PROC GETSPC;
      BEGIN 
      DONE = FALSE; 
      FOR DUMMY = DUMMY 
      WHILE A NQ 0
        AND NOT DONE
      DO
        BEGIN 
        GETA;                      # GET THE NEXT CHARACTER            #
        IF A EQ 0 
        THEN
          BEGIN 
          TEST DUMMY; 
          END 
        IF A EQ "<" 
        THEN
          BEGIN 
          GETA;                    # GET SPECIAL CHARACTER IF ANY      #
          C = A;                   # SAVE CHARACTER                    #
          GETA;                    # GET DELIMITING BRACKET IF ANY     #
          IF A NQ ">"              # IF THIS IS NOT <X>                #
            OR HELPFLG NQ 0        # IF WE ARE PROCESSING HELP TEXT    #
          THEN
            BEGIN 
            A = "<";               # BACKUP AND RETURN THE CHARACTER   #
            FROMC = FROMC - 2;
            END 
          ELSE
            BEGIN 
            A = C;                 # RESTORE CHARACTER                 #
            DONE = TRUE;
            TEST DUMMY; 
            END 
          END 
        B = D / 10;                # WORD NUMBER                       #
        TC = D - 10 * B;           # CHARACTER NUMBER                  #
        D = D + 1;                 # INCREMENT DESTINATION COUNT       #
        IF D GQ 120                # IF LINE IS TOO LONG TRUNCATE      #
        THEN
          BEGIN 
          A = 0;                   # RETURN END OF LINE                #
          D = 120;
          TEST DUMMY; 
          END 
        C<TC,1>DIAGM[B] = A;       # ADD CHARACTER TO STRING           #
        END 
      END 
#----------------------------------------------------------------------#
#                                                                      #
#     D I A G X E Q                                                    #
#                                                                      #
# IF NO DIAGNOSTIC TEXT EXISTS WE ISSUE A MESSAGE AND RETURN.          #
# OTHERWISE WE WRITE EACH ZERO BYTE TERMINATED TEXT LINE TO THE OUTPUT #
# FILE.  HELP TEXT MESSAGES ARE WRITTEN WITHOUT ANY PARAMETER          #
# SUBSTITUTION.  DIAGNSOTIC TEXT MESSAGES ARE SCANED FOR ANY OCCURENCES#
# OF <X> WHERE X IS ANY ONE OF THE FOLLOWING CHARACTERS.  IF X DOES    #
# NOT MATCH ANY OF THE CHARACTERS BELOW THEN THE NULL STRING IS        #
# SUBSTITUTED.  THE REPLACEMENT STRING IS DESCRIBED BELOW FOR EACH     #
# VALID CHARACTER X.                                                   #
#     C - CURRENT TOKEN FROM DIRECTIVE SCAN.                           #
#     N - NEXT TOKEN FROM DIRECTIVE SCAN.                              #
#     A - THE NEXT PARAMETER TO *DIAG* IS A ALPHANUMERIC STRING.       #
#     D - THE NEXT PARAMETER TO *DIAG* IS A DEIMAL NUMBER.             #
#     O - THE NEXT PARAMETER TO *DIAG* IS AN OCTAL NUMBER.             #
#                                                                      #
#     ENTRY  (DIAGPTR) = POINTER TO FWA OF MESSAGE OR 0 IF NO TEXT FOR #
#            THIS DIAGNOSTIC NUMBER OR LEXICAL ID.                     #
#            (HELPFLG) = 0 FOR DIAGNOSTIC TEXT AND 1 FOR HELP TEXT.    #
#----------------------------------------------------------------------#
      IF DIAGPTR EQ 0 AND HELPFLG EQ 0
      THEN
        BEGIN 
        C<2,3>MSG2 = BINDEC(DIAGN,3); 
        WRITE(MSG2,27,A); 
        RETURN; 
        END 
      IF DIAGPTR EQ 0 AND HELPFLG NQ 0
      THEN
        BEGIN 
        WRITE(MSG1,62,A); 
        RETURN; 
        END 
      FOR A = 0 STEP 1
      UNTIL 11
      DO
        BEGIN 
        DIAGM[A] = "          ";
        END 
      D = 7;                       # SET CHARACTER DESTINATION COUNT   #
      IF DIAGN LS 1000
        AND HELPFLG EQ 0
      THEN
        BEGIN 
        DIAGM[0] = " (***)    ";
        C<2,3>DIAGM[0] = BINDEC(DIAGN,3); 
        IF PERFLG                  # IF ERROR OCCURRED DURING A PERFORM#
          AND DIAGN NQ 29          # AND NOT SUPPLEMENTARY DIAGNOSTIC  #
            AND NOT FULLSYNTX      # AND NOT PREPARING A REPORT        #
        THEN
          BEGIN 
          I = 1;                   # INITIALIZE KEYAREA CHARACTER PTR  #
          J = 7;                   # INITIALIZE DIAGM CHARACTER POINTER#
          K = 0;                   # INITIALIZE DIAGM WORD POINTER     #
          DIAGM[1] = "          ";  # BLANK FILL 2ND WORD OF DIAG MSG  #
          DONE = FALSE;            # INITIALIZE LOOP CONTROL VARIABLE  #
          FOR DUMMY = DUMMY        # LOOP UNTIL SESSION AND XMISSION ID#
            WHILE NOT DONE         # ARE MOVED TO DIAGM WITH BLANKS    #
                                   # SQUEEZED OUT                      #
          DO
            BEGIN 
            IF C<I,1>KEYAREA[0] EQ " "  # IF END OF SESSION NAME       #
              OR (I EQ 7
              AND C<I - 1,1>KEYAREA NQ " ") 
            THEN
              BEGIN 
              C<J,1>DIAGM[K] = "-";  # INSERT DASH BETWEEN SESSION AND #
                                     # TRANSMISSION ID                 #
              I = 7;               # SET KEYAREA CHAR PTR TO XMISSN ID #
              J = J + 1;           # INCREMENT DIAGM CHAR POINTER      #
              IF J GR 9            # IF END OF 1ST DIAGM WORD          #
              THEN
                BEGIN 
                J = 0;             # REINITIALIZE DIAGM CHAR POINTER   #
                K = 1;             # INCREMENT DIAGM WORD POINTER      #
                END 
              END 
            C<J,1>DIAGM[K] = C<I,1>KEYAREA[0];  # MOVE NEXT CHAR FROM  #
                                                # KEYAREA TO DIAG MSG  #
            I = I + 1;             # INCREMENT KEYAREA CHAR POINTER    #
            IF I GR 9              # IF END OF TRANSMISSION ID         #
            THEN
              BEGIN 
              DONE = TRUE;         # TERMINATE LOOP                    #
              TEST DUMMY; 
              END 
            J = J + 1;             # INCREMENT DIAGM CHAR POINTER      #
            IF J GR 9              # IF END OF 1ST DIAGM WORD          #
            THEN
              BEGIN 
              J = 0;               # REINITIALIZE DIAGM CHAR POINTER   #
              K = 1;               # INCREMENT DIAGM WORD POINTER      #
              END 
            END 
          D = 12 + J;              # SET CHARACTER DESTINATION COUNT TO#
                                   # NEXT AVAILABLE CHAR IN 2ND WORD IN#
                                   # DIAGM ALLOWING FOR AN EMDEDDED    #
                                   # BLANK                             #
          END 
        END 
      FROMC = 0;
      P<DIAGTP> = DIAGPTR;
      FOR DUMMY = DUMMY 
      WHILE A NQ 0
      DO
        BEGIN 
        GETSPC;                    # GET NEXT SPECIAL CHARACTER        #
        IF A EQ 0 
        THEN
          BEGIN 
          TEST DUMMY; 
          END 
        DLG = 0;                   # NO SUBSTITUTION IF CHAR NOT USED  #
        IF A EQ "C"                # INSERT CURRENT WORD               #
        THEN
          BEGIN 
          IF NOT CHKCUR            # IF CURWORD IS NOT SATISFIED       #
          THEN
            BEGIN                  # ADD DIAGNOSTIC NUMBER TO MESSAGE  #
            C<32,4>MSG3 = BINDEC(DIAGN,4);
            WRITE(MSG3,37,A);      # WRITE THE MESSAGE INSTEAD OF DIAG #
            RETURN; 
            END 
          DICWORD[0] = ICW[0];
          DICWORD[1] = ICW[1];
          DLG = 19; 
          IF CURLENG LS 19
          THEN
            BEGIN 
            DLG = CURLENG;
            END 
          FOR DUMMY = DLG-1        # DELETE TRAILING COLONS AND BLANKS #
          STEP -1 
          WHILE DUMMY GQ 0
            AND (C<DUMMY-10*(DUMMY/10),1>DICWORD[DUMMY/10] EQ " " 
            OR   C<DUMMY-10*(DUMMY/10),1>DICWORD[DUMMY/10] EQ O"00")
          DO
            BEGIN 
            DLG = DLG - 1;         # DECREASE LENGTH OF STRING         #
            END 
          END 
        IF A EQ "N"                # INSERT NEXT WORD                  #
        THEN
          BEGIN 
          IF NOT CHKNEX            # IF NEXWORD IS NOT SATISFIED       #
          THEN
            BEGIN                  # ADD DIAGNOSTIC NUMBER TO MESSAGE  #
            C<32,4>MSG3 = BINDEC(DIAGN,4);
            WRITE(MSG3,37,A);      # WRITE THE MESSAGE INSTEAD OF DIAG #
            RETURN; 
            END 
          DICWORD[0] = INW[0];
          DICWORD[1] = INW[1];
          DLG = 19; 
          IF NEXLENG LS 19
          THEN
            BEGIN 
            DLG = NEXLENG;
            END 
          FOR DUMMY = DLG-1        # DELETE TRAILING COLONS AND BLANKS #
          STEP -1 
          WHILE DUMMY GQ 0
            AND (C<DUMMY-10*(DUMMY/10),1>DICWORD[DUMMY/10] EQ " " 
            OR   C<DUMMY-10*(DUMMY/10),1>DICWORD[DUMMY/10] EQ O"00")
          DO
            BEGIN 
            DLG = DLG - 1;         # DECREASE LENGTH OF STRING         #
            END 
          END 
        IF A EQ "A"                # INSERT ALPHA PARAMETER            #
        THEN
          BEGIN 
          P<PARM> = DIAPARM;       # GET THE NEXT PARAMETER ADDRESS    #
          DICWORD[0] = INSRT1[0]; 
          FOR DUMMY = 0 STEP 1
          WHILE C<DUMMY,1>INSRT1[0] NQ " "
            AND C<DUMMY,1>INSRT1[0] NQ O"00"
            AND DUMMY LS 10 
          DO
            BEGIN 
            DLG = DUMMY + 1;       # SAVE LENGTH OF STRING             #
            END 
          END 
        IF A EQ "D"                # INSERT DECIMAL PARAMETER          #
        THEN
          BEGIN 
          P<PARM> = DIAPARM;       # GET THE NEXT PARAMETER ADDRESS    #
          C<0,10>DICWORD[0] = BINDEC(INSRT1[0],10); 
          DLG = 10; 
          FOR DUMMY = 10 STEP -1
          UNTIL 2                  # LEAVE AT LEAST ONE ZERO DIGIT     #
          DO
            BEGIN 
            IF C<0,1>DICWORD[0] EQ "0"
            THEN
              BEGIN 
              DLG = DLG - 1;
              C<0,9>DICWORD[0] = C<1,9>DICWORD[0];
              END 
            END 
          END 
        IF A EQ "O"                # INSERT OCTAL PARAMETER            #
        THEN
          BEGIN 
          P<PARM> = DIAPARM;       # GET THE NEXT PARAMETER ADDRESS    #
          DICWORD[0] = "000B";
          DLG = 4;
          B<12,6>DICWORD[0] = B<57,3>INSRT1[0] + O"33"; 
          B<06,6>DICWORD[0] = B<54,3>INSRT1[0] + O"33"; 
          B<00,6>DICWORD[0] = B<51,3>INSRT1[0] + O"33"; 
          END 
        B = D / 10;                # WORD NUMBER                       #
        TC = D - 10 * B;           # CHARACTER NUMBER                  #
        D = D + DLG;               # NEW MESSAGE LENGTH                #
        IF D GR 120                # IF DIAGNOSTIC MESSAGE TOO LONG    #
        THEN
          BEGIN 
          A = 0;
          D = 120;
          TEST DUMMY; 
          END 
        P<PARM> = LOC(DIAGMES) + B;  # SET *TO* ADDRESS                #
        CMOVE(FA,0,DLG,PARM,TC);   # MOVE STRING TO DIAGNOSTIC MESSAGE #
        END 
      LINES = LINES - 1;           # BE SURE MORE MESSAGE IS NOT ISSUED# QU3A335
                                   # FOR DIAG                          # QU3A335
      WRITEBL(DIAGMES,D,A);        # ISSUE DIAGNOSTIC MESSAGE          # QU3A335
      RETURN; 
      END 
      TERM
