*DECK XEQREP
USETEXT TAFIT 
USETEXT TCLFN 
USETEXT TCMMDEF 
USETEXT TCONVRT 
USETEXT TCRMDEF 
USETEXT TDESATT 
USETEXT TEMLST
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TINDTBL 
USETEXT TLFNINF 
USETEXT TOPTION 
USETEXT TREPORT 
USETEXT TRPTLST 
USETEXT TSSRC 
      PROC XEQREP;
      BEGIN #REPORT#
      XDEF ITEM BFAFIND S:BFAFTYP;   # INDEX INTO BFAFTYP AND STSTYPE  #
      XDEF ITEM EVMVIND S:EVMVTYP;   # INDEX INTO EVMVTYP AND EVMVLIT  #
      DEF MINBUF #1025#;           # MINIMUM SOURCE FILE BUFFER SIZE   #
          BASED ARRAY EVALDATA; 
          ITEM LOGRST B(0,0,1), 
               DATASTACK I(0,24,18),
               DATACNVT I(0,6,18),
               DATADEFADDR I(0,42,18);
          BASED ARRAY MOVETBL S(2); 
              ITEM MENTRY    U(0,00,03),
                   MFCHAR    U(0,04,04),
                   MTCHAR    U(0,08,04),
                   MCHARLG   U(0,12,12),  # LENGTH OF FIELD IN CHARS   #
                   MFROMADDR I(0,24,18),
                   MTOADDR   I(0,42,18),
                   MCNVT     U(1,00,06),
                   MSTACKADD I(1,06,18),
                   MADDRFR   I(1,24,18),
                   MADDRTO   I(1,42,18),
                   MWORD1    I(0,00,60),
                   MWORD2    I(1,00,60);
          XREF FUNC BINDEC C(10);  # BINARY TO DECIMAL....IN CONVERT   #
          XREF PROC WHATSTEP;      # PROC TO PASS NAME AND LEVEL NUMBER#
                                   # OF A REPORT DIRECTIVE FOR USE IN A#
                                   # DIAGNOSTIC MESSAGE                #
          XREF PROC MOVEC;         #PROC TO MOVE DATAS# 
          XREF PROC CONVERT;
      XREF PROC PGINIT; 
          XREF PROC FIGSUB;        #PROC TO EVALUATE FIG SUB# 
          XREF PROC EXPEVALUATE;
      XREF PROC GET;  #PROC TO GET 1ST RECORD#
      XREF PROC GETN;  #PROC TO GET NEXT RECORD#
          XREF PROC PAGE;          #PROC TO WRITE ONE LINE# 
          XREF PROC PAGECLOSE;     #PROC TO CLOSE ONE PAGE# 
        XREF PROC PGEND;   # PROC TO CLOSE REPORT WITH 1-LINE PAGE #
      XREF PROC WRITER;            # WRITE END OF RECORD               #
      XREF PROC XSETFIT;           # READ FILE CARD INFORMATION        #
      XREF ITEM RA0;
      XREF ITEM SAVEAD I;          # IF CALLED FROM REPORT CONTAINS    #
                                   # ADDRESS OF CM REQUESTED BY REP7100#
                                   # ELSE CONTAINS ZERO                #
      XREF ITEM SM$GROUPID;        # GROUP ID FOR THIS REPORT          #
