*DECK CRMEP 
OVERLAY(CRMEP,0,0)
PRGM CRMEP; 
     BEGIN
 #
 1CD  CRMEP 
 0D   PURPOSE 
 0        DISPLAY CRM AND DATA MANAGER ERRORS.
 0D   CALL
 0        CRMEP[,PARAMETER1,PARAMETER2,....PARAMETERN]. 
 0        EACH PARAMETER IS SPECIFIED IN ONE OF THE FOLLOWING FORMS:  
 0            PARAMETER 
              PARAMETER=OPTION
              PARAMETER=OPTION1/OPTION2/..../OPTIONN
 0D   PARAMETERS
 0        PARAMETER  OPTION    FD    SD    IV    DESCRIPTION
          ---------  ------   ----  ----  ----   -----------------------
 0        LO                                     LIST OPTIONS 
                      N              *           SELECT NOTES 
                     -N        *           *     OMIT NOTES 
                      F        *     *     *     SELECT FATALS
                     -F                          OMIT FATALS
                      D        *     *     *     SELECT DATA MGR. MSGS. 
                     -D                          OMIT DATA MGR. MSGS. 
                      T              *           SELECT TRIVIAL ERRORS
                     -T        *           *     OMIT TRIVIAL ERRORS
 0        SF                                     SELECT MSGS ASSOCIATED 
                     LFN1/     ALL   ALL   NONE  WITH SPECIFIED LFNS. 
                     LFN2/../ 
                     LFNN 
 0        OF                                     OMIT MSGS. ASSOCIATED
                     LFN1/     NONE  NONE  NONE  WITH SPECIFIED LFNS. 
                     LFN2/../ 
                     LFNN 
 0        SN                                     SELECT ONLY SPECIFIED
                     MNO1/     ALL   HARD- NONE  MESSAGE NUMBERS. 
                     MNO2/../        WARE,
                     MNON            PARITY 
                                     ERRORS 
 0        ON                                     OMIT ONLY SPECIFIED
                     MNO1/     NONE  142   NONE  MESSAGE NUMBERS
                     MNO2/../        AND
                     MNON            143
 0        L                                      SPECIFIES POST 
                     LFN      OUTPUT LIST  NONE  PROCESSOR OUTPUT FILE. 
 0        RU                                     DISPOSITON OF ERROR
                                                 FILE AFTER EXECUTION.
                     1               *           RETURN UNLOAD
                     0         *           *     POSITIONED AT EOI
          ---------  ------   ----  ----  ----   -----------------------
 0        SF AND SN TAKE PRECEDENCE OVER OF AND ON RESPECTIVELY.
 #
     CONTROL EJECT; 
 #
 0D   ACTION
 0       IMPLEMENTATION PRIORITIES ARE:  TRANSPORTABILITY,
         MAINTAINABILITY, EXTENSIBILITY, FIELD LENGTH, AND EXECUTION
         SPEED IN THAT ORDER.  THUS THE USE OF HOL AND CRM I/O ROUTINES.
 0       AFTER CRACKING THE CONTROL CARD PARAMETERS THE ERROR FILE
         *ZZZZZEG* IS READ AND COPIED TO THE LISTABLE OUTPUT FILE 
         ACCORDING TO OPTIONS AND SELECTION CRITERIA SPECIFIED. 
 0       THE INPUT FILE CONSISTS OF S-RECORDS IN CRM TERMINOLOGY. 
         WITHIN EACH S-RECORD ARE ONE OR MORE MESSAGE RECORDS.  THE 
         MESSAGE RECORDS CONSIST OF A 30 OR 50 CHARACTER HEADER FOR 
         NOTES AND ERRORS RESPECTIVELY.  A TRAILER CONSISTING OF
         10HZZZZZEF.:: TERMINATES THE RECORD. BETWEEN THE HEADER AND THE
         TRAILER ARE ZERO OR MORE MESSAGE INSERTS.  EACH MESSAGE INSERT 
         CONSISTS OF A CONTROL WORD FOLLOWED BY ZERO OR MORE WORDS OF 
         BINARY INFORMATION.
 0       EACH S-RECORD IS PROCESSED AS A CONTIGUOUS STRING OF WORDS.
         THE HEADER PART OF EACH MESSAGE RECORD IS COPIED DIRECTLY TO 
         THE LISTABLE OUTPUT FILE.  PRODUCT, FILE NAME, MESSAGE CODE AND
         SEVERITY INFORMATION IS EXTRACTED FROM THE HEADER AND USED TO
         SATISFY SELECTION CRITERIA SPECIFIED ON THE CONTROL CARD.
 0       IF CRITERIA IS MET THE MESSAGE CODE IS USED AS A KEY TO EXTRACT
         THE TEXT OF THE MESSAGE FROM A TABLE CONTAINED WITHIN A
         CAPSULE.  AT PRESENT A SIMPLE LINEAR SEARCH IS EMPLOYED. 
         IF, DURING THE COPY OF THE STRING TO THE OUTPUT FILE, AN UP- 
         ARROW SYMBOL IS DETECTED THEN A MESSAGE INSERT IS CALLED FOR 
         FROM THE MESSAGE RECORD AND IS INSERTED IN PLACE OF THE UP-
         ARROW.  ANY NUMBER OF INSERTS CAN BE CALLED FOR BY THE TEXT
         STRING.  IF THE OUTPUT LINE LENGTH IS EXCEEDED THE LINE IS 
         WRITEN AND THE NEXT CHARACTER WILL OCCURR IN COL. 1 OF THE NEXT
         LINE.  THE PROCESS CONTINUES UNTIL THE TEXT STRING IS
         EXHAUSTED.  THE ABSENCE OF AN INSERT FROM THE MESSAGE RECORD 
         WHEN ONE IS CALLED FOR BY THE TEXT WILL SIMPLY OMIT THE UP-
         ARROW SYMBOL AND CONTINUE TRANSFER OF THE TEXT STRING.  ANY
         INSERTS ON THE MESSAGE RECORD NOT CALLED FOR BY THE TEXT WILL
         BE IGNORED.  ANY MESSAGE FOR WHICH THERE IS NO CORRESPONDING 
         TEXT WILL ONLY HAVE ITS RECORD HEADER DISPLAYED. 
 0       THE INPUT FILE WILL BE LEFT AT EOI UPON TERMINATION UNLESS THE 
         RU PARAMETER SPECIFIED RETURN UNLOAD.  ANY ERRORS ENCOUNTERED
         DURING EXECUTION WILL NOT ABORT THE PROGRAM. 
 0D   OTHER CODE REQUIRED 
 0       PROGRAMS - CID,CFG,GETTXT,OCTAL,XCDD,XCOD
                    FILEXX,FITCOM,OPNCLS,PUT,GETP     ******************
                    CRM ROUTINES REQUIRED TO PROCESS: * NOTE:          *
                        INPUT - FO=SQ,BT=C,RT=S       *   EFC FIT FIELD*
                        OUTPUT - FO=SQ,BT=C,RT=Z      *   MUST BE ZERO.*
                    CAPSULES - RM$MSGS,RM$XFIT        ******************
 #
     CONTROL INERT; 
     CONTROL DISJOINT;
     CONTROL FTNCALL; 
     CONTROL FASTLOOP;             #THERE ARE PRESENTLY 3 SLOWLOOPS#
     CONTROL EJECT;                #MACHINE/SYSTEM DECLARATIVES#
     STATUS CHARACTER 
            COLON, A,     B,     C,     D,     E,     F,     G, 
            H,     I,     J,     K,     L,     M,     N,     O, 
            P,     Q,     R,     S,     T,     U,     V,     W, 
            X,     Y,     Z,     ZERO,  ONE,   TWO,   THREE, FOUR,
            FIVE,  SIX,   SEVEN, EIGHT, NINE,  PLUS,  MINUS, STAR,
            SLASH, LPAREN,RPAREN,DOLLAR,EQUAL, SPACE, COMMA, POINT, 
            OCTAL, LBRKT, RBRKT, PERCT, QUOTE, BREAK, OR,    AND, 
            APOST, QUERY, LT,    GT,    AT,    BACK,  CARET, SEMI;
     DEF AL #18#;                  #ADDRESS SIZE IN BITS# 
     DEF CC #80#;                  #CARD SIZE IN CHARACTERS#
     DEF CCEJ #"1"#;               #CARRIAGE CONTROL EJECT# 
     DEF CCSP #CHARACTER"SPACE"#;  #CARRIAGE CONTROL SPACE# 
     DEF CC6L #"S 6 LPI"#;         #CARRIAGE CONTROL 6 LPI# 
     DEF CC8L #"T 8 LPI"#;         #CARRIAGE CONTROL 8 LPI# 
     DEF CL #6#;                   #CHARACTER LENGTH IN BITS# 
     DEF CW #8#;                   #CARD SIZE IN WORDS# 
     DEF NC #7#;                   #FILE NAME LENGTH IN CHARACTERS# 
     DEF WL #60#;                  #WORD LENGTH IN BITS#
     DEF WO #20#;                  #OCTAL DIGITS PER WORD#
     DEF WC #10#;                  #WORD LENGTH IN CHARACTERS#
     DEF FITSIZEW #35#;            #SIZE OF CRM TABLE IN WORDS# 
     DEF EOS #O"20"#;              #CRM END SECTION STATUS# 
     DEF EOP #O"40"#;              #CRM END PARTITION STATUS# 
     DEF EOI #O"100"#;             #CRM END OF INFORMATION STATUS#
     DEF CARDLOC #O"70"#;          #LOCATION OF CRMEP CONTROL CARD# 
     DEF MSGTRM #O"00"#;           #DISPLAY MESSAGE TERMINATOR# 
     DEF OCTDIG( DI,SZ ) #WL-((SZ+1)-DI)*(CL/2),CL/2#;#OCT CHAR TO BIN# 
     DEF HTOL( H,S ) #H LAN CMASK[ S ]#; #H TO L FORMAT CONVERSION# 
     DEF CCTOC( CC ) #(CC*2)#;     #CONVERT CHAR COUNT TO OCT DIG COUNT#
     DEF BCTOC( BC ) #((BC+2)/3)#; #CONVERT BIT COUNT TO OCT DIG COUNT# 
     DEF OCT #OCT20#;              #ENCODES 20 OCTAL DIGITS#
     ARRAY [1:7];                  #USED FOR H TO L FMT CONVERSION# 
           ITEM CMASK = [O" 77 00 00 00 00 00 00 00 00 00 ",
                         O" 77 77 00 00 00 00 00 00 00 00 ",
                         O" 77 77 77 00 00 00 00 00 00 00 ",
                         O" 77 77 77 77 00 00 00 00 00 00 ",
                         O" 77 77 77 77 77 00 00 00 00 00 ",
                         O" 77 77 77 77 77 77 00 00 00 00 ",
                         O" 77 77 77 77 77 77 77 00 00 00 "]; 
     XDEF ITEM SYMBOLS = 0;        #NUMBER OF SYMBOLS IN FIT DUMP#
     XREF BEGIN 
          FUNC CLOCK C(WC);        #RETURN TIME OF DAY# 
          FUNC DATE C(WC);         #RETURN CURRENT DATE#
          FUNC IFETCH;             #CRM INTERFACE#
          PROC CFG;                #CONVERT FLOATING TO FTN G-FMT#
          PROC CID;                #CONVERT INTEGER TO DECIMAL# 
          PROC CLOSEM;             #CRM INTERFACE#
          PROC FIELDER;            #RETURN FIELD INFO FOR FIT DMP ELMNT#
          PROC FILESQ;             #CRM INTERFACE#
          PROC GETP;               #CRM INTERFACE#
          PROC GETPAGE;            #GET PAGE SIZE PARAMETERS# 
          PROC GETTXT;             #DELIVERS MESSAGE TEXT TO WSA# 
          PROC MESSAGE;            #ISSUE DAYFILE MESSAGE#
          PROC OCT20;              #CONVERT BINARY TO OCTAL#
          PROC OPENM;              #CRM INTERFACE#
          PROC PUT;                #CRM INTERFACE#
          END 
     CONTROL EJECT;          #L FORMAT CONSTANTS FOR CRM USAGE# 
     ARRAY [0:5]; 
           ITEM LJZF1 I(0,0,WL) = [6(0)], 
                CHST1 C(0,0,01) = ["S","Z","C","R","N","U"];
     DEF BTEQC  #LJZF1[ 2 ]#;      #CHARACTER TYPE BLOCKS#
     DEF CFEQN  #LJZF1[ 4 ]#;      #CLOSE FLAG IS NO REWIND#
     DEF CFEQR  #LJZF1[ 3 ]#;      #CLOSE FLAG IS NO REWIND#
     DEF CFEQU  #LJZF1[ 5 ]#;      #CLOSE FLAG IS RETURN-UNLOAD#
     DEF OFEQR  #LJZF1[ 3 ]#;      #OPEN FLAG IS REWIND#
     DEF OFEQN  #LJZF1[ 4 ]#;      #OPEN FLAG IS NO REWIND# 
     DEF RTEQS  #LJZF1[ 0 ]#;      #RECORD TYPE IS SCOPE LOGICAL# 
     DEF RTEQZ  #LJZF1[ 1 ]#;      #RECORD TYPE IS ZERO BYTE TERMINATED#
     ARRAY [0:3]; 
           ITEM LJZF2 I(0,0,WL) = [4(0)], 
                CHST2 C(0,0,02) = ["RT","BT","FL","FP"];
     DEF BT     #LJZF2[ 1 ]#;      #BLOCKING TYPE#
     DEF FL     #LJZF2[ 2 ]#;      #FIXED RECORD LENGTH#
     DEF FP     #LJZF2[ 3 ]#;      #FILE POSITION#
     DEF RT     #LJZF2[ 0 ]#;      #RECORD TYPE#
     ARRAY [0:7]; 
           ITEM LJZF3 I(0,0,WL) = [8(0)], 
                CHST3 C(0,0,03) = ["BFS","FWB","LFN","EFC","DFC","PTL", 
                                   "OUT","INP"];
     DEF BFS    #LJZF3[ 0 ]#;      #BUFFER SIZE#
     DEF DFC    #LJZF3[ 4 ]#;      #DAYFILE CONTROL#
     DEF EFC    #LJZF3[ 3 ]#;      #ERROR FILE CONTROL# 
     DEF FWB    #LJZF3[ 1 ]#;      #FIRST WORD ADDRESS OF BUFFER# 
     DEF LFN    #LJZF3[ 2 ]#;      #LOGICAL FILE NAME#
     DEF PDEQI  #LJZF3[ 7 ]#;      #PROCESSING DIRECTION IS INPUT#
     DEF PDEQO  #LJZF3[ 6 ]#;      #PROCESSING DIRECTION IS OUTPUT# 
     DEF PTL    #LJZF3[ 5 ]#;      #PARTIAL TRANSFER LENGTH#
     ARRAY [0:1]; 
           ITEM LJZF4 I(0,0,WL) = [2(0)], 
                CHST4 C(0,0,04) = ["FILE","LIST"];
     DEF FILE   #LJZF4[ 0 ]#;      #CLOSE TYPE IS FILE# 
     DEF LFSDF  #LJZF4[ 1 ]#;      #SECOND DEFAULT OUTPUT LFN#
     ARRAY [0:0]; 
           ITEM LJZF6 I(0,0,WL) = [0],
                CHST6 C(0,0,06) = ["OUTPUT"]; 
     DEF OUTLFN #LJZF6[ 0 ]#;      #OUTPUT FILE NAME# 
     ARRAY [0:0]; 
           ITEM LJZF7 I(0,0,WL) = [0],
                CHST7 C(0,0,07) = ["ZZZZZEG"];
     DEF ZEFLFN #LJZF7[ 0 ]#;      #INPUT FILE NAME#
     ARRAY [0:0]; 
           ITEM LJZF8 I(0,0,WL) = [0],
                CHST8 C(0,0,08) = ["ZZZZZEF."]; 
     DEF EOR    #LJZF8[ 0 ]#;      #INPUT RECORD TERMINATOR#
     CONTROL EJECT; 
     STATUS TYPE                   #MESSAGE INSERT TYPES# 
            DEFAULT, OCTAL, CHARACTER, DECIMAL, REAL; 
     STATUS MODE                   #MESSAGE INSERT MODES# 
            CONTAINED, DIRECTED, CSTRING, BSTRING;
     STATUS ARG                    #PARAMETER KEY ORDINALS# 
             NULL, LO, SF, OF, SN, ON, L, RU, PW; 
     DEF BUFSIZEW #O"240"#;        #CRM BUFFER SIZE IN WORDS# 
     DEF CFLD #9,CHARPOS+1#;       #HEADER FIELD FOR CONTROL CARD#
     DEF CNF #17,40#;             #LOCATION OF CNF FIELD OF FIT#
     DEF CMPFR #ID#;               #USED FOR COMPRESSION INDUCTION# 
     DEF CMPTO #CHARPOS#;          #USED FOR COMPRESSION TERMINATION# 
     DEF DC #20#;                  #MAX SIZE OF DECIMAL FIELD#
     DEF DFLD #99,10#;             #HEADER FIELD FOR CURRENT DATE#
     DEF DMSP #3#;                 #SPACES BETWEEN FIT DMP ELEMENTS#
     DEF EC #20#;                  #CHARACTERS IN CC ERROR MSG# 
     DEF EPL #(PGWIDTH/(DMSP+WO+1+MXSM))#; #LIST ELEMENTS PER LINE# 
     DEF ERRORPOINT #50#;          #CHARS. IN CODED PORTION OF ERROR# 
     DEF EW #2#;                   #WORDS IN CC ERROR MSG#
     DEF FNFLD #22,NC#;            #LFN FIELD POSITION AND LENGTH#
     DEF FTHDS #9#;                #LENGTH OF FIT DMP LOC HDR STRING# 
     DEF HDC #130#;                #CHARACTERS IN OUTPUT HEADER LINE# 
     DEF HDW #13#;                 #WORDS IN OUTPUT HEADER LINE#
     DEF IDPOS #10#;               #POSITION OF MSG. CODE IN OUTPUT WSA#
     DEF IDSIZE #4#;               #NO. OCTAL DIGITS IN MESSAGE CODE# 
     DEF INSCTND #C<WC-8,8>INSVALC#;  #SIGN. CHARS. OF MODE CONTAINED#
     DEF LOEQD #LO[ 3 ]#;          #1= DATA MANAGER MESSAGES SELECTED#
     DEF LOEQF #LO[ 2 ]#;          #1= FATALS SELECTED# 
     DEF LOEQN #LO[ 1 ]#;          #1= NOTES SELECTED#
     DEF LOEQT #LO[ 4 ]#;          #1= NON-FATAL ERRORS SELECTED# 
     DEF LOSDC #4#;                #NUMBER OF LO DEFAULT VALUES#
     DEF LSSP #2#;                 #SPACES BETWEEN LIST ELEMENTS# 
     DEF MAXPW #160#;             #MAXIMUM PAGE WIDTH          #
     DEF MINPW #40#;              #MINIMUM PAGE WIDTH          #
     DEF MXSM #6#;                 #MAXIMUM FIT FIELD SYMBOL SIZE#
     DEF NO #0#;                   #NO - FOR CONDITIONAL ASSEMBLY#
     DEF NOTEPOINT #30#;           #CHARACTERS IN CODED PORTION OF NOTE#
     DEF OCTMAX #O"1777"#;         #MAXIMUM MESSAGE CODE SIZE#
     DEF ONSDC #2#;                #NUMBER OF ON DEFAULT VALUES#
     DEF OUTWSASC #137#;           #LIST FILE WSA SIZE IN CHARACTERS# 
     DEF OUTWSASW #14#;            #LIST FILE WSA SIZE IN WORDS#
     DEF PARS #8#;                 #NUMBER OF PARAMETER TYPES#
     DEF PGC #137#;                #PAGE WIDTH IN CHARACTERS# 
     DEF PC #37#;                  #MAXIMUM VALUES FOR PARAMETER LIST#
     DEF PRFLD #1,1#;              #PRODUCT FIELD POSITION AND LENGTH#
     DEF PW #YES#;                 #PAGE WIDTH PARAMETER IMPLEMENTED# 
     DEF RC #20#;                  #MAX SIZE OF REAL FIELD# 
     DEF SEFLD #4,5#;              #SEVERITY FIELD POSITION AND LENGTH# 
     DEF SNSDC #11#;               #NUMBER OF SN DEFAULT VALUES#
     DEF STRCHS #30#;              #ENCODING BUFFER SIZE IN CHARACTERS# 
     DEF STRWDS #3#;               #ENCODING BUFFER SIZE IN WORDS#
     DEF TFLD #119,10#;            #HEADER FIELD FOR TIME OF DAY# 
     DEF TERMPW #72#;              #TERMINAL PAGE WIDTH#
     DEF TEXTWSASC #80#;           #TEXT BUFFER SIZE IN CHARACTERS# 
     DEF TEXTWSASW #8#;            #TEXT BUFFER SIZE IN WORDS#
     DEF YES #1#;                  #YES - FOR CONDITIONAL ASSEMBLY# 
     DEF ZEFWSASW #O"40"#;         #ERROR FILE WSA SIZE IN WORDS# 
     CONTROL EJECT; 
     ITEM ARGDEX S:ARG,            #CURRENT PARAMETER KEY ORDINAL#
          CF,                      #CLOSE FLAG FOR INPUT FILE#
          CH S:CHARACTER,          #BINARY VALUE OF CURRENT CHARACTER#
          CHARPOS   = 0,           #CURRENT POSITION IN CONTROL CARD# 
          CMPSTRT = 1,             #STARTING POSITION OF COMPRESSION# 
          COL,                     #CURRENT COLUMN OF FIT DMP (ORDINAL)#
          CRMMSG B,                #TRUE WHEN DATA MGR. MSG NOT CURRENT#
          DIGIT,                   #INDUCTION FOR OCTAL DECODE LOOP#
          EMAT,                    #INSERT LIST ITEM FIELD SIZE#
          EOLPNT,                  #OUTPUT RECORD TERMINATION POINT#
          FINDEOR B = FALSE,       #ERROR - SKIP TO END OF INPUT REC.#
          FITDMP C(FTHDS)=" (FIT AT ",#FIT DMP LOCATION HEADER STRING#
          FITWP = 0,               #CURRENT WORD POS. IN FIT DMP WSA# 
          FNT C(WC),               #FILE NAME FROM CUR. INPUT RECORD# 
          FRFILL,                  #LOOP INDUCTION FOR BLANK FILL#
          ID,                      #INDUCTION FOR SELECTION CRIT. LOOPS#
          INSCOM,                  #INDICATES INSPOS COUNTS FROM RIGHT# 
          INSFIT,                  #NON-ZERO INDICATES FIT DUMP#
          INSLEN = 0,              #LENGTH OF CURRENT MSG INSERT# 
          INSLOC = 0,              #ADDRESS OF CURRENT INSERT DATA# 
          INSMODE S:MODE,          #MODE OF CURRENT MESSAGE INSERT# 
          INSPOS,                  #STARTING POSITION OF CURRENT INSERT#
          INSTYPE S:TYPE,          #TYPE OF CURRENT MESSAGE INSERT# 
          KEYPROC B = TRUE,        #TRUE WHEN PARAMETER KEY EXAMINED# 
          LIST B    = FALSE,       #TRUE WHEN LIST FORMATTED INSERT#
          MESID     = 0,           #OCTAL ID OF CURRENT MESSAGE#
          OCTREG    = 0,           #BINARY VALUE ACCUMULATOR# 
          OFC = 0,                 #NO. OMIT FILES ENTRIES# 
          OMIT B    = FALSE,       #DESELECT - CRITERIA NOT MET#
          ONC = 0,                 #NO. OMIT MSG. NUMBERS ENTRIES#
          OUTHDRL = HDC,           #LENGTH OF OUTPUT HEADER IN CHARS.#
          OUTRL = 0,               #CURRENT LENGTH OF OUTPUT RECORD#
          PGB B = FALSE,           #TRUE IF PW PARAMETER SPECIFIED# 
          PGWIDTH = PGC,           #PAGE WIDTH IN CHARACTERS# 
          PRODUCT,                 #R=CRM MESSAGE, D=DATA MGR. MESSAGE# 
          ROW,                     #CURRENT ROW IN FIT DMP# 
          ROWS,                    #NUMBER OF ROWS IN FIT DMP#
          SET B = TRUE,            #STATUS OF CURRENT LO PARAMETER# 
          SEVERE C(WC),            #NOTE, ERROR, FATAL #
          SFC = 0,                 #NO. SELECT FILES ENTRIES# 
          SIZE      = 0,           #LENGTH OF CURRENT STRING# 
          SLEN,                    #LENGTH OF FIT SYMBOL# 
          SNC = 0,                 #NO. SELECT MSG. NUMBERS ENTRIES#
          START B   = FALSE,       #TRUE WHEN POSITIONED PAST CALL NAME#
          STDEX,                   #STRING CHARACTER POINTER (FIT DMP)# 
          SYMBOL C(WC),            #CONTAINS SYMBOL OF CUR. DMP FIELD#
          TEXTCHS,                 #MESSAGE TEXT SIZE IN CHARACTERS#
          TEXTCP,                  #CURRENT POSITION IN MSG TEXT WSA# 
          VALDEX,                  #INDUCTION FOR PAR. DEFAULT/VALIDATE#
          VLEN,                    #LENGTH OF FIELD AT VWORD# 
          VPOS,                    #POS. OF FIELD AT VWORD# 
          VWORD,                   #WORD IN FIT OF CURRENT FIELD OF DMP#
          ZEFFP,                   #CURRENT INPUT FILE POSITION#
          ZEFMAX,                  #WORDS OF DATA IN INPUT WSA# 
          ZEFW,                    #CURRENT WORD POSITION INPUT WSA#
          ZEFWP;                   #CURRENT WORD IN INPUT WSA#
     CONTROL EJECT; 
     BASED ARRAY CTLCARD;          #CRMEP CONTROL CARD WSA# 
           ITEM CTL C(0,0,CC);
     ARRAY [1:LOSDC] P(2);         #LIST OPTIONS# 
           ITEM LO  B(0,0,WL) = [FALSE,TRUE,TRUE,FALSE],
                LOK C(1,0,WC) = ["N","F","D","T"];
     ARRAY [1:PARS] P(2);          #PARAMETER KEY WORD AND MAX VAL SIZE#
          ITEM PAR C(0,0,WC)=["LO","SF","OF","SN","ON","L","RU","PW"],
               VMX I(1,0,WL)=[   1,   7,   7,   4,   4,  7,   1,   3];
     ARRAY [1:LOSDC];              #LIST OPTION SECOND DEFAULTS#
           ITEM LOSDF B(0,0,WL) = [LOSDC( TRUE )];
     ARRAY [1:SNSDC];              #SELECT MSG NO SECOND DEFAULTS#
           ITEM SNSDF = [O"135",O"136",O"137",O"140",O"141",O"352", 
                         O"353",O"370",O"510",O"702",O"721"]; 
     ARRAY [1:ONSDC];              #OMIT MSG NO SECOND DEFAULTS#
           ITEM ONSDF = [O"142",O"143"];
     ARRAY CCEPNT[ 0:CW ] S( 1 );  #CONTROL CARD ERROR POINTER DISPLAY# 
           ITEM CCET C(0,0,WC) = [CW(" "),MSGTRM],
                CCEP C(0,0,CC); 
     ARRAY CCEMSG[ 0:EW ] S( 1 );  #CONTROL CARD ERROR MSG DISPLAY# 
           ITEM CCEMSGI C(0,0,EC) = [" CONTROL CARD ERROR "], 
                CCEMSGT I(0,0,WL) = [EW( ),MSGTRM]; 
     ARRAY[ 1:PC ]; ITEM SF;       #SELECT FILES LIST#
     ARRAY[ 1:PC ]; ITEM OF;       #OMIT FILES LIST#
     ARRAY[ 1:PC ]; ITEM SN;       #SELECT CODES LIST#
     ARRAY[ 1:PC ]; ITEM ON;       #OMIT CODES LIST#
     ARRAY ZZZZZEF [1:FITSIZEW];;  #CRM TABLE#
     ARRAY ZEFWSA [1:ZEFWSASW];    #ERROR FILE WSA# 
           ITEM ZEFWSAI I(0,0,WL), #INPUT WORD INTEGER# 
                ZTYPE   U(0,01,03),#INSERT TYPE#
                ZMODE   U(0,04,02),#INSERT MODE#
                ZVAL    U(0,12,48),#INSERT VALUE (CONTAINED)# 
                ZFIT    U(0,16,01),#1 = FIT DUMP# 
                ZPOS    U(0,17,06),#STARTING POSITION OF INSERT#
                ZCOM    U(0,23,01),#1= POS COUNTS FROM RIGHT# 
                ZLEN    U(0,24,18),#LENGTH OF INSERT# 
                ZLOC    U(0,42,AL),#ADDRESS OF CURRENT INSERT DATA# 
                ZEFWSAC C(0,0,WC); #INPUT WORD CHARACTERS#
     ARRAY PGHDR S( HDW );         #OUTPUT HEADER LINE# 
           ITEM HDR C(0,0,HDC) = [CCEJ];  #PAGE EJECT#
      ARRAY OUTPUT [1:FITSIZEW] S(FITSIZEW);    #CRM TABLE# 
            ITEM CONFLG B(CNF);     #CONNECT FLAG#
     ARRAY OUTWSA S(OUTWSASW);     #LIST FILE WSA#
           ITEM OUTWSAC C(0,0,OUTWSASC);
     ARRAY TEXTWSA S(TEXTWSASW);   #MESSAGE TEXT WSA# 
           ITEM TEXTWSAC C(0,0,TEXTWSASC);
     ARRAY PGSIZE [0:0] S(1);      #JOB PAGE SIZE PARAMETERS# 
           ITEM JPD U(0,28,4),     #PRINT DENSITY#
                JPS U(0,32,8),     #PAGE SIZE#
                JPW U(0,40,8);     #PAGE WIDTH# 
     ARRAY ZEFBUF [1:BUFSIZEW];;   #ERROR FILE BUFFER#
     ARRAY OUTBUF [1:BUFSIZEW];;   #LIST FILE BUFFER# 
     ARRAY;                        #MESSAGE INSERT VALUE# 
           ITEM INSVAL  I(0,0,WL), #NON-CHARACTER USAGE#
                INSVALC C(0,0,WC); #CHARACTER USAGE#
     ARRAY STRTMP S(STRWDS);
           ITEM STR C(0,0,STRCHS); #ENCODING BUFFER#
     ARRAY [1:FITSIZEW]; ITEM FIT; #BUFFER FOR FIT DUMP#
     CONTROL EJECT; 
  
     ARRAY[ 1:PGC ]; ITEM CHPWD;   #LINE COMPRESSION WSA# 
  
     DEF CHSTO( CH ) #BEGIN        ##STORE CHAR. INTO COMPRESSION WSA## 
                      IF OUTRL GQ PGWIDTH 
                         THEN WRITE;
                      OUTRL = OUTRL + 1;
                      CHPWD[ OUTRL ] = CH;
                      END#; 
  
     DEF ERROR #BEGIN              ##DIAGNOSE ERROR AND EXIT##
                ERRCTL; 
                RETURN; 
                END#; 
  
