*DECK PRECOMP 
USETEXT TCLFN 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TLFNINF 
USETEXT TREPORT 
USETEXT TRPTLST 
USETEXT TXSTD 
      PROC PRECOMP; 
  
#----------------------------------------------------------------------#
#                                                                      #
#  THE FOLLOWING PROCS ARE XDEF"D WITHIN THIS DECK:                    #
#                                                                      #
#     CHKRPTN                      CHECK REPORT NAME                   #
#     CHKTXT                       CHECK FOR *TEXT*                    #
#     DESCRIN                      PROCESS *DESCRIBED IN*              #
#     DESSEARCH                    SEARCH FOR UNIQUE DESCRIBE LIST     #
#     FULLSYN                      INITIATE FULL SYNTAX PROCESSING     #
#     PRWFG1                       SET FLAGS FOR *PREVIEW*             #
#     PRWFG2                       SET FLAGS FOR *PREVIEW*             #
#     PWREADY                      INITIATE EXECUTION OF *PREVIEW*     #
#     RECRDPR                      RECORD PREVIEW/PREPARE              #
#     SETCOMP                      SET *RPTOVL* TO INDICATE *COMPILE*  #
#     SETPREP                      SET *RPTOVL* TO INDICATE *PREPARE*  #
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
  
      XREF ITEM A            C(10);  # SCRATCH HOLDING OF ILFN         #
      XREF ITEM B            I;    # SCRATCH HOLDING OF ILFNLG         #
      XREF ITEM CDCSCAT  B;        # TRUE IF IN CDCS CATALOG MODE      #
      XREF ITEM CURRENTLFPTR I;    # LOCATION OF CURRENT LFNINFO ENTRY #
      XREF BASED ARRAY DESPTR;
        BEGIN 
        ITEM DESCOUNT I(00,00,12); # NUMBER OF LOCAL FILES REFERENCING #
                                   # THIS LIST OF DESCRIBE ITEMS.      #
        ITEM DESSIZE U(0,24,18);   # SIZE OF DESCRIBED LIST IN CHAR    #
        ITEM DESADDR U(0,42,18);   # DESLIST FOR THIS FILE             #
        END 
      XREF ITEM DUMMY        I;    # SCRATCH TEMPORARY                 #
      XREF BASED ARRAY HOLDER;     # A FIT *HELD* FOR *SORT*/*COMPILE* #
        BEGIN 
        ITEM HOLDBT       U(11,36,03);  # BLOCK TYPE                   #
        ITEM HOLDCL       U(16,24,06);  # COUNT FIELD LENGTH (RT=D/T)  #
        ITEM HOLDCP       U(17,15,24);  # BCP OF COUNT FIELD (RT=T)    #
        ITEM HOLDC1       B(17,13,01);  # COMP-1 BIT (RT=D/T)          #
        ITEM HOLDHL       U(15,00,24);  # HEADER LENGTH (RT=T)         #
        ITEM HOLDLT       U(10,36,02);  # LABEL TYPE                   #
        ITEM HOLDMRL      U(12,00,24);  # MAXIMUM RECORD LENGTH        #
        ITEM HOLDRT       U(11,32,04);  # RECORD TYPE                  #
        ITEM HOLDSB       B(17,14,01);  # SIGN OVERPUNCH (RT=D/T)      #
        ITEM HOLDTL       U(16,00,24);  # TRAILER LENGTH (RT=T)        #
        END 
  
      ITEM I            I;         # SCRATCH TEMPORARY                 #
      ITEM J            I;         # SCRATCH TEMPORARY                 #
      ITEM KEY          C(10);     # TEMPORARY FOR USE IN CRM CALLS    #
      XREF ITEM LFNLIST      I;    # POINTER TO HEAD OF LFNINFO LIST   #
      XREF ITEM RA0          I;    # LOCATION OF ZERO FOR PARAM LISTS  #
      ITEM RC           I;         # SCRATCH RETURN CODE               #
       DEF DFTRPWD #O"40000000000001000000"#;  #DEFAULT VALUE FOR 
                                                REPORTLIST WORD 1,
                                                BEYOND IS ON, 
                                                LINE NB IS 1# 
         DEF DFTRPWD2 #O"04010000000000000000"#;
  
      XREF ITEM RPTOVL       I;    # INDICATES PRIMARY OVERLAY LEVEL   #
                                   # TO BE USED WITH THE REPORT TABLES #
                                   # JUST BUILT.                       #
      XREF ITEM ROOT         I; 
      XREF ITEM SAVELFNAME   I; 
      BASED ARRAY SCRATCH;;        # SCRATCH WSA                       #
      XREF ITEM SM$GROUPID   I;    # CURRENT GROUP ID FOR SYNTAX STUFF #
  
      XREF PROC CATCHK;            # CALL PROPER CATALOG-ACCESSING PROC#
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC MESSAGE TO USER  #
      XREF PROC EXIT10;            # CALLS LOADOVL TO LEAVE SYNTAX     #
      XREF PROC GET;
      XREF PROC GETREADY; 
      XREF PROC LFNLOOKUP;
      XREF PROC OPNCAT; 
      XREF PROC SETBIT; 
      XREF PROC SYNIO;
      XREF PROC WRITE;
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC CHKRPTN;
          PROC CHKRPTN; 
      BEGIN 
          IF RECORDFLAG THEN STDYES;
          IF PERFLG                # IF DOING A PERFORM                #
            AND NOT FULLSYNTX      # AND THIS IS THE FIRST CALL FOR    #
                                   # THIS REPORT (NOT IN THE MIDDLE OF #
                                   # A MULTI-REPORT PREPARE)           #
          THEN
            BEGIN 
            OLDKEY = KEYAREA;      # SAVE THE KEY OF THE *PREPARE* OR  #
                                   # *COMPILE* SO CAN RESTART *PERFORM*#
                                   # AT THAT DIRECTIVE/TRANSMISSION    #
            END 
  
          OPNCAT(CATAFIT, PD$INPUT, I);  # TRY TO OPEN FOR INPUT       #
          IF I NQ 0                # IF CRM ERR OR NO CATALOG          #
          THEN
            BEGIN 
            STDNO;                 # BAD RETURN - UNKNOWN REPORT       #
            END 
  
          P<SCRATCH> = CMM$ALF((CATAFITMRL[0] + 9) / 10, 0, 0); 
          CATAFITES = 0;                                                 FORMALT
                 KEY = ILFN[IPRE];
                 CATAFITWSA = P<SCRATCH>; 
                 CATAFITKA = LOC(KEY);
                 CATAFITKP = 0; 
                 CATAFITMKL = 7;
                 CATCHK (CGET, LOC(CATAFIT), CDCSCAT);
                 CMM$FRF(LOC(SCRATCH)); 
                 I = CATAFITES;                                          FORMALT
                 IF I EQ UNKNOWNKEY THEN STDNO; 
                 STDYES;
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC CHKTXT; 
          PROC CHKTXT;
          BEGIN 
          TYPEALOW = 7; 
          IF DIRLEXID NQ O"142" THEN   # IF NOT COMPILE                #
                                   # IF COMPILE, THIS HAS ALREADY BEEN #
                                   # DONE IN GETREADY, THEN RPTCTR     #
                                   # WAS CHANGED                       #
            BEGIN 
            CURRENTLFPTR = FLFNINFO[RPTCTR];
            P<LFNINFO> = CURRENTLFPTR;
            P<DESPTR> = L$DESPTR;                                        FORMALT
            DESLIST = DESADDR;
            FSIZE = DESSIZE;
            END 
                 IF PSFLG EQ 1 THEN 
                 BEGIN
          P<REPORTLIST> = AREPORTLIST;
                       DTLFIRST[1] = 1; 
                       DTLLAST[1] = 1;
                       REPORTWORD1[1] = O"40000000000001000000";
                       REPORTWORD2[1] = O"10010000000000000000";
          HEADPOINTER[1] = LOC(DTLWORD[1]); 
           ADDRFROM[1] = LOC(CURRENTSOURC); 
         ADDRTO[1] = LOC(FORMDLADDR); 
          CNVTCODE[1] = 0;
           NONEMPTYRPT = TRUE;
                 STDYES;
                 END
          SM$GROUPID = CMM$AGR(0);  # ALLOCATE GROUP ID FOR REPORT     #
                       STDNO; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