*IF DEF,DEBUG,1 
             XREF PROC SNATCHO; 
          ARRAY P S(2); 
            ITEM PPEDIT B(0,3,1), 
                  PFROMCHAR U(0,4,4), 
                  PNBCHAR U(0,12,12), 
                  PFROMWORD U(0,24,18), 
                  PFROMPTR U(1,24,18),
                  PCONVERTCODE U(1,0,6),
                  PWORD1 U(0,0,60), 
          PTOWORD U(0,42,18),                                           001830
          PTOCHAR U(0,8,4),                                             001840
          PTOPTR U(1,42,18),                                            001850
          PWORD2 U(1,0,60);                                             001860
          ITEM UB;                                                      001870
          ITEM I; 
          ITEM OVFLBRK;            #BRK INDEX OF BRK ON OVERFLOW# 
          ITEM RC;                 #RETURN CODE#
          ITEM CLINE;              #CURRENT LINE NUMBER#
          ITEM CBREAK;             #CURRENT BREAK INDEX#
          ITEM CSELECT;            #CURRENT SELECT INDEX# 
      ITEM BUFGRPID;               # GROUP ID OF ALL CM ALLOC BELOW HHA#
          BASED ARRAY ANYTABLE;    #USED FOR PARAMETERS#
          BEGIN ITEM ANYWD I(,,60); 
                  ITEM ANYWORD C(0,0,10); 
          END 
          BASED ARRAY WSA;; 
          ITEM NSELECT;            #NEXT SELECT INDEX#
          ITEM CHKINDEX;           #INDICATES WHAT KIND OF SPCE CHK#
      ITEM DLINE   I;              # USED TO DENOTE LINE NO. IN A DIAG #
      ITEM DRTWD1  C(10);          # USED FOR DIAG 949 TO EXPRESS FIRST#
                                   # PART OF CURRENT DIRECTIVE         #
      ITEM DRTWD2  C(10);          # USED FOR DIAG 949 TO EXPRESS 2ND  #
                                   # PART OF CURRENT DIRECTIVE         #
      ITEM PP      I;              # USED TO DENOTE DECIMAL            #
                                   # REPRESENTATION OF CURRENT PAGE NO.#
      ITEM PPP     I;              # USED TO DENOTE ALPHANUMERIC       #
                                   # REPRESENTATION OF CURRENT PAGE NO.#
          ITEM J,K,L; 
          ITEM M; 
          ITEM SUB,LG,BP,WP,CP,WP1,CP1,BP1; 
          XREF PROC OPENM;
          XREF PROC CLOSEM; 
         XREF PROC FILESQ;
          DEF NEXTSOURC #PREVIOUSOURC#; 
         ITEM PGCLS B;
         PGCLS = TRUE;
          ITEM B1;
          XDEF ITEM MVFL B; 
          XREF PROC EEXPEVA;
      BASED ARRAY PARAM; ITEM PAR U(,,60);
          ITEM FLG B;                                                   006760
          ITEM  ABSOLINE B; 
      BASED ARRAY COPYOLD S(1); 
        BEGIN 
        ITEM OLDWORD   (00,00,60);
        END 
      BASED ARRAY COPYNEW S(1); 
        BEGIN 
        ITEM NEWWORD   (00,00,60);
        END 
          CONTROL EJECT;
          PROC CALCULATE; 
          BEGIN 
              BASED ARRAY A;
                  ITEM AFIRST I(0,24,12), 
                      ALAST I(0,36,12), 
                      AFTL U(0,3,7),
                      AEND U(0,10,7), 
                      ALB U(0,17,7);
              ITEM I; 
              PROC CAL; 
              BEGIN ITEM LB,FTL,ENDLN,PTR,LAST; 
                  LB =0;
                  FTL = 0;
                  PTR = AFIRST[0];
                  LAST = ALAST[0];
       ADDLBB:   ENDLN = 0; 
                ADDLB:  
          IF BEYOND[PTR] THEN BEGIN 
      IF LINENUMBER[PTR] GR LB THEN 
               LB = LINENUMBER[PTR];
          END 
                  ELSE IF NOT CONTINUATN[PTR] THEN GOTO START;
                  PTR = PTR + 1;
                  IF PTR GR LAST THEN GOTO ALLSET;
                  GOTO ADDLB; 
                START:  
          IF NOT LINEN[PTR] THEN
                  FTL = LINENUMBER[PTR];
                  ENDLN = FTL;
                FF: 
                  PTR = PTR + 1;
                  IF PTR GR LAST THEN GOTO ALLSET;
                  IF CONTINUATN[PTR] THEN GOTO FF;
          IF BEYOND[PTR] THEN GOTO ADDLBB;
                  ELSE
                  BEGIN 
                      IF LINENUMBER[PTR] LS FTL THEN
                          FTL = LINENUMBER[PTR];
                      ENDLN = LINENUMBER[PTR];
                  END 
                  GOTO FF;
                ALLSET: 
                  ALB[0] = LB;
                  AFTL[0] = FTL;
                  AEND[0] = ENDLN;
                  RETURN; 
              END 
        FUNC FB(M); 
         BEGIN ITEM M,N;                                                021100
               N = TOADDRESS[M];                                        021110
              FB = N * 10 + TOCHAR[M];
          END 
          PROC PUTDIAG(K);
          BEGIN ITEM I,J,K,L; 
                I=CALLTYPE[K];
                  J = LEVEL[K]; 
                  IF I EQ 1 AND J EQ 0 THEN I = 6;
                  L = I + 603;
                  DIAG(L,J);
           END
          ITEM J,K,L,FB1,FB2; 
          FOR I=1 STEP 1 UNTIL REPORTINDEX-1 DO 
          BEGIN 
                 FOR J = I + 1 STEP 1 DO
     IF NOT CONTINUATN[J] OR J EQ REPORTINDEX THEN GOTO OLINE;
               OLINE: 
                 J = J - 1; 
                 IF I EQ J THEN TEST I; 
                 FOR K = I STEP 1 UNTIL J - 1 DO
                 BEGIN FOR L = K + 1 STEP 1 UNTIL J DO
                       BEGIN FB1 = FB(K); 
                             FB2 = FB(L); 
          IF FB2 LS FB1 THEN                                            001310
          BEGIN IF CHARLENGTH[L] GR FB1-FB2 THEN                        001320
           BEGIN PUTDIAG(K);
                                      CHARLENGTH[L] = FB1-FB2;
           END
          END                                                           001340
          ELSE IF CHARLENGTH[K] GR FB2-FB1 THEN PUTDIAG(K); 
                       END
                 END
          I = J;
          END 
    ALLCHK: 
          FOR I=0 STEP 1 UNTIL MAXBREAK DO  #START WITH FOOTING0# 
              BEGIN 
                  IF HDGWORD[I] NQ 0 THEN 
                  BEGIN 
                      P<A> = LOC(HDGWORD[I]); 
                      CAL;
                  END 
                      IF FTGWORD[I] NQ 0 THEN 
                  BEGIN 
                      P<A> = LOC(FTGWORD[I]); 
                      CAL;
                  END 
              END 
              FOR I = 1 STEP 1 UNTIL MAXSELECT DO 
                  IF DTLWORD[I] NQ 0 THEN 
                  BEGIN 
                      P<A> = LOC(DTLWORD[I]); 
                      CAL;
                  END 
              IF RECWORD[1] NQ 0 THEN 
              BEGIN 
                  P<A> = LOC(RECAPHEAD);
                  CAL;
              END 
              RETURN; 
          END 
          DEF SEVENS#O"77777777777777777777"#;
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C A L L G E T                                                    #
#                                                                      #
#     *CALLGET* IS CALLED TO RETRIEV A RECORD FROM THE SOURCE FILE     #
# INTO *WSA*. IF A RECORD WAS RETRIEVED, *RC* IS SET TO ZERO. IF *RC*  #
# IS SET TO ONE BY *CALLGET*, IT MEANS NO MORE INPUT SHOULD BE READ.   #
# CRM ERRORS ARE DIAGNOSED AND CAUSE *RC* TO BE ONE.                   #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CALLGET; 
      BEGIN 
      P<FIT> = P<SRCFIT>;          # LOCATE FIT OF SOURCE FILE         #
      FITES = 0;                   # CLEAR ERROR STATUS FIELD IN FIT   #
      FITWSA = LOC(WSA);           # SET POINTER TO WSA                #
      FOR RC = 2                   # LOOP CONTROLLED BY *RC*           #
      WHILE RC EQ 2                # UNTIL *RC*S REAL VALUE OCCURS     #
      DO
        BEGIN 
        GET(FIT, RA0);             # GET A RECORD FROM SOURCE FILE     #
        IF FITES NQ 0              # IF SOME CRM ERROR                 #
        THEN
          BEGIN 
          DIAG(903, FITES, FITLFNC);  # DIAGNOSE CRM ERROR CODE        #
          FITES = 0;               # CLEAR ERROR STATUS                #
          RC = 1;                  # DO NOT READ SOURCE FILE AGAIN     #
          TEST RC;                 # BACK TO THE LOOP                  #
          END 
  
        IF FITFP EQ O"100"         # IF AT EOF/EOI                     #
        THEN
          BEGIN 
          RC = 1;                  # NO MORE RECORDS TO READ           #
          TEST RC;                 # BACK TO THE LOOP                  #
          END 
  
        IF FITFP EQ O"20"          # IF WE HAVE A RECORD               #
        THEN
          BEGIN 
          RC = 0;                  # RECORD RETRIEVED                  #
          TEST RC;                 # BACK TO THE LOOP                  #
          END 
        END 
  
      RETURN; 
      END 
          CONTROL EJECT;
          ITEM OVERLVL;                                                 001160
                                   # TRY TO MOVE REPORTLIST CLOSER HHA #
      IF SAVEAD EQ 0               # IF NOT CALLED FROM REPORT         #
                                   # REPORT DOES NOT REQUEST REPORTLIST#
                                   # AS A CMM BLOCK BY ITSELF          #
      THEN
        BEGIN 
        L = (REPORTINDEX + 1) * 3;  # ACTUAL SIZE OF REPORTLIST        #
        P<COPYNEW> = CMM$ALF((MAXREPORT + 1) * 3, 0, 0);
                                   # REALLOCATE REPORTLIST.  REQUEST   #
                                   # FULL SIZE BLOCK BECAUSE THIS BLOCK#
                                   # WILL BE REUSED FOR PREFACE/SUMMARY#
        IF P<COPYNEW> LS AREPORTLIST  # IF CLOSER TO HHA               #
        THEN
          BEGIN 
          P<COPYOLD> = AREPORTLIST;  # COPY OLD CM BLOCK TO NEW BLOCK  #
          FOR K = 0 STEP 1
            UNTIL L - 1 
          DO
            BEGIN 
            NEWWORD[K] = OLDWORD[K];
            END 
          CMM$FRF(AREPORTLIST);    # FREE OLD BLOCK                    #
          AREPORTLIST = P<COPYNEW>;  # MOVE POINTER TO NEW BLOCK       #
          END 
        ELSE
          BEGIN 
          CMM$FRF(P<COPYNEW>);     # FREE NEW BLOCK                    #
          END 
        END 
          FORMDLADDR = LOC(FORMATDLINE);
          P<REPORTLIST> = AREPORTLIST;
        BUFGRPID = CMM$AGR(BELOW$HHA);   # GROUP-ID FOR REPORT BLOCKS  #
      PGINIT(BUFGRPID);            # ALLOCATE BUFFERS AND FITS         #
         IF PRWFG EQ 1 THEN PVBLK;
        P<SRCFIT> = CMM$ALF(LFIT, 0, BUFGRPID);  #GET CM FOR A NEW FIT #
        P<FIT> = P<SRCFIT>; 
        P<COPYNEW> = P<SRCFIT>;    #COPY THE MODEL FIT                 #
        P<COPYOLD> = LOC(L$FITLOC); 
        FOR I=0 STEP 1
          UNTIL LFITM1
        DO
          BEGIN 
          NEWWORD[I] = OLDWORD[I];
          END 
  
          I = FROMLEN[RPTCTR] * 6;
          FITLFN = 0; 
          B<0,I>FITLFN = B<0,I>FROMLFN[RPTCTR]; 
          FITOC = 0;
          FITPD = 0;
          FITLOP = 0; 
  
          XSETFIT(FIT);            #READ FILE CARD INFORMATION         #
  
          IF FITBFS LS MINBUF      #IF BUFFER INADEQUATE               #
            OR FITFWB EQ 0         #OR NOT ALLOCATED....               #
          THEN
            BEGIN 
            P<AFIT> = P<FIT>;      #ALLOCATE BUFFER AND SET FET FIELDS #
            I = CMM$ALF(MINBUF, 0, BUFGRPID); 
            AFITBFS = MINBUF;      #PUT BUFFER SIZE IN FIT             #
            AFITFWB = I;           #PUT BUFFER ADDRESS IN THE FIT      #
            AFITIN = I;            #NOW SET IN/OUT/LAST                #
            AFITOUT = I;
            AFITLAST = I + MINBUF;
            END 
  
          IF FITMRL EQ 0           #IF NOT DESCRIBED, EG. TEXT         #
          THEN
            BEGIN 
            FITMRL = 1024;
            END 
  
          I = (FITMRL + 9) / 10;   #WSA IN CM WORDS                    #
          CURRENTSOURC = CMM$ALF(I,0,BUFGRPID);  # ALLOCATE TWO WSA-S  #
          NEXTSOURC = CMM$ALF(I,0,BUFGRPID);
          OPENM (SRCFIT, $IO$, $R$, RA0);                               000390
          IF SRCFITES[0] NQ 0 THEN
            BEGIN 
            DIAG(903,SRCFITES[0],SRCFIT); 
            END 
          IF RPTEVBEF[RPTCTR] NQ 0 THEN 
          BEGIN P<EVALDATA> = RPTEVBEF[RPTCTR]; 
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"RPTSUB";   # INDEX FOR "RPTNAME[RPTCTR]"   #
                EXCEV;
          END 
          IF RPTMVBEF[RPTCTR] NQ 0 THEN 
          BEGIN P<MOVETBL> = RPTMVBEF[RPTCTR];
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"RPTSUB";   # INDEX FOR "RPTNAME[RPTCTR]"   #
              MOVEXE; 
          END 
          IF RPTCTR EQ 0 THEN BEGIN 
          I = ILFNLG[IPRE] * 6; 
          P<FIT> = LOC(RPTFIT); 
          FITLFN = 0; 
          B<0,I>FITLFN = B<0,I>ILFN[IPRE];
          FITOC = 0;
          P<AFIT> = P<FIT>;        # USE AFIT SO CAN SET FET POINTERS  #
          IF LVL EQ 0              # IF NO PREFACES/SUMMARIES          #
          THEN
            BEGIN 
            I = BUFGRPID;          # SET *I* TO ALLOCATE BELOW HHA     #
            END 
  
          ELSE                     # PREFACES/SUMMARIES EXIST          #
            BEGIN 
            I = 0;                 # SET *I* TO ALLOCATE ABOVE HHA     #
            END 
  
          AFITFWB = CMM$ALF(MINBUF, FIXED$LWA, I);  # ALLOC REPORT BFR #
          AFITIN = AFITFWB; 
          AFITOUT = AFITFWB;
          AFITLAST = AFITFWB + MINBUF;
          END 
              CHKINDEX = 1;        #PRESET FOR DTL, FTG, AND RECAP CHK# 
          CBREAK = 0; 
              P<WSA> = CURRENTSOURC;
          CALCULATE;
         GETGET: # #                                                    021820
            CALLGET;
         IF RC NQ 0 THEN                                                021750
          BEGIN DIAG(830);
               IF BRKWORD[1] EQ 0 THEN GOTO AAAA; 
                ELSE GOTO BBBB;                                         021770
         END                                                            021780
         PICKDTL;                                                       021790
         IF CSELECT EQ 0 AND SELWORD[1] NQ 0 THEN GOTO GETGET;          021800
          IF TITEVBEF[1] NQ 0 THEN
          BEGIN P<EVALDATA> = TITEVBEF[1];
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"TITLE1";   # INDEX FOR "TITLE"             #
                EXCEV;
                EVAT = FALSE; 
          END 
          ELSE EVAT = TRUE; 
          IF TITMVBEF[1] NQ 0 THEN
          BEGIN P<MOVETBL>= TITMVBEF[1];
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"TITLE1";   # INDEX FOR "TITLE"             #
              MOVEXE; 
              MVFL = FALSE; 
          END 
          ELSE MVFL = TRUE; 
              IF BRKWORD[1] EQ 0 THEN #CHK IF THERE IS BRK# 
              BEGIN #NO BRK#
          OVERLVL = MAXBREAK + 1;                                       001180
          IF HDGWORD[0] NQ 0 THEN HEADING;
          GOTO AAAAA; 
                CONTNOBRK:  
          CALLGET;
          IF RC NQ 0 THEN 
                             #HIT EOF, REPORT IS DONE#
                  BEGIN #EOF 1# 
        AAAA: #  #                                                      021840
          IF FTGWORD[0] NQ 0 THEN FOOTING;
                      PAGECLOSE;   #CLOSE PAGE AND RETURN#
         ENDREP;
                  END   #EOF 1# 
                  PICKDTL;         #SELECT THE DTL FORMAT#
      IF CSELECT EQ 0  AND  SELWORD[1] NQ 0 
        THEN GOTO CONTNOBRK;
       AAAAA: # #                                                       021890
        IF PSFLG EQ 1 
        THEN
          BEGIN 
          P<FIT> = P<SRCFIT>; 
          CHARLENGTH[1] = FITRL;
          END 
  
        IF CHARLENGTH[1] GR MAXCOL THEN CHARLENGTH[1] = MAXCOL; 
                  CHKSPACE;        #CHK IF ENOUGH SPACE#
          IF RC EQ 0 THEN           #NOT ENOUGH, CLOSE PAGE#
          BEGIN PAGECLOSE;
                 IF HDGWORD[0] NQ 0 AND ALLPAGE[HDGFIRST[0]]
                 THEN HEADING;
          END 
                  DETAIL;          #PRINT ONE DTL LINE# 
                  GOTO CONTNOBRK;  #CONT TO PERFORM ON NEXT RCD#
              END   #NO BRK#
          FOR I = 1 STEP 1 UNTIL MAXBREAK DO
            IF BRKOVERFLOW[I] THEN BEGIN
                         OVFLBRK = I; 
           GOTO ENDIT;
                                    END 
          ELSE OVFLBRK = MAXBREAK + 1;
        ENDIT: # #
          OVERLVL = OVFLBRK;                                            001200
      FOR I = 1 STEP 1 UNTIL MAXBREAK DO
      BEGIN IF BRKWORD[I] EQ 0 THEN GOTO EDBK;
            IF BRKLOG[I] THEN TEST I; 
          IF BRKOVERFLOW[I] THEN TEST I;                                001110
             RC = BRKEXPR[I]; 
             IF REPORTWORD3[RC] NQ 0 THEN 
             BEGIN B1 = CHARLENGTH[RC] + 9; 
             B1 = B1 / 10;
                   TOADDRESS[RC] = CMM$ALF(B1, 0, SM$GROUPID);
                   TOCHAR[RC] = FROMCHAR[RC]; 
                   P<PARAM> = LOC(REPORTWORD2[RC]); 
                  MOVEC(PARAM); 
            END 
      END 
     EDBK: # #
           GOTO BBBBB;                                                  021700
            OVERFLBRK:  
          CALLGET;
          IF RC NQ 0 THEN 
                             #HIT EOF, PRT HDG, FTG, AND CLOSE# 
              BEGIN #EOF 2#        #PAGE AND REPORT IS DONE#
      BBBB: # #                                                         021860
                  HEADING;         #PRINT HDG#
                  CHKINDEX = 2;    #CHK SPACE FOR FTG AND#
                  CHKSPACE;        #RECAP#
                  CHKINDEX = 1;    #RESET INDEX FOR DTL, FTG, RECAP#
          IF RC EQ 0 THEN BEGIN PAGECLOSE; BRKOVF; END                  001510
                PRTFTG: 
                  FOOTING;         #PRINT FTG#
                  PAGECLOSE;       #CLOSE PAGE# 
         ENDREP;
              END   #EOF 2# 
              PICKDTL;             #PICK DTL FORMAT FOR CURRENT#
      IF CSELECT EQ 0  AND  SELWORD [1] NQ 0  THEN GOTO OVERFLBRK;
            PRTHDG: 
          BBBBB: # #                                                    021660
              HEADING;             #PRINT HDG#
         PGCLS = TRUE;
            PRTDTL: 
              CBREAK == OVFLBRK;   #CHK SPACE FOR DTL, FTG ON OVERFLOW# 
              CHKSPACE;            #AND RECAP#
              IF RC EQ 0 THEN      #NOT ENOUGH SPACE# 
              BEGIN #NOT ENOUGH#
          FOOTING;
                  PAGECLOSE;       #CLOSE PAGE# 
          BRKOVF;                                                       001530
          HEADING;
              END   #NOT ENOUGH#
              CBREAK == OVFLBRK;   #RESET CURRENT BRK INDEX#
              P<WSA> = NEXTSOURC; 
 GETONEMORE:  # # 
          CALLGET;
          IF RC NQ 0 THEN 
                             #HIT EOF, PTR DTL,FTG AND CLOSE# 
              BEGIN #EOF 3#        #PAGE# 
          CBREAK = 0; 
                  CHKSPACE;        #CHK SPACE FOR DTL,FTG,RECAP#
          IF RC EQ 0 THEN BEGIN 
          CBREAK = OVFLBRK; 
          FOOTING;
          PAGECLOSE;
          BRKOVF;                                                       001550
          HEADING;
          CBREAK = 0; 
          END 
                  DETAIL; 
                  GOTO PRTFTG;     #GO PRT FTG AND CLOSE PAGE#
              END   #EOF 3# 
              CSELECT == NSELECT;  #EXCHANGE CURRENT AND NEXT#
              CURRENTSOURC == NEXTSOURC; #IN ORDER TO PICK FORMAT FOR 
                                         NEXT#
              PICKDTL;             #PICK FORMAT FOR ENXT# 
              CBREAK = 0;          #PRESET TO 0#
              CSELECT == NSELECT;  #CHANGE BACK#
      IF NSELECT EQ 0  AND  SELWORD [1] NQ 0  THEN BEGIN
          CURRENTSOURC = = NEXTSOURC; 
        GOTO GETONEMORE;  END 
          IF BEVBEF[-1] NQ 0 THEN 
          BEGIN P<EVALDATA> = BEVBEF[-1]; 
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"ANYBRK";   # INDEX FOR "ANY-BREAK"         #
                EXCEV;
          END 
          IF BMVBEF[-1] NQ 0 THEN 
          BEGIN P<MOVETBL> = BMVBEF[-1];
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"ANYBRK";   # INDEX FOR "ANY-BREAK"         #
              MOVEXE; 
          END 
              FOR I = 1 STEP 1 UNTIL MAXBREAK DO
              BEGIN #FIND BRK#
                  IF BRKWORD[I] EQ 0 THEN GOTO NOBRK; 
          IF BRKOVERFLOW[I] THEN TEST I;
          IF BEVBEF[I] NQ 0 THEN
          BEGIN P<EVALDATA>= BEVBEF[I]; 
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"BREAKI";   #INDEX FOR "BREAK-(BRKLEVEL[I])"#
                EXCEV;
          END 
          IF BMVBEF[I] NQ 0 THEN
          BEGIN P<MOVETBL> = BMVBEF[I]; 
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"BREAKI";   #INDEX FOR "BREAK-(BRKLEVEL[I])"#
              MOVEXE; 
          END 
          IF BRKLOG[I] THEN 
           BEGIN PROGSTACKLOC = BRKEXPR[I]; 
                LOGICALRESLT = TRUE;
                EXPEVALUATE(RC);   # EVALUATE EXPRESSION               #
                IF RC NQ 0         # IF EXPEVALUATE GENERATED AN ERROR #
                THEN
                  BEGIN 
                  B<0,30>PPP = B<30,30>PAGENUM;  # MOVE CURRENT PAGE NO#
                                                 # TO DIAG 949 PARAM.  #
                  IF XLINE LS 0    # IF LINE NUMBER IS LESS THAN ZERO  #
                  THEN
                    BEGIN 
                    DLINE = 0;     # MOVE 0 TO LINE PARAM. FOR DIAG 949#
                    END 
                  ELSE
                    BEGIN 
                    DLINE = XLINE; # MOVE CURRENT LINE NO. TO PARAMETER#
                                   # FOR DIAGNOSTIC MESSAGE            #
                    END 
                  DRTWD1 = "BREAK-";        # MOVE DIRECTIVE NAME AND  #
                  C<6,2>DRTWD1 = BINDEC(BRKLEVEL[I], 2);  # LEVEL NUMBR#
                                                  # TO DIAG 949 PARAM  #
                  DIAG(949,DRTWD1," ",PPP,DLINE); # PRINT DIRECTIVE,   #
                                                  # PAGE AND LINE NUMBR#
                  END 
                IF LOGICALRESLT THEN GOTO YESBRK; 
          END 
          ELSE
           BEGIN  EEXPEVA(BRKEXPR[I],RC); 
                IF RC EQ 1 THEN GOTO YESBRK;
          END 
              END   #FIND BRK#
            NOBRK:  
              CURRENTSOURC == NEXTSOURC;
              DETAIL;              #PRT CURRENT DETAIL LINE#
            CURRENTSOURC == NEXTSOURC;
              CSELECT = NSELECT;
              GOTO PRTDTL;
            YESBRK: 
      IF I NQ MAXBREAK THEN 
        FOR RC = I + 1 STEP 1 UNTIL MAXBREAK DO 
        BEGIN IF BRKWORD[RC] EQ 0 THEN GOTO NOMBK;
              IF BRKLOG[RC] THEN TEST RC; 
              B1 = BRKEXPR[RC]; 
               IF REPORTWORD3[B1] NQ 0 THEN 
               BEGIN P<PARAM> = LOC(REPORTWORD2[B1]); 
                    MOVEC(PARAM); 
              END 
        END 
      NOMBK: # #
          IF BEVAFT[I] NQ 0 THEN
          BEGIN P<EVALDATA> = BEVAFT[I];
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"BREAKI";   #INDEX FOR "BREAK-(BRKLEVEL[I])"#
                EXCEV;
          END 
          IF BMVAFT[I] NQ 0 THEN
          BEGIN P<MOVETBL> = BMVAFT[I]; 
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"BREAKI";   #INDEX FOR "BREAK-(BRKLEVEL[I])"#
              MOVEXE; 
          END 
          IF BEVAFT[-1] NQ 0 THEN 
          BEGIN P<EVALDATA> = BEVAFT[-1]; 
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"ANYBRK";   # INDEX FOR "ANY-BREAK"         #
                EXCEV;
          END 
          IF BMVAFT[-1] NQ 0 THEN 
          BEGIN P<MOVETBL> = BMVAFT[-1];
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"ANYBRK";   # INDEX FOR "ANY-BREAK"         #
              MOVEXE; 
          END 
              CURRENTSOURC == NEXTSOURC;
              CBREAK = I;          #SET CURRENT BRK INDEX#
              CHKSPACE;            #CHK SPACE FOR DTL, FTG, AND RECAP#
              IF RC EQ 0 THEN 
              BEGIN #NOT ENOUGH#   #NOT ENOUGHSPACE, PRT OVERFLOW FTG#
                  CBREAK == OVFLBRK;
                  FOOTING;
                  PAGECLOSE;       #CLOSE APGE# 
          BRKOVF;                                                       001570
                  HEADING;         #PRT OVERFLOW HDG# 
                  CBREAK == OVFLBRK;
              END   #NOT ENOUGH#
              DETAIL;              #PRT CURRENT DETAIL# 
              FOOTING;             #PRT FOOTINS#
          PGCLS = FALSE;
      FOR I = CBREAK STEP 1 UNTIL MAXBREAK  DO BEGIN
        IF BRKEJECT[I]  THEN BEGIN
          PAGECLOSE;
          PGCLS = TRUE; 
          GOTO CHECKED;  END
        END 
 CHECKED:  # #
              CHKINDEX = 3;        #CHK SPACE FOR HDG, DTL,AND RECAP# 
            CURRENTSOURC == NEXTSOURC;
              CSELECT = NSELECT;
              CHKSPACE; 
              CHKINDEX = 1;        #RESET INDEX#
          IF RC EQ 0 THEN BEGIN PAGECLOSE;
          BRKOVF;                                                       001590
                       PGCLS = TRUE;
                                          END 
              GOTO PRTHDG;         #GO PRT HDG, AND CONT PROCESS# 
          CONTROL EJECT;                                                001350
          PROC BRKOVF;                                                  001360
          BEGIN IF OVERLVL GR MAXBREAK THEN RETURN;                     001370
          IF BEVAFT[OVERLVL] NQ 0 THEN
          BEGIN P<EVALDATA> = BEVAFT[OVERLVL];
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"BREAKO";   # INDEX FOR                     #
                                       # "BREAK-(BRKLEVEL[OVERLVL])"   #
                      EXCEV;                                            001410
                END                                                     001420
          IF BMVAFT[OVERLVL] NQ 0 THEN
          BEGIN P<MOVETBL> = BMVAFT[OVERLVL]; 
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"BREAKO";   # INDEX FOR                     #
                                       # "BREAK-(BRKLEVEL[OVERLVL])"   #
                      MOVEXE;                                           001460
                END                                                     001470
                RETURN;                                                 001480
          END                                                           001490
         CONTROL EJECT; 
          XDEF PROC ENDREP; 
         PROC ENDREP; 
          BEGIN 
          IF PRWFG NQ 1 THEN       # IF NOT PREVIEW WITHOUT SOURCE DATA#
            BEGIN 
            CLOSEM(SRCFIT, $DET$, RA0);  # CLOSE SOURCE FILE           #
            END 
          PRWFG = 0;
          IF RPTCTR NQ 0 AND RPTEVAFT[RPTCTR] NQ 0 THEN 
          BEGIN P<EVALDATA> = RPTEVAFT[RPTCTR]; 
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"RPTSUB";   # INDEX FOR "RPTNAME[RPTCTR]"   #
                EXCEV;
          END 
          IF RPTCTR NQ 0 AND RPTMVAFT[RPTCTR] NQ 0 THEN 
          BEGIN  P<MOVETBL> = RPTMVAFT[RPTCTR]; 
                 EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"       #
                 BFAFIND = S"RPTSUB";   # INDEX FOR "RPTNAME[RPTCTR]"  #
              MOVEXE; 
          END 
          IF RPTCTR EQ LVL THEN 
          BEGIN 
         PGEND; 
          WRITER(RPTFIT);          # FLUSH BUFFER AND WRITE EOR        #
          IF PRWFG NQ 1 THEN BEGIN
          IF RPTEVAFT[0] NQ 0 THEN
          BEGIN P<EVALDATA> = RPTEVAFT[0];
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"RPT0";     # INDEX FOR "RPTNAME[0]"        #
                    EXCEV;
              END 
          IF RPTMVAFT[0] NQ 0 THEN
          BEGIN P<MOVETBL>=RPTMVAFT[0]; 
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"RPT0";     # INDEX FOR "RPTNAME[0]"        #
                  MOVEXE; 
              END 
          END 
  
          END 
       GOTO LDX0;            # GET BACK TO (1,0) OVERLAY #
         END
  
  
  
  
  