PROC WRITE;                        #COMPRESS OUTPUT LINE AND PUT# 
     BEGIN
     CMPTO = OUTRL + 1; 
     IF CMPTO GR CMPSTRT
        THEN FOR CMPFR = CMPSTRT STEP 1 UNTIL CMPTO DO
                 C<CMPFR - 1>OUTWSAC[ 0 ] = CHPWD[ CMPFR ]; 
     PUT( OUTPUT, OUTWSA, OUTRL );
     CHPWD[ 1 ] = CCSP;            #PAGE SPACE# 
     OUTRL = 1; 
     CMPSTRT = 2; 
     END #WRITE#
  
PROC ERRCTL;       #ISSUE DAYFILE MESSAGE FOR CONTROL CARD ERROR# 
     BEGIN
     C<CHARPOS>CCEP[0] = CHARACTER"MINUS";
     MESSAGE( CCEPNT ); 
     MESSAGE( CCEMSG ); 
     END #ERRCTL# 
  
PROC READ;                         #FILL WSA WITH ERROR FILE INPUT# 
     BEGIN
     GETP( ZZZZZEF, ZEFWSA, ZEFWSASW*WC );
     ZEFMAX = IFETCH( ZZZZZEF, PTL )/WC;
     ZEFFP = IFETCH( ZZZZZEF, FP ); 
     ZEFWP = 1; 
     ZEFW = 1;
     END #READ# 
  