#----------------------------------------------------------------------#
#     DESCRIN                                                          #
#                                                                      #
#     FINDS AND SAVES P<LFNINFO> FOR *DESCRIBED IN* OR *FROM* FILE     #
#                                                                      #
      XDEF PROC DESCRIN;
      PROC DESCRIN; 
      BEGIN 
      FNDDESPTR;
      FLFNINFO[0] = CURRENTLFPTR;  # POINTER TO LFNINFO TABLE          #
      STDYES; 
      END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
#----------------------------------------------------------------------#
#     DESSEARCH                                                        #
#     NO *DESCRIBED IN* FILE HAS BEEN SPECIFIED BUT DESLIST IS REQUIRED#
#     SEARCH LFNLIST TO DETERMINE IF EXACTLY ONE DESCRIBE LIST EXISTS  #
#     IF EXACTLY ONE, USE THAT ONE                                     #
#     IF NOT EXACTLY ONE, ISSUE DIAGNOSTIC, ERROR EXIT                 #
#                                                                      #
      XDEF PROC DESSEARCH;
      PROC DESSEARCH; 
      BEGIN 
      ITEM LOOPCON B;              # LOOP CONTROL                      #
      ITEM SAVEDESL;               # CONTAINS DESLIST                  #
      ITEM SAVELF;                 # CONTAINS P<LFNINFO>               #
      IF RECORDFLAG THEN
        BEGIN 
        STDYES; 
        END 
      IF LFNLIST EQ 0 THEN         # NO FILES, HENCE NO DESCRIBE LIST  #
        BEGIN 
        STDNO;
        END 
      LOOPCON = TRUE; 
      SAVEDESL = 0; 
      P<LFNINFO> = LFNLIST;        # POSITION TO FIRST LFN TABLE       #
      FOR J=J                                                            FORMALT
        WHILE LOOPCON                                                    FORMALT
      DO                                                                 FORMALT
        BEGIN 
        SAVELF = P<LFNINFO>;
        P<DESPTR> = L$DESPTR;      #POSITION TO WORD CONTAINING DESLIST# FORMALT
        IF L$NEXT EQ 0             #IF LAST ENTRY IN LIST              # FORMALT
        THEN                                                             FORMALT
          BEGIN 
          LOOPCON = FALSE;         # THIS IS LAST PASS THROUGH LOOP    #
          END 
        ELSE
          BEGIN 
          P<LFNINFO> = L$NEXT;     #POSITION TO NEXT TBL FOR NEXT PASS # FORMALT
          END 
        IF DESADDR NQ 0 THEN       # IF THIS FILE HAS DESCRIBE LIST    #
          BEGIN 
          IF SAVEDESL EQ 0 THEN    # IF FIRST DESCRIBE LIST ENCOUNTERED#
            BEGIN 
            SAVEDESL = DESADDR;    # SAVE DESCRIBE LIST PTR            #
            FLFNINFO[0] = SAVELF;  # SAVE P<LFNINFO> FOR FIRST DESLIST #
            P<HOLDER> = SAVELF + L$FITOFFSET;  # FIT OF FIRST FILE     #
            TEST J;                                                      FORMALT
            END 
          IF SAVEDESL NQ DESADDR THEN  # IF 2ND DESCRIBE LIST          #
            BEGIN 
            STDNO;
            END 
          ELSE                     # IF FILES USE SAME DESCRIBE LIST   #
            BEGIN 
            IF DIRLEXID EQ O"142" THEN  # IF COMPILE                   #
              BEGIN 
              P<FIT> = LOC(L$FITLOC);                                    FORMALT
              IF FITBT NQ HOLDBT   #COMPARE FIT STRUCTURE -- BLOCK     # FORMALT
                OR FITRT NQ HOLDRT # -- RECORD TYPE                    # FORMALT
                OR FITLT NQ HOLDLT # -- LABEL TYPE                     # FORMALT
                OR FITMRL NQ HOLDMRL  # -- MAX RECORD LENGTH           # FORMALT
              THEN                                                       FORMALT
                BEGIN 
                STDNO;
                END 
              END 
            END 
          END 
        END                        # END OF LOOP ON LOOPCON            #
      IF SAVEDESL EQ 0 THEN        # IF NO DESCRIBE LIST ENCOUNTERED   #
        BEGIN 
        STDNO;
        END 
      STDYES; 
      END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