#----------------------------------------------------------------------#
#     RLSCM                                                            #
#                                                                      #
#     RELEASE CM ALLOCATED FOR WSA-S AND CIO BUFFER                    #
#                                                                      #
      PROC RLSCM; 
      BEGIN 
      IF BUFGRPID NQ 0 THEN 
        BEGIN 
        CMM$FGR(BUFGRPID);
        BUFGRPID = 0; 
        END 
  
      IF CREPTLG NQ 0              # IF NOT STAND ALONE REPORT         #
      THEN
        BEGIN 
        IF SM$GROUPID NQ 0         # IF A GROUP ALLOCATED FOR DIRECTIVE#
        THEN
          BEGIN 
          CMM$FGR(SM$GROUPID);     # FREE BLOCKS WITH THIS ID          #
          SM$GROUPID = 0;          # CLEAR INDICATOR FOR THIS GROUP    #
          END 
  
  
        IF RPTCTR EQ LVL           # IF ALL DONE WITH THIS REPORT      #
        THEN
          BEGIN 
          CMM$FRF(AREPORTLIST); 
          AREPORTLIST = LOC(FORMATDLINE); 
          RPTLISTASN = FALSE; 
          FULLSYNTX = FALSE;
          END 
        END 
  
      IF LVL GR 0                  # IF PREFACES/SUMMARIES EXIST       #
      THEN
        BEGIN 
        IF RPTCTR EQ LVL           # IF JUST FINISHED LAST ONE         #
        THEN
          BEGIN 
          P<AFIT> = LOC(RPTFIT);   # POSITION TO REPORT FILE FIT       #
          IF AFITFWB NQ 0          # IF A BUFFER WAS ALLOCATED         #
          THEN
            BEGIN 
            CMM$FRF(AFITFWB);      # FREE THE ABOVE HHA BUFFER         #
            AFITFWB = 0;           # CLEAR POINTER TO THE BUFFER       #
            END 
          END 
        END 
  
      RETURN; 
      END 
          CONTROL EJECT;
          PROC CHECKRC(RC); 
  
#----------------------------------------------------------------------#
#                                                                      #
# THIS PROC CHECKS RC TO PRINT THE DIAGNOSTIC MESSAGE ASSOCIATED WITH  #
# RC AS WELL AS DIAG 949 (ISSUED IN EVMVERR) WHICH SPECIFIES WHAT TYPE #
# OF DIRECTIVE (EVALUATE BEFORE/AFTER OR MOVE BEFORE/AFTER) CAUSED THE #
# ERROR.                                                               #
#                                                                      #
#----------------------------------------------------------------------#
  
          BEGIN 
          ITEM RC  I;              # INCOMING PARAMETER DENOTING A     #
                                   # RETURNCODE                        #
          IF RC NQ 0               # IF RETURNCODE INDICATES AN ERROR  #
          THEN
            BEGIN 
            DIAG(RC);              # PRINT DIAGNOSTIC MESSAGE          #
            EVMVERR;               # PRINT DIRECTIVE, PAGE AND LINE NO.#
            END 
          RETURN; 
          END 
  
          CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     EVMVERR                                                          #