PROC BOUNDCK;                      #HANDLE ERROR FILE BOUNDARIES# 
     BEGIN
     IF ZEFFP EQ EOP  OR  ZEFFP EQ EOI
        THEN BEGIN
             CLOSEM( ZZZZZEF, CF, FILE ); 
             CLOSEM( OUTPUT, CFEQN, FILE ); 
             STOP;
             END
     ZEFWP = ZEFWSASW;
     ZEFW = ZEFWSASW; 
     END #BOUNDCK#
PROC EXEC;    #CRMEP CONTROL CARD CRACKER#    CONTROL EJECT;
     BEGIN
 #
 1CD  EXEC PROCEDURE
 0D   PURPOSE 
 0        CRACK CRMEP CONTROL CARD. 
 0D   CALL
 0        EXEC
 0D   PARAMETERS
 0        NONE
 0D   ACTION
 0        A CHARACTER SCAN OF THE CONTROL CARD IMAGE IN RA+70B IS 
          PERFORMED.  FIRST CHARACTERS ARE SKIPPED UNTIL A NON- 
          ALPHANUMERIC CHARACTER IS DETECTED.  AT THIS POINT THE
          PRECEDING CHARACTERS ARE TESTED FOR 7HEXECUTE.  IF THE RESULT 
          IS TRUE THEN THE PROCESS IS RESTARTED AT THE CURRENT CHARACTER
          POSITION, ELSE THE ACTUAL PARAMETER CRACKING STARTS HERE. 
 0        FROM THIS POINT BLANKS ARE IGNORED.  ALPHANUMERIC CHARACTERS
          ARE PACKED INTO AN ACCUMULATOR FOR USE BY BOTH KEY AND VALUE
          PARTS OF THE PARAMETERS.  THE FIRST THING EXPECTED IS A KEY.
          SUBSEQUENTLY, A COMMA SIGNIFIES THE START OF A KEY, AN EQUAL
          SIGN OR SLASH INDICATES THE START OF A VALUE.  A PERIOD OR
          RIGHT PARENTHESIS TERMINATES PROCESSING.
 0        KEY VALIDATION IS PERFORMED BY SEARCHING A TWO DIMENSION ARRAY
          CONTAINING VALID KEYS AND MAXIMUM STRING SIZE FOR THEIR 
          CORRESPONDING VALUES.  FROM THIS POINT THE ARRAY ORDINAL, A 
          STATUS ITEM, IS USED TO DETERMINE THE PROCESSING FOR EACH 
          SUBSEQUENT ASSOCIATED VALUE.  IF THE KEY IS NOT TERMINATED BY 
          AN EQUAL SIGN THEN THE FIRST DEFAULTS FOR THAT KEY, DEFINED 
          AT COMPILE TIME, ARE REPLACED BY THE SECOND DEFAULTS. 
 0        SN AND ON VALUES ARE VALIDATED AS THEY ARE ACCUMULATED AND
          DECODED TO BINARY EQUIVALENTS.  THESE MUST BE 1 TO 4 OCTAL
          DIGITS WITH NO POSTRADIX.  LO VALUES ARE VALIDATED IN THE SAME
          FASHION AS THE KEYS.  IN THIS CASE THE SECOND HALF OF THE 
          ARRAY CONTAINS THE VALUES REPRESENTED BY A BOOLEAN VALUE.  A
          MINUS PREFIX TRANSLATES TO A VALUE OF FALSE.  SF AND OF VALUES
          ARE CARRIED AS CHARACTER STRINGS.  THE L VALUE IS CONVERTED TO
          LEFT JUSTIFIED AND BINARY ZERO FILL.  THE PRESENCE OF THE RU
          VALUE WILL UNLOAD THE ERROR FILE AT CLOSE TIME UNLESS IT IS A 
          SINGLE ZERO DIGIT.
 0        IF SECOND DEFAULT AND EXPLICIT VALUES ARE SPECIFIED FOR THE 
          SAME KEY, THE LAST FORM SPECIFIED WILL TAKE EFFECT.  IF A KEY 
          IS SPECIFIED MORE THAN ONCE WITH EXPLICIT VALUES THE LAST 
          VALUE OVERRIDES ANY PREVIOUS EXCEPT IN THE CASE OF SN, ON, SF,
          OF VALUES.  IN THE LATER CASE THE NEW VALUES EXTEND THE LIST
          OF ANY PREVIOUS.
 0        ANY ERRORS ENCOUNTERED WILL TERMINATE CONTROL CARD PROCESSING.
          HOWEVER, CRMEP WILL CONTINUE GIVEN THE PARAMETERS PROCESSED 
          CORRECTLY UP TO THAT POINT.  A DAYFILE MESSAGE WILL INDICATE
          THE CHARACTER AT WHICH THE ERROR WAS DETECTED AND THE 
          LISTABLE OUTPUT FILE WILL DISPLAY ONLY THAT PART OF THE CARD
          THAT HAS BEEN PROCESSED.
 #
     ARRAY; 
           ITEM PACKREG  C(0,0,WC) = [" "], 
                PACKREGI I(0,0,WL); 
     GETPAGE(PGSIZE);       #GET PAGE SIZE INFORMATION# 
     CF = CFEQR;
     P<CTLCARD> = CARDLOC;
     FOR CHARPOS=0 STEP 1 UNTIL CC-1 DO 
         BEGIN
         CH = C<CHARPOS>CTL[0]; 
         IF START 
            THEN BEGIN             #POSITIONED AT OR PAST START OF PARS#
                 IF CH EQ S"SPACE"
                    THEN TEST CHARPOS;
                 IF KEYPROC 
                    THEN BEGIN     #PROCESS PARAMETER KEY#
                         IF CH LS S"PLUS" 
                            THEN BEGIN
                                 C<SIZE>PACKREG = CH; 
                                 SIZE = SIZE + 1; 
                                 TEST CHARPOS;
                                 END
                         CONTROL SLOWLOOP;
                         FOR ARGDEX=1 STEP 1
                             WHILE PACKREG NQ PAR[ ARGDEX ] DO
                             IF ARGDEX GR PARS
                                THEN ERROR; 
                         CONTROL FASTLOOP;
                         IF CH EQ S"EQUAL"
                            THEN KEYPROC = FALSE; 
                            ELSE BEGIN
                                 IF ARGDEX EQ S"LO" 
                                    THEN FOR VALDEX=1 STEP 1
                                             UNTIL LOSDC DO 
                                             LO[ VALDEX ] = 
                                                 LOSDF[ VALDEX ]; 
                                    ELSE BEGIN
                                         IF ARGDEX EQ S"SN" 
                                            THEN BEGIN
                                                 SNC = SNSDC; 
                                                 FOR VALDEX=1 STEP 1
                                                     UNTIL SNSDC DO 
                                                     SN[ VALDEX ] = 
                                                        SNSDF[ VALDEX ];
                                                 END
                                    ELSE BEGIN
                                         IF ARGDEX EQ S"ON" 
                                            THEN BEGIN
                                                 ONC = ONSDC; 
                                                 FOR VALDEX=1 STEP 1
                                                     UNTIL ONSDC DO 
                                                     ON[ VALDEX ] = 
                                                        ONSDF[ VALDEX ];
                                                 END
                                    ELSE IF ARGDEX EQ S"L"
                                            THEN OUTLFN = LFSDF;
                                            ELSE IF ARGDEX EQ S"RU" 
                                                    THEN CF = CFEQU;
                                         END
                                         END
                                 END
                         END
                    ELSE BEGIN     #PROCESS PARAMETER VALUE#
                         IF CH LS S"PLUS" 
                            THEN BEGIN
                                 C<SIZE>PACKREG = CH; 
                                 SIZE = SIZE + 1; 
                                IF ARGDEX NQ S"SN" AND
                                   ARGDEX NQ S"ON" AND
                                   ARGDEX NQ S"PW"
                                    THEN TEST CHARPOS;
                                IF ARGDEX EQ S"PW"
                                   THEN IF CH GQ S"ZERO" AND
                                           CH LQ S"NINE"
                                           THEN TEST CHARPOS; 
                                           ELSE ERROR;
                                 IF CH GQ S"ZERO"  AND  CH LQ S"SEVEN"
                                    THEN TEST CHARPOS;
                                 ERROR; 
                                 END
                         IF ARGDEX EQ S"LO" 
                            THEN BEGIN
                                 IF CH EQ S"MINUS"
                                    THEN BEGIN
                                         SET = FALSE; 
                                         TEST CHARPOS;
                                         END
                                 FOR VALDEX=1 STEP 1
                                     WHILE PACKREG NQ LOK[ VALDEX ] DO
                                     IF VALDEX GR LOSDC 
                                        THEN ERROR; 
                                 LO[ VALDEX ] = SET;
                                 SET = TRUE;
                                 END
                            ELSE IF ARGDEX EQ S"SF" 
                                    THEN BEGIN
                                         SFC = SFC + 1; 
                                         SF[ SFC ] = PACKREG; 
                                         END
                            ELSE IF ARGDEX EQ S"OF" 
                                    THEN BEGIN
                                         OFC = OFC + 1; 
                                         OF[ OFC ] = PACKREG; 
                                         END
                            ELSE IF ARGDEX EQ S"SN"  OR 
                                    ARGDEX EQ S"ON" 
                                    THEN BEGIN
                                         OCTREG = 0;
                                         FOR DIGIT=1 STEP 1 
                                             UNTIL SIZE DO
                                             B<OCTDIG( DIGIT,SIZE )>
                                             OCTREG = C<DIGIT - 1>
                                             PACKREG - CHARACTER"ZERO"; 
                                         IF OCTREG GR OCTMAX
                                            THEN ERROR; 
                                         IF ARGDEX EQ S"SN" 
                                            THEN BEGIN
                                                 SNC = SNC + 1; 
                                                 SN[ SNC ] = OCTREG;
                                                 END
                                            ELSE BEGIN
                                                 ONC = ONC + 1; 
                                                 ON[ ONC ] = OCTREG;
                                                 END
                                         END
                           ELSE IF ARGDEX EQ S"PW"
                                   THEN BEGIN 
                                        OCTREG = 0; 
                                        FOR DIGIT =1 STEP 1 UNTIL SIZE
                                            DO
                                             OCTREG=(OCTREG * 10) + 
                                                   (C<DIGIT-1>PACKREG-
                                                   CHARACTER"ZERO");
                                        PGWIDTH = OCTREG; 
                                        IF PGWIDTH LS MINPW 
                                           THEN PGWIDTH = MINPW;
                                        IF PGWIDTH GR MAXPW 
                                           THEN PGWIDTH = MAXPW;
                                        PGB = TRUE; 
                                        END 
                            ELSE BEGIN
                                 IF ARGDEX EQ S"L"
                                    THEN OUTLFN = HTOL( PACKREGI,SIZE );
                                    ELSE IF PACKREG NQ "0"
                                            THEN CF = CFEQU;
                                 IF CH EQ S"SLASH"
                                    THEN ERROR; 
                                 END
                         IF SIZE GR VMX[ ARGDEX ] 
                            THEN ERROR; 
                         IF CH NQ S"SLASH"
                            THEN KEYPROC = TRUE;
                         END
                 PACKREG = " "; 
                 SIZE = 0;
                 END
            ELSE BEGIN             #NOT YET AT START OF PARAMETERS# 
                IF CH LS S"PLUS" OR CH EQ S"SPACE"
                    THEN TEST CHARPOS;
                 IF C<0,CHARPOS>CTL[0] EQ "EXECUTE" 
                    THEN TEST CHARPOS;
                 START = TRUE;
                 END
         IF CH EQ S"POINT"  OR  CH EQ S"RPAREN" 
            THEN RETURN;
         END
     ERROR; 
     END #EXEC# 