#----------------------------------------------------------------------#
#     FNDDESPTR                                                        #
#                                                                      #
#     CALL LFNLOOKUP TO FIND DESPTR FOR LFN IN ICW                     #
#                                                                      #
      PROC FNDDESPTR; 
      BEGIN 
      IF NOT RECORDFLAG THEN
        BEGIN 
        SAVELFNAME = 0; 
        B<0,CURLENG*6>SAVELFNAME = B<0,CURLENG*6>ICW[0];
        LFNLOOKUP(RC);             # SEARCH FOR FILE IN LFNLIST        #
        IF RC NQ 0 OR DESLIST EQ 0 THEN  # IF FILE NOT FOUND OR NOT    #
                                         # DESCRIBED                   #
          BEGIN 
          DIAG(325, SAVELFNAME);
          STDNO;                   # ERROR EXIT                        #
          END 
        END 
      RETURN; 
      END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
      XDEF PROC FULLSYN;
          PROC FULLSYN; 
          BEGIN 
          IF FLAGA THEN BEGIN IF NOT TEXTFG[RPTCTR] THEN SYNIO; 
          ELSE PSFLG = 1; 
          SETBIT; 
          STDYES; 
          END 
          PRWFG = 0;         # CLEAR PREVIEW FLAG                      #
                 FULLSYNTX = TRUE;
           NONEMPTYRPT = FALSE;                                         004080
                 RPTCTR = 1;
          A = ILFN[IPRE]; 
          B = ILFNLG[IPRE]; 
                 PSFLG = 4; 
                 RPTNAME[0] = ILFN[IPRE]; 
                 FROMLFN[0] = ILFN[IFRO]; 
                 RPTLEN[0] = ILFNLG[IPRE];
                 FROMLEN[0] = ILFNLG[IFRO]; 
                 SUMMARYED[0] = FALSE;
                 TEXTFG[0] = FALSE; 
                 PRESUM[0] = 2; 
                 ROOTPTR[0] = -1; 
                 LEVELPTR[0] = 0; 
                 KEYAREA[0] = ILFN[IPRE];                                FEAT157
                 B<42,18>KEYAREA[0] = O"27777";                          FEAT157
          RWSOURCE = FALSE; 
          PRESUMFG = TRUE;
          MAJORKEYLEN = 8;
          READFROM = S"GET1ST"; 
          SYNIO;
                                                                         FORMALT
          IF CATAFITES NQ 0                                              FORMALT
          THEN                                                           FORMALT
            BEGIN                                                        FORMALT
            B<42,6>KEYAREA[0] = "1";                                     FORMALT
            READFROM = S"GET1ST";                                        FORMALT
            SYNIO;                 #READ NEXT XMISSION, RESET ES MAYBE # FORMALT
                                                                         FORMALT
            IF CATAFITES NQ 0                                            FORMALT
            THEN                                                         FORMALT
              BEGIN                                                      FORMALT
          PRESUMFG = FALSE; 
          FULLSYNTX = TRUE; 
           NONEMPTYRPT = FALSE;                                         004100
          READFROM = S"GET1ST"; 
           CURREPT = ILFN[IPRE];
          MAJORKEYLEN = 7;
          KEYAREA[0] = CURREPT;                                          FEAT157
          HIGHKEY = KEYAREA[0];                                          FEAT157
          B<42,18>HIGHKEY = O"777777";
          SYNIO;   #GET THE FIRST DIRECTIVE IN CORE#
          SETBIT; 
          LVL = 0;
          RPTCTR = 0; 
          CURRENTLFPTR = FLFNINFO[0]; 
          P<LFNINFO> = CURRENTLFPTR;
          P<DESPTR> = L$DESPTR;                                          FORMALT
          DESLIST = DESADDR;
          FSIZE = DESSIZE;
          STDYES; 
          END 
                       PSFLG = 1; 
                       SUMMARYED[0] = TRUE; 
                 END
                 TEXTFG[1] = FALSE; 
                 PRESUM[1] = PSFLG; 
                 ROOTPTR[1] = 0;
                 LEVELPTR[1] = 1; 
                 SUMMARYED[1] = FALSE;
                 ROOT = 0;
                 LVL = 1; 
                 STDNO; 
          END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC PRWFG1; 
         PROC PRWFG1; 
         BEGIN RPTCTR = 0;
          ILFN[IPRE] = ILFN[IPRV];
          ILFNLG[IPRE] = ILFNLG[IPRV];
               RPTNAME[0] = ILFN[IPRE]; 
               LVL = 0; 
               RPTLEN[0] = ILFNLG[IPRE];
               TEXTFG[0] = FALSE; 
               FROMLFN[0] = "       ";
               FROMLEN[0] = 0;
               PRWFG = 1; 
               CHKRPTN; 
         END
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
         XDEF PROC PRWFG2;
         PROC PRWFG2; 
         BEGIN FROMLFN[0] = ILFN[IFRO]; 
               FROMLEN[0] = ILFNLG[IFRO]; 
               PRWFG = 2; 
               FNDDESPTR; 
               FLFNINFO[0] = CURRENTLFPTR;  # PTR TO LFNINFO ARRAY     #
               STDYES;
         END
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
         XDEF PROC PWREADY; 
         PROC PWREADY;
         BEGIN GETREADY;
          TYPEALOW = 7; 
          FULLSYNTX = TRUE;        # TURN ON FULL REPORT SYNTAX        #
          SM$GROUPID = CMM$AGR(0);  # ALLOCATE GROUP ID FOR REPORT     #
               STDNO; 
         END
  
  
  
  