#                                                                      #
#     THIS PROC FORMATS EVALUATE BEFORE/AFTER OR MOVE BEFORE/AFTER     #
#     DIRECTIVES FOR USE IN A DIAGNOSTIC MESSAGE. -EVMVIND- ACTS AS AN #
#     INDEX INTO EVMVLIT AS WELL AS EVMVTYP IN ORDER TO REFERENCE THE  #
#     APPROPRIATE DIRECTIVE. -BFAFIND- IS THE INDEX INTO BFAFTYP AND   #
#     STSTYPE FOR THE PARTICULAR REPORT DIRECTIVE REFERENCED AFTER THE #
#     BEFORE/AFTER OPTION.                                             #
#                                                                      #
#----------------------------------------------------------------------#
  
          PROC EVMVERR; 
          BEGIN  #EVMVERR#
  
      SWITCH STSTYPE               # THIS SWITCH CORRESPONDS TO STATUS #
                                   # LIST -BFAFTYP- TO ENABLE BRANCHING#
                                   # TO LABELS ACCORDING TO THE OPTION #
                                   # SPECIFIED FOR A MOVE BEFORE/AFTER #
                                   # OR AN EVALUATE BEFORE/AFTER       #
                                   # DIRECTIVE                         #
             XANYBRK,              # 0 - ANY BREAK                     #
             XANYDTL,              # 1 - ANY DETAIL                    #
             XANYFTG,              # 2 - ANY FOOTING                   #
             XANYHDG,              # 3 - ANY HEADING                   #
             XANYSEL,              # 4 - ANY SELECT                    #
             XBREAKI,              # 5 - BREAK (LEVEL NUMBER)          #
             XBREAKO,              # 6 - BREAK(OVERLEVEL)              #
             XDTLVL,               # 7 - DETAIL (TAG NUMBER)           #
             XFTNGJ,               # 8 - FOOTING (LEVEL NUMBER)        #
             XHDNGJ,               # 9 - HEADING (LEVEL NUMBER)        #
             XNOSEL,               # 10 - NO SELECT                    #
             XRECAP1,              # 11 - RECAP                        #
             XRPT0,                # 12 - REPORT (0)                   #
             XRPTSUB,              # 13 - REPORT (RPTCTR)              #
             XSLECTI,              # 14 - SELECT (TAG NUMBER)          #
             XTITLE1;              # 15 - TITLE                        #
  
      ARRAY EVMVLIT[0:3] S(1);
        BEGIN 
        ITEM RPTDRTV C(0,0,10) = [ "EVAL-BEFRE",    # 0                #
                                   "EVAL-AFTER",    # 1                #
                                   "MOVE-BEFRE",    # 2                #
                                   "MOVE-AFTER"  ]; # 3                #
        END 
  
      DRTWD1 = RPTDRTV[EVMVIND];   # MOVE FIRST HALF OF DIRECTIVE TYPE #
                                   # TO DIAGNOSTIC PARAMETER           #
      GOTO STSTYPE[BFAFIND];       # GO TO APPROPRIATE ROUTINE FOR     #
                                   # ENTERING 2ND HALF OF CURRENT      #
                                   # DIRECTIVE INTO DIAGNOSTIC PARAMETR#
  
XANYBRK:  
          DRTWD2 = "ANY-BREAK";    # MOVE 2ND HALF OF CURRENT DIRECTIVE#
                                   # TO DIAGNOSTIC PARAMETER           #
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XANYDTL:  
          DRTWD2 = "ANY-DETAIL";   # MOVE 2ND HALF OF CURRENT DIRECTIVE#
                                   # TO DIAGNOSTIC PARAMETER           #
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XANYFTG:  
          DRTWD2 = "ANY-FOOTNG";   # MOVE 2ND HALF OF CURRENT DIRECTIVE#
                                   # TO DIAGNOSTIC PARAMETER           #
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XANYHDG:  
          DRTWD2 = "ANY-HEADNG";   # MOVE 2ND HALF OF CURRENT DIRECTIVE#
                                   # TO DIAGNOSTIC PARAMETER           #
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XANYSEL:  
          DRTWD2 = "ANY-SELECT";   # MOVE 2ND HALF OF CURRENT DIRECTIVE#
                                   # TO DIAGNOSTIC PARAMETER           #
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XBREAKI:  
          DRTWD2 = "BREAK-";                     # MOVE 2ND PART OF    #
          C<6,2>DRTWD2 = BINDEC(BRKLEVEL[I],2);  # CURRENT DIRECTIVE TO#
                                                 # DIAGNOSTIC PARAMETER#
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XBREAKO:  
          DRTWD2 = "BREAK-";                           #MOVE 2ND PART  #
          C<6,2>DRTWD2 = BINDEC(BRKLEVEL[OVERLVL],2);  #OF CURRENT DIR-#
                                                       #ECTIVE TO DIAG #
                                                       #PARAMETER      #
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XDTLVL: 
          DRTWD2 = "DETAIL-";                        # MOVE 2ND PART OF#
          C<7,2>DRTWD2 = BINDEC(SELTAG[CSELECT],2);  # CURRENT DIRECTVE#
                                                     # TO DIAG PARAMETR#
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XFTNGJ: 
          DRTWD2 = "FOOTING-";                   # MOVE 2ND PART OF    #
          C<8,2>DRTWD2 = BINDEC(BRKLEVEL[J],2);  # CURRENT DIRECTIVE TO#
                                                 # DIAGNOSTIC PARAMETER#
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XHDNGJ: 
          DRTWD2 = "HEADING-";                   # MOVE 2ND PART OF    #
          C<8,2>DRTWD2 = BINDEC(BRKLEVEL[J],2);  # CURRENT DIRECTIVE TO#
                                                 # DIAGNOSTIC PARAMETER#
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XNOSEL: 
          DRTWD2 = "NO-SELECT";    # MOVE 2ND HALF OF CURRENT DIRECTIVE#
                                   # TO DIAGNOSTIC PARAMETER           #
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XRECAP1:  
          DRTWD2 = "RECAP";        # MOVE 2ND HALF OF CURRENT DIRECTIVE#
                                   # TO DIAGNOSTIC PARAMETER           #
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
XRPT0:  
          DRTWD2 = RPTNAME[0];        # MOVE REPORT NAME TO DIAG PARAM #
          GOTO PRTDIAG;               # GO PRINT DIAGNOSTIC MESSAGE    #
  
XRPTSUB:  
          DRTWD2 = RPTNAME[RPTCTR];        # MOVE REPORT NAME TO DIAG  #
                                           # PARAMETER                 #
          GOTO PRTDIAG;             # GO PRINT DIAGNOSTIC MESSAGE      #
  
XSLECTI:  
          DRTWD2 = "SELECT-";       #MOVE 2ND PART OF CURRENT DIRECTIVE#
          C<7,2>DRTWD2 = BINDEC(SELTAG[I],2);  # TO DIAG PARAMETER     #
          GOTO PRTDIAG;             # GO PRINT DIAGNOSTIC MESSAGE      #
  
XTITLE1:  
          DRTWD2 = "TITLE";        # MOVE 2ND PART OF CURRENT DIRECTIVE#
                                   # TO DIAGNOSTIC PARAMETER           #
          GOTO PRTDIAG;            # GO PRINT DIAGNOSTIC MESSAGE       #
  