PROC MSGINS;    #PROCESS MESSAGE INSERT#    CONTROL EJECT;
 #
 1CD  MSGINS PROCEDURE
 0D   PURPOSE 
 0        TRANSFER ONE MESSAGE INSERT FROM THE CRM ERROR FILE TO THE
          LISTABLE OUTPUT FILE. 
 0D   CALL
 0        MSGINS
 0D   PARAMETERS
 0        NONE
 0D   OTHER CODE
 0        PROGRAMS- READ,WRITE,BOUNDCK,OCT20,CID,CFG,FIELDER
          MACROS- OCT,CHSTO,BCTOC,CCTOC 
 0D   ACTION
 0        IF THE INPUT FILE IS POSITIONED AT END OF MESSAGE RECORD THEN 
          RETURN.  A FLAG IS PRESET TO TURN OFF COLUMN FORMATTING OF
          LIST ELEMENTS.
 0        FROM THIS POINT THE REMAINDER OF THE ROUTINE CONSISTS OF A
          LARGE LOOP THAT PROCESES ONE WORD OF THE INPUT FILE PER 
          ITERATION UNTIL THE CURRENT INSERT HAS BEEN PASSED OR UNTIL A 
          PREMATURE MESSAGE RECORD TERMINATOR OR END OF INFORMATION IS
          ENCOUNTERED.  SINCE THIS ROUTINE IS CALLED FROM WITHIN A LOOP 
          THAT ALSO PROCESSES THE INPUT FILE THE INDUCTION VARIABLE OF
          THE CALLING ROUTINE MUST BE MAINTAINED. 
 0        WHEN INSLEN IS ZERO AT THE TOP OF THE LOOP WE ARE POSITIONED
          AT THE INSERT CONTROL WORD AND CONTROL WORD SUBFIELDS ARE 
          TRANSFERED TO TEMPORARIES.  IF INSERT TYPE IS DEFAULT (ZERO)
          IT WILL BE SET TO OCTAL.  FIELD AND DATA SIZE IS PRESET TO 10 
          IN THE CASE OF CHARACTER CONVERSION AND 20 FOR ALL OTHERS.
          IF THE MODE OF INSERT IS NOT CONTAINED THEN IF MODE IS
          DIRECTED AND LENGTH IS ONE INITIALIZATION FOR COLUMN FORMATION
          IS PERFORMED AND THE OUTPUT RECORD FORMED UP TO THIS POINT IS 
          WRITTEN. (IN THE CASE OF A FIT DUMP INSERT THE FIT ADDRESS IS 
          INCLUDED WITH THE OUTPUT RECORD).  WE NOW LOOP TO GET THE 
          FIRST WORD OF DATA FROM THE ERROR FILE. 
          IF THE MODE IS CONTAINED THE DATA IS ENCODED ACCORDING TO 
          INSERT TYPE INTO A STRING BUFFER AFTER SETTING LENGTH TO ZERO 
          TO INDICATE END OF INSERT.  PROCEDE TO STEP 1.
 0        AT THIS POINT WE HAVE THE FIRST WORD OF DATA AND MODE IS NOT
          CONTAINED.  IF MODE IS DIRECTED ONE OF TWO PROCEDURES IS
          FOLLOWED DEPENDING ON THE FITDMP FLAG.  IF IT IS NOT A FITDMP 
          THEN: DECREMENT THE LENGTH BY ONE.  IF IT IS A LIST THEN SPACE
          TO NEXT COLUMN.  ENCODE THE WORD ACCORDING TO TYPE INTO THE 
          STRING BUFFER.  PROCEDE TO STEP 1.  IF IT IS A FITDMP:  
          INCREMENT THE FIT WORD POINTER AND STORE THE DATA WORD INTO 
          THE FIT BUFFER.  IF THE FIT BUFFER IS NOT FULL LOOP FOR NEXT
          WORD FROM FILE.  IF THE NUMBER OF FIT SYMBOLS IS ZERO CALL
          FIELDER TO LOAD THE FITDMP TABLE CAPSULE.  COMPUTE LINES TO BE
          PRINTED FOR THE FITDMP AND ENTER A LOOP TO PRINT THE DUMP.
          THE OUTER LOOP COUNTS THE NUMBER OF LINES AND THE INNER LOOP
          THE NUMBER OF FIT FIELDS PER LINE.  THIS HAS THE EFFECT OF
          DIVIDING THE SYMBOL TABLE INTO THE SAME NUMBER OF GROUPS AS 
          LINES IN THE DUMP.  THE FIRST FROM EACH GROUP IS PRINTED THEN 
          THE SECOND FROM EACH GROUP AND SO ON.  THE RESULT BEING THE 
          SYMBOLS ARE SORTED VERTICALLY INSTEAD OF HORIZONTALLY ON THE
          LISTING.  PROCEDE TO STEP 1.
 0        IF THE MODE IS CSTRING WE ENCODE ACCORDING TO TYPE AS MUCH OF 
          THE DATA THAT OCCURRS IN THE CURRENT WORD OF THE FILE INTO THE
          STRING BUFFER LEFT JUSTIFIED.  INSERT LENGTH IS DECREMENTED BY
          THE NUMBER OF CHARACTERS EXTRACTED FROM THE CURRENT WORD. 
          INSERT POSITION IS SET TO ZERO FOR SUBSEQUENT INPUT WORDS.
          FIELD SIZE IS SET EQUAL TO DATA SIZE.  PROCEDE TO STEP 1. 
 0        IF THE MODE IS BSTRING INSCOM NON-ZERO INDICATES COMPASS MACRO
          ORIGIN.  IN THIS CASE BIT POSITION IS SPECIFIED FROM THE RIGHT
          AND IS NOW CONVERTED TO ITS SYMPL EQUIVALENT.  THE DATA IS NOW
          EXTRACTED FROM THE FILE WORD AND ENCODED ACCORDING TO TYPE, 
          LEFT JUSTIFIED, INTO THE STRING BUFFER.  INSERT LENGTH IS SET 
          TO ZERO.
 0    STEP ONE
          IF EMAT IS NOT ZERO THEN A FITDMP IS NOT IN PROCESS SO TRANS- 
          FER THE STRING BUFFER TO THE OUTPUT FILE A CHARACTER AT A 
          TIME.  FOR THIS PROCESS EMAT IS THE LENGTH OF THE FIELD AND 
          SIZE IS THE LENGTH OF THE DATA WITHIN THE FIELD.  THUS, 
          EMAT - SIZE = SPACING TO ACHIEVE RIGHT JUSTIFIED COLUMN 
          ALLIGNMENT. 
 0        IF A LIST IS BEING FORMATTED AND MAXIMUM ELEMENTS PER LINE IS 
          ATTAINED THEN WRITE THE LINE TO THE OUTPUT FILE.
          IF THE INSERT LENGTH IS NOW ZERO THEN EXIT ELSE CONTINUE THE
          MAIN INPUT LOOP.
 #
     BEGIN
     IF FINDEOR 
        THEN RETURN;
     LIST = FALSE;                  CONTROL SLOWLOOP; 
     FOR ZEFW = ZEFWP + 1 STEP 1 DO 
         BEGIN                      CONTROL FASTLOOP; 
         IF ZEFW GR ZEFWSASW
            THEN READ;             #EMPTY WSA, GET MORE DATA# 
         IF ZEFMAX EQ 0 
            THEN BEGIN
                 BOUNDCK;          #PERFORM BOUNDARY CHECKING#
                 TEST ZEFW;        #TRY ANOTHER READ# 
                 END
         ZEFWP = ZEFW;
         ZEFMAX = ZEFMAX - 1; 
         IF INSLEN EQ 0 
            THEN BEGIN             #CONTROL WORD - EXTRACT PARAMETERS#
                 IF ZEFWSAI[ ZEFW ] EQ EOR
                    THEN BEGIN
                         FINDEOR = TRUE;
                         RETURN;   #INSERT REQUESTED BUT NONE FOUND#
                         END
                 INSTYPE = ZTYPE[ ZEFW ]; 
                 INSMODE = ZMODE[ ZEFW ]; 
                 INSVAL  = ZVAL[ ZEFW ];
                 INSFIT  = ZFIT[ ZEFW ];
                 INSPOS  = ZPOS[ ZEFW ];
                 INSCOM  = ZCOM[ ZEFW ];
                 INSLEN  = ZLEN[ ZEFW ];
                 INSLOC  = ZLOC[ ZEFW ];
                 IF INSTYPE EQ S"DEFAULT" 
                    THEN INSTYPE = S"OCTAL";
                 EMAT = WO; 
                 SIZE = WO; 
                 IF INSTYPE EQ S"CHARACTER" 
                    THEN BEGIN
                         EMAT = WC; 
                         SIZE = WC; 
                         END
                 IF INSMODE NQ S"CONTAINED" 
                    THEN BEGIN
                         IF INSMODE NQ S"DIRECTED"  OR  INSLEN EQ 1 
                            THEN TEST ZEFW; #NO COLUMN FORMAT#
                         LIST = TRUE; 
                         EOLPNT = LSSP + EMAT;
                         IF INSFIT NQ 0 
                            THEN BEGIN
                                 EMAT = 0;    #INDICATE STRTMP NULL#
                                 FITWP = 0; 
                                 EOLPNT = DMSP + WO + 1 + MXSM; 
                                 FOR STDEX=1 STEP 1 UNTIL FTHDS DO
                                     CHSTO( C<STDEX-1>FITDMP ); 
                                 B<0,AL>INSLOC = B<WL-AL,AL>INSLOC; 
                                 OCT( INSLOC, STRTMP, 0 );
                                 FOR STDEX=0 STEP 1 UNTIL BCTOC(AL)-1 DO
                                     CHSTO( C<STDEX>STR );
                                 CHSTO( CHARACTER"RPAREN" );
                                 END
                         EOLPNT = (PGWIDTH/EOLPNT)*EOLPNT;
                         WRITE; 
                         TEST ZEFW; 
                         END
                 INSLEN = 0;
                 IF INSTYPE EQ S"CHARACTER" 
                    THEN STR = INSCTND; 
                    ELSE IF INSTYPE EQ S"DECIMAL" 
                            THEN CID( INSVAL, SIZE, STRTMP ); 
                            ELSE OCT( INSVAL, STRTMP, 0 );
                 END
            ELSE IF INSMODE EQ S"DIRECTED"
                    THEN BEGIN
                         INSLEN = INSLEN - 1; 
                         IF INSFIT EQ 0 
                            THEN BEGIN
                                 INSVAL = ZEFWSAI[ ZEFW ];
                                 IF LIST
                                    THEN FOR FRFILL=1 STEP 1
                                             UNTIL LSSP DO
                                             CHSTO( CHARACTER"SPACE" ); 
                                 IF INSTYPE EQ S"OCTAL" 
                                    THEN OCT( INSVAL, STRTMP, 0 );
                                    ELSE IF INSTYPE EQ S"CHARACTER" 
                                            THEN STR = INSVALC; 
                                    ELSE IF INSTYPE EQ S"DECIMAL" THEN
                                         CID( INSVAL, SIZE, STRTMP ); 
                                    ELSE CFG( INSVAL, 1, SIZE, STRTMP );
                                 END
                            ELSE BEGIN      #FORMAT FIT DUMP# 
                                 FITWP = FITWP + 1; 
                                 FIT[ FITWP ] = ZEFWSAI[ ZEFW ];
                                 IF INSLEN NQ 0 
                                    THEN TEST ZEFW; #GET NEXT FIT WORD# 
                                 IF SYMBOLS EQ 0
                                    THEN FIELDER;   #LOAD FIT DMP TABLE#
                                 ROWS = (SYMBOLS + (EPL - 1))/EPL;
                                 FOR ROW=1 STEP 1 UNTIL ROWS DO 
                                     BEGIN
                                     FOR COL=ROW STEP ROWS
                                         UNTIL SYMBOLS DO 
                                         BEGIN
                                         FIELDER( COL - 1, #TABLE ORD. #
                                                  SYMBOL,  #FLD. SYMBOL#
                                                  SLEN,    #SYM. LENGTH#
                                                  VWORD,   #WORD OF FLD#
                                                  VPOS,    #POS IN WORD#
                                                  VLEN );  #FIELD SIZE #
                                         INSVAL=B<VPOS,VLEN>FIT[VWORD]; 
                                         VLEN = BCTOC( VLEN );
                                         OCT( INSVAL, STRTMP, 0 );
                                         FOR FRFILL=-1 STEP 1 
                                             UNTIL WO-VLEN DO 
                                             CHSTO( CHARACTER"SPACE" ); 
                                         FOR STDEX=WO-VLEN STEP 1 
                                             UNTIL WO-1 DO
                                             BEGIN
                                             CH = C<STDEX>STR;
                                             CHSTO( CH ); 
                                             END
                                         CHSTO( CHARACTER"SPACE" ); 
                                         FOR STDEX=0 STEP 1 
                                             UNTIL SLEN-1 DO
                                             BEGIN
                                             CH = C<STDEX>SYMBOL; 
                                             CHSTO( CH ); 
                                             END
                                         FOR FRFILL=-1 STEP 1 
                                             UNTIL MXSM-SLEN DO 
                                             CHSTO( CHARACTER"SPACE" ); 
                                         END
                                     WRITE; 
                                     END
                                 END
                         END
                    ELSE IF INSMODE EQ S"CSTRING" 
                            THEN BEGIN
                                 EMAT = INSLEN; 
                                 IF INSPOS + INSLEN GR WC 
                                    THEN EMAT = WC - INSPOS;
                                 INSLEN = INSLEN - EMAT;
                                 INSVALC = C<INSPOS,EMAT>ZEFWSAC[ZEFW]; 
                                 INSPOS = 0;
                                 IF INSTYPE NQ S"CHARACTER" 
                                    THEN BEGIN
                                         OCT( INSVALC, STRTMP, 0 ); 
                                         EMAT = CCTOC( EMAT );
                                         END
                                    ELSE C<0,WC>STR = INSVALC;
                                 SIZE = EMAT; 
                                 END
                    ELSE IF INSMODE EQ S"BSTRING" 
                            THEN BEGIN
                                 IF INSCOM NQ 0 
                                    THEN INSPOS = WL-(INSPOS+INSLEN); 
                                 INSVAL = B<INSPOS,INSLEN>ZEFWSAI[ZEFW];
                                 EMAT = BCTOC( INSLEN );
                                 INSLEN = 0;
                                 IF INSTYPE EQ S"DECIMAL" 
                                    THEN CID( INSVAL, SIZE, STRTMP ); 
                                    ELSE OCT( INSVAL, STRTMP, 0 );
                                 END
         IF EMAT NQ 0 
            THEN BEGIN
                 IF SIZE NQ EMAT
                    THEN FOR VPOS = SIZE + 1 STEP 1 UNTIL EMAT DO 
                             CHSTO( CHARACTER"SPACE" ); 
                 FOR VPOS=0 STEP 1 UNTIL SIZE - 1 DO
                     CHSTO( C<VPOS>STR ); 
                 END
         IF LIST
            THEN IF OUTRL GQ EOLPNT 
                    THEN WRITE; 
         IF INSLEN EQ 0 
            THEN RETURN;
         END
     END #MSGINS# 
     CONTROL EJECT;                  #CRMEP BEGINS HERE#
     EXEC;
     FILESQ( ZZZZZEF, 
             BFS, BUFSIZEW, 
             FWB, ZEFBUF, 
             LFN, ZEFLFN, 
             RT,  RTEQS,
             EFC, 0,
             DFC, 0       );
     FILESQ( OUTPUT,
             BFS, BUFSIZEW, 
             FWB, OUTBUF, 
             LFN, OUTLFN, 
             RT,  RTEQZ,
             BT,  BTEQC,
             FL,  PGWIDTH,
             EFC, 0,
             DFC, 0      ); 
     OPENM( ZZZZZEF, PDEQI, OFEQR );
     OPENM( OUTPUT, PDEQO, OFEQN ); 
     IF NOT PGB 
        THEN BEGIN
             PGWIDTH = JPW; 
             IF CONFLG[1] 
                THEN BEGIN
                     IF PGWIDTH GR TERMPW 
                        THEN PGWIDTH = TERMPW;
                     END
                ELSE BEGIN
                     IF PGWIDTH GR MAXPW
                        THEN PGWIDTH = MAXPW; 
                     IF PGWIDTH LS MINPW
                        THEN PGWIDTH = MINPW; 
                     END
             END
     IF NOT CONFLG[1] 
        THEN BEGIN
             IF JPD EQ 8
                THEN PUT( OUTPUT, CC8L, 8); 
                ELSE PUT( OUTPUT, CC6L, 8); 
             END
     C<CFLD>HDR[0] = C<0,CHARPOS+1>CTL[0];
     C<DFLD>HDR[0] = DATE;
     C<TFLD>HDR[0] = CLOCK; 
     CONTROL IFEQ PW,YES;          #PAGE WIDTH PARAMETER IMPLEMENTED# 
     IF PGWIDTH LS OUTHDRL
        THEN OUTHDRL = PGWIDTH; 
     CONTROL ENDIF; 
     PUT( OUTPUT, PGHDR, OUTHDRL );     CONTROL SLOWLOOP; 
     FOR ZEFWP = ZEFWSASW + 1 STEP 1 DO 
         BEGIN                          CONTROL FASTLOOP; 
         IF ZEFWP GR ZEFWSASW 
            THEN READ;             #EMPTY WSA, GET MORE DATA# 
         IF ZEFMAX EQ 0 
            THEN BEGIN             #WSA DATA EXHAUSTED OR NO XFER#
                 BOUNDCK;          #PERFORM BOUNDARY CHECKING#
                 TEST ZEFWP;       #TRY ANOTHER READ# 
                 END
         ZEFMAX = ZEFMAX - 1; 
         IF NOT FINDEOR AND NOT OMIT
            THEN BEGIN             #PROCESS CURRENT INPUT WORD# 
                 IF ZEFWSAI[ ZEFWP ] EQ EOR 
                    THEN TEST ZEFWP;
                 C<OUTRL,WC>OUTWSAC[ 0 ] = ZEFWSAC[ ZEFWP ];
                 OUTRL = OUTRL + WC;
                 IF OUTRL LS NOTEPOINT
                    THEN TEST ZEFWP; #CONTINUE INPUT TO OUTPUT XFER#
                 IF OUTRL EQ NOTEPOINT
                    THEN BEGIN     #DETERMINE IF SELECTION CRITERIA MET#
                         PRODUCT = C<PRFLD>OUTWSAC[0];
                         SEVERE = C<SEFLD>OUTWSAC[0]; 
                         CRMMSG = TRUE; 
                         IF PRODUCT EQ CHARACTER"D" 
                            THEN BEGIN    #DATA MGR. MSG.#
                                 CRMMSG = FALSE;
                                 OMIT = NOT LOEQD;
                                 END
                         IF SEVERE EQ "NOTE"
                            THEN OMIT = NOT LOEQN;
                            ELSE IF SEVERE EQ "FATAL" 
                                    THEN OMIT = NOT LOEQF;
                                    ELSE OMIT = NOT LOEQT;
                         IF OMIT
                            THEN TEST ZEFWP;
                         FOR DIGIT=1 STEP 1 UNTIL IDSIZE DO 
                             B<OCTDIG( DIGIT,IDSIZE )>MESID = 
                             C<IDPOS + DIGIT - 1>OUTWSAC[0] - 
                             CHARACTER"ZERO"; 
                         IF SNC NQ 0
                            THEN BEGIN    #SELECT MSG IDS SPECIFIED#
                                 FOR ID=1 STEP 1
                                     WHILE MESID NQ SN[ ID ] DO 
                                     IF ID GR SNC 
                                        THEN BEGIN
                                             OMIT = TRUE; 
                                             TEST ZEFWP;
                                             END
                                 END
                            ELSE IF ONC NQ 0    #OMIT MSG IDS SPECIFIED#
                                    THEN FOR ID=1 STEP 1 UNTIL ONC DO 
                                             IF MESID EQ ON[ ID ] 
                                                THEN BEGIN
                                                     OMIT = TRUE; 
                                                     TEST ZEFWP;
                                                     END
                         FNT = C<FNFLD>OUTWSAC[0];
                         IF SFC NQ 0
                            THEN BEGIN    #SELECT LFNS SPECIFIED# 
                                 FOR ID=1 STEP 1 WHILE FNT NQ SF[ID] DO 
                                     IF ID GR SFC 
                                        THEN BEGIN
                                             OMIT = TRUE; 
                                             TEST ZEFWP;
                                             END
                                 END
                            ELSE IF OFC NQ 0    #OMIT LFNS SPECIFIED# 
                                    THEN FOR ID=1 STEP 1 UNTIL OFC DO 
                                             IF FNT EQ OF[ ID ] 
                                                THEN BEGIN
                                                     OMIT = TRUE; 
                                                     TEST ZEFWP;
                                                     END
                         IF SEVERE NQ "NOTE"
                            THEN TEST ZEFWP;
                         END
                    ELSE IF OUTRL NQ ERRORPOINT 
                            THEN TEST ZEFWP;   #XFER REST OF FIXED PART#
                 GETTXT( MESID,    #MESSAGE IDENTIFIER# 
                         CRMMSG,   #TRUE=CRM, FLASE=DATA MGR.#
                         TEXTWSA,  #AREA TO RECEIVE TEXT# 
                         TEXTCHS );#TEXT STRING SIZE IN CHARACTERS# 
                 CMPSTRT = OUTRL + 1; 
                 IF TEXTCHS NQ 0
                    THEN BEGIN
                         CHSTO( CHARACTER"SPACE" ); 
                         FOR TEXTCP=1 STEP 1 UNTIL TEXTCHS DO 
                             BEGIN
                             CH = C<TEXTCP-1>TEXTWSAC[ 0 ]; 
                             IF CH EQ S"APOST"
                                THEN MSGINS;
                                ELSE CHSTO( CH ); 
                             END
                         END
                 FINDEOR = TRUE;    #IGNORE ANY REMAINDER OF RECORD#
                 END
         IF ZEFWSAI[ ZEFWP ] NQ EOR 
            THEN TEST ZEFWP;
         IF NOT OMIT
            THEN WRITE; 
         FINDEOR = FALSE; 
         OMIT = FALSE;
         OUTRL = 0; 
         END
     END #CRMEP#