#----------------------------------------------------------------------#
  
  
  
  
          XDEF PROC RECRDPR;
          PROC RECRDPR; 
       BEGIN                                                             XXXX 
       BASED ARRAY RA1;   ITEM RAA1 U(0,0,60);                           XXXX 
           IF RECORDFLAG THEN STDNO;                                     XXXX 
           IF DIRLEXID EQ O"142" THEN  # IF COMPILE                    #
               BEGIN                                                     XXXX 
               P<RA1>=LOC(RPTLFNS);                                      XXXX 
               FOR I=3 STEP 1 UNTIL 29 DO 
                 BEGIN
                 RAA1[I] = 0; 
                 END
               END                                                       XXXX 
           STDYES;                                                       XXXX 
          END 
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     S E T C O M P                                                    #
#                                                                      #
# SETS *RPTOVL* TO INDICATE THE PRIMARY OVERLAY FOR *COMPILE* EXECUTION#
  
      XDEF PROC SETCOMP;
      PROC  SETCOMP;
      BEGIN 
      RPTOVL = O"12";              # SET PRIMARY OVERLAY LEVEL FOR THE #
                                   # EXECUTION OF *COMPILE*.           #
      STDYES;                      # GOOD RETURN (WHAT ELSE...)        #
      END 
  
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     S E T P R E P                                                    #
#                                                                      #
# SETS *RPTOVL* TO INDICATE THE PRIMARY OVERLAY FOR *PREPARE* EXECUTION#
  
      XDEF PROC SETPREP;
      PROC SETPREP; 
      BEGIN 
      RPTOVL = O"2";               # SET PRIMARY OVERLAY LEVEL FOR THE #
                                   # EXECUTION OF *PREPARE*.           #
      STDYES;                      # GOOD RETURN (WHAT ELSE...)        #
      END 
  
  
  
  
#----------------------------------------------------------------------#
  
  
      END 
      TERM