PRTDIAG:  
          B<0,30>PPP = B<30,30>PAGENUM;      # MOVE CURRENT PAGE NUMBER#
                                             # TO DIAG 949 PARAMETER   #
          IF XLINE LS 0            # IF LINE NUMBER IS LESS THAN ZERO  #
          THEN
            BEGIN 
            DLINE = 0;             # MOVE 0 TO LINE PARAM. FOR DIAG 949#
            END 
          ELSE                     # OTHERWISE                         #
            BEGIN 
            DLINE = XLINE;         # MOVE CURRENT LINE NO. TO PARAMETER#
                                   # FOR DIAGNOSTIC MESSAGE            #
            END 
          DIAG(949,DRTWD1,DRTWD2,PPP,DLINE); # PRINT ERROR MESSAGE     #
          RETURN; 
          END 
          CONTROL EJECT;
          PROC PICKDTL;            #PROC TO SELECT DTL FORMAT#
          BEGIN #PICKDTL# 
              CSELECT = 0;         #PRESET TO 0#
              IF SELWORD[1] EQ 0 THEN  #NO SELECT DIRECTIVE, JUST 1 DTL#
              BEGIN #EQ 0#
          IF B<24,24>DTLWORD[1] NQ 0 THEN 
                  CSELECT = 1;
           IF SEVBEF[-1] NQ 0 THEN
           BEGIN P<EVALDATA> = SEVBEF[-1];
                 EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"       #
                 BFAFIND = S"NOSEL";    # INDEX FOR "NO-SELECT"        #
            EXCEV;                                                      021510
         END                                                            021520
           IF SMVBEF[-1] NQ 0 THEN
           BEGIN P<MOVETBL> = SMVBEF[-1]; 
                 EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"       #
                 BFAFIND = S"NOSEL";    # INDEX FOR "NO-SELECT"        #
               MOVEXE;                                                  021560
         END                                                            021570
         RETURN;                                                        021580
       END                                                              021590
          IF SEVBEF[0] NQ 0 THEN
          BEGIN P<EVALDATA> = SEVBEF[0];
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"ANYSEL";   # INDEX FOR "ANY-SELECT"        #
                EXCEV;
          END 
          IF SMVBEF[0] NQ 0 THEN
          BEGIN P<MOVETBL> = SMVBEF[0]; 
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"ANYSEL";   # INDEX FOR "ANY-SELECT"        #
              MOVEXE; 
          END 
      FOR I = 1 STEP 1
        UNTIL MAXSELECT + 1 
      DO
        BEGIN 
        IF SELWORD[I] EQ 0         # IF SELECT LIST EXHAUSTED          #
          OR I EQ MAXSELECT + 1    # IF SELECT LIST EXHAUSTED          #
        THEN
          BEGIN 
          IF SEVAFT[-1] NQ 0 THEN 
          BEGIN P<EVALDATA> = SEVAFT[-1]; 
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"NOSEL";    # INDEX FOR "NO-SELECT"         #
                EXCEV;
          END 
          IF SMVAFT[-1] NQ 0 THEN 
          BEGIN P<MOVETBL> = SMVAFT[-1];
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"NOSEL";    # INDEX FOR "NO-SELECT"         #
                MOVEXE; 
          END 
          RETURN;                                                       021290
         END                                                            021300
          IF SEVBEF[I] NQ 0 THEN
          BEGIN P<EVALDATA> = SEVBEF[I];
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"SLECTI";   # INDEX FOR "SELECT-(SELTAG[I])"#
                EXCEV;
          END 
          IF SMVBEF[I] NQ 0 THEN
          BEGIN P<MOVETBL> = SMVBEF[I]; 
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"SLECTI";   # INDEX FOR "SELECT-(SELTAG[I])"#
              MOVEXE; 
          END 
                  P<ANYTABLE> = SELEXPR[I]; 
          PROGSTACKLOC = SELEXPR[I];
          LOGICALRESLT = TRUE;
          EXPEVALUATE(RC);         # EVALUATE EXPRESSION               #
          IF RC NQ 0               # IF EXPEVALUATE GENERATED AN ERROR #
          THEN
            BEGIN 
            DRTWD1 = "SELECT-";        # MOVE DIRECTIVE NAME AND LEVEL #
            C<7,2>DRTWD1 = BINDEC(SELTAG[I],2);  #NO. TO DIAG 949 PRMTR#
            B<0,30>PPP = B<30,30>PAGENUM;    # MOVE CURRENT PAGE NUMBER#
                                             # TO DIAG 949 PARAMETER   #
            IF XLINE LS 0          # IF LINE NUMBER IS LESS THAN ZERO  #
            THEN
              BEGIN 
              DLINE = 0;           # MOVE 0 TO LINE PARAM. FOR DIAG 949#
              END 
            ELSE                   # OTHERWISE                         #
              BEGIN 
              DLINE = XLINE;       # MOVE CURRENT LINE NO. TO PARAMETER#
                                   # FOR DIAGNOSTIC MESSAGE            #
              END 
            DIAG(949,DRTWD1," ",PPP,DLINE);  # PRINT DIRECTIVE,PAGE AND#
                                            # LINE NUMBER              #
            END 
          IF LOGICALRESLT THEN
                  BEGIN #QUALIFIED# 
                      CSELECT = I;  #QUALIFIED, SET INDEX AND RETURN# 
          IF SEVAFT[I] NQ 0 THEN
          BEGIN P<EVALDATA> = SEVAFT[I];
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"SLECTI";   # INDEX FOR "SELECT-(SELTAG[I])"#
                EXCEV;
          END 
          IF SMVAFT[I] NQ 0 THEN
          BEGIN P<MOVETBL> = SMVAFT[I]; 
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"SLECTI";   # INDEX FOR "SELECT-(SELTAG[I])"#
              MOVEXE; 
          END 
               GOTO EVALAFTS;                                           021620
            GOTO EVALAFTS;                                              021220
                  END   #QUALIFIED# 
              END   #FIND SELECT# 
        EVALAFTS: 
          IF SEVAFT[0] NQ 0 THEN
          BEGIN P<EVALDATA> = SEVAFT[0];
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"ANYSEL";   # INDEX FOR "ANY-SELECT"        #
                EXCEV;
          END 
          IF SMVAFT[0] NQ 0 THEN
          BEGIN P<MOVETBL> = SMVAFT[0]; 
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"ANYSEL";   # INDEX FOR "ANY-SELECT"        #
              MOVEXE; 
          END 
              RETURN; 
          END   #PICKDTL# 
         CONTROL EJECT; 
         PROC PVBLK;
         BEGIN ITEM I,J;
        ITEM CTR I;                # COUNTS NO. OF TIMES DETAIL IS     #
                                   # CALLED IN CASE OF *LINE 0 BEYOND* #
        ITEM  DTLABSO B;
        ABSOLINE = FALSE; 
        CTR = 0;                   # INITIALIZE CTR FOR DETAIL CALLS   #
        DTLABSO  = FALSE; 
          FOR I = 1 STEP 1 UNTIL MAXBREAK DO
            IF BRKOVERFLOW[I] THEN BEGIN
                         OVFLBRK = I; 
           GOTO OVRFLBRK; 
                                    END 
          ELSE OVFLBRK = MAXBREAK + 1;
     OVRFLBRK: # #
          I = ILFNLG[IPRE] * 6; 
          P<FIT> = LOC(RPTFIT); 
          FITLFN = 0; 
          B<0,I>FITLFN = B<0,I>ILFN[IPRE];
          FITOC = 0;
          P<AFIT> = P<FIT>;        # USE AFIT SO CAN SET FET POINTERS  #
          I = BUFGRPID;            # PUT THE BUFFER UNDER THIS ID      #
          IF LVL NQ 0              # IF THERE IS A PREFACE OR SUMMARY  #
          THEN
            BEGIN 
            I = 0;                 # *REPORT* MAY NEED BUFFER          #
            END 
          AFITFWB = CMM$ALF(MINBUF, FIXED$LWA, I);
          AFITIN = AFITFWB; 
          AFITOUT = AFITFWB;
          AFITLAST = AFITFWB + MINBUF;
               CHKINDEX = 1;
               CBREAK = 0;
               CALCULATE; 
               HEADING; 
               CBREAK = OVFLBRK;
          FOR CSELECT = 1 STEP 1 UNTIL MAXSELECT DO 
            IF DTLWORD[CSELECT] NQ 0 THEN GOTO NOT2PG;
          PAGECLOSE;
          CBREAK = 0; 
          DONEREP;
            NOT2PG: # # 
               FOR CSELECT = 1 STEP 1 UNTIL MAXSELECT DO
               BEGIN
                   IF DTLWORD[CSELECT] EQ 0 THEN TEST CSELECT;
                   FOR J = 1 STEP 1 UNTIL 3 DO
                   BEGIN
                       CHKSPACE;
                       IF RC EQ 0 THEN
                         BEGIN
                         DONEREP;  # PRINT A PAGE (ENDREP GETS CALLED  #
                                   # FROM PAGECLOSE IF 2ND PGE WRITTEN)#
                         END
                       DETAIL;         # PERFORM A DETAIL LINE         #
                       CTR = CTR + 1;  # INCREMENT DETAIL COUNT        #
                       IF CTR GQ 200   # IF *AT LINE 0 BEYOND* SPECIFYD#
                                       # IN DETAIL DIRECTIVE           #
                       THEN 
                         BEGIN
                         DONEREP;      # PRINT A PAGE AND GO TO ENDREP #
                                       # IF 2ND PAGE WAS WRITTEN       #
                         END
        IF  ABSOLINE  THEN
          BEGIN 
          DTLABSO =  TRUE;
         ABSOLINE = FALSE;
          TEST CSELECT; 
          END 
                   END
               END
                  IF  DTLABSO  THEN  DONEREP; 
               GOTO NOT2PG; 
      PROC  DONEREP;
        BEGIN 
        FOOTING;
        PAGECLOSE;
        BRKOVF; 
        HEADING;
        CBREAK = 0; 
        END 
         END
          CONTROL EJECT;
          XDEF PROC EXCEVA; 
          PROC EXCEVA(B1);
          BEGIN ITEM B1; P<EVALDATA>=B1; EXCEV; END 
          PROC EXCEV; 
          BEGIN 
              ITEM I; 
          ITEM RC;
          ITEM KK I;               # LOOP COUNTER                      #
          ITEM JJ I;               # NO OF ENTRIES IN INDEX TABLE      #
          ITEM LL I;
          ITEM UB I;               # UPPER BOUND                       #
          SWITCH EVALTYPE          # SWITCH ON MOVE TABLE ENTRY TYPE   #
            EVACVT,                #0#
            EVAMOV,                #1#
            EVACVT,                #2#
            EVAEVCV,               #3#
            EVASUB;                #4#
      IF PRWFG EQ 1 THEN RETURN;
        RPTEV: # #
          FOR I = 0 STEP 1 UNTIL 5 DO 
                  BEGIN 
          IF B<0,60>DATADEFADDR[I] EQ 0 THEN RETURN;
                      IF DATASTACK[I] NQ 0 THEN 
                      BEGIN PROGSTACKLOC = DATASTACK[I];
         IF LOGRST[I] THEN LOGICALRESLT=TRUE;                           021440
           ELSE                                                         021450
                            LOGICALRESLT = FALSE; 
                            EXPEVALUATE(RC);  # EVALUATE EXPRESSION    #
                            CHECKRC(RC);    # PRINT DIAG 949 IF RC " 0 #
                      END 
                      IF DATACNVT[I] NQ 0 THEN
          BEGIN 
          P<MOVETBL> = DATACNVT[I];  # POSITION TO MOVE TABLE          #
          GOTO EVALTYPE[MENTRY];
  
EVAMOV: 
          MOVEC(MOVETBL); 
          RC = 0; 
          GOTO NXT; 
  
EVACVT: 
          CONVERT(MOVETBL, RC); 
          GOTO NXT; 
  
EVAEVCV:                           # CONVERT THE EVALUATED EXPRESSION  #
          LL = MADDRFR[0];         # MAKE THE FROM ADDRESS RELATIVE    #
          MADDRFR[0] = LOC(LL); 
          CONVERT(MOVETBL, RC);    # CONVERT EVALUATED RESULT          #
          MADDRFR[0] = LL;         # CHANGE BACK TO ABSOLUTE ADDR      #
          GOTO NXT; 
  
EVASUB: 
          P<INDTBL> = MSTACKADD[0];  # POSITION TO INDEX TABLE         #
          JJ = TBLGS[0] - 1;
          FOR KK = 0 STEP 1 
            UNTIL JJ
          DO
            BEGIN 
            IF DEPNDFG[KK]
            THEN
              BEGIN 
              LL = MADDRFR[0];
            UPBUN(INDTBL, UB, LL,RC);  # CHECK THAT SUBSCRIPT IN RANGE #
              IF RC NQ 0           # IF NOT IN RANGE                   #
              THEN
                BEGIN 
                GOTO NXT; 
                END 
              END 
            JJ = JJ - 1;
            END 
          FIGSUB(MOVETBL, RC);
          GOTO NXT; 
  