TERM
#***      CID  -  CONVERT INTEGER TO DECIMAL DISPLAY FORMAT.
* 
*         R. H. GOODELL.     77/01/24.
* 
*         *CID* CONVERTS A 60-BIT SIGNED BINARY INTEGER TO A DISPLAY
*         FORMAT RESEMBLING AN *I20* SPECIFICATION IN FORTRAN.
# 
          PROC  CID  (I, L, A) ;
  
          ITEM I I ;               # INTEGER VALUE #
          ITEM L I ;               # LENGTH (IN CHARACTERS) OF RESULT # 
#         ITEM A C (20)              CONVERSION RESULT, LEFT JUSTIFIED
****
# 
          BEGIN 
  
     DEF  GE  #GQ# ;     DEF  LE  #LQ# ;     DEF  NE  #NQ# ;
     DEF  GT  #GR# ;     DEF  LT  #LS# ;     DEF  THRU  #STEP 1 UNTIL# ;
     DEF  CALL # # ;     DEF  GO  #GOTO# ;     DEF  TO  # # ; 
     DEF  AL  #18# ;     # ADDRESS LENGTH IN BITS # 
     DEF  CL  # 6# ;     # CHARACTER LENGTH IN BITS # 
     DEF  NC  # 7# ;     # NAME LENGTH IN CHARACTERS #
     DEF  NL  #42# ;     # NAME LENGTH IN BITS = NC * CL #
     DEF  WC  #10# ;     # WORD LENGTH IN CHARACTERS = WL / CL #
     DEF  WL  #60# ;     # WORD LENGTH IN BITS #
     DEF  ZL  #42# ;     # NON-ADDRESS LENGTH IN BITS = WL - AL # 
  
          ARRAY A [0:1] ;          # CONVERSION RESULT, LEFT JUSTIFIED #
               ITEM RW C (0, 0, WC) ;   # RESULT WORD # 
          XREF PROC XCDDL ;        # CONVERTS UP TO 10 DIGITS # 
  
#         DISPLAY CODE CHARACTERS.
# 
          STATUS  CHARACTER 
               COLON, A,     B,     C,     D,     E,     F,     G,
               H,     I,     J,     K,     L,     M,     N,     O,
               P,     Q,     R,     S,     T,     U,     V,     W,
               X,     Y,     Z,     ZERO,  ONE,   TWO,   THREE, FOUR, 
               FIVE,  SIX,   SEVEN, EIGHT, NINE,  PLUS,  MINUS, STAR, 
               SLASH, LPAREN,RPAREN,DOLLAR,EQUAL, SPACE, COMMA, POINT,
               OCTAL, LBRKT, RBRKT, PERCT, QUOTE, BREAK, OR,    AND,
               APOST, QUERY, LT,    GT,    AT,    BACK,  CARET, SEMI  ; 
  
#         LOCAL DATA. 
# 
          ARRAY AB [0:1] ;         # ASSEMBLY BUFFER #
               ITEM AW C (0, 0, WC) ;   # ASSEMBLY WORD # 
  
          ARRAY  [13:17] ;         # LARGE POWERS OF TEN #
               ITEM TENS I = [    10000000000000,      # 10**13 # 
                                 100000000000000,      # 10**14 # 
                                1000000000000000,      # 10**15 # 
                               10000000000000000,      # 10**16 # 
                              100000000000000000 ] ;   # 10**17 # 
  
          ITEM C ;                 # CHARACTER COUNT #
          ITEM D ;                 # DIGIT COUNT #
          ITEM N ;                 # ABS (I) #
          ITEM T ;                 # TEMPORARY #
          ITEM W ;                 # WORD COUNT # 
  
  