NXT:  
          IF RC NQ 0
          THEN
            BEGIN 
            DIAG(RC); 
            EVMVERR;               # PRINT DIRECTIVE, PAGE AND LINE NO.#
            END 
          END 
                  END 
          IF DATADEFADDR[6] NQ 0 THEN 
          BEGIN P<EVALDATA> = DATADEFADDR[6]; 
                GOTO RPTEV; 
          END 
          END 
          CONTROL EJECT;
          XREF PROC UPBUN;
          XREF PROC CMOVE;
          XDEF PROC MOVEXET;
          PROC MOVEXET(B1); 
          BEGIN ITEM B1; P<MOVETBL>=B1; MOVEXE; END 
          PROC MOVEXE;
          BEGIN 
          ARRAY ATTR S(2);
         ITEM AWPOS I(0,18,18), 
               ABPOS U(0,36,6), 
               ALG I(0,42,18),
               ADS U(1,4,11), 
               ADSS I(1,27,15), 
              ACLS I(0,12,6); 
              ITEM I,J,RC;
      ARRAY ATTR2 S(2);            # ATTRIBUTES OF INTEGER SUBSCRIPT   #
                                   # USED FOR CONVERT                  #
        BEGIN 
        ITEM AWPOS2 I(0,18,18);    # ADDRESS OF VALUE                  #
        END 
          ITEM SAVTOAD; 
          ITEM ALLFLG B;
          ITEM UBT; 
          ITEM ALLNM B; 
          ARRAY DD[6];
              ITEM DDW I(0,0,60), 
          DDEWPOS I(0,18,18), 
          DDBITPOS I(0,36,6); 
          SWITCH TYPE DIRM,DIRM,CNVT,EVA,FIGSU1,FIGSU1,FIGSU1,FIGSU1; 
          ITEM BLK C(10)="          ";
      IF PRWFG EQ 1 THEN RETURN;
        RPTMOV: # # 
          FOR I = 0 STEP 1 UNTIL 6 DO 
              BEGIN 
          IF MWORD1[I] EQ 0 THEN RETURN;
          ALLFLG = FALSE; 
          ALLNM = FALSE;
                 P<PARAM> = LOC(MWORD1[I]); 
                  GOTO TYPE[MENTRY[I]]; 
                DIRM: 
                  MOVEC(PARAM); 
                  TEST I; 
                CNVT: 
                  CONVERT(PARAM,RC);
                  CHECKRC(RC);     # IF CONVERT FOUND AN ERROR, PRINT  #
                                   # ERROR MESSAGE AND DIAG 949        #
                  TEST I; 
                EVA:  
                  PROGSTACKLOC = MSTACKADD[I];
                  LOGICALRESLT = FALSE; 
                  EXPEVALUATE(RC);  # EVALUATE EXPRESSION              #
                  IF RC NQ 0       # IF EXPEVALUATE FOUND AN ERROR     #
                  THEN
                    BEGIN 
                    EVMVERR;       # PRINT DIRECTIVE, PAGE AND LINE NO.#
                    END 
                  J = MADDRFR[I]; 
                  MADDRFR[I] = LOC(J);
                  CONVERT(PARAM,RC);
                  CHECKRC(RC);     # IF CONVERT FOUND AN ERROR, PRINT  #
                                   # ERROR MESSAGE AND DIAG 949        #
                  MADDRFR[I] = J; 
                  TEST I; 
                FIGSU:  
          FIGSUB(PARAM,RC); 
          CHECKRC(RC);             # IF FIGSUB FOUND AN ERROR, PRINT   #
                                   # ERROR MESSAGE AND DIAG 949        #
          TEST I; 
        FIGSU1: # # 
          P<INDTBL> = MSTACKADD[I]; 
          IF MENTRY[I] EQ 4 AND NOT ALLFG[0] THEN GOTO FIGSU; 
          UB = UPBND[0];                                                001440
          IF DEPNDFG[0] THEN
          BEGIN IF MENTRY[I] NQ 4 THEN J = MADDRTO[I];
                                 ELSE J = MADDRFR[I]; 
                UPBUN(INDTBL,UB,J,RC);
                IF RC NQ 0         # IF ERROR FOUND IN UPBUN           #
                THEN
                  BEGIN 
                  CHECKRC(RC);     # PRINT ERROR MESSAGE AND DIAG 949  #
                  TEST I; 
                  END 
          IF LASTFG[0] THEN                                             001510
          BEGIN SUB = UB;                                               001520
                GOTO CONT;                                              001530
          END                                                           001540
          ELSE IF NEXTFG[0] THEN                                        001550
          BEGIN UB = UB + 1;                                            001560
                IF UB GR UPBND[0] THEN                                  001570
                  BEGIN 
                  DIAG(942);       # -NEXT- EXITS UPPER BOUND          #
                  EVMVERR;         # PRINT DIRECTIVE, PAGE AND LINE NO.#
                  TEST I; 
                  END 
                SUB = UB;                                               001590
                AWPOS2[0] = LOC(UB);  # FROM ADDRESS IN ATTRIB TABLE   #
                PFROMWORD[0] = LOC(ATTR2) - 1;  # ADDRESS OF ATTRIB    #
                                                # TBL IN CONVERT PARAM #
          PWORD2[0] = 0;
          PNBCHAR[0] = ENTYLG[1]; 
                PFROMPTR[0] = 0;                                        001610
          PTOPTR[0] = MADDRTO[I]; 
                PCONVERTCODE[0] = C<DPTYPE[1],1>CCODE[2];               001630
                PTOCHAR[0] = TBLGS[1];                                  001640
                PFROMCHAR[0] = 0;                                       001650
          IF DPTYPE[1] GQ 1        # NUMERIC, INTEGER, UNNORM          #
            AND DPTYPE[1] LQ 3
          THEN
          BEGIN PTOWORD[0] = LOC(ATTR) - 1; 
                AWPOS[0] = INDCE[1];
                ABPOS[0] = PTOCHAR[0] * 6;
                ALG[0] = PNBCHAR[0];
                ADS[0] = ALG[0];
                ADSS[0] = ALG[0]; 
                ACLS[0] = DPTYPE[1];
           END
          ELSE
                PTOWORD[0] = INDCE[1];                                  001660
                GOTO CONT;                                              001670
          END                                                           001680
          END                                                           001690
          IF INTESUB[0] THEN
          BEGIN P<ANYTABLE> = INDCE[0]; SUB = ANYWD[0]; END 
          ELSE SUB = INDCE[0];
          IF ALLFG[0] THEN SUB = 1; 
          ELSE
          IF SUB GR UB OR SUB LS 1 THEN                                 001710
            BEGIN 
            DIAG(610);             #INTEGER ITEM SUBSCRIPT OUT OF BOUND#
            EVMVERR;               # PRINT DIRECTIVE, PAGE AND LINE NO.#
            TEST I; 
            END 
        CONT: # #                                                       001730
          IF MENTRY[I] EQ 4 THEN
          BEGIN 
            ALLITM: # # 
                IF MCNVT[I] EQ 1 THEN 
                BEGIN 
          UB = 1; 
                  BLOCK: # #
                      SUB = UB * MCHARLG[I];
                      P<DESATT1> = MTOADDR[I];
           P<ANYTABLE> = DEWPOS[0];                                     000290
          SUB = UB * DECLSLG[0];
          P<DESATT1> = MFROMADDR[I];                                    000300
                      CP = DECLSLG[0];  #LG#
                      BP = MTCHAR[I]; 
                      WP = MFCHAR[I]; 
                      P<PARAM> = DEWPOS[0]; 
          P<DESATT1> = MADDRFR[I];                                      000340
          IF P<DESATT1> NQ 0 THEN P<PARAM>=P<PARAM>+DDWORD0[0];         000350
          CMOVE(PARAM,WP,SUB,ANYTABLE,BP);                              000360
                END 
                ELSE
                BEGIN 
                      P<DESATT1> = MFROMADDR[I];
                      BP = MCNVT[I];
                      IF BP LS O"11"
                        OR BP GR O"32" THEN 
                        MFROMADDR[I] = DEWPOS[0]; 
                      CONVERT(PARAM,RC);
                      CHECKRC(RC);  # IF CONVERT FOUND AN ERROR, PRINT #
                                   # ERROR MESSAGE AND DIAG 949        #
                      MFROMADDR[I] = P<DESATT1>;
                END 
                IF ALLNM THEN GOTO EVANEXT; 
                TEST I; 
          END 
          LG = ENTYLG[0]; 
          P<DESATT1> = B<18,18>INDTBLWD[2]; 
          SUB = SUB - 1;
          WP1 = DEWPOS[0];
          CP1 = MTCHAR[I];
          BP1 = DBITPOS[0]; 
          CP = BP1 + WP1 * 60 + LG * SUB * 6; 
          WP = CP / 60; 
          BP = CP - WP * 60;
          MTCHAR[I] = BP / 6; 
          SAVTOAD = MTOADDR[I]; 
          IF MTOADDR[I] EQ P<DESATT1> THEN
          BEGIN FOR J = 0 STEP 1 UNTIL 6 DO DDW[J] = DDWORD0[J];
          DDEWPOS[1] = WP;
          DDBITPOS[1] = BP; 
                MTOADDR[I] = LOC(DD); 
          END 
          ELSE MTOADDR[I] = WP; 
          IF MENTRY[I] EQ 5 THEN
          BEGIN IF ALLFG[0] THEN
                BEGIN J = P<INDTBL>;
                P<INDTBL> = INDCE[2]; 
                IF ALLFG[0] THEN
                BEGIN P<INDTBL> = J;
                      IF MCNVT[I] EQ 1 THEN 
                      BEGIN MTOADDR[I] = P<DESATT1>;
          ALLNM = TRUE; 
                            GOTO BLOCK; 
                      END 
                      ELSE GOTO LPALLALL; 
                END 
                ELSE
                P<INDTBL> = J;
                FIGSUB(PARAM,RC); 
                IF RC NQ 0 THEN GOTO EVANEXT; 
                GOTO LOOPALL; 
          END 
          J = P<INDTBL>;
          P<INDTBL> = INDCE[2]; 
          IF ALLFG[0] THEN
          BEGIN ALLNM = TRUE; 
                P<INDTBL> = J;
                GOTO ALLITM;
          END 
             MSTACKADD[I] = P<INDTBL>  ;
                FIGSUB(PARAM,RC); 
                CHECKRC(RC);       # IF FIGSUB FOUND AN ERROR, PRINT   #
                                   # ERROR MESSAGE AND DIAG 949        #
          MSTACKADD[I] = J; 
          END 
          ELSE IF MENTRY[I] EQ 7 THEN                                   001770
          BEGIN PROGSTACKLOC = INDCE[2];
                  LOGICALRESLT = FALSE; 
                  EXPEVALUATE(RC);  # EVALUATE EXPRESSION              #
                  IF RC NQ 0       # IF EXPEVALUATE FOUND AN ERROR     #
                  THEN
                    BEGIN 
                    EVMVERR;       # PRINT DIRECTIVE, PAGE AND LINE NO.#
                    END 
          UBT = MADDRFR[I]; 
          MADDRFR[I] = LOC(UBT);
                  CONVERT(PARAM,RC);
                  CHECKRC(RC);     # IF CONVERT FOUND AN ERROR, PRINT  #
                                   # ERROR MESSAGE AND DIAG 949        #
          MADDRFR[I] = UBT; 
          IF ALLFG[0] THEN ALLFLG = TRUE; 
          END 
          ELSE
          BEGIN CONVERT(PARAM,RC);
                CHECKRC(RC);       # IF CONVERT FOUND AN ERROR, PRINT  #
                                   # ERROR MESSAGE AND DIAG 949        #
                IF RC EQ 0 AND ALLFG[0] THEN ALLFLG = TRUE; 
          END 
          EVANEXT: # #
          MTCHAR[I] = CP1;
          MTOADDR[I] = SAVTOAD; 
          IF RC EQ 610             # IF INT ITEM SUBSCRIPT OUT OF BOUND#
          THEN
            BEGIN 
            CHECKRC(RC);           # PRINT ERROR MESSAGE AND DIAG 949  #
            END 
          IF NEXTFG[0]             # IF SUBSCRIPT IS -NEXT-            #
          THEN
            BEGIN 
            CONVERT(P,RC);         # PERFORM CONVERSION ROUTINE        #
            CHECKRC(RC);           # IF CONVERT FOUND AN ERROR, PRINT  #
                                   # ERROR MESSAGE AND DIAG 949        #
            END 
          IF NOT ALLFLG THEN
          TEST I; 
        LOOPALL: # #
          P<ANYTABLE> = WP + MADDRTO[I];
          CP = BP / 6;
          CP1 = CP + LG;
          IF UB GR 1 THEN 
          FOR J = 2 STEP 1 UNTIL UB DO
          BEGIN CMOVE(ANYTABLE,CP,LG,ANYTABLE,CP1); 
                CP1 = CP1 + LG; 
          END 
          TEST I; 
        LPALLALL: # # 
          CP1 = P<INDTBL>;
          P<INDTBL> = INDCE[2]; 
          UBT = UB; 
          J = MADDRFR[I]; 
          UPBUN(INDTBL,UB,J,RC);
          IF RC NQ 0               # IF UPBUN FOUND AN ERROR           #
          THEN
            BEGIN 
            CHECKRC(RC);           # PRINT ERROR MESSAGE AND DIAG 949  #
            GOTO EVANEXT; 
            END 
          IF UBT LS UB THEN UB = UBT; 
          ALLFG[0] = FALSE; 
          CONSUB[0] = TRUE; 
          LG = LG * 6;
          WP1 = MSTACKADD[I]; 
          MSTACKADD[I]=P<INDTBL>; 
          FOR UBT = 1 STEP 1 UNTIL UB DO
          BEGIN INDCE[0] = UBT; 
               FIGSUB(PARAM,RC);
               IF RC NQ 0 THEN GOTO ENDALL; 
               CP = CP + LG;
               WP = CP / 60;
               BP = CP - WP * 60; 
               MTCHAR[I] = BP / 6;
               IF MTOADDR[I] EQ LOC(DD) THEN
               BEGIN
               DDEWPOS[1] = WP; 
               DDBITPOS[1] = BP;
               END
               ELSE MTOADDR[I] = WP;
          END 
        ENDALL: # # 
          ALLFG[0] = TRUE;
          CONSUB[0]  = FALSE; 
          INDCE[0]  = 0;
          P<INDTBL> = CP1;
          MSTACKADD[I] = WP1; 
          GOTO EVANEXT; 
              END 
          IF MTOADDR[7] NQ 0 THEN 
          BEGIN P<MOVETBL>=MTOADDR[7];
                GOTO RPTMOV;
          END 
          END 
          CONTROL EJECT;
          PROC DETAIL;
          BEGIN #DETAIL#           #PROC TO PERFORM 1 DTL LINE# 
          IF DEVBEF[0] NQ 0 THEN
          BEGIN P<EVALDATA> = DEVBEF[0];
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"ANYDTL";   # INDEX FOR "ANY-DETAIL"        #
                EXCEV;
          END 
          IF DMVBEF[0] NQ 0 THEN
           BEGIN P<MOVETBL> = DMVBEF[0];
                 EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"       #
                 BFAFIND = S"ANYDTL";   # INDEX FOR "ANYDTL"           #
              MOVEXE; 
          END 
      IF CSELECT NQ 0  THEN BEGIN 
          IF DEVBEF[CSELECT] NQ 0 THEN
          BEGIN P<EVALDATA> = DEVBEF[CSELECT];
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"DTLVL";    # INDEX FOR                     #
                                       # "DETAIL-(SELTAG[CSELECT])"    #
              EXCEV;
          END 
          IF DMVBEF[CSELECT] NQ 0 THEN
          BEGIN P<MOVETBL>= DMVBEF[CSELECT];
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"DTLVL";    # INDEX FOR                     #
                                       # "DETAIL-(SELTAG[CSELECT])"    #
              MOVEXE; 
          END 
      END 
      IF DTLWORD[CSELECT] EQ 0  THEN GOTO DEVAL;
      IF CSELECT EQ 0  THEN BEGIN 
        IF SELWORD [1] NQ 0  THEN RETURN; 
        GOTO DEVAL;   END 
              IF SELTAG[CSELECT] NQ LEVEL[DTLFIRST[CSELECT]] THEN 
                      GOTO DETAILERR;  #TABLE HAS ERROR#
              J = DTLFIRST [CSELECT]; 
                  IF NOT BEYOND [J] 
                AND NOT LINEN [J]  THEN 
                ABSOLINE = TRUE;
              DTLCURRENT [CSELECT] = J; 
              J = DTLLAST[CSELECT];  #SAVE LAST PTR#
            FORMLOOP: 
              K = DTLCURRENT[CSELECT];  #CURRENT PTR# 
          IF K GR J THEN
          BEGIN 
          IF DEVAFT[CSELECT] NQ 0 THEN
          BEGIN P<EVALDATA> = DEVAFT[CSELECT];
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"DTLVL";    # INDEX FOR                     #
                                       # "DETAIL-(SELTAG[CSELECT])"    #
                    EXCEV;
              END 
          IF DMVAFT[CSELECT] NQ 0 THEN
          BEGIN P<MOVETBL> = DMVAFT[CSELECT]; 
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"DTLVL";    # INDEX FOR                     #
                                       # "DETAIL-(SELTAG[CSELECT])"    #
                  MOVEXE; 
              END 
 DEVAL:  # #
          IF DEVAFT[0] NQ 0 THEN
          BEGIN P<EVALDATA> = DEVAFT[0];
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"ANYDTL";   # INDEX FOR "ANY-DETAIL"        #
                    EXCEV;
              END 
          IF DMVAFT[0] NQ 0 THEN
          BEGIN P<MOVETBL> = DMVAFT[0]; 
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"ANYDTL";   # INDEX FOR "ANY-DETAIL"        #
                  MOVEXE; 
              END 
              RETURN; 
          END 
          FORMLINE(K,RA0);
              PAGE(K);             #PRINT 1 LINE ON PAGE# 
              GOTO FORMLOOP;       #CONT TO PROCESS#
            DETAILERR:  
              RETURN; 
          END   #DETAIL#
          CONTROL EJECT;
          XREF ITEM LASTLN;                                             000340
          PROC CHKSPACE;           #PROC TO CHK IF ENOUGH SPACE IF LEFT#
          BEGIN #CHKSPACE#
              BASED ARRAY HEAD;    #HEADER WORDS# 
                  ITEM HEADFTL U(0,3,7),  #FIRST LINE#
                       HEADEND U(0,10,7),  #LAST LINE#
                       HEADLB  U(0,17,7);  #LINE BEYOND#
          IF OVERLVL LQ MAXBREAK THEN                                   001220
          BEGIN IF BEVBEF[OVERLVL] NQ 0 THEN
                BEGIN P<EVALDATA> = BEVBEF[OVERLVL];
                      EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"  #
                      BFAFIND = S"BREAKO";   # INDEX FOR               #
                                           #"BREAK-(BRKLEVEL[OVERLVL])"#
                      EXCEV;                                            001260
                END                                                     001270
          IF BMVBEF[OVERLVL] NQ 0 THEN
          BEGIN P<MOVETBL> = BMVBEF[OVERLVL]; 
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"BREAKO";   # INDEX FOR                     #
                                       # "BREAK-(BRKLEVEL[OVERLVL])"   #
                      MOVEXE;                                           001310
                END                                                     001320
          END                                                           001330
              RC = 1;              #PRESET TO ENOUGH# 
           CLINE = LPLINE;
              IF CHKINDEX EQ 1 AND CSELECT NQ 0 THEN
              BEGIN #1#            #CHK SPACE FOR DTL#
                  P<HEAD> = LOC(DTLWORD[CSELECT]); #PICK UP RIGHT HEAD# 
                  CHKROOM;         #CHK SPACE#
                  IF RC EQ 0 THEN RETURN;  #NOT ENOUGH, RETURN# 
              END   #1# 
          IF CLINE LS LASTLN THEN CLINE = LASTLN;                       000320
              IF CHKINDEX NQ 3 THEN  #CHK SPACE FOR FTG#
              BEGIN #NQ 3#
                      FOR I = MAXBREAK STEP -1 UNTIL CBREAK DO
                      BEGIN #I#    #FTG STARTS FROM HIGHEST TO CURRENT# 
                          IF FTGWORD[I] EQ 0 THEN TEST I; 
          IF B<1,1>BRKWORD[I]   NQ B<1,1>BRKWORD[CBREAK]   THEN TEST I; 
                          P<HEAD> = LOC(FTGWORD[I]);
                          CHKROOM;    #CHK SPACE# 
                          IF RC EQ 0 THEN RETURN; #NOT ENOUGH, RETURN#
                      END   #I# 
                RECAPP: 
                  P<HEAD> = LOC(RECAPHEAD);  #CHK SPACE FOR RECAP#
           IF RECWORD[1] NQ 0 THEN
          BEGIN                                                         000360
                 CHKROOM; 
           END
                  RETURN; 
              END   #NQ 3#
              ELSE
              BEGIN #EQ 3#
          FOR I=CBREAK STEP 1 UNTIL MAXBREAK DO 
                      BEGIN #I#    #HDG STARTS FROM CURRENT TO HIGHEST# 
                          IF HDGWORD[I] EQ 0 THEN TEST I; 
          IF B<1,1>BRKWORD[I]   NQ B<1,1>BRKWORD[CBREAK]   THEN TEST I; 
                          P<HEAD> = LOC(HDGWORD[I]);
                          CHKROOM;    #CHK SPACE# 
                          IF RC EQ 0 THEN RETURN; #NOT ENOUGH, RETURN#
                      END   #I# 
                  P<HEAD> = LOC(DTLWORD[CSELECT]);
                  IF CSELECT NQ 0 THEN CHKROOM;  #CHK SPACE FOR DTL#
                  IF RC EQ 0 THEN RETURN; 
                  GOTO RECAPP;     #GO CHK SPACE FOR RECAP# 
              END   #EQ 3#
              PROC CHKROOM; 
              BEGIN #CHKROOM# 
                  CLINE = HEADLB[0] + CLINE;  #UPDATE CURRENT LINE# 
                  IF CLINE GR PSLINE THEN  #PASS PAGE SIZE, NOT ENOUGH# 
                  BEGIN #GT#       #SPACE#
                    INSUFF: 
                      RC = 0; 
                      RETURN; 
                  END   #GT#
                      IF HEADEND[0] NQ 0 THEN CLINE = HEADEND[0]; 
                  RETURN; 
              END   #CHKROOM# 
          END   #CHKSPACE#
          CONTROL EJECT;
          PROC FOOTING;            #PROC TO PRINT FOOTING#
          BEGIN #FOOTING# 
         IF CBREAK GR MAXBREAK THEN RETURN;                             006730
         FLG = FALSE;                                                   006740
              FOR J = MAXBREAK STEP -1 UNTIL CBREAK DO
              BEGIN #J#            #FTG STARTS FROM HIGHEST TO CURRENT# 
          IF BRKWORD[J] EQ 0 AND J NQ 0 THEN TEST J;
                  IF FTGFIRST[J] EQ 0 THEN TEST J; #NO FTG AT THIS LEVE#
          IF B<1,1>BRKWORD[J]   NQ B<1,1>BRKWORD[CBREAK]   THEN TEST J; 
          IF PRWFG EQ 1 THEN                                            021160
         IF CBREAK EQ 0 AND J NQ 0 AND BRKLOG[J] THEN TEST J;           021170
         IF NOT FLG THEN BEGIN FLG=TRUE;                                006680
          IF FEVBEF[-1] NQ 0 THEN 
          BEGIN P<EVALDATA> = FEVBEF[-1]; 
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"ANYFTG";   # INDEX FOR "ANY-FOOTNG"        #
                EXCEV;
          END 
           IF FMVBEF[-1] NQ 0 THEN
          BEGIN P<MOVETBL> = FMVBEF[-1];
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"ANYFTG";   # INDEX FOR "ANY-FOOTNG"        #
              MOVEXE; 
          END 
         END                                                            006700
                  FTGCURRENT[J] = FTGFIRST[J]; #SET CURRENT PTR#
                  L = FTGLAST[J];    #LAST PTR# 
          IF FEVBEF[J] NQ 0 THEN
          BEGIN P<EVALDATA> = FEVBEF[J];
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"FTNGJ";   #INDEX FOR "FOOTNG-(BRKLEVEL[J])"#
                EXCEV;
          END 
          IF FMVBEF[J] NQ 0 THEN
          BEGIN P<MOVETBL> = FMVBEF[J]; 
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"FTNGJ";   #INDEX FOR "FOOTNG-(BRKLEVEL[J])"#
              MOVEXE; 
          END 
                FTGLOOP:  
                  K = FTGCURRENT[J];   #CURRENT PTR#
          IF K GR L THEN
          BEGIN 
          IF FEVAFT[J] NQ 0 THEN
          BEGIN P<EVALDATA> = FEVAFT[J];
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"FTNGJ";   #INDEX FOR "FOOTNG-(BRKLEVEL[J])"#
                  EXCEV;
              END 
          IF FMVAFT[J] NQ 0 THEN
          BEGIN P<MOVETBL> = FMVAFT[J]; 
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"FTNGJ";   #INDEX FOR "FOOTNG-(BRKLEVEL[J])"#
                  MOVEXE; 
              END 
              TEST J; 
          END 
                                   #CURRENT PAST LAST, THID LEVEL FTG 
                                    DONE# 
          FORMLINE(K,RA0);
                  PAGE(K);         #PRINT A LINE# 
                  GOTO FTGLOOP;    #CONT TO PROCESS#
              END   #J# 
        EVALAFTF: 
         IF NOT FLG THEN RETURN;                                        006660
          IF FEVAFT[-1] NQ 0 THEN 
          BEGIN P<EVALDATA> = FEVAFT[-1]; 
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"ANYFTG";   # INDEX FOR "ANY-FOOTNG"        #
              EXCEV;
          END 
          IF FMVAFT[-1] NQ 0 THEN 
          BEGIN P<MOVETBL> = FMVAFT[-1];
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"ANYFTG";   # INDEX FOR "ANY-FOOTNG"        #
              MOVEXE; 
          END 
              RETURN; 
          END   #FOOTING# 
          CONTROL EJECT;
          PROC HEADING;            #PROC TO PRINT HEADINGS# 
          BEGIN #HEADING# 
         FLG = FALSE;                                                   006620
          FOR J = 0 STEP 1 UNTIL MAXBREAK DO
              BEGIN #J#            #HDG STARTS FROM CURRENT TO HIGHEST# 
             IF BRKWORD[J] EQ 0 AND J NQ 0 THEN GOTO EVALAFTH;
                  IF HDGFIRST[J] EQ 0 THEN TEST J; #NO HDG AT THIS LEVE#
          IF J LS CBREAK AND (NOT ALLPAGE[HDGFIRST[J]] OR NOT PGCLS)    000030
      THEN TEST J;
          IF B<1,1>BRKWORD[J] NQ B<1,1>BRKWORD[CBREAK] AND              001020
            (NOT ALLPAGE[HDGFIRST[J]] OR NOT PGCLS) THEN TEST J;        001030
          IF PRWFG NQ 1 THEN
          IF CBREAK EQ 0 AND J NQ 0 AND BRKLOG[J] AND                   001050
            (NOT ALLPAGE[HDGFIRST[J]] OR NOT PGCLS) THEN TEST J;        001060
         IF NOT FLG THEN BEGIN FLG=TRUE;                                006580
          IF HEVBEF[-1] NQ 0 THEN 
          BEGIN P<EVALDATA> = HEVBEF[-1]; 
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"ANYHDG";   # INDEX FOR "ANY-HEADNG"        #
                EXCEV;
          END 
          IF HMVBEF[-1] NQ 0 THEN 
          BEGIN P<MOVETBL>= HMVBEF[-1]; 
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"ANYHDG";   # INDEX FOR "ANY-HEADNG"        #
              MOVEXE; 
          END 
         END                                                            006600
                  HDGCURRENT[J] = HDGFIRST[J]; #SET CURRENT PTR#
                  L = HDGLAST[J]; 
          IF HEVBEF[J] NQ 0 THEN
          BEGIN P<EVALDATA> = HEVBEF[J];
                EVMVIND = S"EVALBEF";  # INDEX FOR "EVAL-BEFRE"        #
                BFAFIND = S"HDNGJ";   #INDEX FOR "HEADNG-(BRKLEVEL[J])"#
                EXCEV;
          END 
          IF HMVBEF[J] NQ 0 THEN
          BEGIN P<MOVETBL> = HMVBEF[J]; 
                EVMVIND = S"MOVEBEF";  # INDEX FOR "MOVE-BEFRE"        #
                BFAFIND = S"HDNGJ";   #INDEX FOR "HEADNG-(BRKLEVEL[J])"#
              MOVEXE; 
          END 
                HDGLOOP:  
                  K = HDGCURRENT[J];   #CURRENT PTR#
          IF K GR L THEN
          BEGIN 
          IF HEVAFT[J] NQ 0 THEN
          BEGIN P<EVALDATA> = HEVAFT[J];
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"HDNGJ";   #INDEX FOR "HEADNG-(BRKLEVEL[J])"#
                  EXCEV;
              END 
          IF HMVAFT[J] NQ 0 THEN
          BEGIN P<MOVETBL> = HMVAFT[J]; 
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"HDNGJ";   #INDEX FOR "HEADNG-(BRKLEVEL[J])"#
                  MOVEXE; 
              END 
              TEST J; 
          END 
          FORMLINE(K,RA0);
                  PAGE(K);         #PRINT A LINE# 
                  GOTO HDGLOOP;    #CONT TO PROCESS#
              END   #J# 
        EVALAFTH: 
         IF NOT FLG THEN RETURN;                                        006640
          IF HEVAFT[-1] NQ 0 THEN 
          BEGIN P<EVALDATA> = HEVAFT[-1]; 
                EVMVIND = S"EVALAFT";  # INDEX FOR "EVAL-AFTER"        #
                BFAFIND = S"ANYHDG";   # INDEX FOR "ANY-HEADNG"        #
                EXCEV;
          END 
          IF HMVAFT[-1] NQ 0 THEN 
          BEGIN P<MOVETBL> = HMVAFT[-1];
                EVMVIND = S"MOVEAFT";  # INDEX FOR "MOVE-AFTER"        #
                BFAFIND = S"ANYHDG";   # INDEX FOR "ANY-HEADNG"        #
              MOVEXE; 
          END 
              RETURN; 
          END   #HEADING# 
          CONTROL EJECT;
          XREF PROC DIAG; 
          XDEF PROC FORMLINE; 
          PROC FORMLINE(PTR,A); 
          BEGIN #FORMLINE#
              ITEM PTR; 
          ITEM L   I;              # USED FOR CHAR. LNGTH AND LINE NO. #
          ITEM M   I; 
          ITEM PAGEORSECT I;       # PAGE OR SECTION WIDTH             #
          ARRAY A;; 
          BASED ARRAY ALINE [0:MAXWPL];  ITEM ALINEFILL;
              ITEM I,J,K; 
              BASED ARRAY BACKPOINTER;
                  ITEM BACKPTR I(0,48,12);
           ITEM XS C(10) = "XXXXXXXXXX";
           ITEM YS C(10) = "YYYYYYYYYY";
          ITEM NINES C(10) = "9999999999";
          ITEM EIGS  C(10) = "8888888888";
           ITEM XORY = 1; 
           BASED ARRAY PARAM1;
               ITEM PAR1 U(0,0,60); 
          ITEM IX  I;              # CONTAINS NAME AND LEVEL NO. WHEN  #
                                   # RETURNED FROM WHATSTEP (IN PAGE)  #
          ITEM RC;
          ITEM ERRCT = 0; 
              SWITCH TYPE DIREMOVE,  #DIRECT MOVE, ABSOLUTE ADDRESS#
                          DIREMOVE,  #DIRECT MOVE, RELATIVE ADDRESS#
                          CNVTDATA,  #CONVERT DATA, ABSOLUTE ADDRESS# 
                    EVALUAT,
                    SUBFIG; 
      IF LOC(A) EQ 0  THEN P<ALINE> = LOC(FORMATDLINE); 
        ELSE P<ALINE> = LOC(A); 
          FOR I = 0  STEP 1  UNTIL MAXWPL  DO 
            ALINEFILL[I] = "          ";
              I = PTR;
            SELECTTYPE:       #PERFORM DIFFERENTLY DEPEND ON ENTRY TYPE#
          IF LOC(A) NQ 0 THEN FORMDLADDR = LOC(A);
          ELSE FORMDLADDR = LOC(FORMATDLINE); 
              GOTO TYPE[TYPENTRY[I]]; 
            DIREMOVE:              #DIRECT MOVE#
          IF PRWFG EQ 1 THEN
          IF ADDRFROM[I] EQ LOC(CURRENTSOURC) THEN
         GOTO PWMV;                                                     021320
              P<PARAM> = LOC(REPORTWORD2[I]); 
          MOVEC(PARAM); 
            UPDPTR:                #UPDATE CURRENT PTR# 
              P<BACKPOINTER> = HEADPOINTER[I];
              BACKPTR[0] = BACKPTR[0] + 1;
              I = I + 1;
              IF CONTINUATN[I] THEN GOTO SELECTTYPE;
              RETURN; 
            CNVTDATA:              #CONVERT DATA# 
           IF PRWFG EQ 1 THEN GOTO PWMV;
              P<PARAM> = LOC(REPORTWORD2[I]); 
              P<PARAM1> = CURRENTSOURC; 
           CONVERT(PARAM,RC); 
           IF RC NQ 0 THEN PRTERR;
              GOTO UPDPTR;
            SUBFIG:                #FIGURATIVE SUBSCRIPT# 
           IF PRWFG EQ 1 THEN GOTO PWMV;
              P<PARAM> = LOC(REPORTWORD2[I]); 
          P<INDTBL> = STACKADD[I];
          IF ALLFG[0] THEN
          BEGIN 
          J = ADDRFROM[I];
          UPBUN(INDTBL,UB,J,RC);
          IF RC NQ 0 THEN 
          BEGIN DIAG(RC); GOTO UPDPTR;
          END 
             J = TOCHAR[I]; 
             K = TOADDRESS[I];
             L = CHARLENGTH[I]; 
             CONSUB[0] = TRUE;
             ALLFG[0] = FALSE;
             M = K * 10 + J;
             IF CALLTYPE[I] EQ 1   # IF DETAIL                         #
             THEN 
               BEGIN
               PAGEORSECT = SECTWID;  # SECTION WIDTH                  #
               END
             ELSE 
               BEGIN
               PAGEORSECT = PSCOLUMN;  # PAGE WIDTH                    #
               END
             FOR PP = 1 STEP 1 UNTIL UB DO
             BEGIN INDCE[0] = PP; 
                   RC = M / 10; 
                   TOADDRESS[I] = RC; 
                   RC = M - RC * 10;
                   TOCHAR[I] = RC;
                   M = M + L; 
          IF M GR PAGEORSECT       # IF LONGER THAN SECTION OR PAGE    #
          THEN
            BEGIN 
            CHARLENGTH[I] = L - M + PAGEORSECT;  # TRUNCATE TO END OF  #
                                                 # SECTION OR PAGE     #
                PP = UB + 1;
                DIAG(613);
          END 
                   FIGSUB(PARAM,RC);
                   IF RC NQ 0 THEN BEGIN PRTERR; GOTO RESET; END
             END
            RESET: # #
             CONSUB[0] = FALSE; 
             ALLFG[0] = TRUE; 
             INDCE[0] = 0;
             TOCHAR[I] = J; 
          CHARLENGTH[I] = L;
             TOADDRESS[I] = K;
             GOTO UPDPTR; 
          END 
          FIGSUB(PARAM,RC); 
           IF RC NQ 0 THEN PRTERR;
              GOTO UPDPTR;
            EVALUAT:               #EVALUATE EXPRESSIONS# 
           IF PRWFG EQ 1 THEN GOTO PWMV;
          PROGSTACKLOC = STACKADD[I]; 
          LOGICALRESLT = FALSE; 
          EXPEVALUATE(RC);         # EVALUATE EXPRESSION               #
          IF RC NQ 0               # IF ERROR FOUND IN EXPEVALUATE     #
          THEN
            BEGIN 
            WHATSTEP(PTR,IX);      # GET NAME AND LEVEL NO. OF CURRENT #
                                   # DIRECTIVE.                        #
            B<0,30>PPP = B<30,30>PAGENUM;    # MOVE CURRENT PAGE NUMBER#
                                             # TO DIAG 949 PARAMETER   #
            IF XLINE LS 0          # IF LINE NUMBER IS LESS THAN ZERO  #
            THEN
              BEGIN 
              DLINE = 0;           # MOVE 0 TO LINE PARAM. FOR DIAG 949#
              END 
            ELSE                   # OTHERWISE                         #
              BEGIN 
              DLINE = XLINE;       # MOVE CURRENT LINE NO. TO PARAMETER#
                                   # FOR DIAGNOSTIC MESSAGE            #
              END 
            DIAG(949,IX," ",PPP,DLINE);      # PRINT DIRECTIVE,PAGE AND#
                                   # LINE NUMBER.                      #
            END 
          J = ADDRFROM[I];
          ADDRFROM[I] = LOC(J); 
          P<PARAM> = LOC(REPORTWORD2[I]); 
           CONVERT(PARAM,RC); 
           IF RC NQ 0 THEN PRTERR;
          ADDRFROM[I] = J;
              GOTO UPDPTR;
        PWMV: # # 
         P<PARAM1> = FORMDLADDR + TOADDRESS[I];                         021340
         IF CNVTCODE[I] NQ 1 AND CNVTCODE[I] NQ 45 AND                  021370
             CNVTCODE[I] NQ 0 THEN
         BEGIN IF XORY EQ 2 THEN XORY=3; ELSE XORY=2; END               021390
          ELSE
           IF XORY EQ 0 THEN XORY = 1;
                        ELSE XORY = 0;
           J = TOCHAR[I]; 
           K = CHARLENGTH[I]; 
           P<PARAM> = LOC(XS);
           IF 10 - J GR K THEN GOTO LASTWORD; 
                          ELSE C<J,10-J>PAR1[0]=C<0,10-J>PAR[XORY]; 
           K = K - (10 - J);
            J = 0;                                                      021420
        NOTLAST: # #
           P<PARAM1> = P<PARAM1> + 1; 
           IF K EQ 0 THEN GOTO UPDPTR;
           IF K LS 10 THEN GOTO LASTWORD; 
           PAR1[0] = PAR[XORY]; 
           K = K - 10;
           GOTO NOTLAST;
        LASTWORD: # # 
           C<J,K>PAR1[0] = C<0,K>PAR[XORY]; 
           GOTO UPDPTR; 
      PROC PRTERR;
      BEGIN 
          PP = 0; 
         FOR L = 30 STEP 6 UNTIL 54 DO
          BEGIN M = B<L,6>PAGENUM - O"33";
          PP = PP * 10 + M; 
          END 
         IF LINEN[I] THEN                                               022600
         BEGIN P<PARAM1> = LINENBN[I];                                  022610
               L = PAR1[0];                                             022620
         END                                                            022630
         ELSE                                                           022640
         BEGIN                                                          022650
          L = LINENUMBER[I];
          IF BEYOND[PTR]     # IF BEYOND OPTION WAS SPECIFIED FOR THE  #
                             # CURRENT LINE                            #
          THEN
            BEGIN 
            L = L + XLINE;   # INCREMENT LINE POINTER APPROPRIATELY    #
            END 
         END                                                            022670
          WHATSTEP(PTR,IX);        # GET NAME AND LEVEL NO. OF CURRENT #
                                   # DIRECTIVE                         #
          DIAG(600,RC,IX,PP,L);    # PRINT MESSAGE TO RELAY A SOURCE   #
                                   # DATA CONVERSION ERROR             #
          ERRCT = ERRCT + 1;
           IF ERRCT EQ 61 THEN
          BEGIN 
               DIAG(601); 
            WRITER(RPTFIT);        # FLUSH BUFFER AND WRITE EOR        #
         CLOSEM(SRCFIT, $DET$, RA0);  # CLOSE SOURCE FILE              #
          GOTO LDX0;               # LEAVE THIS EXECUTION OVERLAY      #
          END 
      END 
          END   #FORMLINE#
     # THIS IS THE PLACE TO DO ANY CLEAN UP FOR THE OVERLAY IF AN       000660
       ABORT HAS OCCURRED - NO ASSURANCE OF HOW FAR THE OVERLAY WAS IN  000670
       EXECUTION #                                                      000680
      XDEF PROC AUTOPSY;                                                000690
      PROC AUTOPSY;                                                     000700
     BEGIN
        P<FIT> = P<SRCFIT>; 
        IF FITOC EQ 1 
        THEN
          BEGIN 
          CLOSEM(FIT, $DET$, RA0);
          END 
  
        WRITER(RPTFIT);            # FLUSH BUFFER AND WRITE EOR        #
  
      RLSCM;                       # RELEASE CM FOR WSA-S AND BUFFER   #
     END
LDX0:                        # KLUGE TO RETURN TO (1,0) OVERLAY # 
          RLSCM;                   # RELEASE CM FOR WSA-S AND BUFFER   #
      RETURN;                                                           000710
      END   #REPORT#
      TERM