#         PROCEDURE.
# 
          W = 0 ;                       # RESET ASSEMBLY WORDS #
          C = 0 ;                        # AND POINTERS # 
          AW [0] = " " ;
          AW [1] = " " ;
          N = ABS (I) ; 
          IF  I LT 0                    # IF NEGATIVE # 
          THEN BEGIN
               AW [0] = "-" ;                # INSERT MINUS SIGN #
               C = 1 ;
               END
          IF  N LT 10000000000          # IF SHORT INTEGER < 10**WC # 
          THEN BEGIN
               CALL XCDDL (N, W, D) ;        # CONVERT TO DECIMAL # 
               D = D / CL ;                  # DIGIT COUNT #
               T = WC - C ; 
               IF  T GT D                    # MOVE CHARACTERS TO 1ST # 
               THEN T = D ;                   # WORD OF ASSEMBLY AREA # 
               C<C,T> AW [0] = C<0,T> W ; 
               C = C + D ;
               D = D - T ;                   # MOVE CHARACTERS TO 2ND # 
               IF  D GT 0                     # WORD OF ASSEMBLY AREA # 
               THEN C<0,D> AW [1] = C<T,D> W ;
               L = C ;                       # RETURN RESULTS # 
               RW [0] = AW [0] ;
               RW [1] = AW [1] ;
               RETURN ; 
               END
          IF  N GE TENS [14]            # IF TOO LARGE FOR DIVISION # 
          THEN BEGIN
               FOR  T = 17 STEP -1           # FIND LARGEST POWER OF #
                    WHILE  TENS [T] GT N      # TEN THAT IS .LE. N  # 
                    DO  BEGIN  END
               FOR  T = T STEP -1 UNTIL 14  DO         # CONVERT THESE #
                    BEGIN                              # DIGITS VIA    #
                    FOR  D = CHARACTER"ZERO" STEP 1    # ITERATIVE     #
                         WHILE  N GE TENS [T]  DO      # SUBTRACTION   #
                         N = N - TENS [T] ;            # RATHER THAN   #
                    C<C> AW [0] = D ;                  # DIVISION      #
                    C = C + 1 ; 
                    END 
               T = TENS [13] ;               # SET NEXT POWER OF TEN #
               END
          ELSE BEGIN
               FOR  T = TENS [13]       # SKIP LEADING ZEROS #
                    WHILE  T GT N  DO 
                    T = T / 10 ;
               END
          FOR  T = T                    # CONVERT REMAINING DIGITS BY # 
               WHILE  T NE 0  DO         # DIVISION, LEFT TO RIGHT #
               BEGIN
               D = N / T ;                             # GET DIGIT #
               N = N - D * T ;
               C<C> AW [W] = D + CHARACTER"ZERO" ;     # STORE DIGIT #
               T = T / 10 ; 
               C = C + 1 ;                             # ADVANCE #
               IF  C EQ WC
               THEN BEGIN                              # NEXT WORD #
                    C = 0 ;                            # OF DIGITS #
                    W = W + 1 ; 
               END  END 
          L = W * WC + C ;              # RETURN RESULTS #
          RW [0] = AW [0] ; 
          RW [1] = AW [1] ; 
          RETURN ;
  
          END 
          TERM
