PROFILE 
          IDENT  PROFILE,ORIG 
          TITLE  PROFILE - PROJECT PROFILE MANAGER. 
          ABS 
          SST    DSSL 
          SYSCOM B1 
          ENTRY  PROFILE
          ENTRY  ARG= 
          ENTRY  RFL= 
          ENTRY  SSJ= 
          SPACE  4
*COMMENT  PROFILE - PROJECT PROFILE MANAGER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       PROFILE - PROJECT PROFILE MANAGER.
*         D. A. HIVELEY.     72/05/29.
*         G. R. GREENFIELD   76/04/19. (MODIFIED) 
          SPACE  4
***       PROFILE PROVIDES CREATION, MODIFICATION AND DISPLAYS FOR THE
*         PROJECT PROFILE FILE. THIS FILE CONTAINS INFORMATION REQUIRED 
*         T0 VALIDATE A USER,S REQUEST FOR ACCESS TO CHARGE-PROJECT 
*         NUMBERS, AND ALSO CONTAINS INFORMATION BY WHICH PROJECTS CAN
*         BE CONTROLLED- SUCH AS TOTAL SRUS THE PROJECT CAN USE.
          SPACE  4
***       COMMAND FORMAT. 
* 
*         PROFILE(P1=F1,P2=F2,...,PN=FN)
* 
*         WHERE P1,...,PN CAN BE THE FOLLOWING -
*                I = INPUT DATA FOR OP=C OR OP=U OPTIONS. 
*                    DEFAULT IS *INPUT*.
*                L = FILE TO RECEIVE OUTPUT.
*                    DEFAULT IS *OUTPUT*. 
*                P = PROJECT PROFILE FILE.
*                    DEFAULT IS *PROFILA*.
*                    IF SPECIFIED, FILE MUST NOT BE A FAST-ATTACH FILE. 
*                S = FILE TO RECEIVE PROFILA SOURCE DATA FOR OP=S.
*                    DEFAULT IS *SOURCE*. 
*                OP= OPTION CAN BE ANY OF THE FOLLOWING - 
*                    C = CREATE, PROCESS INPUT FILE AND CREATE A
*                        PROJECT PROFILE FILE (AT LEAST 1 CHARGE NUMBER 
*                        MUST BE SPECIFIED).
*                    U = UPDATE, UPDATE FILE SPECIFIED BY *P* OPTION
*                        WITH DATA ON INPUT FILE.  (* - SEE FOOTNOTE) 
*                    I = INQUIRE, WRITES REQUESTED INFORMATION TO 
*                        OUTPUT FILE.  (* - SEE FOOTNOTE) 
*                    R = RESTRUCTURE, THE NEW OR REBUILT PROFILA FILE 
*                        WILL REPLACE THE CURRENT ONE (AT LEAST 1 
*                        CHARGE NUMBER MUST REMAIN AFTER RESTRUCTURE).
*                        FILE RESTRUCTURED CAN NOT BE *FAST-ATTACH*.
*                    S = RETURN PROFILA FILE TO SOURCE FORMAT AND 
*                        PLACE ON FILE SPECIFIED BY *S* OPTION. 
*                    K = K-DISPLAY OPTION, ALL OTHER OPTIONS ARE
*                        CLEARED AND INSTRUCTIONS MUST BE ENTERED VIA 
*                        THE K-DISPLAY. 
*                    T = INTERACTIVE UPDATE, SAME AS UPDATE BUT 
*                        SUPPRESS PRELIMINARY INSTRUCTIONS. 
*                    L = LIST OPTION, LISTS SELECTED PORTIONS OF
*                        THE PROFILA FILE DETERMINED BY THE 
*                        *LO* PARAMETER.  (* - SEE FOOTNOTE)
*                FM= FAMILY NAME IF OTHER THAN SYSTEM DEFAULT.
*                    LEGAL FROM SYSTEM ORIGIN ONLY. 
*                CN= CHARGE NUMBER FOR INQUIRE. 
*                PN= PROJECT NUMBER FOR INQUIRE.
*                    *CN* AND *PN* CAN ONLY BE ENTERED FOR
*                    INQUIRE.  IF THESE PARAMETERS ARE REQUIRED AND 
*                    ARE NOT ENTERED ON THE COMMAND, THEN THE 
*                    INPUT FILE IS READ FOR THEM. 
*                LO= CAN BE ANY OF THE FOLLOWING -
*                    F = FULL FILE LIST OF THE WHOLE PROFILA FILE.
*                    C = CHARGE NUMBER LIST OF THE WHOLE PROFILA FILE.
*                    P = PROJECT NUMBER LIST OF WHOLE PROFILA FILE. 
*                    THE FOLLOWING THREE LIST OPTIONS ARE PERMISSIBLE 
*                    FROM OTHER THAN SYSTEM ORIGIN. 
*                    FM= FULL FILE LIST OF ALL PROJECTS FOR WHICH THE 
*                        USER IS THE MASTER USER. 
*                    CM= CHARGE NUMBER LIST OF ALL CHARGE NUMBERS FOR 
*                        WHICH THE USER IS THE MASTER USER. 
*                    PM= PROJECT NUMBER LIST OF ALL PROJECT NUMBERS FOR 
*                        WHICH THE USER IS THE MASTER USER. 
*                    DEFAULT IS *LO=F* IF FROM SYSTEM ORIGIN OR 
*                    SPECIAL ACCOUNTING USER, OTHERWISE *LO=FM*.
*                CV  CONVERSION OPTION.  BUILD SOURCE FILE FROM 
*                    NOS 2.2 PROFILE FILE, SUPRESSING DIRECTIVES
*                    NOT DEFINED BEFORE NOS 2.2.
*                    THIS PARAMETER IS MEANINGFUL ONLY WITH OP=S. 
* 
*         IF NO PARAMETERS ARE SPECIFIED ON THE COMMAND, DEFAULT
*         OPTION TAKEN IS *K* IF FROM SYSTEM ORIGIN, AND *U* OTHERWISE. 
* 
*         ALL PARAMETERS MAY BE ENTERED FROM SYSTEM ORIGIN. 
* 
*         FOOTNOTE * - THESE OPTIONS MAY BE ENTERED FROM ANY JOB
*                      ORIGIN BY SPECIAL ACCOUNTING USERS (I.E.-
*                      *CSAP* BIT SET IN USER ACCESS CONTROL WORD) OR 
*                      BY THE MASTER USER OF A REFERENCED CHARGE NUMBER.
          SPACE  4,10 
***       INPUT DIRECTIVES. 
* 
*         INPUT STREAM IS DIVIDED INTO CHARGE NUMBER ENTRIES, WHICH ARE 
*         DELIMITED BY A */* IN COLUMN 1 OR BY DIRECTIVE *CN* OR *ACN*. 
*         CHARGE NUMBER ENTRIES ARE DIVIDED INTO PROJECT NUMBER 
*         ENTRIES, WHICH ARE DELIMITED BY DIRECTIVE *PN* OR *APN*.
*         ALL DIRECTIVES PERTAINING TO A CHARGE OR PROJECT NUMBER 
*         MUST APPEAR WITHIN THE CHARGE OR PROJECT NUMBER ENTRY,
*         RESPECTIVELY. VALID SEPARATORS CONSIST OF ALL SPECIAL 
*         CHARACTERS (EXCEPT $/$, $+$, $-$, $*$, AND COLON) PLUS END OF 
*         LINE OR END OF CARD.  ALL DATA WITHIN A CHARGE NUMBER ENTRY 
*         IS FREE FORMAT TO COLUMN 72, HOWEVER, DIRECTIVES CANNOT BE
*         SPLIT BETWEEN CARDS OR LINES.  ALL BLANKS ARE IGNORED.
* 
*         EACH DIRECTIVE MUST BE SEPARATED FROM THE OTHER DIRECTIVES BY 
*         ONE OF THE SEPARATORS DENOTED ABOVE, HOWEVER, AN EQUAL *=*
*         CANNOT BE USED TO SEPARATE DIRECTIVES.  DIRECTIVES CONSIST OF 
*         AN IDENTIFIER FOLLOWED BY A DATA FIELD.  THE IDENTIFIER AND 
*         DATA FIELD MUST BE SEPARATED BY AN EQUAL *=*. 
* 
*         DIRECTIVE INPUT PROCESSING (PERTINENT ONLY FOR *CREATE* AND 
*         *UPDATE* OPTIONS) IS TERMINATED UPON ENCOUNTERING AN EOR, 
*         EOF, OR EOI ON INPUT FILE (E.G.- NULL LINE IF FROM TELEX).
* 
*         EXAMPLE INPUT STREAM- 
* 
*         /CHNUMBER01                      (FIRST CHARGE NUMBER ENTRY)
*            MU=USERAAA 
*            M2 = 30B 
*            PN=PROJECTNUMBER0000001       (FIRST PROJECT NUMBER ENTRY) 
*               TI=1200 
*               AUN=USERAAB 
*               AUN=USERAAC 
*            M1=10B 
*            PN=PROJECTNUMBER0000002       (SECOND PROJECT NUMBER ENTRY)
*               SML=10000 
*         CN = CHNUMBER02                  (SECOND CHARGE NUMBER ENTRY) 
*            CEX=751130 
*            PN=PROJECTNUMBER0000001       (FIRST PROJECT NUMBER ENTRY) 
*               DUN=USERAAB 
*         / -ETC.-                         (THIRD CHARGE NUMBER ENTRY)
* 
*         NUMERIC DATA IS ASSUMED DECIMAL UNLESS FOLLOWED BY A RADIX
*         CHARACTER, *D* = DECIMAL AND *B* = BINARY OR OCTAL. 
          SPACE  4
***       DIRECTIVE IDENTIFIERS.
* 
*         / OR CN = CHARGE NUMBER.
*                   CHARGE NUMBER MUST BE ACTIVE (EXCEPTION- WHEN 
*                   *OP=C* SPECIFIED, INTERPRETED AS *ACN*).
*                            1-10 ALPHANUMERIC CHARACTERS.
*                            (** - SEE FOOTNOTE.) 
* 
*         ACN =  ADD OR ACTIVATE CHARGE NUMBER. 
*                CHARGE NUMBER MUST BE INACTIVE OR NOT EXIST. 
*                (EXCEPTION- WHEN *OP=C* SPECIFIED, CHARGE
*                NUMBER MUST NOT EXIST).
*                            1-10 ALPHANUMERIC CHARACTERS.
* 
*         DCN =  DEACTIVATE CHARGE NUMBER.
*                CHARGE NUMBER MUST BE ACTIVE.
*                NOTE- REFORMAT RUNS (*OP=R*) PURGE ALL DEACTIVATED 
*                CHARGE NUMBER ENTRIES. 
*                (EXCEPTION- NOT LEGAL WHEN *OP=C* SPECIFIED).
*                            1-10 ALPHANUMERIC CHARACTERS.
* 
*         PN =   PROJECT NUMBER.
*                PROJECT NUMBER MUST BE ACTIVE (EXCEPTION- WHEN 
*                *OP=C* SPECIFIED, INTERPRETED AS *APN*). 
*                            1-20 ALPHANUMERIC CHARACTERS.
*                            (** - SEE FOOTNOTE.) 
* 
*         APN =  ADD OR ACTIVATE PROJECT NUMBER.
*                PROJECT NUMBER MUST BE INACTIVE OR NOT EXIST.
*                (EXCEPTION- WHEN *OP=C* SPECIFIED, PROJECT 
*                NUMBER MUST NOT EXIST).
*                            1-20 ALPHANUMERIC CHARACTERS.
*                            (** - SEE FOOTNOTE.) 
* 
*         DPN =  DEACTIVATE PROJECT NUMBER. 
*                PROJECT NUMBER MUST BE ACTIVE. 
*                NOTE- REFORMAT RUNS (*OP=R*) PURGE ALL DEACTIVATED 
*                PROJECT NUMBER ENTRIES.
*                (EXCEPTION- NOT LEGAL WHEN *OP=C* SPECIFIED).
*                            1-20 ALPHANUMERIC CHARACTERS.
*                            (** - SEE FOOTNOTE.) 
* 
*         MU =   MASTER USER NAME WHICH HAS THE ABILITY TO INQUIRE OR 
*                UPDATE DATA WITHIN THE CHARGE NUMBER RECORD.  THE
*                MASTER USER NAME HAS IMPLIED PERMISSION TO USE ANY OF
*                THE PROJECT NUMBERS DEFINED FOR THAT CHARGE NUMBER. A
*                NULL VALUE CLEARS A MASTER USER NAME DEFINED FOR THE 
*                CHARGE NUMBER. 
*                            1-7 ALPHANUMERIC CHARACTERS. 
*                            NULL VALUE CLEARS MASTER USER NAME.
*                            1 ENTRY PER CHARGE NUMBER RECORD.
* 
*         M1 =   INDEX FOR THE SRU MULTIPLIER TO WEIGHT CALCULATED
*                SYSTEM RESOUCES USED AGAINST THOSE NOT DIRECTLY
*                MEASURABLE FOR THIS CHARGE NUMBER. 
*                            1-2 NUMERIC DIGITS + RADIX.
*                            MAXIMUM VALUE OF 77B GIVES SYSTEM DEFAULT. 
*                            1 ENTRY PER CHARGE NUMBER RECORD.
* 
*         M2 =   INDEX FOR THE SRU MULTIPLIER TO WEIGHT INPUT/OUTPUT
*                USAGE FOR THIS CHARGE NUMBER.
*                            1-2 NUMERIC DIGITS + RADIX.
*                            MAXIMUM VALUE OF 77B GIVES SYSTEM DEFAULT. 
*                            1 ENTRY PER CHARGE NUMBER RECORD.
* 
*         M3 =   INDEX FOR THE SRU MULTIPLIER TO WEIGHT CENTRAL MEMORY
*                FIELD LENGTH USAGE FOR THIS CHARGE NUMBER. 
*                            1-2 NUMERIC DIGITS + RADIX.
*                            MAXIMUM VALUE OF 77B GIVES SYSTEM DEFAULT. 
*                            1 ENTRY PER CHARGE NUMBER RECORD.
* 
*         M4 =   INDEX FOR THE SRU MULTIPLIER TO WEIGHT EXTENDED CORE 
*                FIELD LENGTH USAGE FOR THIS CHARGE NUMBER. 
*                            1-2 NUMERIC DIGITS + RADIX.
*                            MAXIMUM VALUE OF 77B GIVES SYSTEM DEFAULT. 
*                            1 ENTRY PER CHARGE NUMBER RECORD.
* 
*         AD =   INDEX FOR THE SRU CONSTANT TO CHARGE FOR RESOURCES 
*                NOT DIRECTLY MEASURABLE BY THE SYSTEM FOR THIS 
*                CHARGE NUMBER. 
*                            1-2 NUMERIC DIGITS + RADIX.
*                            MAXIMUM VALUE OF 77B GIVES SYSTEM DEFAULT. 
*                            1 ENTRY PER CHARGE NUMBER RECORD.
* 
*         PCL =  PROJECT COUNT LIMIT. 
*                MAXIMUM NUMBER OF ACTIVE PROJECTS ALLOWED AT ANY 
*                ONE TIME FOR THIS CHARGE NUMBER. 
*                            MAY NOT BE LESS THAN CURRENT ACTIVE PROJECT
*                            COUNT- UNLESS VALUE SPECIFIED IS ZERO. 
*                            ZERO (DEFAULT) IMPLIES NO RESTRICTION. 
*                            (*** - SEE FOOTNOTE.)
* 
*         CEX =  CHARGE NUMBER EXPIRATION DATE. 
*                DATE AFTER WHICH THE VALIDATED USER CAN NOT USE
*                THIS CHARGE NUMBER.
*                            6 NUMERIC DIGITS IN FORM- YYMMDD 
*                            WHERE YY=YEAR, MM=MONTH, DD=DAY. 
*                            ZERO (DEFAULT) IMPLIES NO RESTRICTION. 
* 
*         ISL =  INDEX FOR DEFAULT VALUE OF *SIL*.
*                            1-2 NUMERIC DIGITS + RADIX. MAXIMUM
*                            VALUE OF 77B (DEFAULT) IMPLIES UNLIMITED.
* 
*         IR1 =  INDEX FOR DEFAULT VALUE OF *LR1*.
*                            1-2 NUMERIC DIGITS + RADIX. MAXIMUM
*                            VALUE OF 77B (DEFAULT) IMPLIES UNLIMITED.
* 
*         IR2 =  INDEX FOR DEFAULT VALUE OF *LR2*.
*                            1-2 NUMERIC DIGITS + RADIX. MAXIMUM
*                            VALUE OF 77B (DEFAULT) IMPLIES UNLIMITED.
* 
*         IR3 =  INDEX FOR DEFAULT VALUE OF *LR3*.
*                            1-2 NUMERIC DIGITS + RADIX. MAXIMUM
*                            VALUE OF 77B (DEFAULT) IMPLIES UNLIMITED.
* 
*         IR4 =  INDEX FOR DEFAULT VALUE OF *LR4*.
*                            1-2 NUMERIC DIGITS + RADIX. MAXIMUM
*                            VALUE OF 77B (DEFAULT) IMPLIES UNLIMITED.
* 
*         IR5 =  INDEX FOR DEFAULT VALUE OF *LR5*.
*                            1-2 NUMERIC DIGITS + RADIX. MAXIMUM
*                            VALUE OF 77B (DEFAULT) IMPLIES UNLIMITED.
* 
*         IR6 =  INDEX FOR DEFAULT VALUE OF *LR6*.
*                            1-2 NUMERIC DIGITS + RADIX. MAXIMUM
*                            VALUE OF 77B (DEFAULT) IMPLIES UNLIMITED.
* 
*         IR7 =  INDEX FOR DEFAULT VALUE OF *IR7*.
*                            1-2 NUMERIC DIGITS + RADIX. MAXIMUM
*                            VALUE OF 77B (DEFAULT) IMPLIES UNLIMITED.
* 
*         IR8 =  INDEX FOR DEFAULT VALUE OF *LR8*.
*                            1-2 NUMERIC DIGITS + RADIX. MAXIMUM
*                            VALUE OF 77B (DEFAULT) IMPLIES UNLIMITED.
* 
*         PEX =  PROJECT NUMBER EXPIRATION DATE.
*                DATE AFTER WHICH THE VALIDATED USER CAN NOT USE
*                THIS PROJECT NUMBER. 
*                            6 NUMERIC DIGITS IN FORM- YYMMDD 
*                            WHERE YY=YEAR, MM=MONTH, DD=DAY. 
*                            ZERO (DEFAULT) IMPLIES NO RESTRICTION. 
*                            (** - SEE FOOTNOTE.) 
* 
*         TI =   TIME BEFORE WHICH THE VALIDATED USER CAN NOT USE 
*                THIS PROJECT NUMBER. 
*                            4 NUMERIC DIGITS + RADIX.  AFTER 
*                            CONVERSION TO DECIMAL NUMBER, TIME 
*                            IS IN FORM HHMM WHERE HH = HOURS 
*                            (0-24D) AND MM = MINUTES (0-59). 
*                            MAXIMUM VALUE IS 2400D.
*                            IF *TI* VALUE EQUALS *TO* VALUE, 
*                            IMPLIES NO RESTRICTION (DEFAULT = 0).
*                            (** - SEE FOOTNOTE.) 
* 
*         TO =   TIME AFTER  WHICH THE VALIDATED USER CAN NOT USE 
*                THIS PROJECT NUMBER. 
*                            4 NUMERIC DIGITS + RADIX.  AFTER 
*                            CONVERSION TO DECIMAL NUMBER, TIME 
*                            IS IN FORM HHMM WHERE HH = HOURS 
*                            (0-24D) AND MM = MINUTES (0-59). 
*                            MAXIMUM VALUE IS 2400D.
*                            IF *TI* VALUE EQUALS *TO* VALUE, 
*                            IMPLIES NO RESTRICTION (DEFAULT = 0).
*                            (** - SEE FOOTNOTE.) 
* 
*         PFN =  PROJECT PROLOGUE FILE NAME.  IDENTIFIES THE PROJECT
*                PROLOGUE FILE TO EXECUTE AT THE BEGINNING OF THE 
*                ACCOUNT BLOCK WHEN THE PROJECT NUMBER IS VALIDATED.
*                THE PROJECT PROLOGUE IS EXECUTED BY FILE NAME AND MAY
*                BE A *CCL* PROCEDURE OR A BINARY PROGRAM.  A NULL
*                VALUE CLEARS A DEFINED PROJECT PROLOGUE FILE NAME. 
*                            1-7 ALPHANUMERIC CHARACTER FILE NAME.
*                            DEFAULT VALUE OF NULL = NO PROJECT 
*                            PROLOGUE REQUIRED. 
*                            1 ENTRY PER PROJECT NUMBER.
* 
*         PUN =  PROJECT PROLOGUE USER NAME.  IDENTIFIES THE USER NAME
*                ON WHICH THE PROJECT PROLOGUE FILE IS CATALOGED.  IF 
*                A PROJECT PROLOGUE FILE IS DEFINED BUT THE PROJECT 
*                PROLOGUE USER NAME IS NOT, THE PROJECT PROLOGUE IS 
*                ACCESSED FROM USER-S CATALOG.  A NULL VALUE CLEARS A 
*                DEFINED PROJECT PROLOGUE USER NAME.
*                            1-7 ALPHANUMERIC CHARACTER USER NAME.
*                            DEFAULT VALUE OF NULL = FILE WILL BE 
*                            ACCESSED FROM USER-S CATALOG.
*                            1 ENTRY PER PROJECT NUMBER.
* 
*         PPW =  PROJECT PROLOGUE PASSWORD.  IDENTIFIES THE PERMANENT 
*                FILE PASSWORD TO BE USED TO ACCESS THE PROJECT 
*                PROLOGUE FILE.  IF NULL, NO PASSWORD WILL BE USED.  A
*                NULL VALUE CLEARS A DEFINED PROJECT PROLOGUE PASSWORD. 
*                            1-7 ALPHANUMERIC CHARACTER PASSWORD. 
*                            DEFAULT VALUE OF NULL = NO PASSWORD
*                            REQUIRED TO ACCESS FILE. 
*                            1 ENTRY PER PROJECT NUMBER.
* 
*         PCR =  PROLOGUE CHARGE REQUIRED OPTION.  DEFINES UNDER WHAT 
*                CONDITIONS CHARGE REQUIRED WILL BE SET ON TERMINATION
*                OF THE PROJECT PROLOGUE. 
*                OPTION = NULL - DO NOT SET CHARGE REQUIRED.
*                       = *A*  - SET CHARGE REQUIRED ON ABORT.
*                       = *U*  - UNCONDITIONALLY SET CHARGE REQUIRED. 
*                            0-1 CHARACTER OPTION (NULL, *A*, *U*). 
*                            DEFAULT VALUE IS NULL. 
*                            1 ENTRY PER PROJECT NUMBER.
* 
*         EFN =  PROJECT EPILOGUE FILE NAME.  IDENTIFIES THE PROJECT
*                EPILOGUE FILE TO EXECUTE AT THE END OF THE ACCOUNT 
*                BLOCK WHEN THE PROJECT NUMBER IS USED.  THE PROJECT
*                EPILOGUE IS EXECUTED BY FILE NAME AND MAY BE A *CCL* 
*                PROCEDURE OR A BINARY PROGRAM.  A NULL VALUE CLEARS A
*                DEFINED PROJECT EPILOGUE FILE NAME.
*                            1-7 ALPHANUMERIC FILE NAME.
*                            DEFAULT VALUE OF NULL = NO PROJECT 
*                            EPILOGUE REQUIRED. 
*                            1 ENTRY PER PROJECT NUMBER.
* 
*         EUN =  PROJECT EPILOGUE USER NAME.  IDENTIFIES THE USER NAME
*                ON WHICH THE PROJECT EPILOGUE FILE IS CATALOGED.  IF 
*                A PROJECT EPILOGUE FILE IS DEFINED BUT THE PROJECT 
*                EPILOGUE USER NAME IS NOT, THE PROJECT EPILOGUE IS 
*                ACCESSED FROM USER-S CATALOG.  A NULL VALUE CLEARS A 
*                DEFINED PROJECT EPILOGUE USER NAME.
*                            1-7 ALPHANUMERIC CHARACTER USER NAME.
*                            DEFAULT VALUE OF NULL = FILE WILL BE 
*                            ACCESSED FROM USER-S CATALOG.
*                            1 ENTRY PER PROJECT NUMBER.
* 
*         EPW =  PROJECT EPILOGUE PASSWORD.  IDENTIFIES THE PERMANENT 
*                FILE PASSWORD TO BE USED TO ACCESS THE PROJECT 
*                EPILOGUE FILE.  IF NULL, NO PASSWORD WILL BE USED.  A
*                NULL VALUE CLEARS A DEFINED PROJECT EPILOGUE PASSWORD. 
*                            1-7 ALPHANUMERIC CHARACTER PASSWORD. 
*                            DEFAULT VALUE OF NULL = NO PASSWORD
*                            REQUIRED TO ACCESS FILE. 
*                            1 ENTRY PER PROJECT NUMBER.
* 
*         ISV =  INDEX FOR SRU VALIDATION LIMIT.
*                            1-2 NUMERIC DIGITS + RADIX. MAY NOT
*                            BE GREATER THAN *ISL* VALUE. MAXIMUM 
*                            VALUE OF 77B (DEFAULT) IMPLIES UNLIMITED.
*                            (** - SEE FOOTNOTE.) 
* 
*         THE FOLLOWING 20 DIRECTIVES CORRESPOND TO 10 PAIRS OF 
*         *REGISTERS*- EACH PAIR BEING A LIMIT REGISTER AND ACCUMULATOR 
*         AND CORRESPONDING TO USAGE OF A RESOURCE. ONLY THE FIRST
*         2 PAIRS ARE DEFINED (NAMELY, ACCUMULATED SRUS) AND UPDATED
*         BY THE SYSTEM. THE MEANING OF THE REMAINING 8 PAIRS, AND
*         THEIR APPROPRIATE UPDATE BY THE SYSTEM, MUST BE PROVIDED
*         BY THE INSTALLATION (DEFAULT FOR ALL ACCUMULATORS = 0). 
* 
*         SML =  SRU MASTER USER LIMIT REGISTER.
*                TOTAL NUMBER OF SRUS THE PROJECT CAN USE AS SET
*                BY THE MASTER USER.
*                            MAY NOT BE GREATER THAN *SIL* VALUE
*                            (UNLESS *SIL* VALUE = 0).
*                            ZERO (DEFAULT) IMPLIES NO RESTRICTION. 
*                            (** - SEE FOOTNOTE.) 
*                            (*** - SEE FOOTNOTE.)
* 
*         SMA =  SRU MASTER USER ACCUMULATOR. 
*                            (** - SEE FOOTNOTE.) 
*                            (*** - SEE FOOTNOTE.)
* 
*         SIL =  SRU INSTALLATION LIMIT REGISTER. 
*                TOTAL NUMBER OF SRUS THE PROJECT CAN USE AS SET
*                BY THE INSTALLATION. 
*                            ZERO IMPLIES NO RESTRICTION. 
*                            (*** - SEE FOOTNOTE.)
* 
*         SIA =  SRU INSTALLATION ACCUMULATOR.
*                            (*** - SEE FOOTNOTE.)
* 
*         LR1 =  INSTALLATION LIMIT REGISTER 1. 
*                            ZERO IMPLIES NO RESTRICTION. 
*                            (*** - SEE FOOTNOTE.)
* 
*         AR1 =  INSTALLATION ACCUMULATOR 1.
*                            (*** - SEE FOOTNOTE.)
* 
*         LR2 =  INSTALLATION LIMIT REGISTER 2. 
*                            ZERO IMPLIES NO RESTRICTION. 
*                            (*** - SEE FOOTNOTE.)
* 
*         AR2 =  INSTALLATION ACCUMULATOR 2.
*                            (*** - SEE FOOTNOTE.)
* 
*         LR3 =  INSTALLATION LIMIT REGISTER 3. 
*                            ZERO IMPLIES NO RESTRICTION. 
*                            (*** - SEE FOOTNOTE.)
* 
*         AR3 =  INSTALLATION ACCUMULATOR 3.
*                            (*** - SEE FOOTNOTE.)
* 
*         LR4 =  INSTALLATION LIMIT REGISTER 4. 
*                            ZERO IMPLIES NO RESTRICTION. 
*                            (*** - SEE FOOTNOTE.)
* 
*         AR4 =  INSTALLATION ACCUMULATOR 4.
*                            (*** - SEE FOOTNOTE.)
* 
*         LR5 =  INSTALLATION LIMIT REGISTER 5. 
*                            ZERO IMPLIES NO RESTRICTION. 
*                            (*** - SEE FOOTNOTE.)
* 
*         AR5 =  INSTALLATION ACCUMULATOR 5.
*                            (*** - SEE FOOTNOTE.)
* 
*         LR6 =  INSTALLATION LIMIT REGISTER 6. 
*                            ZERO IMPLIES NO RESTRICTION. 
*                            (*** - SEE FOOTNOTE.)
* 
*         AR6 =  INSTALLATION ACCUMULATOR 6.
*                            (*** - SEE FOOTNOTE.)
* 
*         LR7 =  INSTALLATION LIMIT REGISTER 7. 
*                            ZERO IMPLIES NO RESTRICTION. 
*                            (*** - SEE FOOTNOTE.)
* 
*         AR7 =  INSTALLATION ACCUMULATOR 7.
*                            (*** - SEE FOOTNOTE.)
* 
*         LR8 =  INSTALLATION LIMIT REGISTER 8. 
*                            ZERO IMPLIES NO RESTRICTION. 
*                            (*** - SEE FOOTNOTE.)
* 
*         AR8 =  INSTALLATION ACCUMULATOR 8.
*                            (*** - SEE FOOTNOTE.)
* 
*         AUN =  ADD USER NAME. 
*                THIS USER NAME IS ADDED TO LIST OF USER NAMES
*                VALIDATED TO USE THIS PROJECT NUMBER. IF NO LIST IS
*                SPECIFIED FOR A PROJECT, ALL USER NAMES ARE
*                VALIDATED TO USE IT. 
*                NOTE- THE MASTER USER IS IMPLICITLY A VALIDATED USER.
*                            1-7 ALPHANUMERIC CHARACTERS. 
*                            (** - SEE FOOTNOTE.) 
* 
*         DUN =  DELETE USER NAME.
*                THIS USER NAME IS DELETED FROM LIST OF USER NAMES
*                VALIDATED TO USE THIS PROJECT. 
*                (EXCEPTION- NOT LEGAL WHEN *OP=C* SPECIFIED).
*                            1-7 ALPHANUMERIC CHARACTERS. 
*                            (** - SEE FOOTNOTE.) 
* 
*         ALL DIRECTIVES MAY BE ISSUED FROM SYSTEM ORIGIN OR
*         FROM ANY JOB ORIGIN BY SPECIAL ACCOUNTING USERS.
* 
*         FOOTNOTE ** - THESE DIRECTIVES MAY BE ISSUED FROM ANY 
*                       JOB ORIGIN BY THE MASTER USER OF THE
*                       SPECIFIED CHARGE NUMBER.
* 
*         FOOTNOTE *** - THESE DIRECTIVES PERMIT THE CURRENT FIELD
*                        VALUE TO BE INCREMENTED OR DECREMENTED BY
*                        THE INPUT VALUE BY PLACING A *+* OR *-*, 
*                        RESPECTIVELY, BEFORE THE VALUE. DECREMENTING 
*                        TO A NEGATIVE VALUE CAUSES ZERO TO BE USED.
*                        ABSENCE OF A *+* OR *-* CAUSES THE INPUT 
*                        VALUE TO REPLACE THE CURRENT FIELD VALUE.
          SPACE  4
***       DAYFILE MESSAGES. 
* 
*         * ERROR IN PROFILE ARGUMENTS.* - ERROR ON COMMAND.
* 
*         * PROFILE ABORTED.* - ERROR FLAG SET AT CONTROL POINT.
* 
*         * DIRECTIVE ERRORS.* - INTERROGATE OUTPUT FILE FOR REASON 
*          ERROR OCURRED. 
* 
*         * FM NOT LEGAL FAMILY.* - INCORRECT FAMILY NAME SPECIFIED 
*          WITH *FM* PARAMETER. 
* 
*         * FAST-ATTACH ALTERNATE FILE NOT ALLOWED.* - FILE SPECIFIED 
*          BY THE *P* OPTION CANNOT BE A FAST-ATTACH FILE.
* 
*         * FAST-ATTACH PROFILE FILE INCORRECT.* - PROJECT FILE CANNOT
*          BE IN FAST-ATTACH STATUS ON A REFORMAT RUN.
* 
*         * MASTER USER NAME REQUIRED.* - USER NAME THAT IS MASTER
*          USER FOR THE SPECIFIED CHARGE NUMBER ENTRIES MUST BE 
*          PRESENT IN CONTROL POINT AREA (SET VIA USER COMMAND) 
*          FOR A MASTER USER LIST AND FOR AN INQUIRE FROM 
*          OTHER THAN SYSTEM ORIGIN OR SPECIAL ACCOUNTING USER. 
* 
*         * PROFILE FILE DATA BASE ERROR.* - PROJECT FILE DOES NOT
*          CONTAIN BOTH A LEVEL-0 AND A LEVEL-1 BLOCK.
* 
*         * PROFILE FILE CREATE COMPLETE.* - CREATION RUN COMPLETE. 
* 
*         * PROFILE FILE UPDATE COMPLETE.* - UPDATE RUN COMPLETE. 
* 
*         * PROFILE FILE INQUIRY COMPLETE.* - INQUIRE RUN COMPLETE. 
* 
*         * PROFILE FILE REFORMAT COMPLETE.* - REFORMAT RUN COMPLETE. 
* 
*         * PROFILE FILE SOURCE COMPLETE.* - SOURCE RUN COMPLETE. 
* 
*         * PROFILE FILE LIST COMPLETE.* - LIST RUN COMPLETE. 
* 
*         * DATA BASE ERROR   N - NOTIFY ANALYST.* - AN ERROR WHICH 
*          SHOULD NEVER NORMALLY OCCUR HAS BEEN DETECTED. 
*          FOLLOWING ARE THE POSSIBLE VALUES OF *N* - 
*          N =  1, BAD TABLE 2 POINTER - ROUTINE *PDE*. 
*            =  2, BAD OVERFLOW BLOCK POINTER - ROUTINE *PRF*.
*            =  3, NEGATIVE PROJECT COUNT - ROUTINE *UPC*.
*            =  4, BAD QUEUE POINTER - ROUTINE *MQE*. 
*            =  5, BAD LEVEL 0 OR 1 BLOCK - ROUTINE *RCE*.
*            =  6, EXISTING CHARGE NUMBER NOT FOUND - ROUTINE *RCE*.
*            =  7, EXISTING CHARGE NUMBER NOT FOUND - ROUTINE *CNP*.
*            =  8, EXISTING PROJECT NUMBER NOT FOUND - ROUTINE *PNP*. 
*            =  9, INCORRECT K-DISPLAY UPDATE - ROUTINE *CKU*.
*            = 10, BAD LEVEL 0 OR 1 BLOCK - ROUTINE *CNP*.
*            = 11, EXISTING CHARGE NUMBER NOT FOUND - ROUTINE *CNP*.
*            = 13, EXISTING PROJECT NUMBER NOT FOUND - ROUTINE *PNP*. 
*            = 14, BAD LEVEL-3 BLOCK - ROUTINE *PDE*. 
*            = 15, BAD LEVEL-3 BLOCK - ROUTINE *PDE*. 
*            = 16, BAD TABLE 3 LENGTH - ROUTINE *WOB*.
*            = 17, BAD TABLE 3 POINTER - ROUTINE *WOB*. 
*            = 18, BAD TABLE 3 POINTER - ROUTINE *WOB*. 
*            = 19, BAD LEVEL-3 BLOCK - ROUTINE *ADB*. 
*            = 20, BAD LEVEL-3 BLOCK - ROUTINE *ADB*. 
*            = 21, BAD LEVEL-3 BLOCK - ROUTINE *ADB*. 
*            = 22, BAD LEVEL-3 BLOCK - ROUTINE *CEP*. 
*            = 23, BAD RANDOM ADDRESS - ROUTINE *RDB*.
*            = 24, INCORRECT FIELD SIZE - ROUTINE *GFV*.
*            = 25, BAD LEVEL-3 BLOCK - ROUTINE *RDB*. 
*            = 26, BAD QUEUE POINTER - ROUTINE *DQP*. 
*            = 27, NEGATIVE USER NAME COUNT - ROUTINE *DUN*.
*            = 30, BAD LEVEL-0 BLOCK - ROUTINE *PRF*. 
*            = 31, BAD USER NAME POINTER - ROUTINE *NUE*. 
*            = 32, BAD USER NAME POINTER - ROUTINE *NUE*. 
*            = 33, BAD OVERFLOW BLOCK - ROUTINE *NUE*.
*            = 34, BAD LEVEL 0 OR 1 BLOCK - ROUTINE *PIO*.
*            = 38, BAD LEVEL 0 OR 1 BLOCK - ROUTINE *CND*.
*            = 39, BAD LEVEL-2 BLOCK - ROUTINE *PEI*. 
*            = 40, BAD LEVEL-0 BLOCK - ROUTINE *PCS*. 
*            = 41, BAD LEVEL-0 BLOCK - ROUTINE *PLO*. 
*            = 42, BAD TABLE 3 LENGTH - ROUTINE *FUH*.
*            = 43, BAD TABLE 3 POINTER - ROUTINE *FHP*. 
*            = 45, BAD LEVEL 0 OR 1 BLOCK - ROUTINE *DQP*.
          SPACE  4
***       ERROR MESSAGES TO OUTPUT FILE.
* 
*         $ **** INCORRECT DIRECTIVE.$ - UNRECOGIZABLE IDENTIFIER 
*          ISSUED, IDENTIFIER AND VALUE NOT SEPARATED BY *=*, 
*          DIRECTIVES SEPARATED BY *=*, *DCN*, *DPN*, OR *DUN*
*          DIRECTIVE ISSUED WHEN *OP=C* SPECIFIED.
* 
*         $ **** TOO MANY CHARACTERS IN VALUE.$ - DIRECTIVE,S 
*          VALUE CONSISTS OF TOO MANY CHARACTERS. 
* 
*         $ **** DIRECTIVE NOT AUTHORIZED.$ - USER,S ACCESS 
*          CLASSIFICATION IS INSUFFICIENT TO ISSUE THIS DIRECTIVE.
*          USER MUST EITHER BE A SPECIAL ACCOUNTING USER OR FROM
*          SYSTEM ORIGIN. 
* 
*         $ **** CHARGE NUMBER ACTIVE.$ - *ACN* DIRECTIVE 
*          ISSUED TO AN ALREADY ACTIVE CHARGE NUMBER. 
* 
*         $ **** CHARGE NUMBER DOES NOT EXIST.$ - *CN* OR *DCN* 
*          DIRECTIVE ISSUED TO A NON-EXISTENT CHARGE NUMBER.
* 
*         $ **** CHARGE NUMBER INACTIVE.$ - *CN* OR *DCN* 
*          DIRECTIVE ISSUED TO AN ALREADY INACTIVE CHARGE NUMBER. 
* 
*         $ **** NOT MASTER USER.$ - REFERENCE MADE TO A CHARGE 
*          NUMBER FOR WHICH THE USER IS NOT THE MASTER USER, NOR
*          A SPECIAL ACCOUNTING USER, NOR FROM SYSTEM ORIGIN. 
* 
*         $ **** NO CHARGE NUMBER IN EFFECT.$ - DIRECTIVE ISSUED
*          WHICH REQUIRES A CHARGE NUMBER IN EFFECT.
* 
*         $ **** PROJECT NUMBER DOES NOT EXIST.$ - *PN* OR *DPN*
*          DIRECTIVE ISSUED TO A NON-EXISTENT PROJECT NUMBER. 
* 
*         $ **** PROJECT NUMBER ACTIVE.$ - *APN* DIRECTIVE
*          ISSUED TO AN ALREADY ACTIVE PROJECT NUMBER.
* 
*         $ **** INCORRECT VALUE.$ - DIRECTIVE-S VALUE CAN
*          NOT BE CONVERTED TO BINARY, IS TOO LARGE, TOO SMALL, 
*          OR DOES NOT VALIDATE AGAINST ANOTHER VALUE.
* 
*         $ **** NO PROJECT NUMBER IN EFFECT.$ - DIRECTIVE
*          ISSUED WHICH REQUIRES A PROJECT NUMBER IN EFFECT.
* 
*         $ **** PROJECT COUNT LIMIT EXCEEDED.$ - *APN* DIRECTIVE 
*          ISSUED WHICH WOULD EXCEED THE PROJECT COUNT LIMIT. 
* 
*         $ **** PROJECT NUMBER INACTIVE.$ - *PN* OR *DPN*
*          DIRECTIVE ISSUED TO AN ALREADY INACTIVE PROJECT NUMBER.
* 
*         $ **** MISSING VALUE.$ - NO VALUE SPECIFIED WITH DIRECTIVE. 
* 
*         $ **** DUPLICATE CHARGE NUMBER.$ - CHARGE NUMBER ALREADY
*          EXISTS WHEN *OP=C* SPECIFIED.
* 
*         $ **** DUPLICATE PROJECT NUMBER.$ - PROJECT NUMBER ALREADY
*          EXISTS WHEN *OP=C* SPECIFIED.
* 
*         $ **** DUPLICATE USER NAME.$ - USER NAME TO BE ADDED
*          IS ALREADY PRESENT IN THE SPECIFIED CHARGE AND PROJECT 
*          NUMBER ENTRY.
* 
*         $ **** DELETE NON-EXISTENT USER NAME.$ - USER NAME
*          TO BE DELETED FROM THE SPECIFIED CHARGE AND PROJECT
*          NUMBER ENTRY DOES NOT EXIST. 
* 
*         $ **** USER NAME LIMIT.$ - AN ATTEMPT WAS MADE TO 
*         VALIDATE MORE THAN 4095 USER NAMES FOR THE SPECIFIED
*         CHARGE AND PROJECT NUMBER ENTRY.
          TITLE  PROGRAM MACROS AND EQUIVALENCES. 
**        WRITH - WRITE *H* FORMAT CODED LINE.
* 
*         WRITH  FILE,BUF,N 
*         TRAILING SPACES ARE DELETED.
*         CALLS  WOL. 
  
  
 WRITH    MACRO  F,S,N
  R= B6,S 
  R= B7,N 
  R= X2,F 
  RJ WOL
  ENDM
          SPACE  4
*CALL     COMSACC 
*CALL     COMCMAC 
*CALL     COMCCMD 
*CALL     COMCDCM 
*CALL     COMCDCP 
*CALL     COMCMTM 
*CALL     COMSLFD 
*CALL     COMSPRD 
*CALL     COMSPFM 
*CALL     COMSSFS 
*CALL     COMSSRU 
          LIST   X
*CALL     COMSPRO 
          LIST   -X 
          SPACE  4
 TOPT     EQU    6           TIME-SHARING UPDATE OPTION 
 LOPT     EQU    7           LIST OPTION
 IBUFL    EQU    1001B       INPUT BUFFER LENGTH
 PBUFL    EQU    101B        PROFILO BUFFER LENGTH
 .CPB1    EQU    CNLC/3 
 .CMB1    EQU    CMLC/3 
 .PPB1    EQU    PNLC/3 
 .CPB2    EQU    CNLC-.CPB1 
 .CMB2    EQU    CMLC-.CMB1 
 .PPB2    EQU    PNLC-.PPB1 
 CPBP     EQU    .CPB2*CNWE  CHARGE NUMBER PARTIAL BLOCK LENGTH 
 CMBP     EQU    .CMB2*CMWE  CHARGE NO. + MASTER U.N. PARTIAL LENGTH
 PPBP     EQU    .PPB2*PNWE  PROJECT NUMBER PARTIAL BLOCK LENGTH
  
  
 OV       EQU    0           OVERLAY TYPE 
          TITLE  MANAGED TABLE AND DIRECT CELL INITIALIZATION.
 ORIG     EQU    DIRC 
  
          IDIRC  INITIALIZE DIRECT CELLS
  
          ITAB   CNWE,CMWE,PNWE,PMWE   INITIALIZE TABLES
 TFBL     SPACE  4
*         TABLE OF FULL BLOCK LENGTHS.
  
          ORG    TFBL 
          CON    CBLP 
          CON    CMLP 
          CON    PBLP 
 TPBL     SPACE  4
*         TABLE OF PARTIAL BLOCK LENGTHS. 
  
          ORG    TPBL 
          CON    CPBP 
          CON    CMBP 
          CON    PPBP 
 STAB     SPACE  4
*         TABLE OF COMPARE WORD COUNTS FOR SEARCH.
  
          ORG    STAB 
          CON    1
          CON    1
          CON    2
          CON    1
          SPACE  4
*         TABLE OF WORD COUNTS. 
  
          ORG    CTAB 
          CON    C.TAB0 
          CON    C.TAB1 
          CON    C.TAB2 
          CON    C.TAB3 
          SPACE  4
*         CONTROL WORDS.
  
          ORG    CWL0 
          VFD    12/0,12/0,12/CNWE,12/0,12/3
          VFD    12/1,12/0,12/CMWE,12/0,12/3
          VFD    12/2,12/0,12/PNWE,12/0,12/3
          SPACE  4
*         TABLE MEMORY LIMIT. 
  
          ORG    ML 
          CON    RFL= 
          SPACE  4
*         INITIAL K-DISPLAY MESSAGE BUFFERS.
  
          ORG    M1 
          CON    MESA+1 
          ORG    IL 
          CON    INPA+1 
          SPACE  4
**        LIST OPTIONS. 
  
  
 FSLO     EQU    0           FULL LIST
 PSLO     EQU    1           PROJECT NUMBER LIST
 CSLO     EQU    2           CHARGE NUMBER LIST 
 FMLO     EQU    3           MASTER USER FULL LIST
 PMLO     EQU    4           MASTER USER PROJECT NUMBER LIST
 CMLO     EQU    5           MASTER USER CHARGE NUMBER LIST 
          TITLE  PROGRAM CONSTANTS. 
**        FETS. 
  
          ORG    OVLA 
 I        BSS    0
 INPUT    FILEC  IBUF,IBUFL,EPR,(FET=8) 
 O        BSS    0
 OUTPUT   FILEC  OBUF,IBUFL,EPR,(FET=8) 
 N        BSS    0
 SCR1     RFILEB NBUF,PBUFL,EPR,(FET=13B),(PFN="PPFN"),(PWD="PPWD") 
 P        BSS    0
 SCR      RFILEB PBUF,PBUFL,EPR,(FET=16B),(PFN="PPFN"),(PWD="PPWD") 
 S        BSS    0
 SOURCE   FILEC  IBUF,IBUFL,(FET=8) 
          SPACE  4
**        TDIR - TABLE OF DIRECTIVES. 
* 
*         THIS TABLE DEFINES LEGAL NOS VERSION 2 DIRECTIVES.
*         EACH TABLE ENTRY HAS THE FOLLOWING FORMAT-
*                18/A, 18/B, 6/C, 6/D, 6/E, 6/F 
*                WHERE
*                A = DIRECTIVE KEYWORD IDENTIFIER.
*                B = ADDRESS OF MAXIMUM VALUE (0 IMPLIES INFINITE). 
*                C = FIELD,S UPPER BIT POSITION.
*                D = FIELD SIZE IN BITS.
*                E = FIELD,S ENTRY WORD INDEX.
*                F = TABLE INDEX. 
  
  
 TDIR     BSS    0
          LOC    0
 XMUN     INENT  MU,=0,59,42,CMUW,XMUN        *MU*
 XPND     INENT  PN,=0,,,,XPND                *PN*
 XAUN     INENT  AUN,=0,,,,XAUN               *AUN* 
 XIM1     INENT  M1,=77B,29,6,CSRW,XIM1       *M1*
 XIM2     INENT  M2,=77B,23,6,CSRW,XIM2       *M2*
 XIM3     INENT  M3,=77B,17,6,CSRW,XIM3       *M3*
 XIM4     INENT  M4,=77B,11,6,CSRW,XIM4       *M4*
 XIAD     INENT  AD,=77B,05,6,CSRW,XIAD       *AD*
 XTIN     INENT  TI,=2400,35,18,PTMW,XTIN     *TI*
 XTOF     INENT  TO,=2400,17,18,PTMW,XTOF     *TO*
 XPFN     INENT  PFN,=0,59,42,PPNW,XPFN       *PFN* 
 XPUN     INENT  PUN,=0,59,42,PPUW,XPUN       *PUN* 
 XPPW     INENT  PPW,=0,59,42,PPPW,XPPW       *PPW* 
 XPCR     INENT  PCR,=0,1,2,PPNW,XPCR         *PCR* 
 XEFN     INENT  EFN,=0,59,42,PENW,XEFN       *EFN* 
 XEUN     INENT  EUN,=0,59,42,PEUW,XEUN       *EUN* 
 XEPW     INENT  EPW,=0,59,42,PEPW,XEPW       *EPW* 
 XSML     INENT  SML,=0,59,30,PMSW,XSML       *SML* 
 XSMA     INENT  SMA,=0,29,30,PMSW,XSMA       *SMA* 
 XDCN     INENT  DCN,=0,,,,XDCN               *DCN* 
 XDPN     INENT  DPN,=0,,,,XDPN               *DPN* 
 XDUN     INENT  DUN,=0,,,,XDUN               *DUN* 
 XCND     INENT  CN,,,,,XCND                  *CN*
 XACN     INENT  ACN,=0,,,,XACN               *ACN* 
 XAPN     INENT  APN,=0,,,,XAPN               *APN* 
 XPCL     INENT  PCL,=0,53,12,CSRW,XPCL       *PCL* 
 XCEX     INENT  CEX,=0,41,18,CDTW,XCEX       *CEX* 
 XISL     INENT  ISL,=77B,59,6,CLCW,XISL      *ISL* 
 XIR1     INENT  IR1,=77B,53,6,CLCW,XIR1      *IR1* 
 XIR2     INENT  IR2,=77B,47,6,CLCW,XIR2      *IR2* 
 XIR3     INENT  IR3,=77B,41,6,CLCW,XIR3      *IR3* 
 XIR4     INENT  IR4,=77B,35,6,CLCW,XIR4      *IR4* 
 XIR5     INENT  IR5,=77B,29,6,CLCW,XIR5      *IR5* 
 XIR6     INENT  IR6,=77B,23,6,CLCW,XIR6      *IR6* 
 XIR7     INENT  IR7,=77B,17,6,CLCW,XIR7      *IR7* 
 XIR8     INENT  IR8,=77B,11,6,CLCW,XIR8      *IR8* 
 XPEX     INENT  PEX,=0,41,18,PCDW,XPEX       *PEX* 
 XISV     INENT  ISV,=77B,59,6,PCGW,XISV      *ISV* 
 XSIL     INENT  SIL,=0,59,30,PISW,XSIL       *SIL* 
 XSIA     INENT  SIA,=0,29,30,PISW,XSIA       *SIA* 
 XLR1     INENT  LR1,=0,59,30,PIRW+1-1,XLR1   *LR1* 
 XAR1     INENT  AR1,=0,29,30,PIRW+1-1,XAR1   *AR1* 
 XLR2     INENT  LR2,=0,59,30,PIRW+2-1,XLR2   *LR2* 
 XAR2     INENT  AR2,=0,29,30,PIRW+2-1,XAR2   *AR2* 
 XLR3     INENT  LR3,=0,59,30,PIRW+3-1,XLR3   *LR3* 
 XAR3     INENT  AR3,=0,29,30,PIRW+3-1,XAR3   *AR3* 
 XLR4     INENT  LR4,=0,59,30,PIRW+4-1,XLR4   *LR4* 
 XAR4     INENT  AR4,=0,29,30,PIRW+4-1,XAR4   *AR4* 
 XLR5     INENT  LR5,=0,59,30,PIRW+5-1,XLR5   *LR5* 
 XAR5     INENT  AR5,=0,29,30,PIRW+5-1,XAR5   *AR5* 
 XLR6     INENT  LR6,=0,59,30,PIRW+6-1,XLR6   *LR6* 
 XAR6     INENT  AR6,=0,29,30,PIRW+6-1,XAR6   *AR6* 
 XLR7     INENT  LR7,=0,59,30,PIRW+7-1,XLR7   *LR7* 
 XAR7     INENT  AR7,=0,29,30,PIRW+7-1,XAR7   *AR7* 
 XLR8     INENT  LR8,=0,59,30,PIRW+8-1,XLR8   *LR8* 
 XAR8     INENT  AR8,=0,29,30,PIRW+8-1,XAR8   *AR8* 
 TDIRL    CON    0           END OF TABLE 
          LOC    *O 
 XPAS     EQU    77B         *PASS* DIRECTIVE TABLE INDEX 
          ERRNG  77B-TDIRL   CHECK TABLE SIZE 
          SPACE  4,10 
**        TOPR - TABLE OF PROCESSING ROUTINES.
* 
*         TABLE ENTRIES MUST MATCH WITH TABLE *TDIR*. 
*         EACH TABLE ENTRY HAS THE FOLLOWING FORMAT-
*                6/A, 6/C, 6/D, 6/, 18/E, 18/F
*                WHERE
*                A = FLAGS - OF FORMAT 1/, 1/AB, 1/AC, 1/AD, 1/AE, 1/AF 
*                    AB = 1, IF SIGN ALLOWED ON VALUE.
*                    AC = 1, IF ASTERISK ALLOWED ON VALUE.
*                    AD = 1, IF FORCES UPDATE OF LEVEL-1. 
*                    AE = 1, IF FORCES UPDATE OF LEVEL-2. 
*                    AF = 1, IF FORCES UPDATE OF LEVEL-3. 
*                C = MAXIMUM ACCESS CLASSIFICATION ALLOWED. 
*                D = MAXIMUM NUMBER OF CHARACTERS ALLOWED IN VALUE. 
*                E = ADDRESS OF INPUT PROCESSOR.
*                F = ADDRESS OF QUEUE PROCESSOR.
  
  
 TOPR     BSS    0
          LOC    0
          VFD    6/14B,6/1,6/07,6/,18/UND,18/MDP1   *MU*
          VFD    6/10B,6/2,6/20,6/,18/PND,18/PNP    *PN*
          VFD    6/11B,6/2,6/07,6/,18/UND,18/AUP    *AUN* 
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *M1*
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *M2*
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *M3*
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *M4*
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *AD*
          VFD    6/01B,6/2,6/05,6/,18/TMD,18/MDP2   *TI*
          VFD    6/01B,6/2,6/05,6/,18/TMD,18/MDP2   *TO*
          VFD    6/01B,6/2,6/07,6/,18/PED,18/MDP2   *PFN* 
          VFD    6/11B,6/2,6/07,6/,18/PED,18/MDP2   *PUN* 
          VFD    6/11B,6/2,6/07,6/,18/PED,18/MDP2   *PPW* 
          VFD    6/01B,6/2,6/01,6/,18/PED,18/MDP2   *PCR* 
          VFD    6/01B,6/2,6/07,6/,18/PED,18/MDP2   *EFN* 
          VFD    6/11B,6/2,6/07,6/,18/PED,18/MDP2   *EUN* 
          VFD    6/11B,6/2,6/07,6/,18/PED,18/MDP2   *EPW* 
          VFD    6/21B,6/2,6/10,6/,18/CVD2,18/MDP2  *SML* 
          VFD    6/21B,6/2,6/10,6/,18/NUD,18/MDP2   *SMA* 
          VFD    6/14B,6/1,6/10,6/,18/CND,18/CNP    *DCN* 
          VFD    6/15B,6/2,6/20,6/,18/PND,18/PNP    *DPN* 
          VFD    6/11B,6/2,6/07,6/,18/UND,18/DUP    *DUN* 
          VFD    6/10B,6/2,6/10,6/,18/CND,18/CNP    *CN*
          VFD    6/14B,6/1,6/10,6/,18/CND,18/CNP    *ACN* 
          VFD    6/17B,6/2,6/20,6/,18/PND,18/PNP    *APN* 
          VFD    6/24B,6/1,6/10,6/,18/PCL,18/MDP1   *PCL* 
          VFD    6/04B,6/1,6/06,6/,18/DTD,18/MDP1   *CEX* 
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *ISL* 
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *IR1* 
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *IR2* 
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *IR3* 
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *IR4* 
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *IR5* 
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *IR6* 
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *IR7* 
          VFD    6/04B,6/1,6/03,6/,18/NUD,18/MDP1   *IR8* 
          VFD    6/01B,6/2,6/06,6/,18/DTD,18/MDP2   *PEX* 
          VFD    6/01B,6/2,6/03,6/,18/CVD1,18/MDP2  *ISV* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *SIL* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *SIA* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *LR1* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *AR1* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *LR2* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *AR2* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *LR3* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *AR3* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *LR4* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *AR4* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *LR5* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *AR5* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *LR6* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *AR6* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *LR7* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *AR7* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *LR8* 
          VFD    6/21B,6/1,6/10,6/,18/NUD,18/MDP2   *AR8* 
          LOC    *O 
          SPACE  4,10 
**        TSKD - TABLE OF SPECIAL K-DISPLAY DIRECTIVES. 
* 
*         EACH TABLE ENTRY HAS THE FOLLOWING FORMAT-
*                42/A, 18/B 
*                WHERE
*                A = DIRECTIVE IDENTIFIER.
*                B = UNIQUE NEGATIVE CODE VALUE.
  
  
 TSKD     BSS    0
          VFD    42/0LEND,18/-1 
          VFD    42/0LDROP,18/-2
          VFD    42/0LSTOP,18/-5
          VFD    42/1L+,18/-1R+ 
          VFD    42/1L-,18/-1R- 
          CON    0           END OF TABLE 
 TPCO     SPACE  4,5
**        TPCO - TABLE OF PROLOGUE CHARGE REQUIRED OPTIONS. 
* 
*         EACH TABLE ENTRY HAS THE FOLLOWING FORMAT - 
*T TPCO   6/OP, 54/0
*                WHERE
*                OP = PROLOGUE CHARGE REQUIRED OPTION.
  
  
 TPCO     BSS    0
          LOC    0
          CON    0           NULL 
          DATA   L*U*        UNCONDITIONAL
          DATA   L*A*        ABORT
          LOC    *O 
 TPCOL    EQU    *-TPCO      TABLE LENGTH 
          SPACE  4,10 
**        EQUIVALENCES. 
  
  
 CBUFL    EQU    3           CHARACTER BUFFER LENGTH
 CSAP     EQU    12          SPECIAL ACCOUNTING USER BIT POSITION 
 LBAS     EQU    0           LIMIT REGISTER BASE VALUE
 QINC     EQU    30          DIRECTIVE QUEUE INCREMENT VALUE
          SPACE  4,10 
**        COMMON LOCATIONS. 
  
  
 BS       BITCON ( )         BLANK SUPPRESSION
 CN       BSSZ   1           CHARGE NUMBER
 CV       CON    0           FILE CONVERSION INDICATOR
 FN       CON    -1          ALTERNATE FAMILY NAME
 LO       CON    1LF         LIST OPTION
 PI       CON    1           TERMINAL INPUT FILE FLAG 
 PN       BSSZ   2           PROJECT NUMBER 
 PO       CON    1           TERMINAL OUTPUT FILE FLAG
 UF       CON    0           UPDATE FLAG
 UN       BSS    1           USER NAME
 UNUM     BSS    1           ADD/DELETE USER NAME 
 ACCC     CON    2           ACCESS CLASSIFICATION
                             =0, SYSTEM ORIGIN. 
                             =1, SPECIAL ACCOUNTING USER. 
                             =2, ELSE.
 CBUF     BSSZ   CBUFL       CHARACTER BUFFER 
 DTII     BSS    1           INPUT PROCESSOR DIRECTIVE TABLE INDEX
 DTIQ     BSS    1           QUEUE PROCESSOR DIRECTIVE TABLE INDEX
 EBUF     BSS    4           *PFM* ERROR MESSAGE BUFFER 
 FCNP     CON    0           CHARGE NUMBER PRESENT FLAG 
 FDER     CON    0           DIRECTIVE ERROR MESSAGE FLAG 
 FLDV     BSS    1           FIELD,S VALUE
 FPNP     CON    0           PROJECT NUMBER PRESENT FLAG
 FUP1     CON    0           UPDATE LEVEL-1 FLAG
 FUP2     CON    0           UPDATE LEVEL-2 FLAG
 FUP3     CON    0           UPDATE LEVEL-3 FLAG
 KSAV     BSS    2           K-DISPLAY BUFFER HOLD LOCATIONS
 PGLC     CON    99999       LINE COUNT 
 LL       CON    0           LINE LIMIT 
          ERRNZ  LL-PGLC-1   LOCATIONS MUST BE CONTIGUOUS 
 PDEN     CON    0           PRINT DENSITY FORMAT EFFECTOR
 QMAX     CON    0           DIRECTIVE QUEUE MAXIMUM SIZE 
 QPTR     BSS    1           DIRECTIVE QUEUE ENTRY POINTER
 QSIZ     CON    0           DIRECTIVE QUEUE CURRENT SIZE 
 T1IE     BSS    1           TABLE 1 INDEX OF ENTRY 
 T2IE     BSS    1           TABLE 2 INDEX OF ENTRY 
 T3IE     BSS    1           TABLE 3 INDEX OF ENTRY 
          SPACE  4,10 
**        D1AA - DEFAULT LEVEL-1 ENTRY. 
  
  
 D1AA     BSS    0
          CON    0
          VFD    1/0,5/,12/0,12/0,6/77B,6/77B,6/77B,6/77B,6/77B 
          VFD    18/0,18/0,24/
          VFD   6/77B,6/77B,6/77B,6/77B,6/77B,6/77B,6/77B,6/77B,6/77B,6/
          VFD    42/0,18/0
          SPACE  4,10 
**        D3AA - DEFAULT LEVEL-3 ENTRY. 
* 
*         NOTE- ALSO USED AS A BUFFER AREA ON REFORMAT RUNS.
  
  
 D3AA     BSS    0
          VFD    12/3,12/0,12/0,6/,18/0 
          CON    0,0
          CON    0
          VFD    18/0,18/0,24/
          VFD    1/0,23/,18/0,18/0
          VFD    42/0,16/,2/0 
          VFD    42/0,18/ 
          VFD    42/0,18/ 
          VFD    42/0,18/ 
          VFD    42/0,18/ 
          VFD    42/0,18/ 
          VFD    6/77B,18/0,36/ 
          VFD    30/0,30/0
          VFD    24/0,18/0,18/0 
          VFD    30/,30/0 
          VFD    30/,30/0 
          VFD    30/,30/0 
          VFD    30/,30/0 
          VFD    30/,30/0 
          VFD    30/,30/0 
          VFD    30/,30/0 
          VFD    30/,30/0 
          VFD    30/,30/0 
          CON 
          DUP    NUNS,1 
          CON    1
          SPACE  4
*         SPECIAL SYSTEM JOB PARAMETER AREA.
  
*CALL     COMSSSJ 
  
 SSJ=     BSSZ   SSJL 
          TITLE  MAIN LOOP. 
 PRO      SA1    OP          PICK UP INPUT OPTION 
          SB2    X1+
          SA2    PROC        GET INPUT FILE READ FLAG 
          SA1    X1+TOFS
          LX2    B2 
          SB7    X1 
          SA5    PI 
          PL     X2,PRO0     IF INPUT FILE NOT USED 
          ZR     X5,PRO0     IF TERMINAL ACCESS 
          READ   I
 PRO0     RJ     SIN         JUMP TO FUNCTION PROCESSOR 
  
 PROX     BSS    0           RETURN FROM FUNCTION PROCESSOR 
          SA1    FDER 
          ZR     X1,PRO1     IF NO DIRECTIVE ERRORS 
          SB2    PROB        *DIRECTIVE ERRORS.*
 PRO1     MESSAGE B2,3,R
          RECALL N
          RETURN P
          RETURN N
          RJ     COB         CHECK OUTPUT FILE BUFFER 
          RJ     CAF         CHECK ALTERNATE FAMILY 
          ENDRUN
  
  
 PROB     DIS    ,* DIRECTIVE ERRORS.*
          SPACE  4,10 
**        INPUT FILE READ FLAGS, FLAG SET FOR OPTION IF INPUT FILE
*         TO BE READ. 
  
  
 PROC     BSS    0
          POS    60-COPT     CREATE 
          VFD    1/1
          POS    60-UOPT     UPDATE 
          VFD    1/1
          POS    60-TOPT     TIME-SHARING UPDATE
          VFD    1/1
          POS    0
 TOFS     SPACE  4
**        TOFS - TABLE OF FUNCTION PROCESSORS.
*                ORDER DEPENDENT ON TABLE *OPT*.
  
  
 TOFS     INDEX  CON,8,( )
          INDEX  ,KOPT,(/PUD/)     PROCESS K-DISPLAY INPUT
          INDEX  ,COPT,(/PID/)     PROCESS CREATE INPUT 
          INDEX  ,UOPT,(/PUD/)     PROCESS UPDATE INPUT 
          INDEX  ,ROPT,(/PRF/)     PROCESS REFORMAT 
          INDEX  ,SOPT,(/PCS/)     PROCESS CHANGE TO SOURCE 
          INDEX  ,IOPT,(/PIO/)     PROCESS INQUIRE
          INDEX  ,TOPT,(/PUD/)     PROCESS TIME-SHARING UPDATE
          INDEX  ,LOPT,(/PLO/)     PROCESS LIST OPTION
          TITLE  FUNCTION ROUTINES. 
 PCS      SPACE  4,10 
**        PCS - PROCESS CHANGE TO SOURCE OPTION.
* 
*         ONLY ACTIVE CHARGE/PROJECT NUMBERS ARE CONVERTED TO SOURCE. 
* 
*         EXIT   (B2) = MESSAGE ADDRESS.
* 
*         CALLS  ADB, CSC, CSP, PNA.
* 
*         USES   ALL REGISTERS. 
  
  
 PCS4     WRITER S
          SETFS  X2,0        SET ID CODE
          SB2    PCSA 
  
 PCS      SUBR               ENTRY/EXIT 
          SX6    B1 
          SA6    RA0+1
 PCS1     SA0    B0 
          SX0    N
          FUNC   PNAT        PICK NEXT ADDRESS - LEVEL-0
          ZR     X6,PCS4     IF END OF TABLE 0
          SX6    X3 
          ZR     X6,ERD40    IF NO LEVEL-1 CHAIN
          SA6    RA1+1
          BX6    X6-X6       EMPTY TABLE 1
          SA6    L.TAB1 
  
*         CONVERT CHARGE NUMBER TO SOURCE.
  
 PCS2     SA0    B1 
          SX0    N
          FUNC   PNAT        PICK NEXT ADDRESS - LEVEL-1
          ZR     X6,PCS1     IF END OF TABLE 1
          SA1    A3-C.TAB1+1+CSRW 
          NG     X1,PCS2     IF INACTIVE ENTRY
          SX6    X3 
          SA6    RA2+1
          SA5    A3-C.TAB1+1 CHARGE NUMBER
          BX6    X5 
          SA6    CN 
          SA1    F.TAB1      TABLE 1 INDEX OF ENTRY 
          SB2    X1 
          SX6    A5-B2
          SA6    T1IE 
          RJ     CSC         CHANGE TO SOURCE CHARGE ENTRY
          SA1    RA2+1
          ZR     X1,PCS2     IF NO LEVEL-2 CHAIN
          BX6    X6-X6       EMPTY TABLE 2
          SA6    L.TAB2 
  
*         CONVERT PROJECT NUMBER TO SOURCE. 
  
 PCS3     SA0    B1+B1
          SX0    N
          FUNC   PNAT        PICK NEXT ADDRESS - LEVEL-2
          ZR     X6,PCS2     IF END OF TABLE 2
          SX7    X3 
          SA1    A3-C.TAB2+1 PROJECT NUMBER 
          BX6    X1 
          SA6    PN 
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          SX0    N
          RJ     ADB         ADD DATA LEVEL BLOCK 
          SA1    A5+PTMW
          NG     X1,PCS3     IF INACTIVE ENTRY
          RJ     CSP         CHANGE TO SOURCE PROJECT ENTRY 
          EQ     PCS3        LOOP 
  
 PCSA     DATA   L* PROFILE FILE SOURCE COMPLETE. * 
 PID      SPACE  4,10 
**        PID - PROCESS INPUT DATA - CREATE OPTION. 
* 
*         EXIT   (B2) = MESSAGE ADDRESS.
* 
*         CALLS  BLD, DIP, PUD. 
* 
*         USES   ALL REGISTERS. 
  
  
 PID      SUBR               ENTRY/EXIT 
          RJ     DIP         DIRECTIVE INPUT PROCESSOR
          SX5    P
          BX0    X0-X0
          FUNC   BLDT        BUILD DIRECTORY
          SA1    TV 
          ZR     X1,PID1     IF NO OVERFLOW 
          BX6    X6-X6       CLEAR OVERFLOW 
          SA6    A1 
          RECALL P
          RJ     PUD         PROCESS REMAINING INPUT AS UPDATE RUN
 PID1     SB2    PIDA 
          EQ     PIDX 
  
 PIDA     DATA   L* PROFILE FILE CREATE COMPLETE. * 
 PIO      SPACE  4,10 
**        PIO - PROCESS INQUIRE OPTION. 
* 
*         EXIT   (B2) = MESSAGE ADDRESS.
* 
*         EXIT   TO ABM, IF DIRECTIVE ERROR ENCOUNTERED.
*                TO ERD34, IF DATA BASE ERROR ENCOUNTERED.
* 
*         CALLS  ABD, ADB, CIO=, OCE, OPE, PEI, PNO, SPB, VMU, WTH=.
* 
*         USES   ALL REGISTERS. 
  
  
 PIO      SUBR               ENTRY/EXIT 
          SA1    CN 
          ZR     X1,PIO1     IF INPUT FILE TO BE PROCESSED
          SX6    B1+
          SA6    PIOA 
          EQ     PIO5        PROCESS COMMAND INQUIRE
  
 PIO1     SA1    PI 
          ZR     X1,PIO3     IF TERMINAL INPUT
          READ   I
          SB2    TIDR 
          RJ     ABD         ASSEMBLE DIRECTIVE IDENTIFIER
          LT     B5,PIO11    IF EOF ENCOUNTERED 
          GT     B5,PIO2     IF */* ENCOUNTERED 
          SB3    ERUA        **** INCORRECT DIRECTIVE 
          NE     B4,ABM      IF NOT *CN* DIRECTIVE
 PIO2     BX6    X6-X6       CLEAR CHARGE AND PROJECT NUMBERS 
          SA6    PN 
          SA6    A6+B1
          SA1    PI 
          SA6    CN 
          ZR     X1,PIO3     IF TERMINAL INPUT
          SA1    ET 
          NG     X1,PIO11    IF EOF ENCOUNTERED 
          EQ     PIO4        ASSEMBLE CHARGE NUMBER 
  
 PIO3     WRITEH O,PIOC,2    *ENTER CHARGE NUMBER*
          READ   I
  
*         ASSEMBLE CHARGE NUMBER AND SET PRIMARY BLOCK. 
  
 PIO4     SB2    -10
          RJ     ABD         ASSEMBLE CHARGE NUMBER 
          LT     B5,PIO11    IF EOF ENCOUNTERED ON TERMINAL 
          SA1    CBUF 
          BX6    X1 
          SA6    CN 
 PIO5     SX1    CN 
          SX0    N
          FUNC   SPBT        SET PRIMARY BLOCK
          NZ     X6,ERD34    IF DATA BASE ERROR 
          SB3    ERUE        **** CHARGE NUMBER DOES NOT EXIST
          NZ     X4,ABM      IF ENTRY NOT FOUND 
          SA0    X3 
          RJ     VMU         VALIDATE MASTER USER 
          SB3    ERUG        **** NOT MASTER USER 
          NZ     X1,ABM      IF VALIDATION FAILED 
          SA1    PIOA 
          ZR     X1,PIO7     IF INPUT FILE PROCESSING 
          SA1    PN 
          NZ     X1,PIO10    IF PROJECT ENTRY INQUIRE 
 PIO6     SA1    PN 
          NZ     X1,PIO2     IF PROJECT ENTRY INQUIRE ALREADY PROCESSED 
  
*         PROCESS CHARGE ENTRY INQUIRE. 
  
          SX3    A0 
          RJ     OCE         OUTPUT CHARGE ENTRY
          SA1    SL 
          SX6    X1 
          SA6    RA2+1
          RJ     PNO         PROJECT NUMBER LIST TO OUTPUT
          SA1    PIOA 
          NZ     X1,PIO11    IF COMMAND INQUIRE PARAMETERS
          EQ     PIO2        PROCESS NEXT REQUEST 
  
 PIO7     SA1    PI 
          ZR     X1,PIO8     IF TERMINAL INPUT
          SB2    TIDR 
          RJ     ABD         ASSEMBLE DIRECTIVE IDENTIFIER
          LT     B5,PIO6     IF EOF ENCOUNTERED 
          GT     B5,PIO6     IF */* ENCOUNTERED 
          EQ     B4,PIO6     IF *CN* DIRECTIVE
          EQ     PIO9        *PN* DIRECTIVE 
  
 PIO8     WRITEH O,PIOD,2    *ENTER PROJECT NUMBER* 
          READ   I
  
*         ASSEMBLE PROJECT NUMBER.
  
 PIO9     SB2    -20
          RJ     ABD         ASSEMBLE PROJECT NUMBER
          LT     B5,PIO6     IF EOF ENCOUNTERED ON TERMINAL 
          SA1    CBUF 
          SA2    A1+1 
          BX6    X1 
          LX7    X2 
          SA6    PN 
          SA7    A6+1 
  
*         ADD DATA BLOCK AND PROCESS PROJECT ENTRY INQUIRE. 
  
 PIO10    RJ     PEI         PROJECT ENTRY INITIALIZATION 
          SB3    ERUI        **** PROJECT NUMBER DOES NOT EXIST 
          NZ     X4,ABM      IF PROJECT NOT FOUND 
          SX7    X5 
          RJ     OPE         OUTPUT PROJECT ENTRY 
          SA1    PIOA 
          ZR     X1,PIO7     IF INPUT FILE PROCESSING 
 PIO11    SB2    PIOB 
          EQ     PIOX        RETURN 
  
  
 PIOA     CON    0           COMMAND/INPUT FILE INDICATOR 
  
 PIOB     DATA   L* PROFILE FILE INQUIRY COMPLETE.* 
  
 PIOC     DIS    2,ENTER CHARGE NUMBER
  
 PIOD     DIS    2,ENTER PROJECT NUMBER 
  
  
 TIDR     BSS    0           TABLE OF INQUIRE DIRECTIVES
          LOC    0
          CON    2LCN 
          CON    2LPN 
          CON    0
          LOC    *O 
 PLO      SPACE  4,10 
**        PLO - PROCESS LIST OPTION.
* 
*         EXIT   (B2) = MESSAGE ADDRESS.
*                TO *ABT*, IF NO CHARGE ENTRIES PROCESSED.
* 
*         CALLS  ADB, CDD, HDR, OCE, OPE, PNA, PNO, SFN, WOL. 
* 
*         USES   ALL REGISTERS. 
  
  
 PLO7     SA1    PLOA        CHECK NUMBER OF CHARGE ENTRIES LISTED
          SX2    =C* MASTER USER NAME REQUIRED.*
          SB4    X1 
          LE     B4,B1,ABT   IF NO CHARGE ENTRIES PROCESSED 
          SB2    PLOB        * PROFILE FILE LIST COMPLETE.* 
  
 PLO      SUBR               ENTRY/EXIT 
          SX6    B1 
          SA6    RA0+1
 PLO1     SA0    B0 
          SX0    N
          FUNC   PNAT        PICK NEXT ADDRESS - LEVEL-0
          ZR     X6,PLO7     IF END OF TABLE 0
          SX6    X3 
          ZR     X6,ERD41    IF NO LEVEL-1 CHAIN
          SA6    RA1+1
          BX6    X6-X6       EMPTY TABLE 1
          SA6    L.TAB1 
  
 PLO2     SA0    B1 
          SX0    N
          FUNC   PNAT        PICK NEXT ADDRESS - LEVEL-1
          ZR     X6,PLO1     IF END OF TABLE 1
          SX6    X3 
          SA6    RA2+1
          SA5    LO 
          SX1    X5-FMLO
          NG     X1,PLO3     IF NOT MASTER USER LIST
          SA1    A3-C.TAB1+1+CMUW 
          MX2    42 
          BX1    X1*X2
          SA2    UN 
          BX2    X1-X2
          NZ     X2,PLO2     IF USER NOT MASTER USER
 PLO3     SA0    A3-C.TAB1+1 FWA OF ENTRY 
          SA1    A0          CHARGE NUMBER
          BX6    X1 
          SA6    CN 
          RJ     SFN         SPACE FILL NAME
          SA6    OUTB+1 
          SA1    PLOA        CHARGE NUMBER COUNTER
          SX6    X1+B1       INCREMENT COUNTER
          SA6    A1 
          RJ     CDD         DECIMAL DISPLAY CODE CONVERSION
          LX6    12          INSERT *.* 
          MX1    -12
          BX6    X1*X6
          SX2    2R.
          BX6    X2+X6
          SA6    OUTB 
          SB2    B1+B1       PRESET WORD COUNT TO WRITE 
          SX2    X5-FMLO
          PL     X2,PLO4     IF MASTER USER LIST
          SX2    X5-FSLO
          ZR     X2,PLO4     IF FULL LIST 
          SA1    A0+CMUW
          MX2    42 
          BX6    X1*X2
          ZR     X6,PLO4     IF NO MASTER USER PRESENT
          SA6    OUTB+3      DISPLAY MASTER USER NAME 
          SA1    =1H
          BX6    X1 
          SA6    A6-B1
          SB2    4
 PLO4     WRITH  O,OUTB,B2
          SX2    X5-CSLO
          ZR     X2,PLO2     IF CHARGE NUMBER LIST
          SX2    X5-CMLO
          ZR     X2,PLO2     IF MASTER USER CHARGE NUMBER LIST
          SX2    X5-FSLO
          ZR     X2,PLO5     IF FULL LIST 
          SX2    X5-FMLO
          ZR     X2,PLO5     IF MASTER USER FULL LIST 
          RJ     PNO         PROJECT NUMBER LIST TO OUTPUT
          EQ     PLO2        LOOP 
  
 PLO5     SX3    A0 
          RJ     OCE         OUTPUT CHARGE ENTRY
          SA1    RA2+1
          ZR     X1,PLO2     IF NO LEVEL-2 CHAIN
          BX6    X6-X6       EMPTY TABLE 2
          SA6    L.TAB2 
  
 PLO6     SA0    B1+B1
          SX0    N
          FUNC   PNAT        PICK NEXT ADDRESS - LEVEL-2
          ZR     X6,PLO2     IF END OF TABLE 2
          SX7    X3 
          SA1    A3-C.TAB2+1 PROJECT NUMBER 
          BX6    X1 
          SA6    PN 
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          RJ     OPE         OUTPUT PROJECT ENTRY 
          EQ     PLO6        LOOP 
  
 PLOA     CON    1           CHARGE NUMBER COUNTER
 PLOB     DATA   L* PROFILE FILE LIST COMPLETE.*
 PRF      SPACE  4,10 
**        PRF - PROCESS REFORMAT OPTION.
* 
*         INACTIVE CHARGE/PROJECT NUMBERS ARE PURGED. 
* 
*         EXIT   (B2) = MESSAGE ADDRESS.
* 
*         CALLS  ADB, FUH, MVE, NUE, PDE, PNA, PNE, RBA, STB, WDL, WTB. 
* 
*         USES   ALL REGISTERS. 
  
  
 PRF      SUBR               ENTRY/EXIT 
          SX6    B1 
          SA6    RA0+1
 PRF1     SA0    B0 
          SX0    N
          FUNC   PNAT        PICK NEXT ADDRESS - LEVEL-0
          ZR     X6,PRF11    IF END OF TABLE 0
          SX6    X3 
          ZR     X6,ERD30    IF NO LEVEL-1 CHAIN
          SA6    RA1+1
  
 PRF2     SA0    B1 
          SX0    N
          SX5    P
          FUNC   PNET        PICK NEXT ENTRY - LEVEL-1
          ZR     X6,PRF1     IF END OF TABLE 1
          SA1    A3-C.TAB1+1+CSRW 
          PL     X1,PRF3     IF ACTIVE CHARGE NUMBER
          BX6    X6-X6       CLEAR INACTIVE CHARGE NUMBER ENTRY 
          SA6    A3-C.TAB1+1
          EQ     PRF2        LOOP 
  
 PRF3     SX6    X3 
          ZR     X6,PRF2     IF NO LEVEL-2 CHAIN
          SA6    RA2+1
          SA1    F.TAB1      SAVE TABLE 1 INDEX OF ENTRY
          SX2    A3-C.TAB1+1
          IX6    X2-X1
          SA6    T1IE 
          SA3    X2          CHARGE NUMBER
          BX6    X3 
          SA6    CN 
          BX6    X6-X6       EMPTY TABLE 2
          SA6    L.TAB2 
  
 PRF4     SA0    B1+B1
          SX0    N
          SX5    P
          FUNC   PNET        PICK NEXT ENTRY - LEVEL-2
          ZR     X6,PRF10    IF END OF TABLE 2
          SX7    X3 
          SA1    F.TAB2      SAVE TABLE 2 INDEX OF ENTRY
          SX2    A3-C.TAB2+1
          IX6    X2-X1
          SA6    T2IE 
          BX6    X6-X6       CLEAR LINK WORD OF ENTRY 
          SA6    A3 
          SA3    X2          PROJECT NUMBER 
          BX6    X3 
          SA6    PN 
          SA3    A3+B1
          BX6    X3 
          SA6    A6+B1
          SX0    N
          RJ     ADB         ADD DATA LEVEL BLOCK 
          SA1    A5+PTMW
          PL     X1,PRF5     IF ACTIVE PROJECT NUMBER 
          SA1    F.TAB2      CLEAR INACTIVE PROJECT NUMBER ENTRY
          SA2    T2IE 
          IX1    X1+X2
          BX6    X6-X6
          SA6    X1 
          EQ     PRF4        LOOP 
  
 PRF5     MOVE   C.TAB3,A5,D3AA  SAVE PROJECT ENTRY 
          SA1    D3AA        CLEAR ENTRY,S WORD POINTER 
          MX2    12 
          LX2    -12
          BX6    -X2*X1 
          SA6    A1 
          SA5    T2IE 
          SX0    P
          RJ     PDE         PROCESS DATA LEVEL ENTRY 
          MOVE   C.TAB3,D3AA,X0 
          SX1    B1          READ IN ALL OVERFLOW BLOCKS
 PRF6     RJ     NUE         NEXT USER NAME ENTRY 
          NZ     B2,PRF7     IF END OF LEVEL-3 CHAIN
          SX1    X1 
          ZR     X1,PRF6     IF NOT END OF LIST 
 PRF7     SA1    F.TAB3 
          RJ     FUH         FILL USER NAME HOLES 
          SA2    T3IE        CLEAR ALL LEVEL-3 LINKS
          IX2    X1+X2
          SA2    X2 
          MX3    42          FIRST LEVEL-3 BLOCK
          BX6    X3*X2
          SA6    A2 
          SB2    X1          OVERFLOW BLOCKS
          SA4    L.TAB3 
          SB3    X4+B2
 PRF8     SB2    B2+PRUS
          EQ     B2,B3,PRF9  IF THRU ALL OVERFLOW BLOCKS
          GT     B2,B3,ERD2  IF ERROR 
          SA4    B2 
          BX6    X4*X3
          SA6    A4 
          EQ     PRF8        LOOP 
  
 PRF9     SX6    B1          FORCE WRITE OF TABLE 3 
          SA6    FUP3 
          RJ     WDL         WRITE DATA LEVEL 
          EQ     PRF4        LOOP 
  
 PRF10    SA0    B1+B1
          FUNC   STBT        SORT TABLE 2 
          SX5    P
          FUNC   RBAT        RESET BLOCK ADDRESSES - LEVEL-2
          SA1    T1IE        LEVEL-2 RANDOM ADDRESS 
          SA2    F.TAB1 
          IX1    X1+X2
          SA3    X1+C.TAB1-1
          MX4    42 
          BX4    X4*X3
          BX6    X4+X6
          SA6    A3 
          EQ     PRF2        LOOP 
  
 PRF11    SA6    RA0+1       CLEAR LINK 
          SA6    L.TAB0      EMPTY TABLE 0
          SX6    B1          INDICATE LEVEL-1 BUILD 
          SA6    CZ 
          SA0    B1 
          FUNC   STBT        SORT TABLE 1 
          SX5    P
          FUNC   RBAT        RESET BLOCK ADDRESSES - LEVEL-1
          SA0    B0 
          FUNC   STBT        SORT TABLE 0 
          BX0    X0-X0
          SX5    P
          FUNC   WTBT        WRITE TABLE 0
          PURGE  N,,,,,IP 
          CHANGE P,,(N+CFPN),,,,,,,IP 
          SB2    PRFA 
          EQ     PRFX 
  
 PRFA     DATA   L* PROFILE FILE REFORMAT COMPLETE.*
 PUD      SPACE  4
**        PUD - PROCESS UPDATE DATA.
* 
*         EXIT   (B2) = MESSAGE ADDRESS.
* 
*         CALLS  DIP, WOL.
* 
*         USES   ALL REGISTERS. 
  
  
 PUD      SUBR               ENTRY/EXIT 
          SX6    B1          SET UPDATE INDICATOR 
          SA6    UF 
          SA2    OP 
          SX3    X2-KOPT
          ZR     X3,PUD2     IF K-DISPLAY 
          SX3    X2-COPT
          ZR     X3,PUD2     IF CREATE OVERFLOW 
          SX2    X2-TOPT
          SX6    UOPT 
          SA6    A2 
          SA1    PI 
          NZ     X1,PUD2     IF NOT INTERACTIVE/INPUT 
          ZR     X2,PUD2     IF *T* OPTION
          SB2    PUDL1       PRESET 
          SA1    ACCC 
          SX1    X1-2 
          PL     X1,PUD1     IF RESTRICTED DIRECTIVE LIST 
          SB2    PUDL2
 PUD1     WRITH  O,PUDB,B2
          WRITH  O,PUDC,PUDL3 
 PUD2     RJ     DIP         DIRECTIVE INPUT PROCESSOR
          BX6    X6-X6       CLEAR DISPLAYS 
          SA6    DSA+1
          SB2    PUDA 
          EQ     PUDX 
  
 PUDA     DATA   L* PROFILE FILE UPDATE COMPLETE. * 
  
*         THE FOLLOWING IS OUTPUTTED FOR TERMINAL JOBS HAVING *OP=U*. 
  
 PUDB     BSS    0
          DIS    ,* THE FOLLOWING ARE VALID INPUT DIRECTIVES FOR* 
          DIS    ,* UPDATE-*
          DIS    ,*    CN OR /  -  CHARGE NUMBER.*
          DIS    ,*    PN   -  PROJECT NUMBER.* 
          DIS    ,*    APN  -  ADD OR ACTIVATE PROJECT NUMBER.* 
          DIS    ,*    DPN  -  DEACTIVATE PROJECT NUMBER.*
          DIS    ,*    PEX  -  PROJECT NUMBER EXPIRATION DATE.* 
          DIS    ,*    TI   -  TIME IN.*
          DIS    ,*    TO   -  TIME OFF.* 
          DIS    ,*    PFN  -  PROLOGUE FILE NAME.* 
          DIS    ,*    PUN  -  PROLOGUE USER NAME.* 
          DIS    ,*    PPW  -  PROLOGUE PASSWORD.*
          DIS    ,*    PCR  -  PROLOGUE CHARGE REQUIRED OPTION.*
          DIS    ,*            NULL - CHARGE REQUIRED NOT SET.* 
          DIS    ,*            U    - UNCONDITIONAL.* 
          DIS    ,*            A    - ON ABORT.*
          DIS    ,*    EFN  -  EPILOGUE FILE NAME.* 
          DIS    ,*    EUN  -  EPILOGUE USER NAME.* 
          DIS    ,*    EPW  -  EPILOGUE PASSWORD.*
          DIS    ,*    ISV  -  SRU VALIDATION LIMIT INDEX.* 
          DIS    ,*    SML  -  SRU MASTER USER LIMIT.*
          DIS    ,*    SMA  -  SRU MASTER USER ACCUMULATOR.*
          DIS    ,*    AUN  -  ADD USER NAME.*
          DIS    ,*    DUN  -  DELETE USER NAME.* 
 PUDL1    EQU    *-PUDB 
          DIS    ,*    ACN  -  ADD OR ACTIVATE CHARGE NUMBER.*
          DIS    ,*    DCN  -  DEACTIVATE CHARGE NUMBER.* 
          DIS    ,*    MU   -  MASTER USER NAME.* 
          DIS    ,*    PCL  -  PROJECT COUNT LIMIT.*
          DIS    ,*    M1  - M4  -  SRU MULTIPLIER INDICES.*
          DIS    ,*    AD   -  SRU CONSTANT INDEX.* 
          DIS    ,*    CEX  -  CHARGE NUMBER EXPIRATION DATE.*
          DIS    ,*    ISL  -  INSTALLATION SRU LIMIT INDEX.* 
          DIS    ,*    IR1 - IR8  -  INSTALLATION LIMIT INDICES.* 
          DIS    ,*    SIL  -  SRU INSTALLATION LIMIT.* 
          DIS    ,*    SIA  -  SRU INSTALLATION ACCUMULATOR.* 
          DIS    ,*    LR1 - LR8  -  INSTALLATION LIMIT REGISTERS.* 
          DIS    ,*    AR1 - AR8  -  INSTALLATION ACCUMULATORS.*
 PUDL2    EQU    *-PUDB 
  
 PUDC     DATA   L* A NULL LINE COMPLETES DIRECTIVE INPUT PROCESSING. * 
          CON    0           BLANK LINE 
 PUDL3    EQU    *-PUDC 
          TITLE  LIST/INQUIRE SUBROUTINES.
 CEO      SPACE  4,10 
 ABD      SPACE  4,10 
**        ABD - ASSEMBLE DIRECTIVE OR DATA. 
* 
*         ASSEMBLES AND VERIFIES DIRECTIVE IDENTIFIERS, OR ASSEMBLES
*         AND VERIFIES DATA.
* 
*         ENTRY  (B2) = DIRECTIVE TABLE ADDRESS, IF DIRECTIVE ASSEMBLY. 
*                (B2) = NEGATIVE OF MAXIMUM NUMBER OF  CHARACTERS,
*                       IF DATA ASSEMBLY. 
* 
*         EXIT   (B5) .LT. 0, IF EOF ENCOUNTERED. 
*                (B5) = 0, IF ASSEMBLY COMPLETE.
*                (B5) .GT. 0, IF */* ENCOUNTERED (DIRECTIVE ASSEMBLY).
*                (B4) = INDEX OF ENTRY IN TABLE OF DIRECTIVES,
*                       IF DIRECTIVE ASSEMBLY.
*                TO ABM, IF ERROR.
*                       (B3) = ERROR MESSAGE ADDRESS. 
* 
*         USES   A - 1, 2, 3, 4, 6. 
*                B - 2, 3, 4, 5.
*                X - 1, 2, 3, 4, 6. 
* 
*         CALLS  ACI. 
  
  
 ABD4     SA4    CBUF 
          ZR     B6,ABDX     IF ENTRY TERMINATION 
          ZR     X4,ABD1     IF NO CHARACTERS ASSEMBLED 
          NZ     B2,ABM      IF INCORRECT SEPARATOR 
          SB5    B0 
          SB4    -B1
 ABD5     SB4    B4+B1
          SA1    X3+B4
          ZR     X1,ABM      IF DIRECTIVE NOT FOUND 
          BX1    X1-X4
          NZ     X1,ABD5     IF NO MATCH
  
 ABD      SUBR               ENTRY/EXIT 
          SX6    B2+
          SA6    ABDA 
 ABD1     SA1    ABDB        ALLOW ASTERISK SPECIAL CHARACTER 
          RJ     ACI         ASSEMBLE CHARACTERS INTERFACE
          SB3    ERUA        **** INCORRECT DIRECTIVE 
          SA3    ABDA 
          SA2    PI 
          SA1    ET 
          SB2    B5-1R= 
          SB5    X1+
          PL     X3,ABD4     IF DIRECTIVE ASSEMBLY
          NZ     X2,ABD2     IF NOT TERMINAL INPUT
          NZ     B6,ABD3     IF NOT ENTRY TERMINATION 
          NG     X1,ABDX     IF EOF ENCOUNTERED 
          EQ     ABM         ERROR - */* ENCOUNTERED
  
 ABD2     ZR     B6,ABM      IF INCORRECT ENTRY TERMINATION 
 ABD3     SX3    X3-1 
          ZR     B2,ABM      IF INCORRECT SEPARATOR 
          IX4    X4+X3
          SB5    B0 
          SB3    ERUB        **** TOO MANY CHARACTERS IN VALUE
          PL     X4,ABM      IF DATA TOO LONG 
          EQ     ABDX        RETURN 
  
  
 ABDA     CON    0           HOLD FOR ENTRY CONDITION 
 ABDB     BITCON (*)
 CEO      SPACE  4,10 
**        CEO - CHARGE ENTRY TO OUTPUT ASSEMBLY AREA. 
*         ASSEMBLY AREA OUTPUTTED A LINE AT A TIME (7 WORDS PER LINE).
  
  
 CEO      BSS    0
          DATA   L*             CONTROLS FOR CHARGE NUMBER *
 CEOB     BSS    1
 CEOL1    EQU    *-CEO
 CEZP     BSS    0
          DATA   1H 
          DATA   L*    CREATION DATE   *
 CEOC     BSS    1
          DATA   L*    EXPIRATION DATE *
 CEOD     BSS    1
          DATA   1H 
          DATA   L*    ENTRY *
 CEOE     BSS    1           *ACTIVE* OR *INACTIVE* 
          DATA   1H 
          DATA   L*    PROJECT COUNT = *
 CEOF     BSS    1
          DATA   1H 
          DATA   L*    MU  = *
 CEOG     BSS    1
          DATA   1H 
          DATA   L*    PCL = *
 CEOH     DIS    2, 
          DATA   1H 
          DATA   L*    ISL = *
 CEOS     BSS    1
          BSS    1           SIL DEFAULT VALUE
          DATA   L*    IR1 = *
 CEOU     BSS    1
          BSS    1           LR1 DEFAULT VALUE
          DATA   1H 
          DATA   L*    IR2 = *
 CEOW     BSS    1
          BSS    1           LR2 DEFAULT VALUE
          DATA   L*    IR3 = *
 CEOY     BSS    1
          BSS    1           LR3 DEFAULT VALUE
          DATA   1H 
          DATA   L*    IR4 = *
 CEZB     BSS    1
          BSS    1           LR4 DEFAULT VALUE
          DATA   L*    IR5 = *
 CEZD     BSS    1
          BSS    1           LR5 DEFAULT VALUE
          DATA   1H 
          DATA   L*    IR6 = *
 CEZF     BSS    1
          BSS    1           LR6 DEFAULT VALUE
          DATA   L*    IR7 = *
 CEZH     BSS    1
          BSS    1           LR7 DEFAULT VALUE
          DATA   1H 
          DATA   L*    IR8 = *
 CEZJ     BSS    1
          BSS    1           LR8 DEFAULT VALUE
          DIS    3, 
 CEOL2    EQU    *
          DATA   1H 
          DATA   L*    M1  = *
 CEZK     BSS    1
          BSS    1           SRU MULTIPLIER 1 
          DATA   L*    M2  = *
 CEZL     BSS    1
          BSS    1           SRU MULTIPLIER 2 
          DATA   1H 
          DATA   L*    M3  = *
 CEZM     BSS    1
          BSS    1           SRU MULTIPLIER 3 
          DATA   L*    M4  = *
 CEZN     BSS    1
          BSS    1           SRU MULTIPLIER 4 
          DATA   1H 
          DATA   L*    AD  = *
 CEZO     BSS    1
          BSS    1           SRU CONSTANT 
          DIS    3, 
 CEOL3    EQU    *
 OCE      SPACE  4,10 
**        OCE - OUTPUT CHARGE ENTRY.
* 
*         ENTRY  (X3) = FWA OF CHARGE ENTRY.
*                (CN) = CHARGE NUMBER.
*                (ACCC) .LT. 2, IF NO DISPLAY OF VALUES *M1* THRU *AD*. 
* 
*         CALLS  CPV, SFC, SFN, WOL.
* 
*         USES   ALL REGISTERS EXCEPT A0. 
  
  
 OCE1     WRITH  O,X5,7      OUTPUT LINE
          SX5    X5+7 
          BX1    X0-X5
          NZ     X1,OCE1     IF NOT THRU CHARGE ASSEMBLY AREA 
          WRITH  O,=0,B1     BLANK LINE 
  
 OCE      SUBR               ENTRY/EXIT 
          SA1    F.TAB1      TABLE 1 INDEX OF ENTRY 
          IX6    X3-X1
          SA6    T1IE 
          RJ     SFC         CHARGE ENTRY SPECIAL FIELDS
          SA1    CN          CHARGE NUMBER
          RJ     SFN         SPACE FILL NAME
          SA6    CEOB 
          SA5    TOIA 
          RJ     CPV         CONVERT AND PLACE VALUES 
          WRITH  O,CEO,CEOL1
          WRITH  O,=0,B1     BLANK LINE 
          SX5    CEZP        FWA OF CHARGE ASSEMBLY AREA
          SX0    CEOL2       PRESET 
          SA1    ACCC 
          SX1    X1-2 
          PL     X1,OCE1     IF RESTRICTED DISPLAY
          SX0    CEOL3
          EQ     OCE1 
 OPE      SPACE  4,10 
**        OPE - OUTPUT PROJECT ENTRY. 
* 
*         ENTRY  (X7) = RANDOM ADDRESS OF FIRST LEVEL-3 BLOCK.
*                (PN - PN+1) = PROJECT NUMBER.
* 
*         USES   A - 1, 5, 6. 
*                X - 0, 1, 5, 6.
* 
*         CALLS  ADB, CPV, OUN, SFN, SFP. 
* 
*         MACROS WRITH. 
  
  
 OPE      SUBR               ENTRY/EXIT 
          SX0    N
          RJ     ADB         ADD DATA LEVEL BLOCK 
          RJ     SFP         PROJECT ENTRY SPECIAL FIELDS 
          SA1    PN          PROJECT NUMBER 
          RJ     SFN         SPACE FILL NAME
          SA6    PEOA 
          SA1    A1+B1
          RJ     SFN         SPACE FILL NAME
          SA6    A6+B1
          SA5    TOID 
          RJ     CPV         CONVERT AND PLACE VALUES 
          WRITH  O,PEO,PEOL1
          WRITH  O,=0,B1     BLANK LINE 
          SX5    PEZG        FWA OF PROJECT ASSEMBLY AREA 
 OPE1     WRITH  O,X5,7      OUTPUT LINE
          SX5    X5+7 
          SX1    X5-PEOL2 
          NZ     X1,OPE1     IF NOT THRU PROJECT ASSEMBLY AREA
          WRITH  O,=0,B1     BLANK LINE 
          RJ     OUN         OUTPUT USER NAMES
          EQ     OPEX 
 OUN      SPACE  4,10 
**        OUN - OUTPUT USER NAMES VALIDATED FOR PROJECT.
* 
*         USES   A - 1, 2, 5, 6, 7. 
*                B - 3, 4.
*                X - 1, 2, 5, 6, 7. 
* 
*         CALLS  SFN, SUN.
* 
*         MACROS WRITH. 
  
  
 OUN      SUBR               ENTRY/EXIT 
          RJ     SUN         SORT USER NAMES
          ZR     X6,OUN4     IF NO USER NAMES 
          SA1    PEOA        WRITE USER NAME HEADER LINE
          SA2    A1+B1
          BX6    X1 
          SA6    OUNC 
          LX7    X2 
          SA7    A6+B1
          WRITH  O,OUNB,OUNBL 
          SA1    =1H
          SA5    F.TAB3 
          BX6    X1 
          SA6    OUTB 
 OUN1     SB3    B0+
          SB4    5
 OUN2     SA1    X5          GET NEXT USER NAME 
          SX5    X5+B1
          RJ     SFN         SPACE FILL USER NAME 
          SA1    L.TAB3 
          SX7    X1-1 
          SB3    B3+B1
          SA7    A1 
          SA6    OUTB+B3
          ZR     X7,OUN3     IF END OF USER NAMES 
          LT     B3,B4,OUN2  IF NOT FULL LINE 
 OUN3     WRITH  X2,OUTB,B3+B1  WRITE USER NAME LINE
          SA1    L.TAB3 
          NZ     X1,OUN1     IF MORE USER NAMES 
 OUN4     WRITH  O,=0,B1     WRITE BLANK LINE 
          EQ     OUNX        RETURN 
  
  
 OUNB     DATA   40H              USER NAMES VALID TO USE 
 OUNC     BSS    2
 OUNBL    EQU    *-OUNB 
 PEO      SPACE  4,10 
**        PEO - PROJECT ENTRY TO OUTPUT ASSEMBLY AREA.
*         ASSEMBLY AREA OUTPUTTED A LINE AT A TIME (7 WORDS PER LINE).
  
  
 PEO      BSS    0
          DATA   L*            CONTROLS FOR PROJECT NUMBER *
 PEOA     BSS    2
 PEOL1    EQU    *-PEO
 PEZG     BSS    0
          DATA   1H 
          DATA   L*    CREATION DATE   *
 PEOB     BSS    1
          DATA   L*    LAST CHANGE DATE*
 PEOC     BSS    1
          DATA   1H 
          DATA   L*    LAST UPDATE DATE*
 PEOD     BSS    1
          DATA   L*    LAST UPDATE TIME*
 PEOE     BSS    1
          DATA   1H 
          DATA   L*    ENTRY *
 PEOF     BSS    1           *ACTIVE* OR *INACTIVE* 
          DATA   1H 
          DATA   L*    EXPIRATION DATE *
 PEOG     BSS    1
          DATA   1H 
          DATA   L*    TI  = *
 PEOH     BSS    1
          DATA   1H 
          DATA   L*    TO  = *
 PEOI     DIS    2, 
          DATA   1H 
          DATA   L*    PFN = *
 PEZH     BSS    1
          DATA   1H 
          DATA   L*    EFN = *
 PEZI     DIS    2, 
          DATA   1H 
          DATA   L*    PUN = *
 PEZJ     BSS    1
          DATA   1H 
          DATA   L*    EUN = *
 PEZK     DIS    2, 
          DATA   1H 
          DATA   L*    PPW = *
 PEZL     BSS    1
          DATA   1H 
          DATA   L*    EPW = *
 PEZM     DIS    2, 
          DATA   1H 
          DATA   L*    PCR = *
 PEZN     BSS    1
          DATA   1H 
          DATA   L*    ISV = *
 PEOJ     DIS    2, 
          DATA   1H 
          DATA   L*    SML = *
 PEOL     BSS    1
          DATA   1H 
          DATA   L*    SMA = *
 PEOM     DIS    2, 
          DATA   1H 
          DATA   L*    SIL = *
 PEON     BSS    1
          DATA   1H 
          DATA   L*    SIA = *
 PEOO     DIS    2, 
          DATA   1H 
          DATA   L*    LR1 = *
 PEOP     BSS    1
          DATA   1H 
          DATA   L*    AR1 = *
 PEOQ     DIS    2, 
          DATA   1H 
          DATA   L*    LR2 = *
 PEOR     BSS    1
          DATA   1H 
          DATA   L*    AR2 = *
 PEOS     DIS    2, 
          DATA   1H 
          DATA   L*    LR3 = *
 PEOT     BSS    1
          DATA   1H 
          DATA   L*    AR3 = *
 PEOU     DIS    2, 
          DATA   1H 
          DATA   L*    LR4 = *
 PEOV     BSS    1
          DATA   1H 
          DATA   L*    AR4 = *
 PEOW     DIS    2, 
          DATA   1H 
          DATA   L*    LR5 = *
 PEOX     BSS    1
          DATA   1H 
          DATA   L*    AR5 = *
 PEOY     DIS    2, 
          DATA   1H 
          DATA   L*    LR6 = *
 PEZA     BSS    1
          DATA   1H 
          DATA   L*    AR6 = *
 PEZB     DIS    2, 
          DATA   1H 
          DATA   L*    LR7 = *
 PEZC     BSS    1
          DATA   1H 
          DATA   L*    AR7 = *
 PEZD     DIS    2, 
          DATA   1H 
          DATA   L*    LR8 = *
 PEZE     BSS    1
          DATA   1H 
          DATA   L*    AR8 = *
 PEZF     DIS    2, 
 PEOL2    EQU    *
 PNO      SPACE  4,10 
**        PNO - PROJECT NUMBER LIST TO OUTPUT.
* 
*         ENTRY  (RA2+1) = LEVEL-2 RANDOM ADDRESS.
* 
*         CALLS  PNA, SFN, WOL. 
* 
*         USES   ALL REGISTERS. 
  
  
 PNO      SUBR               ENTRY/EXIT 
          SA1    RA2+1
          ZR     X1,PNO4     IF NO LEVEL-2 CHAIN
          SA1    =1H
          BX6    X1 
          SA0    B1+B1
          SA6    OUTB 
          SA6    OUTB+3 
          BX7    X7-X7
          SA7    PNOA        CLEAR PROJECT NUMBERS PER LINE COUNT 
          SA7    A7+B1       CLEAR HEADER LINE FLAG 
          SX0    N
          SA7    L.TAB2      EMPTY TABLE 2
 PNO1     FUNC   PNAT        PICK NEXT ADDRESS - LEVEL 2
          SA6    PNOC        SAVE END OF TABLE INDICATOR
          ZR     X6,PNO2     IF END OF TABLE 2
          SA5    PNOA 
          SA1    A3-C.TAB2+1
          RJ     SFN         SPACE FILL NAME
          SA6    X5+OUTB+1
          SA1    A1+B1
          RJ     SFN         SPACE FILL NAME
          SA6    A6+B1
          SX6    X5+3 
          SA6    A5 
          SX2    X6-6 
          NZ     X2,PNO1     IF NOT FULL LINE 
 PNO2     SA5    PNOA 
          ZR     X5,PNO4     IF NO ENTRIES IN LINE
          BX6    X6-X6
          SA1    PNOB        CHECK HEADER LINE FLAG 
          SA6    A5 
          NZ     X1,PNO3     IF HEADER ALREADY WRITTEN
          SX7    B1 
          SA7    A1 
          WRITH  O,PNOD,PNODL  WRITE PROJECT NUMBER HEADER LINE 
 PNO3     WRITH  O,OUTB,X5   WRITE PROJECT NUMBER LINE
          SA1    PNOC 
          NZ     X1,PNO1     IF MORE LEVEL-2 ENTRIES TO PROCESS 
 PNO4     WRITH  O,=0,B1     WRITE BLANK LINE 
          EQ     PNOX        RETURN 
  
  
 PNOA     BSS    1           PROJECT NUMBERS PER LINE COUNTER 
 PNOB     BSS    1           HEADER LINE WRITTEN FLAG 
 PNOC     BSS    1           END OF TABLE INDICATOR 
 PNOD     DATA   L*              VALIDATED PROJECT NUMBERS ARE -* 
 PNODL    EQU    *-PNOD 
          TITLE  REFORMAT SUBROUTINES.
 FUH      SPACE 
**        FUH - FILL USER NAME HOLES. 
* 
*         THIS ROUTINE DELETES UNNECESSARY LEVEL-3 OVERFLOW BLOCKS
*         FROM TABLE 3 BY FILLING USER NAME HOLES.
* 
*         ENTRY  (X1) = FWA OF TABLE 3. 
* 
*         CALLS  FHP. 
* 
*         USES   X - 2, 3, 7. 
*                A - 2, 3, 7. 
*                B - 2, 3, 4, 5.
  
  
 FUH2     BX7    X2          STORE UPDATED TABLE 3 LENGTH 
          SA7    L.TAB3 
  
 FUH      SUBR               ENTRY/EXIT 
          SA2    L.TAB3 
          SX3    X2-PRUS
          ZR     X3,FUHX     IF ONLY 1 BLOCK IN TABLE 3 
          NG     X3,ERD42    IF ERROR 
          IX3    X1+X2
          SB2    X3-1        (B2) = BACKWARD POINTER
          SB3    X3-PRUS     (B3) = BACKWARD POINTER LIMIT - 1
          SA3    T3IE 
          IX3    X1+X3
          SB4    X3+PUNW     (B4) = FORWARD POINTER 
          SB5    B4+NUNS     (B5) = FORWARD POINTER LIMIT + 1 
          RJ     FHP         FILLING HOLES PROCESSOR
          NZ     B6,FUH2     IF HOLES FILLED
          SB4    X1+PRUS+1   UPDATE FORWARD POINTER AND LIMIT 
          SB5    B4+PRUS-1
 FUH1     RJ     FHP         FILLING HOLES PROCESSOR
          NZ     B6,FUH2     IF HOLES FILLED
          SB4    B4+B1       UPDATE FORWARD POINTER AND LIMIT 
          SB5    B5+PRUS
          EQ     FUH1        LOOP 
 FHP      SPACE  4,10 
**        FHP - FILLING HOLES PROCESSOR.
* 
*         THIS ROUTINE SEARCHES IN A FORWARD DIRECTION FOR HOLES TO BE
*         FILLED BY USER NAMES SEARCHED FOR IN A BACKWARD DIRECTION.
* 
*         ENTRY  (B2) = BACKWARD POINTER. 
*                (B3) = BACKWARD POINTER LIMIT - 1. 
*                (B4) = FORWARD POINTER.
*                (B5) = FORWARD POINTER LIMIT + 1.
*                (X2) = TABLE 3 LENGTH. 
* 
*         EXIT   (B6) = 0, IF FORWARD POINTER LIMIT REACHED.
*                (B6) .NE. 0, IF THRU ALL ENTRIES.
*                (B2) - (B4), (X2) UPDATED. 
* 
*         USES   X - 3, 4, 5, 6, 7. 
*                A - 3, 4, 6, 7.
  
  
 FHP4     SB6    1           SET THRU ALL ENTRIES 
  
 FHP      SUBR               ENTRY/EXIT 
          SB6    B0          PRESET 
          MX5    42 
          SX6    B1 
 FHP1     EQ     B2,B4,FHP4  IF THRU ENTRIES
          EQ     B4,B5,FHPX  IF FORWARD LIMIT REACHED 
          SA3    B4          NEXT FORWARD ENTRY 
          SX7    X3 
          NZ     X7,FHP4     IF THRU LIST 
          SB4    B4+B1       INCREMENT FORWARD POINTER
          NZ     X3,FHP1     IF NOT HOLE
 FHP2     EQ     B2,B4,FHP4  IF THRU ENTRIES
          EQ     B2,B3,FHP3  IF BACKWARD LIMIT REACHED
          SA4    B2          NEXT BACKWARD ENTRY
          SA6    A4          FREE LOCATION (INITIALIZE TO 1)
          BX7    X5*X4
          SB2    B2-B1       DECREMENT BACKWARD POINTER 
          ZR     X7,FHP2     IF HOLE
          SA7    A3          SET USER NAME IN HOLE
          EQ     FHP1        LOOP 
  
 FHP3     SX2    X2-PRUS     UPDATE TABLE 3 LENGTH
          SX3    X2-PRUS
          ZR     X3,FHP4     IF THRU ENTRIES
          NG     X3,ERD43    IF ERROR 
          SB2    B2-B1       UPDATE BACKWARD POINTER AND LIMIT
          SB3    B3-PRUS
          EQ     FHP2        LOOP 
          TITLE  CHANGE TO SOURCE SUBROUTINES.
 CSC      SPACE  4,15 
**        CSC - CHANGE TO SOURCE CHARGE ENTRY.
* 
*         ENTRY  (A5) = FWA OF CHARGE ENTRY.
*                (CN) = CHARGE NUMBER.
*                (T1IE) = TABLE 1 INDEX OF ENTRY. 
* 
*         EXIT   CHARGE NUMBER DIRECTIVES WRITTEN TO SOURCE FILE. 
* 
*         USES   A - 1, 5, 6, 7.
*                X - 1, 2, 5, 6, 7. 
* 
*         CALLS  CTS, EDD, SFN. 
* 
*         MACROS WRITH. 
  
  
 CSC      SUBR               ENTRY/EXIT 
          SA1    CN 
          RJ     SFN         SPACE FILL CHARGE NUMBER 
          BX7    X6          *ACN* FORMAT 
          SA1    =A*ACN = * 
          BX6    X1 
          SA6    OUTB 
          SA7    A6+B1
          WRITH  S,A6,B1+B1 
          SA1    A5+CMUW     *MU* 
          MX2    42 
          BX6    X2*X1
          ZR     X6,CSC3     IF NO MASTER USER
          SA6    OUTB+1 
          SA1    =A*MU  = * 
          BX6    X1 
          SA6    A6-B1
          WRITH  S,A6,B1+B1 
 CSC3     SA1    A5+CDTW     *CEX*
          LX1    36 
          SX1    X1 
          ZR     X1,CSC4     IF NO CHARGE EXPIRATION DATE 
          RJ     EDD         EDIT DATE
          SA6    OUTB+1 
          SA1    =A*CEX = * 
          BX6    X1 
          SA6    A6-B1
          WRITH  S,A6,B1+B1 
 CSC4     SA5    TOIB 
          RJ     CTS         CONVERT TO SOURCE
          EQ     CSCX 
 CSP      SPACE  4,10 
**        CSP - CHANGE TO SOURCE PROJECT ENTRY. 
* 
*         ENTRY  (A5) = FWA OF PROJECT ENTRY. 
*                (PN - PN+1) = PROJECT NUMBER.
*                (T3IE) = TABLE 3 INDEX OF ENTRY. 
* 
*         USES   A - 1, 2, 5, 6, 7. 
*                X - 1, 2, 5, 6, 7. 
* 
*         CALLS  CTS, EDD, ETM, SFN, SUN. 
* 
*         MACROS WRITH. 
  
  
 CSP      SUBR               ENTRY/EXIT 
          SA1    =A*APN = *  PRESET *APN* FORMAT
 CSP1     BX6    X1 
          SA6    OUTB 
          SA1    PN 
          RJ     SFN         SPACE FILL NAME
          SA6    A6+B1
          SA1    A1+B1
          RJ     SFN         SPACE FILL NAME
          SA6    A6+B1
          WRITH  S,OUTB,3 
          SA1    A5+PCDW     *PEX*
          LX1    36 
          SX1    X1 
          ZR     X1,CSP2     IF NO PROJECT EXPIRATION DATE
          RJ     EDD         EDIT DATE
          SA6    OUTB+1 
          SA1    =A*PEX = * 
          BX6    X1 
          SA6    A6-B1
          WRITH  S,A6,B1+B1 
 CSP2     SA1    =1H0        *TO* 
          BX6    X1 
          SA5    A5+PTMW
          SX1    X5 
          ZR     X1,CSP3     IF ZERO VALUE
          RJ     ETM         EDIT TIME
 CSP3     SA6    OUTB+1 
          SA1    =A*TO  = * 
          BX6    X1 
          SA6    A6-B1
          WRITH  S,A6,B1+B1 
          SA1    =1H0        *TI* 
          BX6    X1 
          LX5    -18
          SX1    X5 
          ZR     X1,CSP4     IF ZERO VALUE
          RJ     ETM         EDIT TIME
 CSP4     SA6    OUTB+1 
          SA1    =A*TI  = * 
          BX6    X1 
          SA6    A6-B1
          WRITH  S,A6,B1+B1 
          SA1    CV 
          NZ     X1,CSP4.1   IF CONVERSION OPTION SELECTED
          SA1    =A*PCR = *  CONVERT PROLOGUE CHARGE REQUIRED OPTION
          SA5    A5-PTMW+PPNW 
          BX6    X1 
          SA6    OUTB 
          MX2    -2 
          BX1    -X2*X5 
          SA1    TPCO+X1
          RJ     SFN         SPACE FILL NAME
          SA6    A6+B1
          WRITH  S,OUTB,2 
          SA5    TOID 
          RJ     CTS         CONVERT TO SOURCE
          SA5    TOIF 
          EQ     CSP4.2      CONVERT TO SOURCE
  
 CSP4.1   SA5    TOIE 
 CSP4.2   RJ     CTS         CONVERT TO SOURCE
  
*         USER NAMES. 
  
          RJ     SUN         SORT USER NAMES
          SA1    =A*AUN = *  PRESET *AUN* FORMAT
 CSP5     SA2    F.TAB3 
          BX7    X1 
          SA5    X2-1 
          SA7    OUTB 
 CSP6     ZR     X6,CSPX     IF END OF USER NAMES 
          SA5    A5+B1
          BX7    X5 
          SA7    OUTB+1 
          WRITH  S,A7-B1,B1+B1
          SA1    L.TAB3 
          SX6    X1-1 
          SA6    A1 
          EQ     CSP6        LOOP 
 CTS      SPACE  4,10 
**        CTS - CONVERT TABLE OF INDICES (TOI) ENTRIES TO SOURCE. 
* 
*         ENTRY  (X5) = FIRST ENTRY OF PERTINENT TABLE OF *TOI*.
*                (A5) = ADDRESS OF FIRST ENTRY. 
*                (T1IE) = TABLE 1 INDEX OF ENTRY, IF LEVEL-1 DIRECTIVE. 
*                (T3IE) = TABLE 3 INDEX OF ENTRY, IF LEVEL-3 DIRECTIVE. 
* 
*         CALLS  CED, DFS, GFV, SFN, WOL. 
* 
*         USES   ALL REGISTERS EXCEPT A0. 
  
  
 CTS      SUBR               ENTRY/EXIT 
          MX0    12 
          LX0    -12
 CTS1     ZR     X5,CTSX     IF END OF TABLE
          BX7    X0*X5
          LX7    -36
          RJ     DFS         (DF) - (DF+4) SET-UP 
          RJ     GFV         GET FIELD,S VALUE
          RJ     CED         CONVERT ENTRY TO DISPLAY CODE
          SA6    OUTB+1 
          SA1    DF+4 
          RJ     SFN         SPACE FILL NAME
          LX6    -24
          MX1    -12
          BX6    X1*X6
          SX1    2R=
          BX6    X1+X6
          SA6    A6-B1
          WRITH  S,A6,B1+B1 
          SA5    A5+B1
          EQ     CTS1        LOOP 
          TITLE  UPDATE/CREATE SUBROUTINES - MAIN INPUT ROUTINE.
 DIP      SPACE  4,10 
**        DIP - DIRECTIVE INPUT PROCESSOR.
* 
*         READ DIRECTIVES FROM INPUT FILE- OR K-DISPLAY IF
*         *K-DISPLAY* OPTION- AND CALL APPROPRIATE INPUT PROCESSOR. 
*         INPUT PROCESSING TERMINATES UPON ENCOUNTERING AN EOI, EOF,
*         OR EOR- OR *STOP* IF K-DISPLAY. DIRECTIVES ARE QUEUED FOR 
*         PROCESSING BY ROUTINE *DQP* (NOT PERTINENT IF *CREATE* MODE). 
* 
*         EXIT   TO INPUT PROCESSORS- 
*                (X1) = (DTII) = TABLE INDEX. 
*                (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
* 
*         CALLS  ACI, AMQ, DQP, PGD, SCI, SPT, STB, WDL, WPL, 
*                INPUT PROCESSORS.
* 
*         USES   ALL REGISTERS. 
  
  
 DIP9     SA1    UF 
          ZR     X1,DIP10    IF *CREATE* MODE 
          RJ     DQP         DIRECTIVE QUEUE PROCESSOR
          EQ     DIPX 
  
 DIP10    RJ     WDL         WRITE DATA LEVEL 
          SA0    B1+B1
          FUNC   STBT        SORT TABLE 2 
          RJ     WPL         WRITE PROJECT LEVEL
  
 DIP      SUBR               ENTRY/EXIT 
          SA1    CBUF        CHECK FOR OVERFLOW SUSPENDED PROCESSING
          NZ     X1,CND1     IF CHARGE NUMBER PRESENT 
          SA1    UF 
          ZR     X1,DIP1     IF *CREATE* MODE 
          RJ     AMQ         ALLOCATE MEMORY TO QUEUE 
          SA1    PI 
          NZ     X1,DIP1     IF NOT TERMINAL FILE 
          WRITEH O,DIPB,2    *ENTER DIRECTIVES* 
          READ   I
  
*         *MAIN LOOP* 
  
 DIP1     BSS    0
          SX0    I
          SA1    DIPC        ALLOW K-DISPLAY PAGING CHARACTERS
          SX6    TDIR        TABLE OF DIRECTIVES
          SX3    TSKD        TABLE OF SPECIAL K-DISPLAY DIRECTIVES
          FUNC   SCIT        SCAN FOR CODE IDENTIFIER 
          ZR     X1,DIP6     IF ERROR 
          ZR     B6,DIP4     IF ENTRY TERMINATION 
          PL     B7,DIP5     IF NOT SPECIAL K-DISPLAY DIRECTIVE 
          SB2    -5 
          GT     B2,B7,DIP1.1  IF PAGING COMMAND
          SB2    -1 
          EQ     B2,B7,DIP2  IF *END* 
          SX6    B0+         PERFORM NO UPDATE
          SA6    FUP1 
          SA6    A6+B1
          SA6    A6+B1
          SB2    -2 
          EQ     B2,B7,DIP3    IF *DROP*
          SX7    -B1         *STOP* - FORCE LEVEL-0 UPDATE
          SA7    ET 
          RJ     DQP         DIRECTIVE QUEUE PROCESSOR
          EQ     DIPX 
  
 DIP1.1   SA2    KPAG        SET ENTRY CONDITIONS FOR *PGD* 
          BX4    X4-X4
          LX3    54 
          SX1    KIA
          RJ     PGD         PAGE DISPLAY 
          SA1    KPAG        UPDATE MESSAGE LINE POINTERS 
          SA1    X1 
          AX1    30 
          SB2    X1 
          SA1    A1+B2
          AX1    18 
          SX7    X1 
          AX1    18 
          SA7    M1 
          SX6    X1 
          SA6    IL 
          EQ     DIP1        CONTINUE 
  
 DIP2     RJ     DQP         DIRECTIVE QUEUE PROCESSOR
 DIP3     BX6    X6-X6       CLEAR CHARGE AND PROJECT NUMBER FLAGS
          SA6    FCNP 
          SA6    FPNP 
          SA6    DSCN        DISABLE K-DISPLAY FOR CHARGE NUMBER
          SX1    B0+
          RJ     SPT         SET PAGE TABLE 
          EQ     DIP1        LOOP 
  
 DIP4     SA1    ET 
          NG     X1,DIP9     IF EOF 
          SB7    XCND        EQIVALENCE */* TO *CN* 
 DIP5     SX6    B7          TABLE INDEX
          MX0    1
          SA6    DTII 
          SA1    TOPR+B7     SET SPECIAL CHARACTERS TO PERMIT 
          LX1    1
          BX6    X0*X1
          LX0    -1 
          AX6    1
          BX1    X0*X1
          LX6    -58
          LX1    -56
          BX1    X6+X1
          RJ     ACI         ASSEMBLE CHARACTERS INTERFACE
          ZR     B6,DIP8     IF ENTRY TERMINATION 
          SB5    B5-1R= 
          ZR     B5,DIP7     IF INCORRECT SEPARATOR 
          SA1    DTII 
          SX2    X1-XPAS
          ZR     X2,DIP1     IF *PASS* DIRECTIVE
          SA2    X1+TOPR
          BX3    X2 
          LX3    -18
          SB2    X3 
          JP     B2          INPUT PROCESSOR
  
 DIP6     NZ     B5,DIP7     IF SEPARATOR NOT *=* 
          SA1    DIPA        GET RID OF PARAMETER VALUE 
          RJ     ACI         ASSEMBLE CHARACTERS INTERFACE
          ZR     B6,DIP8     IF ENTRY TERMINATION 
 DIP7     SB3    ERUA 
          RJ     ERU         USER ERROR 
          EQ     DIP1        LOOP 
  
 DIP8     SB3    ERUQ 
          RJ     ERU         USER ERROR 
          EQ     DIP9 
  
 DIPA     BITCON (-,+,*)     BIT STRING OF CHARACTERS TO PERMIT 
  
 DIPB     DIS    2,ENTER DIRECTIVES 
 DIPC     BITCON (-,+)       BIT STRING OF PAGING CHARACTERS TO PERMIT
  
 PGD      HERE               REMOTE BLOCK FROM *COMCDCP*
          TITLE  UPDATE/CREATE SUBROUTINES - INPUT PROCESSORS.
 CND      SPACE  4,10 
**        CND - CHARGE NUMBER DIRECTIVE.
* 
*         *ACN*, *CN*, *DCN* DIRECTIVES.
* 
*         ENTRY  (X1) = (DTII) = TABLE INDEX. 
*                (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
*                TO CND1, IF OVERFLOW SUSPENDED PROCESSING. 
* 
*         EXIT   TO DIPX, IF *CREATE* OVERFLOW DETECTED.
*                TO DIP1, ELSE. 
*                (CN) = CHARGE NUMBER.
* 
*         CALLS  ATS, CDV, DQP, KOC, MQE, MVE, MWS, SPB, SPT, STB, VMU, 
*                WDL, WPL.
* 
*         USES   ALL REGISTERS. 
  
  
 CND      BSS    0
          BX6    X6-X6       CLEAR CHARGE AND PROJECT NUMBER FLAGS
          SA6    FCNP 
          SA6    FPNP 
          SA6    DSCN        DISABLE K-DISPLAY FOR CHARGE NUMBER
          BX6    X1          SAVE REGISTER CONTENTS 
          BX7    X2 
          SA6    CNDA 
          SA7    CNDB 
          SX1    B0+
          RJ     SPT         SET PAGE TABLE TO INITIAL DISPLAY
          SA1    CNDA        RESTORE REGISTERS
          SA2    CNDB 
          RJ     CDV         CHECK DIRECTIVE AND VALUE
          SA3    UF 
          NZ     X3,CND1     IF *UPDATE* MODE 
          SX1    X1-XDCN
          ZR     X1,CND15    IF *DCN* 
          RJ     WDL         WRITE DATA LEVEL 
          SA0    B1+B1
          FUNC   STBT        SORT TABLE 2 
          RJ     WPL         WRITE PROJECT LEVEL
          BX6    X6-X6
          SA6    L.TAB2      EMPTY TABLE 2
          SA6    RA2         RESET LINKS
          SA6    A6+B1
          SA1    TV 
          NZ     X1,DIPX     IF OVERFLOW
          SA0    B1 
          SB6    CBUF 
          FUNC   MWST        SEARCH TABLE 1 
          ZR     X2,CND11    IF CHARGE NUMBER FOUND 
          SA5    L.TAB1      TABLE 1 INDEX OF ENTRY 
          BX6    X5 
          SA6    T1IE 
          ALLOC  TAB1,C.TAB1
          IX5    X2+X5
          MOVE   C.TAB1,D1AA,X5  INITIALIZE ENTRY TO DEFAULT
          SX6    B1          INDICATE CHARGE NUMBER PRESENT 
          SA6    FCNP 
          SA1    CBUF        CHARGE NUMBER
          BX6    X1 
          SA6    X5 
          SA6    D3AA+PCHW
          SA6    CN 
          EQ     DIP1        *MAIN LOOP* RETURN 
  
*         *UPDATE* MODE.
  
 CND1     RJ     DQP         DIRECTIVE QUEUE PROCESSOR
          SA1    CBUF        CHARGE NUMBER
          BX6    X1 
          SA6    D1AA 
          SA6    D3AA+PCHW
          SA6    CN 
          SX1    A6 
          SX0    N
          FUNC   SPBT        SET PRIMARY BLOCK
          NZ     X6,ERD38    IF ERROR 
          SA1    OP 
          SB2    X1-COPT
          SA1    DTII 
          NZ     X4,CND6     IF CHARGE NUMBER NOT FOUND 
          ZR     B2,CND11    IF *CREATE* OPTION 
          SA2    F.TAB1      TABLE 1 INDEX OF ENTRY 
          IX6    X3-X2
          SA6    T1IE 
          MX0    1
          SA2    X3+CSRW
          SB3    X1-XCND
          ZR     B3,CND3     IF *CN*
          SB3    X1-XACN
          ZR     B3,CND2     IF *ACN* 
          NG     X2,CND12    IF CHARGE NUMBER INACTIVE
          BX6    X0+X2       DEACTIVATE CHARGE NUMBER 
          SA6    A2 
          EQ     CND10
  
 CND2     NG     X2,CND5     IF CHARGE NUMBER INACTIVE
          EQ     CND14       ERROR
  
 CND3     NG     X2,CND12    IF CHARGE NUMBER INACTIVE
          RJ     VMU         VALIDATE FOR MASTER USER 
          ZR     X1,CND9     IF VALIDATION OK 
          EQ     CND13       ERROR
  
 CND5     BX6    -X0*X2      ACTIVATE CHARGE NUMBER 
          SA6    A2 
          EQ     CND9 
  
 CND6     SB3    X1-XACN
          ZR     B3,CND8     IF *ACN* 
          SB3    X1-XDCN
          ZR     B3,CND16    IF *DCN* 
          NZ     B2,CND16    IF NOT *CREATE* OPTION 
 CND7     SX6    XACN        SET TO *ACN* 
          SA6    DTII 
 CND8     SA5    L.TAB1      TABLE 1 INDEX OF ENTRY 
          BX6    X5 
          SA6    T1IE 
          ALLOC  TAB1,C.TAB1
          IX5    X2+X5
          MOVE   C.TAB1,D1AA,X5  INITIALIZE ENTRY TO DEFAULT
          BX3    X5 
  
 CND9     SX6    B1          INDICATE CHARGE NUMBER PRESENT 
          SA6    FCNP 
 CND10    RJ     KOC         K-DISPLAY OUTPUT FOR CHARGE NUMBER 
          BX6    X6-X6       RE-SET FIELD SIZE
          SA6    DF+2 
          SA1    DTII 
          SA2    X1+TOPR
          BX5    X5-X5
          RJ     MQE         MAKE QUEUE ENTRY 
          JP     DIP1        *MAIN LOOP* RETURN 
  
 CND11    SB3    ERUR 
          EQ     CND17
 CND12    SB3    ERUF 
          EQ     CND17
 CND13    SB3    ERUG 
          EQ     CND17
 CND14    SB3    ERUD 
          EQ     CND17
 CND15    SB3    ERUA 
          EQ     CND17
 CND16    SB3    ERUE 
 CND17    RJ     ERU         USER ERROR 
          JP     DIP1        *MAIN LOOP* RETURN 
  
  
 CNDA     BSS    1           HOLD REGISTER CONTENTS 
 CNDB     BSS    1           HOLD REGISTER CONTENTS 
 CVD      SPACE  4,10 
**        CVD - CONVERSION-VALIDATION DIRECTIVE.
* 
*         *ISV*, *SML* DIRECTIVES.
*         *ISV* IS VALIDATED AGAINST *ISL* VALUE. 
*         *SML* IS VALIDATED AGAINST *SIL* VALUE. 
* 
*         ENTRY  (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
*                (DTII) = TABLE INDEX.
* 
*         EXIT   TO DIP1. 
* 
*         CALLS  CCP, CDV, CNV, DFS, GFV, MQE.
* 
*         USES   ALL REGISTERS. 
  
  
 CVD      BSS    0
 CVD1     SA0    XISL        *ISV* DIRECTIVE
          EQ     CVD3 
  
 CVD2     SA0    XSIL        *SML* DIRECTIVE
  
 CVD3     RJ     CDV         CHECK DIRECTIVE AND VALUE
          RJ     CNV         CONVERT NUMERIC VALUE
          SA1    DTII 
          SA2    X1+TOPR
          RJ     CCP         CHECK FOR CHARGE/PROJECT NUMBER REQUIRED 
          SX7    A0 
          RJ     DFS         (DF) - (DF+4) SET-UP 
          RJ     GFV         GET FIELD,S VALUE
          SB2    A0-XISL
          ZR     B2,CVD4     IF *ISV* DIRECTIVE 
          ZR     X1,CVD5     IF VALIDATION NOT NECESSARY
 CVD4     IX3    X1-X5
          NG     X3,CVD6     IF VALIDATION FAILED 
 CVD5     SA1    DTII        RESTORE DIRECTIVE,S (DF) - (DF+4)
          SX7    X1 
          RJ     DFS         (DF) - (DF+4) SET-UP 
          SA2    X1+TOPR
          RJ     MQE         MAKE QUEUE ENTRY 
          JP     DIP1        *MAIN LOOP* RETURN 
  
 CVD6     SB3    ERUK 
          RJ     ERU         USER ERROR 
          JP     DIP1        *MAIN LOOP* RETURN 
 DTD      SPACE  4,10 
**        DTD - DATE DIRECTIVES.
* 
*         *CEX*, *PEX* DIRECTIVES.
*         CONVERT DATE TO PACKED FORMAT PRODUCED BY *PDATE*.
* 
*         ENTRY  (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
*                (DTII) = TABLE INDEX.
* 
*         EXIT   TO DIP1. 
* 
*         CALLS  CCP, CDV, CNV, MQE, VDT. 
* 
*         USES   ALL REGISTERS. 
  
  
 DTD      BSS    0
          RJ     CDV         CHECK DIRECTIVE AND VALUE
          RJ     CNV         CONVERT NUMERIC VALUE
          SA1    DTII 
          SA2    X1+TOPR
          RJ     CCP         CHECK FOR CHARGE/PROJECT NUMBER REQUIRED 
          ZR     X5,DTD1     IF ZERO VALUE
          SA1    CBUF 
          MX2    0
          RJ     VDT         VALIDATE DATE
          NG     X6,DTD2     IF INCORRECT DATE
          NG     X1,DTD2     IF DATE PRIOR TO TODAY 
          SA1    DTII 
          SA2    X1+TOPR
          BX5    X6 
 DTD1     RJ     MQE         MAKE QUEUE ENTRY 
          JP     DIP1        *MAIN LOOP* RETURN 
  
 DTD2     SB3    ERUK 
          RJ     ERU         USER ERROR 
          JP     DIP1        *MAIN LOOP* RETURN 
 NUD      SPACE  4,10 
**        NUD - NUMERIC DIRECTIVE (NO VALIDATION REQUIRED). 
* 
*         *M1*,..., *M4*, *AD*, *ISL*, *IR1*,..., *IR8*, *SMA*, 
*         *SIL*, *SIA*, *LR1*, *AR1*,..., *LR8*, *AR8* DIRECTIVES.
* 
*         ENTRY  (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
*                (DTII) = TABLE INDEX.
* 
*         EXIT   TO DIP1. 
* 
*         CALLS  CCP, CDV, CNV, MQE.
* 
*         USES   ALL REGISTERS. 
  
  
 NUD      BSS    0
          RJ     CDV         CHECK DIRECTIVE AND VALUE
          RJ     CNV         CONVERT NUMERIC VALUE
          SA1    DTII 
          SA2    X1+TOPR
          RJ     CCP         CHECK FOR CHARGE/PROJECT NUMBER REQUIRED 
          RJ     MQE         MAKE QUEUE ENTRY 
          JP     DIP1        *MAIN LOOP* RETURN 
 PCL      SPACE  4,10 
**        PCL - *PCL* DIRECTIVE.
* 
*         VALIDATE AGAINST CURRENT PROJECT COUNT. 
* 
*         ENTRY  (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
*                (DTII) = TABLE INDEX.
* 
*         EXIT   TO DIP1. 
* 
*         CALLS  CCP, CDV, CNV, MQE.
* 
*         USES   ALL REGISTERS. 
  
  
 PCL      BSS    0
          RJ     CDV         CHECK DIRECTIVE AND VALUE
          RJ     CNV         CONVERT NUMERIC VALUE
          SA1    DTII 
          SA2    X1+TOPR
          RJ     CCP         CHECK FOR CHARGE/PROJECT NUMBER REQUIRED 
          ZR     X5,PCL1     IF VALIDATION NOT NECESSARY
          SA3    F.TAB1      PROJECT COUNT
          SA4    T1IE 
          IX3    X3+X4
          SA3    X3+CSRW
          MX4    -12
          LX3    30 
          BX3    -X4*X3 
          IX3    X5-X3
          NG     X3,PCL2     IF LESS THAN PROJECT COUNT 
 PCL1     RJ     MQE         MAKE QUEUE ENTRY 
          JP     DIP1        *MAIN LOOP* RETURN 
  
 PCL2     SB3    ERUK 
          RJ     ERU         USER ERROR 
          JP     DIP1        *MAIN LOOP* RETURN 
 PED      SPACE  4,15 
**        PED - PROLOGUE/EPILOGUE DIRECTIVES. 
* 
*         *PFN*, *PUN*, *PPW*, *PCR*, *EFN*, *EUN*, *EPW* DIRECTIVES. 
* 
*         ENTRY  (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
*                (DTII) = DIRECTIVE TABLE INDEX.
* 
*         EXIT   TO DIP1. 
* 
*         USES   A - 1, 2, 3, 5.
*                X - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3.
* 
*         CALLS  CCP, CDV, DFS, MQE.
  
  
 PED      BSS    0
          NZ     X4,PED1     IF NOT EMPTY DIRECTIVE 
          BX6    X4 
          SX4    B1 
 PED1     RJ     CDV         CHECK DIRECTIVE AND VALUE
          SA1    DTII 
          SA2    X1+TOPR
          RJ     CCP         CHECK FOR CHARGE/PROJECT NUMBER REQUIRED 
          SA5    CBUF 
          SX3    X1-XPCR
          ZR     X3,PED2     IF PROLOGUE CHARGE REQUIRED DIRECTIVE
          LX5    -18         RIGHT JUSTIFY NAME 
          EQ     PED4        PROCESS DIRECTIVE
  
 PED2     SB2    -B1         SCAN OPTION TABLE
          SB3    TPCOL
 PED3     SB2    B2+B1
          GE     B2,B3,PED5  IF END OF TABLE
          SA3    B2+TPCO
          BX3    X5-X3
          NZ     X3,PED3     IF OPTION NOT FOUND
          SX5    B2 
 PED4     BX7    X1 
          RJ     DFS         (DF) - (DF+4) SET UP 
          RJ     MQE         MAKE QUEUE ENTRY 
          EQ     DIP1        *MAIN LOOP* RETURN 
  
 PED5     SB3    ERUK 
          RJ     ERU         USER ERROR 
          EQ     DIP1        *MAIN LOOP* RETURN 
 PND      SPACE  4,10 
**        PND - PROJECT NUMBER DIRECTIVE. 
* 
*         *APN*, *DPN*, AND *PN* DIRECTIVES.
* 
*         ENTRY  (X1) = (DTII) = TABLE INDEX. 
*                (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
* 
*         EXIT   TO DIP1. 
*                (PN - PN+1) = PROJECT NUMBER.
* 
*         CALLS  ADB, ATS, CDD, CDV, DQP, ILR, KOP, MQE, MVE, MWS, PDE, 
*                PEI, RCE, SPT, UPC, WDL. 
* 
*         USES   ALL REGISTERS. 
  
  
 PND      BSS    0
          BX6    X6-X6       CLEAR PROJECT NUMBER FLAG
          SA6    FPNP 
          BX6    X1          SAVE REGISTER CONTENTS 
          BX7    X2 
          SA6    PNDA 
          BX1    X1-X1
          SA7    PNDB 
          RJ     SPT         SET PAGE TABLE TO CHARGE DISPLAY 
          SA1    PNDA        RESTORE REGISTERS
          SA2    PNDB 
          RJ     CDV         CHECK DIRECTIVE AND VALUE
          SA3    FCNP 
          ZR     X3,PND13    IF NO CHARGE NUMBER PRESENT
          SA3    UF 
          NZ     X3,PND2     IF *UPDATE* MODE 
          SX1    X1-XDPN
          ZR     X1,PND14    IF *DPN* 
          RJ     WDL         WRITE DATA LEVEL 
          SA0    B1+B1
          BX1    X1-X1
          SB6    CBUF 
          FUNC   MWST        SEARCH TABLE 2 
          ZR     X2,PND15    IF PROJECT NUMBER FOUND
          SX1    XAPN 
          RJ     UPC         UPDATE PROJECT COUNT 
          LX6    18          VALIDATE AGAINST *PCL* VALUE 
          MX3    -12
          BX3    -X3*X6 
          ZR     X3,PND1     IF NO RESTRICTION
          IX3    X3-X4
          NG     X3,PND19    IF *PCL* VALUE EXCEEDED
 PND1     LX6    -18
          SA6    A2 
          SX6    B1          INDICATE NEED TO UPDATE LEVELS 2 AND 3 
          SA6    FUP2 
          SA6    A6+B1
          SA5    L.TAB2      TABLE 2 INDEX OF ENTRY 
          BX6    X5 
          SA6    T2IE 
          SA1    CBUF 
          ADDWRD TAB2,X1
          SA1    CBUF+1 
          ADDWRD TAB2,X1
          BX1    X1-X1
          ADDWRD TAB2,X1
          SX0    N
          RJ     PDE         PROCESS DATA LEVEL ENTRY 
          RJ     ILR         INITIALIZE INSTALLATION LIMIT REGISTERS
          MOVE   C.TAB3,D3AA,X0 
          SX6    B1          INDICATE PROJECT NUMBER PRESENT
          SA6    FPNP 
          MOVE   2,CBUF,X0+PRJW  PROJECT NUMBER 
          MOVE   2,CBUF,PN
          EQ     DIP1        *MAIN* LOOP* RETURN
  
*         *UPDATE* MODE.
  
 PND2     RJ     DQP         DIRECTIVE QUEUE PROCESSOR
          BX6    X6-X6       RE-SET FIELD SIZE
          SA6    DF+2 
          RJ     RCE         REGENERATE CHARGE NUMBER QUEUE ENTRY 
          MOVE   2,CBUF,PN   PROJECT NUMBER 
          RJ     PEI         PROJECT ENTRY INITIALIZATION 
          SA1    OP 
          SB2    X1-COPT
          NZ     X4,PND6     IF PROJECT NUMBER NOT FOUND
          ZR     B2,PND15    IF *CREATE* OPTION 
          SX7    X5 
          SX0    N
          RJ     ADB         ADD DATA LEVEL BLOCK 
          MX0    1
          SA1    DTII 
          SA2    A5+PTMW
          SB3    X1-XPND
          ZR     B3,PND4     IF *PN*
          SB3    X1-XAPN
          ZR     B3,PND3     IF *APN* 
          NG     X2,PND16    IF PROJECT NUMBER INACTIVE 
          BX6    X0+X2       DEACTIVATE PROJECT NUMBER
          SA6    A2 
          RJ     UPC         UPDATE PROJECT COUNT 
          SA6    A2 
          BX1    X4          UPDATE K-DISPLAY PROJECT COUNT 
          RJ     CDD         DECIMAL DISPLAY CODE CONVERSION
          BX6    X4 
          SA6    DSCO+2 
          EQ     PND12
  
 PND3     NG     X2,PND5     IF PROJECT NUMBER INACTIVE 
          EQ     PND17       ERROR
  
 PND4     PL     X2,PND11    IF PROJECT NUMBER ACTIVE 
          EQ     PND16       ERROR
  
 PND5     BX6    -X0*X2      ACTIVATE PROJECT NUMBER
          SA6    A2 
          EQ     PND9 
  
 PND6     SA1    DTII 
          SB3    X1-XAPN
          ZR     B3,PND8     IF *APN* 
          SB3    X1-XDPN
          ZR     B3,PND18    IF *DPN* 
          NZ     B2,PND18    IF NOT *CREATE* OPTION 
 PND7     SX6    XAPN        SET TO *APN* 
          SA6    DTII 
 PND8     BX6    X6-X6
          SA6    T3IE        TABLE 3 INDEX OF ENTRY 
          SA6    L.TAB3      EMPTY TABLE 3
          ALLOC  TAB3,PUNW
          SA5    X2 
          RJ     ILR         INITIALIZE INSTALLATION LIMIT REGISTERS
          MOVE   2,PN,D3AA+PRJW 
          MOVE   PUNW,D3AA,A5  INITIALIZE ENTRY TO DEFAULT
  
 PND9     SX1    XAPN 
          RJ     UPC         UPDATE PROJECT COUNT 
          LX6    18          VALIDATE AGAINST *PCL* VALUE 
          MX3    -12
          BX3    -X3*X6 
          ZR     X3,PND10    IF NO RESTRICTION
          IX3    X3-X4
          NG     X3,PND19    IF *PCL* VALUE EXCEEDED
 PND10    LX6    -18
          SA6    A2 
          BX1    X4          UPDATE K-DISPLAY PROJECT COUNT 
          RJ     CDD         DECIMAL DISPLAY CODE CONVERSION
          BX6    X4 
          SA6    DSCO+2 
 PND11    SX6    B1          INDICATE PROJECT NUMBER PRESENT
          SA6    FPNP 
 PND12    RJ     KOP         K-DISPLAY OUTPUT FOR PROJECT NUMBER
          BX6    X6-X6       RE-SET FIELD SIZE
          SA6    DF+2 
          SA1    DTII 
          SA2    X1+TOPR
          BX5    X5-X5
          RJ     MQE         MAKE QUEUE ENTRY 
          JP     DIP1        *MAIN LOOP* RETURN 
  
 PND13    SB3    ERUH 
          EQ     PND20
 PND14    SB3    ERUA 
          EQ     PND20
 PND15    SB3    ERUS 
          EQ     PND20
 PND16    SB3    ERUO 
          EQ     PND20
 PND17    SB3    ERUJ 
          EQ     PND20
 PND18    SB3    ERUI 
          EQ     PND20
 PND19    SB3    ERUN 
 PND20    RJ     ERU         USER ERROR 
          JP     DIP1        *MAIN LOOP* RETURN 
  
  
 PNDA     BSS    1           HOLD REGISTER CONTENTS 
 PNDB     BSS    1           HOLD REGISTER CONTENTS 
 TMD      SPACE  4,10 
**        TMD - TIME DIRECTIVES.
* 
*         *TI*, *TO* DIRECTIVES.
*         CONVERT TIME TO PACKED FORMAT PRODUCED BY *PDATE*.
* 
*         ENTRY  (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
*                (DTII) = TABLE INDEX.
* 
*         EXIT   TO DIP1. 
* 
*         CALLS  CCP, CDV, CNV, MQE.
* 
*         USES   ALL REGISTERS. 
  
  
 TMD      BSS    0
          RJ     CDV         CHECK DIRECTIVE AND VALUE
          RJ     CNV         CONVERT NUMERIC VALUE
          SA1    DTII 
          SA2    X1+TOPR
          RJ     CCP         CHECK FOR CHARGE/PROJECT NUMBER REQUIRED 
          ZR     X5,TMD1     IF ZERO VALUE
          SX0    100         CALCULATE HOURS
          BX3    X5 
          IX3    X3/X0
          SX0    100
          IX4    X0*X3       CALCULATE MINUTES
          IX4    X5-X4
          SX7    X4-60
          PL     X7,TMD2     IF TOO LARGE 
          LX3    6           POSITION HOURS 
          BX5    X3+X4       MERGE HOURS AND MINUTES
          LX5    6           ASSUME ZERO SECONDS
 TMD1     RJ     MQE         MAKE QUEUE ENTRY 
          JP     DIP1        *MAIN LOOP* RETURN 
  
 TMD2     SB3    ERUK 
          RJ     ERU         USER ERROR 
          JP     DIP1        *MAIN LOOP* RETURN 
 UND      SPACE  4,10 
**        UND - USER NAME DIRECTIVE.
* 
*         *MU*, *AUN*, *DUN* DIRECTIVES.
* 
*         ENTRY  (X1) = TABLE INDEX.
*                (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
* 
*         EXIT   TO DIP1. 
* 
*         CALLS  AUN, CCP, CDV, MQE.
* 
*         USES   ALL REGISTERS. 
  
  
 UND      BSS    0
          NZ     X4,UND0.1   IF ENTERED VALUE NOT NULL
          SB2    X1-XMUN
          NZ     B2,UND0.1   IF NOT *MU*
          SX4    1           ALLOW NULL VALUE 
 UND0.1   RJ     CDV         CHECK DIRECTIVE AND VALUE
          RJ     CCP         CHECK FOR CHARGE/PROJECT NUMBER REQUIRED 
          SA5    CBUF        RIGHT JUSTIFY USER NAME
          LX5    -18
          SB2    X1-XMUN
          ZR     B2,UND2     IF *MU*
          SB2    X1-XDUN
          ZR     B2,UND1     IF *DUN* 
          SA3    UF 
          NZ     X3,UND2     IF *UPDATE* MODE 
          BX1    X5 
          RJ     AUN         ADD USER NAME
          EQ     DIP1 
  
 UND1     SA3    OP 
          SB2    X3-COPT
          ZR     B2,UND3     IF *CREATE* OPTION 
 UND2     RJ     MQE         MAKE QUEUE ENTRY 
          JP     DIP1        *MAIN LOOP* RETURN 
  
 UND3     SB3    ERUA 
          RJ     ERU         USER ERROR 
          JP     DIP1        *MAIN LOOP* RETURN 
          TITLE  UPDATE/CREATE SUBROUTINES - INPUT PROCESSOR ROUTINES.
 AMQ      SPACE  4,10 
**        AMQ - ALLOCATE MEMORY TO DIRECTIVE QUEUE. 
* 
*         THE DIRECTIVE QUEUE IS DYNAMICALLY EXPANDABLE, BEGINS 
*         AT LOCATION *MEML*, AND PRECEDES TABLE 0. 
*         *QINC* WORDS ARE ALLOCATED PER CALL.
* 
*         CALLS  ATS, MVE.
* 
*         USES   ALL REGISTERS EXCEPT X0. 
  
  
 AMQ      SUBR               ENTRY/EXIT 
          SA5    L.TAB0      SAVE TABLE 0 LENGTH
          ALLOC  TAB0,QINC
          SB2    X2+QINC
          MOVE   X5,X2,B2 
          SX6    B2          UPDATE TABLE 0 FWA AND LOWER MEMORY LIMIT
          SA6    F.TAB0 
          SA6    LM 
          BX6    X5          RESTORE TABLE 0 LENGTH 
          SA6    A5 
          SA1    QMAX        UPDATE QUEUE MAXIMUM SIZE
          SX6    X1+QINC
          SA6    A1 
          EQ     AMQX 
 CCP      SPACE  4,10 
**        CCP - CHECK FOR CHARGE/PROJECT NUMBER REQUIRED. 
* 
*         LEVEL-1 DIRECTIVES REQUIRE A CHARGE NUMBER IN EFFECT, 
*         AND LEVEL-3 DIRECTIVES A PROJECT NUMBER.
*         IF AN ERROR IS DETECTED THE APPROPRIATE MESSAGE IS ISSUED.
* 
*         ENTRY  (X2) = TABLE ENTRY (TOPR). 
* 
*         EXIT   TO CCPX, IF NO ERROR.
*                TO DIP1, IF ERROR DETECTED.
* 
*         CALLS  NONE, IF NO ERROR. 
* 
*         USES   IF NO ERROR- 
*                X - 3, 4.
*                A - 4. 
  
  
 CCP      SUBR               ENTRY/EXIT 
          BX3    X2 
          LX3    5
          PL     X3,CCP1     IF NOT LEVEL-3 DIRECTIVE 
          SA4    FPNP 
          NZ     X4,CCPX     IF PROJECT NUMBER PRESENT
          EQ     CCP2        ERROR
  
 CCP1     SA4    FCNP 
          NZ     X4,CCPX     IF CHARGE NUMBER PRESENT 
  
          SB3    ERUH        ERROR
          EQ     CCP3 
  
 CCP2     SB3    ERUM 
 CCP3     RJ     ERU         USER ERROR 
          JP     DIP1        *MAIN LOOP* RETURN 
 CDV      SPACE  4,10 
**        CDV - CHECK DIRECTIVE AND VALUE.
* 
*         CHECK NUMBER OF CHARACTERS IN DIRECTIVE,S PARAMETER VALUE 
*         AND DIRECTIVE,S AUTHORIZATION. IF AN ERROR IS DETECTED, 
*         THE APPROPRIATE MESSAGE IS ISSUED.
* 
*         ENTRY  (X2) = TABLE ENTRY (TOPR). 
*                (X4) = NUMBER OF CHARACTERS IN VALUE.
* 
*         EXIT   TO CDVX, IF NO ERROR.
*                TO DIP1, IF ERROR DETECTED.
* 
*         CALLS  NONE, IF NO ERROR. 
* 
*         USES   IF NO ERROR- 
*                X - 3, 4, 5, 6.
*                A - 4. 
  
  
 CDV      SUBR               ENTRY/EXIT 
          ZR     X4,CDV1     IF NO CHARACTERS ASSEMBLED 
          BX3    X2 
          LX3    -42
          MX5    -6 
          BX6    -X5*X3 
          IX6    X6-X4
          NG     X6,CDV2     IF TOO MANY CHARACTERS 
          LX3    -6 
          BX3    -X5*X3 
          SA4    ACCC 
          IX3    X3-X4
          PL     X3,CDVX     IF DIRECTIVE AUTHORIZED
  
          SB3    ERUC 
          EQ     CDV3 
 CDV1     SB3    ERUQ 
          EQ     CDV3 
 CDV2     SB3    ERUB 
 CDV3     RJ     ERU         USER ERROR 
          EQ     DIP1        *MAIN LOOP* RETURN 
 CKU      SPACE  4,10 
**        CKU - CHECK FOR K-DISPLAY UPDATE. 
* 
*         ENTRY  (X1) = (DTII) = TABLE INDEX. 
*                (B7) = FWA OF PERTINENT TABLE OF INDICES (TOI).
*                (X5) = FIELD,S NEW VALUE.
* 
*         CALLS  CED, PVF, SFN. 
* 
*         USES   ALL REGISTERS EXCEPT A0. RESTORES X5, X1 IF USED.
  
  
 CKU5     BX1    X0 
          SA4    CBUF 
          RJ     CED         CONVERT ENTRY TO DISPLAY CODE
          RJ     PVF         PLACE DISPLAY CODE VALUE IN FIELD
 CKU6     BX5    X0          RESTORE
          SA1    DTII 
  
 CKU      SUBR               ENTRY/EXIT 
          SA3    OP 
          SX3    X3-KOPT
          NZ     X3,CKUX     IF NOT *K-DISPLAY* OPTION
          BX0    X5          SAVE 
          MX7    12 
          LX7    -12
 CKU1     SA5    B7 
          ZR     X5,CKU2     IF END OF TABLE
          BX3    X7*X5
          LX3    24 
          BX3    X1-X3
          SB7    B7+B1
          NZ     X3,CKU1     IF NO MATCH
          EQ     CKU5 
  
 CKU2     SB6    DSCE+2      PRESET DISPLAY ADDRESS 
          SX3    X1-XCEX
          ZR     X3,CKU3     IF *CEX* 
          SX3    X1-XPEX
          NZ     X3,CKU4.1   IF NOT *PEX* 
          SB6    DSPE+2 
 CKU3     SA1    =10H UNDEFINED 
          BX6    X1 
          ZR     X0,CKU4     IF ZERO VALUE
          EDATE  X0 
 CKU4     SA6    B6 
          EQ     CKU6 
  
 CKU4.1   SB6    DSPP+1      CHECK *PPW* DIRECTIVE
          SX3    X1-XPPW
          ZR     X3,CKU4.2   IF *PPW* DIRECTIVE 
          SB6    DSEP+1      CHECK *EPW* DIRECTIVE
          SX3    X1-XEPW
          ZR     X3,CKU4.2   IF *EPW* DIRECTIVE 
          SB6    DSPO+1      CHECK *PCR* DIRECTIVE
          SX3    X1-XPCR
          ZR     X3,CKU4.4   IF *PCR* DIRECTIVE 
          EQ     ERD9        DATA BASE ERROR
  
 CKU4.2   SA1    CBUF        PROCESS PASSWORD 
          SA2    =10H 
          ZR     X1,CKU4.3   IF EMPTY INPUT 
          SA2    =10H*******
 CKU4.3   BX6    X2 
          EQ     CKU4.5      SET VALUE IN DISPLAY BUFFER
  
 CKU4.4   SA1    CBUF 
          RJ     SFN         SPACE FILL NAME
 CKU4.5   SA6    B6 
          EQ     CKU6        RESTORE
 CNV      SPACE  4,10 
**        CNV - CONVERT NUMERIC VALUE FROM DISPLAY CODE TO BINARY.
* 
*         VALUES ALLOWED AND HAVING SIGNS ARE INCREMENTED OR
*         DECREMENTED FROM FIELD,S CURRENT VALUE. 
*         IF AN ERROR IS DETECTED THE APPROPRIATE MESSAGE IS ISSUED.
* 
*         ENTRY  (X1) = (DTII) = TABLE INDEX. 
*                (X2) = TABLE ENTRY (TOPR). 
*                (DF) = MAXIMUM VALUE.
*                (CBUF) = VALUE TO CONVERT (LEFT JUSTIFIED).
* 
*         EXIT   TO CNVX, IF NO ERROR.
*                (X5) = FIELD,S NEW VALUE.
*                TO DIP1, IF ERROR DETECTED.
* 
*         CALLS  DXB, GFV.
* 
*         USES   ALL REGISTERS EXCEPT A0, X0. 
  
  
 CNV8     MX1    -42         INSURE 42 BIT FIELD
          BX5    -X1*X6 
  
 CNV      SUBR               ENTRY/EXIT 
          SB6    B0          PRESET NO INCREMENT-DECREMENT
          SA5    CBUF 
          LX2    1
          PL     X2,CNV3     IF SIGN NOT ALLOWED
          MX7    6
          BX2    X7*X5
          SA3    =1L+ 
          BX3    X2-X3
          ZR     X3,CNV1     IF *+* SIGN
          SA3    =1L- 
          BX3    X2-X3
          NZ     X3,CNV3     IF NOT *-* SIGN
          SB6    -B1         DECREMENT
          EQ     CNV2 
  
 CNV1     SB6    B1          INCREMENT
 CNV2     BX5    -X7*X5      TAKE OUT SIGN
          LX5    6
 CNV3     SB7    B1 
          RJ     DXB         DISPLAY CODE TO BINARY CONVERSION
          NZ     X4,CNV7     IF ERROR 
          ZR     B6,CNV6     IF NO INCREMENT/DECREMENT
          SA1    DTII 
          SX7    X1 
          RJ     GFV         GET FIELD,S VALUE
          NG     B6,CNV5     IF DECREMENT 
          IX6    X1+X6       INCREMENT
          MX2    -12
          NZ     X1,CNV6     IF NOT PREVIOUSLY UNLIMITED
          SA1    X7+TOPR     GET TABLE ENTRY
          SA3    TOIA-1      SEARCH FOR TOI TABLE ENTRY 
          LX1    3
          NG     X1,CNV4     IF LEVEL-1 ENTRY 
          SA3    TOIC-1      SEARCH LEVEL-3 TABLE 
 CNV4     SA3    A3+B1
          ZR     X3,CNV6     IF END OF TABLE
          LX3    24 
          BX1    -X2*X3 
          IX1    X1-X7
          NZ     X1,CNV4     IF NO MATCH
          LX3    -20
          PL     X3,CNV6     IF ZERO VALUE NOT UNLIMITED
          BX6    X6-X6       LEAVE REGISTER UNLIMITED 
          EQ     CNV6 
  
 CNV5     IX6    X1-X6
          PL     X6,CNV6     IF NOT NEGATIVE RESULT 
          BX6    X6-X6       SET RESULT OF ZERO 
 CNV6     SA1    DF          MAXIMUM VALUE
          ZR     X1,CNV8     IF INFINITE VALUE ALLOWED
          IX1    X1-X6
          PL     X1,CNV8     IF MAXIMUM VALUE NOT EXCEEDED
  
 CNV7     SB3    ERUK 
          RJ     ERU         USER ERROR 
          JP     DIP1        *MAIN LOOP* RETURN 
 ILR      SPACE  4,10 
**        ILR - INITIALIZE INSTALLATION LIMIT REGISTERS.
* 
*         CALLS  CIV. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6. 
*                B - 2. 
  
  
 ILR      SUBR               ENTRY/EXIT 
          SA2    F.TAB1      LEVEL-1 INDICES
          SA3    T1IE 
          IX2    X2+X3
          SA2    X2+CLCW
          BX6    X2 
          SB2    8
          SA6    ILRA        SAVE LIMIT REGISTERS DEFAULT INDICES 
 ILR1     SA2    ILRA 
          LX2    -6 
          MX7    -6 
          BX6    X2 
          BX3    -X7*X2 
          SA4    B2+TISL
          SA6    A2 
          RJ     CIV         CONVERT INDEX TO VALUE 
          PL     X1,ILR2     IF NOT UNLIMITED 
          SX1    B0+
 ILR2     LX1    30 
          MX7    30 
          BX6    X7*X1
          SA6    B2+D3AA+PISW 
          SB2    B2-B1
          PL     B2,ILR1     IF MORE REGISTERS TO INITIALIZE
          EQ     ILRX 
  
  
 ILRA     BSS    1           LIMIT REGISTERS DEFAULT INDICES
 KOC      SPACE  4,10 
**        KOC - K-DISPLAY OUTPUT FOR CHARGE NUMBER ENTRY. 
* 
*         ENTRY  (X3) = FWA OF CHARGE ENTRY.
*                (CN) = CHARGE NUMBER.
*                (T1IE) = TABLE 1 INDEX OF ENTRY. 
* 
*         CALLS  CPV, SFC, SFN, SPT.
* 
*         USES   ALL REGISTERS EXCEPT A0, X0. 
  
  
 KOC      SUBR               ENTRY/EXIT 
          SA1    OP 
          SX6    X1-KOPT
          NZ     X6,KOCX     IF NOT *K-DISPLAY* OPTION
          RJ     SFC         CHARGE ENTRY SPECIAL FIELDS
          SA1    CN          CHARGE NUMBER
          RJ     SFN         SPACE FILL NAME
          SA6    DSCN+2 
          SA5    TOIA 
          RJ     CPV         CONVERT AND PLACE VALUES 
          SA1    KSAV+1      ENABLE K-DISPLAY FOR CHARGE NUMBER 
          BX6    X1 
          SA6    DSCN 
          SX1    B0+
          RJ     SPT         SET PAGE TABLE 
          EQ     KOCX 
 KOP      SPACE  4,10 
**        KOP - K-DISPLAY OUTPUT FOR PROJECT NUMBER ENTRY.
* 
*         ENTRY  (A5) = FWA OF PROJECT ENTRY. 
*                (PN - PN+1) = PROJECT NUMBER.
*                (T3IE) = TABLE 3 INDEX OF ENTRY. 
* 
*         CALLS  CPV, SFN, SFP, SPT.
* 
*         USES   ALL REGISTERS EXCEPT A0, X0. 
  
  
 KOP      SUBR               ENTRY/EXIT 
          SA1    OP 
          SX6    X1-KOPT
          NZ     X6,KOPX     IF NOT *K-DISPLAY* OPTION
          RJ     SFP         PROJECT ENTRY SPECIAL FIELDS 
          SA1    PN          SET PROJECT NUMBER IN K-DISPLAY FIELDS 
          RJ     SFN         SPACE FILL NAME
          SA6    DSPN+2 
          SA6    DSP2+2 
          SA1    A1+B1
          RJ     SFN         SPACE FILL NAME
          SA6    DSPN+3 
          SA6    DSP2+3 
          SA5    TOID 
          RJ     CPV         CONVERT AND PLACE VALUES 
          SX1    B1+
          RJ     SPT         SET PAGE TABLE 
          EQ     KOPX 
 SPT      SPACE  4,10 
**        SPT - SET PAGE TABLE. 
* 
*         ENTRY  (X1) = 0, INITIAL/CHARGE PAGE TABLE. 
*                     = 1, CHARGE/PROJECT PAGE TABLE. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
  
  
 SPT      SUBR               ENTRY/EXIT 
          SX6    SPTA        SET CURRENT PAGE TABLE TO INITIAL/CHARGE 
          MX2    42 
          ZR     X1,SPT1     IF INITIAL/CHARGE PAGE TABLE 
          SA3    SPTB        RESET PAGE TABLE HEADER TO PAGE ONE
          LX3    30 
          BX3    X2*X3
          SX6    B1 
          BX6    X6+X3
          LX6    30 
          SA6    A3 
          SA1    KSAV        RESTORE PAGE NUMBER LINE 
          SX6    SPTB        SET CURRENT PAGE TABLE TO PROJECT DISPLAY
 SPT1     BX7    X1          FORMAT PAGE NUMBER LINE
          SA6    KPAG 
          SA7    KPLN 
          SA1    KIA         SET CURRENT MESSAGE AREAS
          SX3    DSA
          BX6    X1*X2
          BX6    X3+X6
          SA6    A1+
          SX6    MESA+1 
          SX7    INPA+1 
          SA6    M1 
          SA7    IL 
          EQ     SPTX        RETURN 
  
  
*         INITIAL AND CHARGE DISPLAY PAGE TABLE.
  
 SPTA     PAGT   DSA,MESA+1,INPA+1  LEFT SCREEN PAGE 1
          PAGT
          PAGT   DSD         RIGHT SCREEN 
          PAGT   *
  
*         PROJECT DISPLAY PAGE TABLE. 
  
 SPTB     PAGT   DSA,MESA+1,INPA+1  LEFT SCREEN PAGE 1
          PAGT   DSB,MESB+1,INPB+1  LEFT SCREEN PAGE 2
          PAGT   DSC,MESC+1,INPC+1  LEFT SCREEN PAGE 3
          PAGT
          PAGT   DSD         RIGHT SCREEN 
          PAGT   *
 MQE      SPACE  4,10 
**        MQE - MAKE QUEUE ENTRY. 
* 
*         A NEW QUEUE ENTRY IS APPENDED TO END OF DIRECTIVE QUEUE 
*         (NOT PERTINENT FOR *CREATE* MODE). IF NECESSARY, QUEUE
*         MAXIMUM SIZE IS INCREASED TO MAKE ROOM FOR ENTRY. 
*         IN ADDITION, DIRECTIVE,S CORRESPONDING TABLE 1 OR 3 FIELD 
*         IS UPDATED (PERTINENT WHEN FIELD SIZE VALUE .NE. 0), AND
*         K-DISPLAY UPDATED (PERTINENT WHEN *K-DISPLAY* OPTION).
*         ONE WORD QUEUE ENTRY GENERATED IS IN FORM-
*                12/A, 6/, 42/B 
*                WHERE
*                A = TABLE INDEX. 
*                B = VALUE. 
* 
*         ENTRY  (X1) = (DTII) = TABLE INDEX. 
*                (X2) = TABLE ENTRY (TOPR). 
*                (X5) = VALUE FIELD OF ENTRY. 
* 
*         CALLS  AMQ, CKU, SDF. 
* 
*         USES   ALL REGISTERS. 
  
  
 MQE      SUBR               ENTRY/EXIT 
          SX6    B1 
          LX2    3
          PL     X2,MQE1     IF NO LEVEL-1 UPDATE NEEDED
          SA6    FUP1 
 MQE1     LX2    1
          PL     X2,MQE2     IF NO LEVEL-2 UPDATE NEEDED
          SA6    FUP2 
 MQE2     LX2    1
          PL     X2,MQE3     IF NO LEVEL-3 UPDATE NEEDED
          SA6    FUP3 
 MQE3     SA4    DF+2        FIELD SIZE 
          ZR     X4,MQE5     IF SET DATA IN FIELD NOT PERTINENT 
          BX6    X5 
          SA3    F.TAB3      PRESET LEVEL-3 DIRECTIVE 
          SA4    T3IE 
          SB7    TOIC 
          NG     X2,MQE4     IF LEVEL-3 DIRECTIVE 
          SA3    F.TAB1 
          SA4    T1IE 
          SB7    TOIA 
 MQE4     IX3    X3+X4
          FUNC   SDFT        SET DATA IN FIELD
          SA1    DTII 
          RJ     CKU         CHECK FOR K-DISPLAY UPDATE 
  
 MQE5     SA2    UF 
          ZR     X2,MQEX     IF QUEUE ENTRY NOT PERTINENT 
          LX1    -12         MERGE INTO QUEUE ENTRY 
          BX7    X1+X5
          SA1    QSIZ        CHECK FOR FULL QUEUE 
          SA2    QMAX 
          IX3    X1-X2
          NG     X3,MQE6     IF NO NEED TO ALLOCATE MORE TO QUEUE 
          NZ     X3,ERD4     IF ERROR 
          BX0    X7          PRESERVE 
          RJ     AMQ         ALLOCATE MEMORY TO QUEUE 
          SA1    QSIZ        RESTORE
          BX7    X0 
 MQE6     SX6    X1+B1       UPDATE QUEUE SIZE AND STORE ENTRY
          SA6    A1 
          SA7    X1+MEML
          EQ     MQEX 
 RCE      SPACE  4,10 
**        RCE - REGENERATE CHARGE NUMBER QUEUE ENTRY. 
* 
*         *CN* ENTRY IS MADE IN DIRECTIVE QUEUE.
* 
*         ENTRY  (DTII) = TABLE INDEX.
* 
*         CALLS  MQE, SPB.
* 
*         USES   ALL REGISTERS. 
  
  
 RCE      SUBR               ENTRY/EXIT 
          SA1    DTII        SAVE TABLE INDEX 
          BX6    X1 
          SA6    RCEA 
          SX1    XCND        TABLE INDEX FOR QUEUE ENTRY
          BX7    X1 
          SA7    A1 
          SA2    X1+TOPR
          BX5    X5-X5
          RJ     MQE         MAKE QUEUE ENTRY 
          SA1    RCEA        RESTORE TABLE INDEX
          BX6    X1 
          SA6    DTII 
          SX1    CN 
          SX0    N
          FUNC   SPBT        SET PRIMARY BLOCK
          NZ     X6,ERD5     IF ERROR 
          NZ     X4,ERD6     IF ENTRY NOT FOUND 
          SA1    F.TAB1      TABLE 1 INDEX OF ENTRY 
          IX6    X3-X1
          SA6    T1IE 
          EQ     RCEX 
  
 RCEA     BSS    1           HOLD LOCATION
          TITLE  UPDATE/CREATE SUBROUTINES - MAIN QUEUE ROUTINE.
 DQP      SPACE  4,10 
**        DQP - DIRECTIVE QUEUE PROCESSOR.
* 
*         EACH QUEUE ENTRY IS PROCESSED BY CALLING THE APPROPRIATE
*         QUEUE PROCESSOR. QUEUE PROCESSING CONTINUES UNTIL ALL 
*         ENTRIES HAVE BEEN PROCESSED. PROFILE FILE IS INTERLOCKED
*         IN MODIFY MODE WHILE QUEUE PROCESSING (NOT NECESSARY IF 
*         *CREATE* OPTION). QUEUE PROCESSING IS INITIATED WHEN A
*         DIFFERENT CHARGE OR PROJECT NUMBER ENTRY IS ENCOUNTERED 
*         DURING DIRECTIVE INPUT PROCESSING, WHEN DIRECTIVE INPUT 
*         PROCESSING IS TERMINATED, OR WHEN *END* DIRECTIVE ISSUED
*         (WHEN *K-DISPLAY* OPTION).
* 
*         ENTRY  (QSIZ) = QUEUE SIZE. 
*                (CN) = CHARGE NUMBER.
*                (PN - PN+1) = PROJECT NUMBER, IF PERTINENT.
* 
*         EXIT   TO QUEUE PROCESSORS- 
*                (X1) = QUEUE ENTRY.
*                (X7) = (DTIQ) = TABLE INDEX. 
* 
*         CALLS  IPP, MSG, UDD, WCL, WDL, WPL, QUEUE PROCESSORS.
* 
*         USES   ALL REGISTERS. 
  
  
 DQP4     SX0    P
          SX5    P
          BX6    X6-X6
          FUNC   UDDT        UPDATE DIRECTORY 
          NZ     X6,ERD45    IF ERROR 
 DQP5     RETURN P,R
          SA1    IPPD        RESET CPU PRIORITY 
          SETPR  X1 
          SETRNR ROLL        ALLOW JOB ROLLOUT
          MESSAGE DQPB,1,R   B-DISPLAY MESSAGE
 DQP6     BX6    X6-X6       EMPTY QUEUE
          SA6    QSIZ 
  
 DQP      SUBR               ENTRY/EXIT 
          SA1    OP 
          SX1    X1-COPT
          SA2    FUP1 
          SA3    A2+B1
          SA4    A3+B1
          BX6    X2+X3
          BX6    X4+X6
          NZ     X6,DQP1     IF NEED TO PROCESS QUEUE 
          SA2    ET 
          PL     X2,DQP6     IF NO LEVEL-0 UPDATE 
          SA2    DQPA 
          ZR     X2,DQP6     IF NEVER PROCESSED QUEUE 
          ZR     X1,DQP6     IF *CREATE* OPTION 
          RJ     IPP         INTERLOCK PROFILE FILE 
          EQ     DQP4 
  
 DQP1     BX7    X7-X7       CLEAR QUEUE POINTER
          SA7    QPTR 
          ZR     X1,DQP2     IF *CREATE* OPTION 
          SA6    DQPA        INDICATE PROCESS OF QUEUE
          RJ     IPP         INTERLOCK PROFILE FILE 
  
*         *MAIN LOOP* 
  
 DQP2     BSS    0
          SA1    QPTR        QUEUE POINTER
          SA2    QSIZ        QUEUE SIZE 
          IX3    X1-X2
          ZR     X3,DQP3     IF THRU PROCESSING QUEUE 
          PL     X3,ERD26    IF ERROR 
          SX6    X1+B1       INCREMENT QUEUE POINTER
          SA6    A1 
          SA1    X1+MEML     NEXT QUEUE ENTRY TO PROCESS
          MX2    12 
          BX7    X2*X1
          LX7    12 
          SA7    DTIQ        TABLE INDEX
          SA2    X7+TOPR     TABLE ENTRY
          SB2    X2 
          JP     B2          QUEUE PROCESSOR
  
 DQP3     SA1    OP 
          SX1    X1-COPT
          NZ     X1,DQP3.1   IF NOT *CREATE* OPTION 
          RECALL N           COMPLETE I/O ON DUPLICATE FET
 DQP3.1   RJ     WDL         WRITE DATA LEVEL 
          RJ     WPL         WRITE PROJECT LEVEL
          RJ     WCL         WRITE CHARGE LEVEL 
          SA1    OP 
          SX6    X1-COPT
          ZR     X6,DQP3.2   IF *CREATE* OPTION 
          SA1    ET 
          PL     X1,DQP5     IF NO LEVEL-0 UPDATE 
          EQ     DQP4 
  
 DQP3.2   RECALL P           COMPLETE I/O ON DUPLICATE FET
          EQ     DQP6        SET QUEUE EMPTY AND RETURN 
  
  
 DQPA     CON    0           QUEUE PROCESSED FLAG 
 DQPB     DATA   L* PROFILE FILE RELEASED * 
          TITLE  UPDATE/CREATE SUBROUTINES - QUEUE PROCESSORS.
 AUP      SPACE  4,10 
**        AUP - *AUN* PROCESSOR.
* 
*         ENTRY  (X1) = QUEUE ENTRY.
* 
*         EXIT   TO DQP2. 
* 
*         CALLS  AUN. 
* 
*         USES   ALL REGISTERS. 
  
  
 AUP      BSS    0
          MX3    -42
          BX1    -X3*X1 
          RJ     AUN         ADD USER NAME
          JP     DQP2        *MAIN LOOP* RETURN 
 CNP      SPACE  4,10 
**        CNP - CHARGE NUMBER PROCESSOR.
* 
*         PROCESSES *ACN*, *CN*, *DCN*. 
* 
*         ENTRY  (DTIQ) = TABLE INDEX.
*                (CN) = CHARGE NUMBER.
* 
*         EXIT   TO DQP2. 
*                (T1IE) = TABLE 1 INDEX OF ENTRY. 
* 
*         CALLS  ATS, MVE, MWS, SPB.
* 
*         USES   ALL REGISTERS. 
  
  
 CNP      BSS    0
          SX1    CN 
          SX0    N
          FUNC   SPBT        SET PRIMARY BLOCK
          NZ     X6,ERD10    IF ERROR 
          SA1    DTIQ 
          NZ     X4,CNP2     IF CHARGE NUMBER NOT FOUND 
          SA2    F.TAB1      TABLE 1 INDEX OF ENTRY 
          IX6    X3-X2
          SA6    T1IE 
          SB2    X1-XCND
          ZR     B2,DQP2     IF *CN*
          MX2    1
          SA3    X3+CSRW
          SB2    X1-XDCN
          ZR     B2,CNP1     IF *DCN* 
          BX6    -X2*X3      ACTIVATE CHARGE NUMBER 
          SA6    A3 
          EQ     DQP2 
  
 CNP1     BX6    X2+X3       DEACTIVATE CHARGE NUMBER 
          SA6    A3 
          EQ     DQP2 
  
 CNP2     SB2    X1-XACN
          NZ     B2,ERD11    IF NOT *ACN* 
          SA5    L.TAB1 
          ALLOC  TAB1,C.TAB1
          IX5    X2+X5
          MOVE   C.TAB1,D1AA,X5  INITIALIZE ENTRY TO DEFAULT
          SA0    B1 
          FUNC   STBT        SORT TABLE 1 
          SX1    B1 
          SB6    CN 
          FUNC   MWST        SEARCH TABLE 1 
          NZ     X2,ERD7     IF CHARGE NUMBER NOT FOUND 
          SB3    X4          TABLE 1 INDEX OF ENTRY 
          SX6    B2-B3
          SA6    T1IE 
          JP     DQP2        *MAIN LOOP* RETURN 
 DUP      SPACE  4,10 
**        DUP - *DUN* PROCESSOR.
* 
*         ENTRY  (X1) = QUEUE ENTRY.
* 
*         EXIT   TO DQP2. 
* 
*         USES   A - 1, 2, 6. 
*                B - 2, 3.
*                X - 1, 2, 3, 4, 6. 
* 
*         CALLS  GES, NUE.
  
  
 DUP      BSS    0
          MX3    -42         SEARCH FOR USER NAME 
          BX6    -X3*X1 
          LX6    18 
          SA6    UNUM 
 DUP1     RJ     NUE         GET NEXT USER NAME ENTRY 
          NZ     B2,DUP2     IF END OF LEVEL-3 CHAIN
          SX2    X1 
          NZ     X2,DUP2     IF END OF LIST 
          SA2    UNUM 
          BX6    X1-X2
          BX1    X1-X1
          NZ     X6,DUP1     IF NO MATCH
          SA6    A1          CLEAR ENTRY FROM TABLE 
          SA1    F.TAB3      DECREMENT USER NAME COUNT FIELD
          SA2    T3IE 
          IX1    X1+X2
          SA2    X1 
          LX2    -24
          MX3    -12
          BX4    -X3*X2 
          SX4    X4-1 
          NG     X4,ERD27    IF ERROR 
          BX2    X3*X2
          BX6    X2+X4
          LX6    24 
          SA6    A2 
          EQ     DQP2        *MAIN LOOP* RETURN 
  
 DUP2     SB3    ERUL        **** DELETE NON-EXISTENT USER NAME.
          RJ     ERU         USER ERROR 
          EQ     DQP2        RETURN TO MAIN LOOP
 MDP      SPACE  4,10 
**        MDP - MISCELLANEOUS DIRECTIVE PROCESSOR.
* 
*         PROCESSES *MU*, *PCL*, *M1*,..., *M4*, *AD*, *CEX*, 
*         *ISL*, *IR1*,...,*IR8*, *PEX*, *TI*, *TO*, *PFN*, *PUN*,
*         *PPW*, *PCR*, *EFN*, *EUN*, *EPW*, *ISV*, *SML*,
*         *SMA*, *SIL*, *SIA*, *LR1*, *AR1*,..., *LR8*, *AR8*.
* 
*         ENTRY  (X1) = QUEUE ENTRY.
*                (X7) = TABLE INDEX.
*                TO MDP1, IF LEVEL-1 DIRECTIVE. 
*                TO MDP3, IF LEVEL-3 DIRECTIVE. 
* 
*         EXIT   TO DQP2. 
* 
*         CALLS  DFS, SDF.
* 
*         USES   ALL REGISTERS. 
  
  
 MDP      BSS    0
 MDP1     SA2    F.TAB1 
          SA5    T1IE 
          EQ     MDP3 
  
 MDP2     SA2    F.TAB3 
          SA5    T3IE 
  
 MDP3     RJ     DFS         (DF) - (DF+4) SET-UP 
          MX3    -42
          BX6    -X3*X1 
          IX3    X2+X5       FWA OF ENTRY 
          FUNC   SDFT        SET DATA IN FIELD
          JP     DQP2        *MAIN LOOP* RETURN 
 PNP      SPACE  4,10 
**        PNP - PROJECT NUMBER PROCESSOR. 
* 
*         PROCESSES *APN*, *DPN*, *PN*. 
* 
*         ENTRY  (DTIQ) = TABLE INDEX.
*                (PN - PN+1) = PROJECT NUMBER.
* 
*         EXIT   TO DQP2. 
*                (RA3) = 0, IF NEW LEVEL-3 BLOCK. 
*                      = LEVEL-3 RANDOM ADDRESS, ELSE.
*                (T2IE) = TABLE 2 INDEX OF ENTRY. 
*                PROJECT COUNT UPDATED, IF *APN* OR *DPN*.
* 
*         CALLS  ADB, ATS, MVE, MWS, PDE, PEI, STB, UPC.
* 
*         USES   ALL REGISTERS. 
  
  
 PNP      BSS    0
          RJ     PEI         PROJECT ENTRY INITIALIZATION 
          NZ     X4,PNP2     IF PROJECT NUMBER NOT FOUND
          SA1    F.TAB2      TABLE 2 INDEX OF ENTRY 
          IX6    X3-X1
          SA6    T2IE 
          SX7    X5          LEVEL-3 RANDOM ADDRESS 
          SA7    RA3
          SX0    N
          RJ     ADB         ADD DATA LEVEL BLOCK 
          SA1    DTIQ 
          SB2    X1-XPND
          ZR     B2,DQP2     IF *PN*
          MX2    1
          SA3    A5+PTMW
          SB2    X1-XDPN
          ZR     B2,PNP1     IF *DPN* 
          PL     X3,DQP2     IF ALREADY ACTIVE
          BX6    -X2*X3      ACTIVATE PROJECT NUMBER
          SA6    A3 
          EQ     PNP3 
  
 PNP1     NG     X3,DQP2     IF ALREADY INACTIVE
          BX6    X2+X3       DEACTIVATE PROJECT NUMBER
          SA6    A3 
          EQ     PNP3 
  
 PNP2     SA1    DTIQ 
          SX1    X1-XAPN
          NZ     X1,ERD13    IF NOT *APN* 
          SA5    L.TAB2 
          SA1    PN 
          ADDWRD TAB2,X1
          SA1    PN+1 
          ADDWRD TAB2,X1
          BX1    X1-X1
          ADDWRD TAB2,X1
          SX0    N
          RJ     PDE         PROCESS DATA LEVEL ENTRY 
          MOVE   C.TAB3,D3AA,X0 
          SA0    B1+B1
          FUNC   STBT        SORT TABLE 2 
          SX1    B1 
          SB6    PN 
          FUNC   MWST        SEARCH TABLE 2 
          NZ     X2,ERD8     IF PROJECT NUMBER NOT FOUND
          SB3    X4          TABLE 2 INDEX OF ENTRY 
          SX6    B2-B3
          SA6    T2IE 
          SX1    XAPN 
  
 PNP3     RJ     UPC         UPDATE PROJECT COUNT 
          SA6    A2 
          JP     DQP2        *MAIN LOOP* RETURN 
          TITLE  UPDATE/CREATE SUBROUTINES - QUEUE PROCESSOR ROUTINES.
 IPP      SPACE  4,10 
**        IPP - INTERLOCK PROFILE FILE. 
* 
*         PROFILE FILE IS ATTACHED IN MODIFY MODE. IF FILE BUSY,
*         A ROLLOUT IS PERFORMED AND ANOTHER ATTEMPT MADE.
* 
*         EXIT   TO IPPX, IF ATTACH SUCCESSFUL. 
*                TO ABT1, IF PFM ERROR. 
* 
*         CALLS  CFS, MSG.
* 
*         USES   ALL REGISTERS. 
  
  
 IPP2     MESSAGE IPPB,1,R   B-DISPLAY MESSAGE
          SETRNR NOROLL      PREVENT JOB ROLLOUT
          SETPR  LSCS 
  
 IPP      SUBR               ENTRY/EXIT 
          GETPR  IPPD 
 IPP1     ATTACH P,,,,M,,,IP,MA 
          SB2    P
          RJ     CFS         CHECK FILE STATUS
          ZR     X2,IPP2     IF NO PFM ERROR
          SX3    X2-1 
          NZ     X3,ABT3     IF ERROR IS NOT *FILE BUSY*
          ROLLOUT =0
          EQ     IPP1        TRY AGAIN
  
 IPPB     DATA   L* PROFILE FILE INTERLOCKED* 
  
 IPPD     CON    0           CPU PRIORITY 
 WCL      SPACE  4,10 
**        WCL - WRITE CHARGE LEVEL (LEVEL-1). 
* 
*         ENTRY  (FUP1) .NE. 0, IF UPDATE OF LEVEL-1 NECESSARY. 
* 
*         CALLS  WTB. 
* 
*         USES   ALL REGISTERS. 
  
  
 WCL      SUBR               ENTRY/EXIT 
          SA1    FUP1 
          ZR     X1,WCLX     IF NO LEVEL-1 UPDATE NEEDED
          BX6    X6-X6       CLEAR LEVEL-1 UPDATE FLAG
          SA6    A1 
          SA0    B1 
          SX5    P
          FUNC   WTBT        WRITE TABLE 1
          EQ     WCLX 
          TITLE  COMMON SUBROUTINES.
 ACI      SPACE  4,10 
 ACI      SPACE 4,18
**        ACI - ASSEMBLE CHARACTERS INTERFACE.
* 
*         ENTRY  (X1) = BIT STRING OF CHARACTERS TO PERMIT. 
* 
*         EXIT   (CBUF - CBUF+CBUFL) = LEFT-JUSTIFIED ASSEMBLED 
*                                      CHARACTERS.
*                (X4) = NUMBER OF CHARACTERS. 
*                (B5) = SEPARATOR (0 IF END OF LINE). 
*                (B6) = 0, IF ENTRY TERMINATION.
*                (B6) .NE. 0, IF ASSEMBLY COMPLETE. 
*                (ET) = -1, IF EOF. 
*                (ET) = 1, IF */* ENTRY TERMINATION.
* 
*         CALLS  ASC. 
* 
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 4.
  
  
 ACI      SUBR               ENTRY/EXIT 
          BX6    X1 
          SA6    ACIB        SAVE BIT STRING
          BX6    X6-X6
          SA6    ACIA        CLEAR CHARACTER COUNT
          SA6    ACIC        CLEAR CHARACTER BUFFER INDEX 
          SB2    CBUFL-1
 ACI1     SA6    B2+CBUF     CLEAR CHARACTER BUFFER 
          SB2    B2-1 
          PL     B2,ACI1
 ACI2     SX0    I           INPUT FET ADDRESS
          SA2    BS          BLANK SUPPRESSION
          BX6    X2 
          SA1    ACIB        BIT STRING OF CHARACTERS TO PERMIT 
          FUNC   ASCT        ASSEMBLE CHARACTERS
          SA2    ACIC 
          SA6    CBUF+X2     STORE ASSEMBLED CHARACTERS 
          SA1    ACIA 
          SB4    X4-10
          IX4    X1+X4       INCREMENT CHARACTER COUNT
          NG     B4,ACIX     RETURN IF SEPARATOR ENCOUNTERED
          BX7    X4 
          SA7    A1 
          SX3    X2-CBUFL-1 
          PL     X3,ACI2     IF BUFFER FULL 
          SX7    X2+B1
          SA7    A2          INCREMENT CHARACTER BUFFER INDEX 
          EQ     ACI2 
  
  
 ACIA     CON    0           CHARACTER COUNT
 ACIB     CON    0           BIT STRING OF CHARACTERS TO PERMIT 
 ACIC     CON    0           CHARACTER BUFFER INDEX 
 COB      SPACE  4,15 
**        COB - CHECK OUTPUT BUFFER.
* 
*         EXIT   OUTPUT BUFFER FLUSHED IF NECESSARY AND *SSST* STATUS 
*                REMOVED FROM OUTPUT FILE.
* 
*         USES   X - 1, 2, 3. 
*                A - 1, 2, 3. 
* 
*         MACROS SETFS, STATUS, WRITER. 
  
  
 COB      SUBR               ENTRY/ EXIT
          SA3    PO 
          SA1    PGLC 
          ZR     X3,COB1     IF TERMINAL FILE 
          SX1    X1-99999 
          ZR     X1,COBX     IF NO DATA WRITTEN 
 COB1     WRITER O,R         FLUSH OUTPUT 
          ZR     X3,COBX     IF TERMINAL FILE 
          STATUS O,P
          SA2    O+5         GET FNT
          MX1    -6 
          BX2    -X1*X2      GET FILE STATUS
          SX1    X2-SSST
          NZ     X1,COBX     IF PRIOR OUTPUT ID 
          SETFS  O,0         CLEAR FILE STATUS
          EQ     COBX        RETURN 
 SIN      SPACE  4,11 
**        SIN - SUBROUTINE INTERFACE. 
* 
*         ENTRY  (B7)        SUBROUTINE ADDRESS.
* 
*         EXIT   TO ROUTINE WITH RETURN ADDRESS SET.
* 
*         CALLS  NONE.
* 
*         USES   A - 1, 6.
*                X - 1, 6.
*                B - 7. 
  
  
 SIN      SUBR               ENTRY/EXIT 
          SA1    SIN         SET RETURN ADDRESS 
          BX6    X1 
          SA6    B7 
          JP     B7+1        JUMP TO ROUTINE
 ABT      SPACE  4
**        ABT - ABORT EXIT. 
  
  
 ABM      SA1    CN          ABORT AFTER ISSUING OUTPUT FILE MESSAGE
          SA2    PN 
          BX6    X1 
          LX7    X2 
          SA6    FCNP        SET CHARGE PRESENT INDICATOR 
          SA7    FPNP        SET PROJECT PRESENT INDICATOR
          RJ     ERU         ISSUE ERROR MESSAGE
          SX2    PROB        *DIRECTIVE ERRORS.*
          EQ     ABT         ABORT AFTER CLEAN UP 
  
 ABE      SX2    =C* PROFILE ABORTED.*
 ABT      MESSAGE X2
 ABT1     BX6    X6-X6       CLEAR K-DISPLAY
          SA6    DSA+1
          RECALL N
          RETURN P
          RETURN N
          RJ     COB         CHECK OUTPUT FILE BUFFER 
          RJ     CAF         CHECK ALTERNATE FAMILY 
          ABORT 
  
 ABT3     SX2    EBUF 
          EQ     ABT         ISSUE *PFM* ERROR MESSAGE AND ABORT
 TOV      SPACE  4
**        TOV - TABLE OVERFLOW. 
* 
*         ENTRY  FROM *ATS* ONLY. 
*                (B6) = EXIT ADDRESS IN *COMCMTP* TO CONTINUE 
*                       PROCESSING. 
* 
*         EXIT   TO (B6). 
*                FIELD LENGTH INCREASED BY *FLIN* WORDS.
*                (TV) .NE. 0, IF FIELD LENGTH LIMIT REACHED.
* 
*         USES   X - 3, 4, 6. 
*                A - 3, 4, 6. 
* 
*         MACROS MEMORY.
  
  
 TOV      BSS    0           ENTRY
          SA4    FLM         MAXIMUM FIELD LENGTH 
          SA3    ML          CURRENT FIELD LENGTH 
          SX3    X3+FLIN
          IX4    X3-X4       LIMIT FIELD LENGTH 
          NG     X4,TOV1     IF ADEQUATE FIELD LENGTH 
          SX6    B1          INDICATE OVERFLOW
          SA6    TV 
 TOV1     MEMORY CM,TOVB,R,X3 
          SA3    TOVB        GET FIELD LENGTH ASSIGNED
          AX3    30 
          BX6    X3 
          SA6    ML          SET NEW FIELD LENGTH 
          SX6    X6-10B 
          SA6    F.TEND      ADJUST TABLE LENGTH
          JP     B6          EXIT 
  
  
 TOVB     CON    0           FIELD LENGTH STATUS RETURN 
 HDR      SPACE  4
**        HDR - WRITE HEADER. 
* 
*         ENTRY  NONE.
* 
*         EXIT   HEADER LINES WRITTEN TO OUTPUT FILE. 
*                (X2) = OUTPUT FILE FET ADDRESS.
* 
*         USES   ALL REGISTERS EXCEPT A0, X0, A5 AND X5.
* 
*         CALLS  CDD, SFN.
* 
*         MACROS WRITEH, WRITEW.
  
  
 HDR5     SA7    PGLC        DISABLE FURTHER PAGING 
          ZR     X1,HDRX     IF TERMINAL OUTPUT 
          SA3    HDRL 
          SA1    CCDR+8 
          BX6    X3 
 HDR6     SA1    A1-B1       BLANK FILL COMMAND IMAGE 
          SA6    A1 
          ZR     X1,HDR6     IF NOT END OF COMMAND
          RJ     SFN         BLANK FILL LAST WORD OF COMMAND
          SA6    A1 
          WRITEW O,HDRK,B1   WRITE PAGE EJECT 
          WRITEW X2,CCDR,8   WRITE COMMAND
          WRITEH X2,HDRH,B1+B1  WRITE DATE AND TIME 
 HDR7     WRITEH X2,HDRL,B1  WRITE BLANK LINE 
  
 HDR      SUBR               ENTRY/EXIT 
          SA3    OP          CHECK FOR LIST OPTION
          SA1    PO          CHECK FOR TERMINAL OUTPUT
          SX3    X3-LOPT
          SX7    -1 
          NZ     X3,HDR5     IF NOT LIST OPTION 
          NZ     X1,HDR1     IF NOT TERMINAL OUTPUT 
          MX6    6
          SA1    HDRA 
          BX6    -X6*X1 
          SA2    =1L
          BX6    X6+X2
          SA6    A1 
          SA7    PGLC        DISABLE FURTHER PAGING 
  
 HDR1     WRITEW O,HDRA,B1
          SA4    LO 
          SX2    HDRB 
          SX1    X4-CSLO
          ZR     X1,HDR2     IF CHARGE NUMBER LIST
          SX1    X4-CMLO
          ZR     X1,HDR2     IF MASTER USER CHARGE NUMBER LIST
          SX2    HDRC 
          SX1    X4-PSLO
          ZR     X1,HDR2     IF PROJECT NUMBER LIST 
          SX1    X4-PMLO
          ZR     X1,HDR2     IF MASTER USER PROJECT NUMBER LIST 
          SX2    HDRD 
  
 HDR2     WRITEW O,X2,B1+B1 
          SA4    LO 
          SX2    HDRE 
          SX1    X4-FMLO
          PL     X1,HDR3     IF MASTER USER OPTION
          SX2    HDRF 
  
 HDR3     WRITEW O,X2,3 
          SA2    PO 
          ZR     X2,HDR4     IF TERMINAL FILE 
          SA1    HDRJ        PAGE NUMBER
          SX6    X1+B1
          SA6    A1 
          RJ     CDD
          MX4    -36
          SA2    =4LPAGE
          BX6    -X4*X6 
          BX6    X6+X2
          SA6    HDRI 
  
 HDR4     WRITEH O,HDRI,B1
          WRITEH X2,HDRG,7
          EQ     HDR7        WRITE BLANK LINE 
  
  
 HDRA     DIS    1,1 "PPFN" 
 HDRB     DIS    2,CHARGE NUMBER LIST 
 HDRC     DIS    2,PROJECT NUMBER LIST
 HDRD     DIS    2,FULL FILE LIST 
 HDRE     DIS    3,OF MASTER USER 
 HDRF     DIS    2,OF FULL FILE.
 HDRG     DIS    5,          CHARGE NUMBER       MASTER USER
 HDRH     BSSZ   2           DATE AND TIME
 HDRI     CON    0
 HDRJ     CON    1           PAGE NUMBER
 HDRK     CON    1H1
 HDRL     CON    10H
 WOL      SPACE  4
**        WOL - WRITE OUTPUT LINE.
* 
*         ENTRY  (X2)        ADDRESS OF FET FOR FILE. 
*                (B6)        FWA OF WORKING BUFFER. 
*                (B7)        WORD COUNT OF WORKING BUFFER.
*                IF (B7) = 0, NO TRANSFER WILL BE PERFORMED.
* 
*         EXIT   (X2)        ADDRESS OF FET FOR FILE. 
*                NEW HEADER WRITTEN IF END OF PAGE. 
* 
*         CALLS  HDR, WTH.
* 
*         USES   ALL REGISTERS EXCEPT A0, X0, A5 AND X5.
  
  
 WOL      SUBR               ENTRY/EXIT 
          SX3    X2-O 
          NZ     X3,WOL1     IF NOT OUTPUT FILE 
          SA1    PGLC 
          NG     X1,WOL1     IF PAGING DISABLED 
          SX6    X1+B1       INCREMENT LINE COUNT 
          SA4    A1+B1       GET LINE LIMIT 
          IX4    X1-X4
          SA6    A1 
          NG     X4,WOL1     IF NOT END OF PAGE 
          SX6    4
          SX7    B6 
          SA6    A1          RESET LINE COUNT 
          SA7    WOLA 
          SX6    B7          SAVE REGISTERS 
          SA6    A7+B1
          RJ     HDR         WRITE HEADER 
          SA3    WOLA        RESTORE REGISTERS
          SA4    A3+B1
          SB6    X3 
          SB7    X4 
 WOL1     WRITEH X2,B6,B7 
          EQ     WOLX        RETURN 
  
 WOLA     BSSZ   2           HOLD AREA FOR REGISTERS
 CAF      SPACE  4
**        CAF - CHECK ALTERNATE FAMILY. 
* 
*         EXIT   (X6) .NE. 0, IF FAMILY NAME CHANGE NOT ALLOWED.
*                FAMILY NAME SET TO (FN) IF (FN) .NE. -1 AND JOB
*                IS FROM SYSTEM ORIGIN. 
*                TO *ABT*, IF INCORRECT FAMILY NAME SPECIFIED.
* 
*         USES   A - 1,2,6. 
*                B - NONE.
*                X - 1,2,6. 
* 
*         CALLS  CPM,ABT. 
  
  
 CAF      SUBR               ENTRY/EXIT 
          SA1    FN 
          MX6    59 
          BX6    X1-X6
          ZR     X6,CAFX     IF FAMILY NOT SPECIFIED
          SA1    OT 
          SX6    X1-SYOT
          NZ     X6,CAFX     IF NOT SYSTEM ORIGIN 
          ENFAM  FN 
          SA1    FN 
          MX6    -18
          BX6    X6*X1
          LX1    59-11
          SX2    =C* FM NOT LEGAL FAMILY.*
          PL     X1,CAF1     IF FAMILY CHANGED
          MX6    59 
          SA6    A1 
          EQ     ABT
  
 CAF1     SA6    A1          SET OLD FAMILY NAME
          BX6    X6-X6
          EQ     CAFX        RETURN 
 ADB      SPACE  4,10 
**        ADB - ADD DATA LEVEL BLOCK TO TABLE 3.
* 
*         ENTRY  (X7) = RANDOM ADDRESS OF BLOCK TO READ.
*                (X0) = FET ADDRESS TO READ FROM. 
*                (CN) = CHARGE NUMBER.
*                (PN - PN+1) = PROJECT NUMBER.
* 
*         EXIT   (A5) = FWA OF LEVEL-3 ENTRY. 
*                (T3IE) = TABLE 3 INDEX OF ENTRY. 
* 
*         CALLS  CEP, RDB.
* 
*         USES   ALL REGISTERS. 
  
  
 ADB2     SX6    B2+         SET TABLE 3 INDEX OF ENTRY 
          SA6    T3IE 
  
 ADB      SUBR               ENTRY/EXIT 
          BX6    X6-X6       EMPTY TABLE 3
          SA6    L.TAB3 
          RJ     RDB         READ DATA LEVEL BLOCK
          SA3    F.TAB3 
          MX4    -12
          SB2    B0 
 ADB1     SA5    X3+B2       ENTRY,S CONTROL WORD 
          LX5    12 
          BX6    -X4*X5 
          SX6    X6-3 
          NZ     X6,ERD19    IF NOT LEVEL-3 BLOCK 
          LX5    12          ENTRY,S WORD POINTER 
          BX6    -X4*X5 
          RJ     CEP         CHECK ENTRY,S PROJECT NUMBER 
          ZR     X2,ADB2     IF ENTRY FOUND 
          ZR     X6,ERD20    IF ENTRY NOT IN BLOCK
          SB2    B2+X6
          SX6    B2-PRUS
          NG     X6,ADB1     IF NO ERROR
          JP     ERD21
 AUN      SPACE  4,10 
**        AUN - ADD USER NAME.
* 
*         IF NECESSARY, ANOTHER LEVEL-3 OVERFLOW BLOCK IS ALLOCATED.
* 
*         ENTRY  (X1) = USER NAME TO ADD (RIGHT JUSTIFIED,
*                       WITH LEADING ZEROS).
* 
*         USES   A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3.
*                X - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  GES, NUE.
* 
*         MACROS ALLOC. 
  
  
 AUN7     SB3    ERUP        **** DUPLICATE USER NAME.
 AUN8     RJ     ERU         USER ERROR 
  
 AUN      SUBR               ENTRY/EXIT 
          BX6    X1          SEARCH FOR USER NAME 
          LX6    18 
          SA6    UNUM 
          BX6    X6-X6       CLEAR FIRST HOLE INDEX 
          SA6    AUNB 
          SX1    B1 
 AUN1     RJ     NUE         NEXT USER NAME ENTRY 
          NZ     B2,AUN4     IF END OF LEVEL-3 CHAIN
          MX2    42 
          BX2    X2*X1
          ZR     X2,AUN2     IF HOLE
          SA2    UNUM 
          BX2    X1-X2
          ZR     X2,AUN7     IF USER NAME ALREADY PRESENT 
          BX1    X1-X1
          EQ     AUN1        LOOP 
  
 AUN2     SA2    AUNB        SAVE INDEX OF FIRST HOLE 
          NZ     X2,AUN3     IF ALREADY HAVE A HOLE 
          SA3    F.TAB3 
          SB2    X3 
          SX7    A1-B2
          SA7    A2 
 AUN3     ZR     X1,AUN1     IF NOT END OF LIST 
  
 AUN4     SA1    AUNB 
          SA2    F.TAB3 
          IX3    X1+X2
          NZ     X1,AUN6     IF HOLE EXISTS 
          SA5    L.TAB3      ALLOCATE NEW OVERFLOW BLOCK
          ALLOC  TAB3,PRUS
          IX3    X2+X5
          SA4    =2LOV       CONTROL WORD 
          BX6    X4 
          SA6    X3 
          SB2    PRUS-1      INITIALIZE REST OF NEW BLOCK (WITH 1)
          SX6    B1 
 AUN5     SA6    A6+B1
          SB2    B2-B1
          NZ     B2,AUN5     IF MORE WORDS IN BLOCK 
          SX3    X3+B1
  
 AUN6     SA4    UNUM        PLACE USER NAME IN HOLE
          BX7    X4 
          SA5    T3IE        INCREMENT USER NAME COUNT FIELD
          IX1    X2+X5
          SA2    X1 
          LX2    -24
          MX5    -12
          BX4    -X5*X2 
          SX4    X4+B1
          BX6    X5*X4
          SB3    ERUT        **** USER NAME LIMIT.
          NZ     X6,AUN8     IF FIELD OVERFLOW
          SA7    X3 
          BX2    X5*X2
          BX6    X2+X4
          LX6    24 
          SA6    A2 
          EQ     AUNX 
  
  
 AUNB     BSS    1           FIRST HOLE INDEX 
 CED      SPACE  4,10 
**        CED - CONVERT ENTRY TO DISPLAY CODE.
* 
*         ENTRY  (X5) = TABLE OF INDICES ENTRY (TOI). 
*                (X1) = FIELD,S CURRENT VALUE (RIGHT JUSTIFIED).
*                (X4) = FIELD,S CURRENT VALUE (LEFT JUSTIFIED). 
* 
*         EXIT   (X6) = DISPLAY CODE VALUE, LEFT JUSTIFIED
*                       WITH TRAILING SPACES. 
*                (FLDV) = FIELD,S CURRENT VALUE (RIGHT JUSTIFIED, 
*                         PERTINENT ONLY FOR NUMERIC DIRECTIVES). 
* 
*         CALLS  CDD, COD, SFN. 
* 
*         USES   ALL REGISTERS EXCEPT A0, X0, A5, X5. 
  
  
 CED2     BX1    X4 
          RJ     SFN         SPACE FILL NAME
  
 CED      SUBR               ENTRY/EXIT 
          BX6    X1          SAVE FIELD,S VALUE 
          SA6    FLDV 
          MX2    2
          BX2    X2*X5
          ZR     X2,CED2     IF NO CONVERSION 
          LX2    2
          SX2    X2-1 
          ZR     X2,CED1     IF OCTAL CONVERSION
          RJ     CDD         DECIMAL DISPLAY CODE CONVERSION
          BX6    X4 
          EQ     CEDX 
  
 CED1     RJ     COD         OCTAL DISPLAY CODE CONVERSION
          SB3    B2-60       INSERT *B* AFTER VALUE 
          SB3    -B3         FIRST CLEAR CHARACTER POSITION 
          MX2    6
          LX2    B3 
          BX4    -X2*X4 
          SA2    =1LB        MERGE IN *B* 
          LX2    B3 
          BX6    X2+X4
          EQ     CEDX 
 CEP      SPACE  4,10 
**        CEP - CHECK ENTRY,S PROJECT NUMBER. 
* 
*         ENTRY  (A5) = FWA OF LEVEL-3 ENTRY. 
*                (CN) = CHARGE NUMBER.
*                (PN - PN+1) = PROJECT NUMBER.
* 
*         EXIT   (X2) = 0, IF PROJECT NUMBER MATCH. 
* 
*         USES   X - 1. 
*                A - 1, 2.
  
  
 CEP      SUBR               ENTRY/EXIT 
          SA1    A5+PRJW     ENTRY,S PROJECT NUMBER 
          SA2    PN          CURRENT PROJECT NUMBER 
          BX2    X1-X2
          NZ     X2,CEPX     IF NO MATCH
          SA1    A1+B1
          SA2    A2+B1
          BX2    X1-X2
          NZ     X2,CEPX     IF NO MATCH
          SA1    A5+PCHW     CHECK CHARGE NUMBER
          SA2    CN 
          BX2    X1-X2
          ZR     X2,CEPX     IF MATCH 
          JP     ERD22       ERROR
 CFS      SPACE  4,10 
**        CFS - CHECK FILE STATUS.
* 
*         ENTRY  (B2) = FET ADDRESS.
* 
*         EXIT   (X2) = PFM ERROR CODE FROM FET+0, RIGHT JUSTIFIED. 
* 
*         USES   X - 1. 
*                A - 1. 
  
  
 CFS      SUBR               ENTRY/EXIT 
          SA1    B2 
          AX1    10 
          MX2    -8 
          BX2    -X2*X1 
          EQ     CFSX 
 CIV      SPACE  4,35 
**        CIV - CONVERT INDEX TO VALUE. 
* 
*         VALUE IS CALCULATED USING ONE OF THE FOLLOWING METHODS- 
*         1) IF I = 77B, V = DEFAULT VALUE (FROM TABLE TDSM). 
*            IF I = 0, V = 0. 
*            ELSE, V = I * (U-L) / 64  +  L 
*         2) IF I = 77B, V = LARGEST POSSIBLE NUMBER. 
*            ELSE, V = (100B * I  +  LBAS) * 100D 
*         3) IF I = 77B, V = LARGEST POSSIBLE NUMBER. 
*            ELSE, USE *COMCCVI* *SLI* CONVERSION.
*         WHERE 
*         V = VALUE.
*         I = INDEX.
*         U = UPPER LIMIT VALUE (FROM TABLE *TVC*). 
*         L = LOWER LIMIT VALUE (FROM TABLE *TVC*). 
* 
*         ENTRY  (X3) = INDEX TO CONVERT. 
*                (X4) = TABLE OF INDICES (TOI) ENTRY. 
*                (A4) = ADDRESS OF TABLE OF INDICES ENTRY.
* 
*         EXIT   (X1) = CALCULATED VALUE. 
*                (X1) .LT. 0, IF UNLIMITED VALUE. 
*                (X6) = 1, IF METHOD 1 USED TO CONVERT INDEX. 
*                     .NE. 1, IF METHOD 2 OR 3 USED TO CONVERT INDEX. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2. 
*                A - 1. 
* 
*         CALLS  SLI. 
  
  
 CIV2     SX1    B0+
          SB2    A4-TIM1
          ZR     X3,CIVX     IF ZERO INDEX
          SX7    X3-77B 
          SA1    TDSM+B2     DEFAULT VALUE
          ZR     X7,CIVX     IF USE DEFAULT VALUE 
          SA2    TCSM+B2     CALCULATE MULTIPLIER 
          SX4    X2          LOWER LIMIT
          AX2    18 
          SX7    X2          UPPER LIMIT
          IX1    X7-X4
          SX7    64 
          IX1    X1*X3
          IX1    X1/X7
          IX1    X1+X4
          AX2    18 
          IX1    X1*X2       POSITION FOR F10.3 CONVERSION
  
 CIV      SUBR               ENTRY/EXIT 
          MX7    -2 
          LX4    4
          BX6    -X7*X4 
          SX7    X6-1 
          ZR     X7,CIV2     IF USE METHOD 1
          SX1    -B1
          SX7    X3-77B 
          ZR     X7,CIVX     IF UNLIMITED 
          SX7    X6-3 
          ZR     X7,CIV1     IF USE METHOD 3
          LX3    6
          SX4    LBAS 
          SX2    100D 
          IX1    X3+X4
          IX1    X1*X2
          EQ     CIVX        RETURN 
  
 CIV1     BX1    X3          CONVERT SRU INDEX
          BX4    X0          SAVE (X0)
          RJ     SLI
          BX0    X4          RESTORE (X0) 
          LX1    3
          EQ     CIVX        RETURN 
 CPV      SPACE  4,10 
**        CPV - CONVERT AND PLACE VALUES. 
* 
*         ENTRY  (X5) = FIRST ENTRY OF PERTINENT TABLE OF INDICES (TOI).
*                (A5) = ADDRESS OF FIRST ENTRY. 
*                (T1IE) = TABLE 1 INDEX OF ENTRY, IF LEVEL-1 DIRECTIVE. 
*                (T3IE) = TABLE 3 INDEX OF ENTRY, IF LEVEL-3 DIRECTIVE. 
* 
*         CALLS  CED, DFS, GFV, PVF.
* 
*         USES   ALL REGISTERS EXCEPT A0, X0. 
  
  
 CPV      SUBR               ENTRY/EXIT 
 CPV1     ZR     X5,CPVX     IF END OF TABLE
          MX7    12 
          LX7    -12
          BX7    X5*X7
          LX7    -36
          RJ     DFS         (DF) - (DF+4) SET-UP 
          RJ     GFV         GET FIELD,S VALUE
          RJ     CED         CONVERT ENTRY TO DISPLAY CODE
          RJ     PVF         PLACE DISPLAY CODE VALUE IN FIELD
          SA5    A5+B1
          EQ     CPV1        LOOP 
 DFS      SPACE  4,10 
**        DFS - (DF) - (DF+4) SET-UP. 
* 
*         ENTRY  (X7) = TABLE INDEX.
* 
*         EXIT   (DF) =   MAXIMUM VALUE.
*                (DF+1) = UPPER BIT POSITION. 
*                (DF+2) = FIELD SIZE. 
*                (DF+3) = ENTRY WORD INDEX. 
*                (DF+4) = IDENTIFIER, LEFT JUSTIFIED
*                         WITH TRAILING ZEROS.
* 
*         USES   X - 3, 4, 6. 
*                A - 3, 4, 6. 
  
  
 DFS      SUBR               ENTRY/EXIT 
          SA3    X7+TDIR     TABLE ENTRY
          MX4    18          IDENTIFIER 
          BX6    X4*X3
          SA6    DF+4 
          MX4    -6          ENTRY WORD INDEX 
          LX3    -6 
          BX6    -X4*X3 
          SA6    A6-B1
          LX3    -6          FIELD SIZE 
          BX6    -X4*X3 
          SA6    A6-B1
          LX3    -6          UPPER BIT POSITION 
          BX6    -X4*X3 
          SA6    A6-B1
          LX3    -6          MAXIMUM VALUE
          SX4    X3 
          SA4    X4 
          BX6    X4 
          SA6    A6-B1
          EQ     DFSX 
 EDD      SPACE  4,10 
**        EDD - EDIT DATE.
* 
*         CONVERTS DATE FROM PACKED FORMAT TO DISPLAY CODE YYMMDD 
*         LEFT-JUSTIFIED WITH BINARY ZERO FILL. 
* 
*         ENTRY  (X1) = PACKED DATE.
* 
*         EXIT   (X6) = EDITED DATE, LEFT-JUSTIFIED WITH ZERO FILL. 
* 
*         USES   X - 1, 2, 3, 6.
  
  
 EDD      SUBR               ENTRY/EXIT 
          EDATE  X1 
          MX2    12 
          LX6    6
          BX1    X2*X6       YEAR 
          LX6    6
          LX2    -12
          BX3    X2*X6       MONTH
          BX1    X1+X3
          LX6    6
          LX2    -12
          BX3    X2*X6       DAY
          BX6    X1+X3
          EQ     EDDX        RETURN 
 ETM      SPACE  4,10 
**        ETM - EDIT TIME.
* 
*         CONVERTS TIME FROM PACKED FORMAT TO JUST DISPLAY CODE DIGITS. 
* 
*         ENTRY  (X1) = PACKED TIME.
* 
*         EXIT   (X6) = EDITED TIME, LEFT JUSTIFIED 
*                       WITH TRAILING BLANKS. 
* 
*         CALLS  SFN. 
* 
*         USES   ALL REGISTERS EXCEPT A0, X0, A5, X5. 
  
  
 ETM      SUBR               ENTRY/EXIT 
          ETIME  X1 
          MX1    12          HOURS
          LX6    6
          BX2    X1*X6
          LX6    6           MINUTES
          LX1    -12
          BX3    X1*X6
          BX1    X2+X3       MERGE HOURS AND MINUTES
          RJ     SFN         SPACE FILL NAME
          EQ     ETMX 
 GFV      SPACE  4,10 
**        GFV - GET FIELD,S VALUE.
* 
*         ENTRY  (X7) = TABLE INDEX.
*                (DF+1) = UPPER BIT POSITION. 
*                (DF+2) = FIELD SIZE. 
*                (DF+3) = ENTRY WORD INDEX. 
*                (T1IE) = TABLE 1 INDEX OF ENTRY, IF LEVEL-1 DIRECTIVE. 
*                (T3IE) = TABLE 3 INDEX OF ENTRY, IF LEVEL-3 DIRECTIVE. 
* 
*         EXIT   (X1) = FIELD,S CURRENT VALUE (RIGHT JUSTIFIED).
*                (X4) = FIELD,S CURRENT VALUE (LEFT JUSTIFIED). 
* 
*         USES   X - 2, 3.
*                A - 2, 3, 4. 
*                B - 2, 3, 4. 
  
  
 GFV      SUBR               ENTRY/EXIT 
          SA2    DF+1        UPPER BIT POSITION 
          SB2    X2-59
          SB2    -B2
          SA2    A2+B1       FIELD SIZE 
          ZR     X2,ERD24    IF ERROR 
          SB3    X2 
          SB4    B3-B1
          SA2    A2+B1       ENTRY WORD INDEX 
          SA3    X7+TOPR
          LX3    5
          NG     X3,GFV1     IF LEVEL-3 DIRECTIVE 
          SA3    F.TAB1      TABLE 1 POINTERS 
          SA4    T1IE 
          EQ     GFV2 
  
 GFV1     SA3    F.TAB3      TABLE 3 POINTERS 
          SA4    T3IE 
 GFV2     IX3    X3+X4       FWA OF ENTRY 
          IX2    X2+X3
          SA2    X2          FIELD,S WORD 
          LX2    B2 
          MX3    1           FORM MASK HAVING FIELD SIZE
          AX3    B4 
          BX4    X3*X2       EXTRACT FIELD
          LX1    B3,X4       RIGHT JUSTIFY
          EQ     GFVX 
 NUE      SPACE  4,10 
**        NUE - NEXT USER NAME ENTRY. 
* 
*         FETCH NEXT USER NAME ENTRY (HOLES INCLUDED) FROM
*         TABLE 3. IF NECESSARY, READ IN NEXT OVERFLOW BLOCK. 
* 
*         ENTRY  (X1) .NE. 0, IF INITIALIZATION CALL. 
*                             INITIALIZE POSITION AND LIMIT 
*                             POINTERS TO FIRST LEVEL-3 BLOCK.
*                     = 0, IF CONTINUE FROM PRESENT ENTRY POINTED TO. 
*                (T3IE) = TABLE 3 INDEX OF ENTRY. 
* 
*         EXIT   (B2) .NE. 0, IF END OF LEVEL-3 CHAIN ENCOUNTERED.
*                (X1) = NEXT ENTRY, IF (B2) = 0.
*                (A1) = ADDRESS OF ENTRY, IF (B2) = 0.
* 
*         CALLS  RDB. 
* 
*         USES   ALL REGISTERS. 
  
  
 NUE5     SB2    1           END OF LEVEL-3 CHAIN 
  
 NUE      SUBR               ENTRY/EXIT 
          ZR     X1,NUE1     IF NOT INITIALIZATION CALL 
          SA1    F.TAB3      INITIALIZE POSITION AND LIMIT POINTERS 
          SA2    T3IE 
          IX3    X1+X2
          SX6    X3+PUNW
          SA6    NUEA 
          SX6    X6+NUNS
          SA6    A6+B1
  
 NUE1     SA1    NUEA        POSITION POINTER 
          SA2    A1+B1       LIMIT POINTER
          IX3    X1-X2
          NG     X3,NUE4     IF LIMIT NOT REACHED 
          NZ     X3,ERD31    IF ERROR 
          SA3    F.TAB3 
          SX4    X3+PRUS
          SA5    X2-PRUS     PRESET 
          SX7    X5 
          IX5    X4-X2
          NG     X5,NUE2     IF NOT FIRST LEVEL-3 BLOCK 
          SA5    X2-C.TAB3
          SX7    X5 
          SX2    X4 
 NUE2     SA4    L.TAB3 
          IX4    X3+X4
          IX4    X2-X4
          NG     X4,NUE3     IF ANOTHER BLOCK IN TABLE 3
          NZ     X4,ERD32    IF ERROR 
          ZR     X7,NUE5     IF NO MORE OVERFLOW BLOCKS 
          SX0    N
          RJ     RDB         READ DATA LEVEL BLOCK
          SA1    F.TAB3      CHECK BLOCK,S CONTROL WORD 
          SA2    L.TAB3 
          IX3    X1+X2
          SA3    X3-PRUS
          MX4    12 
          BX3    X4*X3
          SA4    =2LOV
          BX4    X3-X4
          NZ     X4,ERD33    IF ERROR 
          SX2    A3 
  
 NUE3     SX1    X2+B1       ADVANCE PAST OVERFLOW BLOCK CONTROL WORD 
          SX6    X2+PRUS     UPDATE LIMIT POINTER 
          SA6    NUEA+1 
  
 NUE4     SX6    X1+B1       ADVANCE POSITION POINTER 
          SA6    NUEA 
          SA1    X1          FETCH ENTRY
          SB2    B0 
          EQ     NUEX 
  
 NUEA     BSS    2           POSITION AND LIMIT POINTERS
 PDE      SPACE  4,10 
**        PDE - PROCESS DATA LEVEL ENTRY. 
* 
*         THIS ROUTINE SEARCHES THE SPECIFIED RANGE OF TABLE 2
*         FOR AN ENTRY HAVING A NON-*FULL* LEVEL-3 BLOCK. 
*         BEGINNING OF SEARCH IS FWA OF TABLE 2.
* 
*         ENTRY  (X5) = TABLE 2 INDEX OF END OF SEARCH + 1. 
*                (X0) = FET ADDRESS TO READ FROM. 
* 
*         EXIT   (X0) = FWA OF LEVEL-3 ENTRY. 
*                (RA3) = 0, IF NEW LEVEL-3 BLOCK. 
*                      = LEVEL-3 RANDOM ADDRESS, ELSE.
*                (T3IE) = TABLE 3 INDEX OF ENTRY. 
* 
*         CALLS  ATS, RDB.
* 
*         USES   ALL REGISTERS. 
  
  
 PDE      SUBR               ENTRY/EXIT 
          BX6    X6-X6       EMPTY TABLE 3
          SA6    L.TAB3 
          SB2    X5          SEARCH FOR NON-*FULL* LEVEL-3 BLOCK
          SB3    -C.TAB2     INITIALIZE POINTER 
          SA2    F.TAB2 
 PDE1     SB3    B3+C.TAB2   ADVANCE POINTER
          EQ     B3,B2,PDE2  IF THRU SEARCH 
          GT     B3,B2,ERD1  IF ERROR 
          SA3    X2+B3       FIRST WORD OF ENTRY
          ZR     X3,PDE1     IF DELETED ENTRY 
          SA3    A3+C.TAB2-1 LINK WORD OF ENTRY 
          NG     X3,PDE1     IF NOT AVAILABLE 
          MX4    1           SET ENTRY *FULL* 
          BX6    X4+X3
          SA6    A3 
          SX7    X3 
          SA7    RA3
          RJ     RDB         READ DATA LEVEL BLOCK
          SA1    F.TAB3      CHECK ENTRY,S CONTROL WORD 
          SA2    X1 
          MX3    12 
          BX4    X3*X2
          LX4    12 
          SX4    X4-3 
          NZ     X4,ERD14    IF ERROR 
          LX3    -12
          BX3    X3*X2
          NZ     X3,ERD15    IF ERROR 
          SX6    C.TAB3 
          SA6    T3IE 
          LX6    -24         UPDATE ENTRY,S WORD POINTER
          BX6    X2+X6
          SA6    A2 
          SX0    X1+C.TAB3
          EQ     PDEX 
  
 PDE2     BX6    X6-X6
          SA6    RA3
          SA6    T3IE 
          ALLOC  TAB3,PRUS   ALLOCATE FOR FIRST LEVEL-3 BLOCK 
          BX0    X2 
          EQ     PDEX 
 PEI      SPACE  4,10 
**        PEI - PROJECT ENTRY INITIALIZATION. 
* 
*         ENTRY  (PN - PN+1) = PROJECT NUMBER.
*                (SL) = LEVEL-2 RANDOM ADDRESS. 
* 
*         EXIT   (X4) = 0, IF ENTRY FOUND.
*                (X3) = FWA OF LEVEL-2 ENTRY, IF (X4) = 0.
*                (X5) = LEVEL-3 RANDOM ADDRESS, IF (X4) = 0.
* 
*         CALLS  SBT. 
* 
*         USES   ALL REGISTERS. 
  
  
 PEI1     SX4    B1 
          SA6    RA2         CLEAR LINKS
          SA6    A6+B1
  
 PEI      SUBR               ENTRY/EXIT 
          BX6    X6-X6       EMPTY TABLE 2
          SA6    L.TAB2 
          SA1    SL 
          SB6    X1 
          ZR     B6,PEI1     IF NO LEVEL-2 CHAIN
          SA0    B1+B1
          SX0    N
          SX6    PN 
          SA6    SE 
          FUNC   SBTT        SET BLOCK IN TABLE 2 
          ZR     X6,PEIX     IF NO ERROR
          JP     ERD39
 PVF      SPACE  4,10 
**        PVF - PLACE DISPLAY CODE VALUE IN OUTPUT AND K-DISPLAY FIELD. 
* 
*         ENTRY  (X5) = TABLE OF INDICES ENTRY (TOI). 
*                (A5) = ADDRESS OF TABLE OF INDICES ENTRY.
*                (X6) = DISPLAY CODE VALUE, LEFT JUSTIFIED
*                       WITH TRAILING SPACES. 
*                (FLDV) = FIELD,S VALUE BEFORE CONVERSION (PERTINENT
*                         ONLY FOR NUMERIC DIRECTIVES). 
* 
*         CALLS  CDD, CFD, CIV. 
* 
*         USES   ALL REGISTERS EXCEPT A0, X0, A5. 
  
  
 PVF2     RJ     CFD         F10.3 DISPLAY CODE CONVERSION
 PVF3     MX1    -12         BRACKET WITH *(* AND *)* 
          LX6    12 
          BX6    X1*X6
          SX2    2R)( 
          BX6    X2+X6
          LX6    -6 
 PVF4     SA6    X5+B1
          LX5    18 
          SA6    X5+B1
  
 PVF      SUBR               ENTRY/EXIT 
          SA4    A5 
          SA3    FLDV        FIELD VALUE
          LX4    4
          PL     X4,PVF1     IF ZERO VALUE NOT UNLIMITED
          NZ     X3,PVF1     IF NOT UNLIMITED 
          SA1    =10H(NO LIMIT) 
          BX6    X1 
 PVF1     SA6    X5 
          LX5    -18
          SA6    X5 
          MX7    -2 
          BX7    -X7*X4 
          ZR     X7,PVFX     IF NOT INDEX DIRECTIVE 
          LX4    -4 
          RJ     CIV         CONVERT INDEX TO VALUE 
          SX6    X6-1 
          ZR     X6,PVF2     IF METHOD 1 USED TO CONVERT INDEX
          SA2    =10H(NO LIMIT) 
          BX6    X2 
          NG     X1,PVF4     IF UNLIMITED 
          RJ     CDD         DECIMAL DISPLAY CODE CONVERSION
          EQ     PVF3 
 RDB      SPACE  4,10 
**        RDB - READ DATA LEVEL BLOCK INTO TABLE 3. 
* 
*         BLOCK IS APPENDED TO END OF TABLE, AND TABLE LENGTH UPDATED.
* 
*         ENTRY  (X7) = RANDOM ADDRESS OF BLOCK TO READ.
*                (X0) = FET ADDRESS TO READ FROM. 
* 
*         EXIT   (X5) = FWA NEW LEVEL-3 BLOCK.
* 
*         CALLS  ATS, RDW, WNB. 
* 
*         USES   ALL REGISTERS. 
  
  
 RDB      SUBR               ENTRY/EXIT 
          ZR     X7,ERD23    IF ERROR 
          RECALL X0 
          SA7    X0+6 
          READ   X0 
          SA5    L.TAB3 
          ALLOC  TAB3,PRUS   ALLOCATE FOR LEVEL-3 BLOCK 
          IX5    X2+X5
          READW  X0,X5,PRUS 
          ZR     X1,RDBX     IF READ COMPLETE 
          JP     ERD25       ERROR
 SFC      SPACE  4,10 
**        SFC - CHARGE ENTRY SPECIAL FIELDS FOR OUTPUT AND K-DISPLAY. 
* 
*         ENTRY  (X3) = FWA OF CHARGE ENTRY.
* 
*         CALLS  CDD. 
* 
*         USES   ALL REGISTERS EXCEPT A0, X0. 
  
  
 SFC      SUBR               ENTRY/EXIT 
          SA5    X3+CDTW     CREATION DATE
          LX5    18 
          SX1    X5 
          EDATE  X1 
          SA6    CEOC 
          SA6    DSCC+2 
          SA1    =10H UNDEFINED  *CEX*
          BX6    X1 
          LX5    18 
          SX1    X5 
          ZR     X1,SFC1     IF ZERO VALUE
          EDATE  X1 
 SFC1     SA6    CEOD 
          SA6    DSCE+2 
          SA1    =10H*ACTIVE* 
          SA5    A5-CDTW+CSRW 
          PL     X5,SFC2     IF *ACTIVE*
          SA1    =10H*INACTIVE* 
 SFC2     BX6    X1 
          SA6    CEOE 
          SA6    DSCA+1 
          LX5    30          PROJECT COUNT
          MX1    -12
          BX1    -X1*X5 
          RJ     CDD         DECIMAL DISPLAY CODE CONVERSION
          BX6    X4 
          SA6    CEOF 
          SA6    DSCO+2 
          EQ     SFCX 
 SFP      SPACE  4,10 
**        SFP - PROJECT ENTRY SPECIAL FIELDS FOR OUTPUT AND K-DISPLAY.
* 
*         ENTRY  (A5) = FWA OF PROJECT ENTRY. 
* 
*         CALLS  ETM, SFN.
* 
*         USES   ALL REGISTERS EXCEPT A0, X0. 
  
  
 SFP      SUBR               ENTRY/EXIT 
          SA5    A5+PCDW     CREATION DATE
          LX5    18 
          SX1    X5 
          EDATE  X1 
          SA6    PEOB 
          SA6    DSPC+2 
          SA1    =10H UNDEFINED  *PEX*
          BX6    X1 
          LX5    18 
          SX1    X5 
          ZR     X1,SFP1     IF ZERO VALUE
          EDATE  X1 
 SFP1     SA6    PEOG 
          SA6    DSPE+2 
          SA1    =10H UNDEFINED  LAST UPDATE TIME 
          BX6    X1 
          SA5    A5-PCDW+PUDW 
          SX1    X5 
          ZR     X1,SFP2     IF ZERO VALUE
          ETIME  X1 
 SFP2     SA6    PEOE 
          SA6    DSUT+2 
          SA1    =10H UNDEFINED  LAST UPDATE DATE 
          BX6    X1 
          AX5    18 
          ZR     X5,SFP3     IF ZERO VALUE
          EDATE  X5 
 SFP3     SA6    PEOD 
          SA6    DSUD+2 
          SA1    =10H UNDEFINED  LAST CHANGE DATE 
          BX6    X1 
          SA5    A5-PUDW+PCGW 
          LX5    -36
          SX1    X5 
          ZR     X1,SFP4     IF ZERO VALUE
          EDATE  X1 
 SFP4     SA6    PEOC 
          SA6    DSLC+2 
          SA1    =10H*ACTIVE* 
          SA5    A5-PCGW+PTMW 
          PL     X5,SFP5     IF *ACTIVE*
          SA1    =10H*INACTIVE* 
 SFP5     BX6    X1 
          SA6    PEOF 
          SA6    DSPA+1 
          SX1    X5          TIME OFF 
          RJ     ETM         EDIT TIME
          SA6    PEOI 
          SA6    DSOF+1 
          LX5    -18
          SX1    X5          TIME IN
          RJ     ETM         EDIT TIME
          SA6    PEOH 
          SA6    DSIN+1 
          SA5    A5-PTMW+PPNW  GET PROLOGUE CHARGE REQUIRED OPTION
          MX2    -2 
          BX1    -X2*X5 
          SA1    TPCO+X1
          RJ     SFN         SPACE FILL NAME
          SA6    PEZN 
          SA6    DSPO+1 
          SA5    A5-PPNW+PPPW  GET PROJECT PROLOGUE PASSWORD
          MX2    42 
          BX1    X2*X5
          SA4    =10H 
          ZR     X1,SFP6     IF NO PROJECT PROLOGUE PASSWORD DEFINED
          SA4    =10H*******
 SFP6     BX6    X4 
          SA6    PEZL 
          SA6    DSPP+1 
          SA5    A5-PPPW+PEPW  GET PROJECT EPILOGUE PASSWORD
          BX1    X2*X5
          SA4    =10H 
          ZR     X1,SFP7     IF NO PROJECT EPILOGUE PASSWORD DEFINED
          SA4    =10H*******
 SFP7     BX6    X4 
          SA6    PEZM 
          SA6    DSEP+1 
          EQ     SFPX 
 SUN      SPACE  4,15 
**        SUN - SORT USER NAMES.
* 
*         ENTRY  FIRST LEVEL-3 BLOCK IN TABLE 3.
*                (T3IE) = INDEX OF PROJECT ENTRY IN TABLE 3.
* 
*         EXIT   (X6) = 0, IF NO USER NAMES.
* 
*         USES   A - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 3, 4, 6, 7. 
*                X - 0, 1, 2, 3, 4, 6, 7. 
* 
*         CALLS  RDB, STB.
  
  
 SUN      SUBR               ENTRY/EXIT 
  
*         READ IN ALL LEVEL-3 OVERFLOW BLOCKS.
  
          SA1    F.TAB3      GET RANDOM ADDRESS OF FIRST OVERFLOW BLOCK 
          SA2    T3IE 
          IX2    X1+X2
          SA1    X2 
 SUN1     SX7    X1+
          ZR     X7,SUN2     IF NO MORE OVERFLOW BLOCKS 
          SX0    N
          RJ     RDB         READ LEVEL-3 OVERFLOW BLOCK
          SA1    X5          GET RANDOM ADDRESS OF NEXT OVERFLOW BLOCK
          EQ     SUN1        CONTINUE READING OVERFLOW BLOCKS 
  
*         PACK USER NAMES IN TABLE 3. 
  
 SUN2     SA4    F.TAB3      FWA TABLE 3
          SA2    T3IE        PROJECT ENTRY INDEX IN TABLE 3 
          SA3    L.TAB3      LENGTH TABLE 3 
          SB3    PUNW-1+X2
          SB2    X4 
          SB4    X4+PRUS     FWA FIRST OVERFLOW BLOCK 
          SB3    X4+B3       FWA-1 USER NAMES IN FIRST BLOCK
          IX1    X4+X3
          SB6    B3+NUNS+1   LWA+1 USER NAMES IN FIRST BLOCK
          SB7    X1          LWA+1 TABLE 3
 SUN3     SB3    B3+B1
          GE     B3,B6,SUN4  IF END OF USER NAMES IN THIS BLOCK 
          SA1    B3 
          ZR     X1,SUN3     IF EMPTY ENTRY 
          SX2    X1 
          BX6    X1 
          NZ     X2,SUN5     IF END OF USER NAMES 
          SA6    B2 
          SB2    B2+B1
          EQ     SUN3        CONTINUE PACKING USER NAMES
  
 SUN4     SB3    B4          FWA-1 USER NAMES IN NEXT OVERFLOW BLOCK
          SB4    B4+PRUS
          SB6    B4          LWA+1 USER NAMES IN NEXT OVERFLOW BLOCK
          LT     B3,B7,SUN3  IF NOT END OF TABLE 3
 SUN5     SX6    B2          SET LENGTH OF TABLE 3
          IX6    X6-X4
          SA6    A3 
          SX7    B1 
          ZR     X6,SUNX     IF NO USER NAMES 
  
*         SORT USER NAMES IN TABLE 3. 
  
          SA7    CTAB+3      SET 1 WORD PER ENTRY FOR TABLE 3 
          SA0    3
          FUNC   STBT        SORT TABLE 3 
          SX6    C.TAB3      RESET WORDS PER ENTRY FOR TABLE 3
          SA6    CTAB+3 
          EQ     SUNX        RETURN 
 TOI      SPACE  4,10 
**        TOI - TABLES OF DIRECTIVE INDICES.
* 
*         END OF EACH TABLE IS DENOTED BY A ZERO WORD.
*         EACH TABLE ENTRY HAS THE FOLLOWING FORMAT-
*                2/A, 2/B, 1/L, 7/, 12/C, 18/D, 18/E
*                WHERE
*                A = 0, IF NO CONVERSION. 
*                  = 1, IF OCTAL CONVERSION.
*                  = 2, IF DECIMAL CONVERSION.
*                B = 0, IF NOT INDEX DIRECTIVE. 
*                  = 1, IF USE METHOD 1 TO CONVERT INDEX (SEE *CIV* 
*                    DOCUMENTATION). ALSO, DISPLAY CODE IN F10.3 FORMAT.
*                  = 2, IF USE METHOD 2 TO CONVERT INDEX (SEE *CIV* 
*                    DOCUMENTATION). ALSO, DISPLAY CODE IN I10 FORMAT.
*                  = 3, IF USE METHOD 3 TO CONVERT INDEX (SEE *CIV* 
*                    DOCUMENTATION). ALSO, DISPLAY CODE IN I10 FORMAT.
*                L = 1, IF ZERO VALUE SPECIFIES NO LIMIT. 
*                C = TABLE INDEX. 
*                D = ADDRESS FOR VALUE FOR K-DISPLAY. 
*                E = ADDRESS FOR VALUE FOR OUTPUT.
*         RESTRICTIONS- 
*         1) ENTRIES FOR DIRECTIVES *M1* THRU *AD*, AND *ISL* THRU
*            *IR8*, MUST BE IN GIVEN ORDER AND STARTING AT *TIM1* AND 
*            *TISL*, RESPECTIVELY.
  
  
 TOI      BSS    0
  
*         CHARGE ENTRY INDICES. 
  
 TOIA     BSS    0
          VFD    2/0,2/0,8/,12/XMUN,18/DSMU+1,18/CEOG     *MU*
 TOIB     BSS    0
 TIM1     VFD    2/1,2/1,8/,12/XIM1,18/DSM1+1,18/CEZK     *M1*
          VFD    2/1,2/1,8/,12/XIM2,18/DSM2+1,18/CEZL     *M2*
          VFD    2/1,2/1,8/,12/XIM3,18/DSM3+1,18/CEZM     *M3*
          VFD    2/1,2/1,8/,12/XIM4,18/DSM4+1,18/CEZN     *M4*
          VFD    2/1,2/1,8/,12/XIAD,18/DSAD+1,18/CEZO     *AD*
 TISL     VFD    2/1,2/3,8/,12/XISL,18/DSSL+1,18/CEOS     *ISL* 
          VFD    2/1,2/2,8/,12/XIR1,18/DSR1+1,18/CEOU     *IR1* 
          VFD    2/1,2/2,8/,12/XIR2,18/DSR2+1,18/CEOW     *IR2* 
          VFD    2/1,2/2,8/,12/XIR3,18/DSR3+1,18/CEOY     *IR3* 
          VFD    2/1,2/2,8/,12/XIR4,18/DSR4+1,18/CEZB     *IR4* 
          VFD    2/1,2/2,8/,12/XIR5,18/DSR5+1,18/CEZD     *IR5* 
          VFD    2/1,2/2,8/,12/XIR6,18/DSR6+1,18/CEZF     *IR6* 
          VFD    2/1,2/2,8/,12/XIR7,18/DSR7+1,18/CEZH     *IR7* 
          VFD    2/1,2/2,8/,12/XIR8,18/DSR8+1,18/CEZJ     *IR8* 
          VFD    2/2,2/0,1/1,7/,12/XPCL,18/DSPL+1,18/CEOH *PCL* 
          CON    0           END OF TABLE 
  
*         PROJECT ENTRY INDICES.
  
 TOIC     BSS    0
          VFD    2/0,2/0,8/,12/XTIN,18/DSIN+1,18/PEOH     *TI*
          VFD    2/0,2/0,8/,12/XTOF,18/DSOF+1,18/PEOI     *TO*
 TOID     BSS    0
          VFD    2/0,2/0,8/,12/XPFN,18/DSPF+1,18/PEZH     *PFN* 
          VFD    2/0,2/0,8/,12/XPUN,18/DSPU+1,18/PEZJ     *PUN* 
          VFD    2/0,2/0,8/,12/XEFN,18/DSEF+1,18/PEZI     *EFN* 
          VFD    2/0,2/0,8/,12/XEUN,18/DSEU+1,18/PEZK     *EUN* 
 TOIE     BSS    0
          VFD    2/1,2/3,8/,12/XISV,18/DSSV+1,18/PEOJ     *ISV* 
          VFD    2/2,2/0,1/1,7/,12/XSML,18/DSML+1,18/PEOL *SML* 
          VFD    2/2,2/0,8/,12/XSMA,18/DSMA+1,18/PEOM     *SMA* 
          VFD    2/2,2/0,1/1,7/,12/XSIL,18/DSIL+1,18/PEON *SIL* 
          VFD    2/2,2/0,8/,12/XSIA,18/DSIA+1,18/PEOO     *SIA* 
          VFD    2/2,2/0,1/1,7/,12/XLR1,18/DSL1+1,18/PEOP *LR1* 
          VFD    2/2,2/0,8/,12/XAR1,18/DSA1+1,18/PEOQ     *AR1* 
          VFD    2/2,2/0,1/1,7/,12/XLR2,18/DSL2+1,18/PEOR *LR2* 
          VFD    2/2,2/0,8/,12/XAR2,18/DSA2+1,18/PEOS     *AR2* 
          VFD    2/2,2/0,1/1,7/,12/XLR3,18/DSL3+1,18/PEOT *LR3* 
          VFD    2/2,2/0,8/,12/XAR3,18/DSA3+1,18/PEOU     *AR3* 
          VFD    2/2,2/0,1/1,7/,12/XLR4,18/DSL4+1,18/PEOV *LR4* 
          VFD    2/2,2/0,8/,12/XAR4,18/DSA4+1,18/PEOW     *AR4* 
          VFD    2/2,2/0,1/1,7/,12/XLR5,18/DSL5+1,18/PEOX *LR5* 
          VFD    2/2,2/0,8/,12/XAR5,18/DSA5+1,18/PEOY     *AR5* 
          VFD    2/2,2/0,1/1,7/,12/XLR6,18/DSL6+1,18/PEZA *LR6* 
          VFD    2/2,2/0,8/,12/XAR6,18/DSA6+1,18/PEZB     *AR6* 
          VFD    2/2,2/0,1/1,7/,12/XLR7,18/DSL7+1,18/PEZC *LR7* 
          VFD    2/2,2/0,8/,12/XAR7,18/DSA7+1,18/PEZD     *AR7* 
          VFD    2/2,2/0,1/1,7/,12/XLR8,18/DSL8+1,18/PEZE *LR8* 
          VFD    2/2,2/0,8/,12/XAR8,18/DSA8+1,18/PEZF     *AR8* 
          CON    0           END OF TABLE 
  
*         PROJECT PROLOGUE/EPILOGUE FILE PASSWORDS. 
  
 TOIF     BSS    0
          VFD    2/0,2/0,8/,12/XPPW,18/DSPP+1,18/PEZL     *PPW* 
          VFD    2/0,2/0,8/,12/XEPW,18/DSEP+1,18/PEZM     *EPW* 
          CON    0           END OF TABLE 
 TVC      SPACE  4,10 
**        TCSM - TABLE FOR CALCULATING SRU MULTIPLIER FROM INDEX. 
* 
*         TABLE ENTRIES MUST MATCH WITH TABLE *TOI* ENTRIES 
*         STARTING AT *TIM1*. 
*         EACH TABLE ENTRY HAS THE FOLLOWING FORMAT-
*                6/0, 18/F, 18/U, 18/L
*                WHERE
*                U = UPPER LIMIT VALUE. 
*                L = LOWER LIMIT VALUE. 
*                F = POSITIONING FACTOR FOR F10.3 DISPLAY CONVERSION. 
  
  
 TCSM     BSS    0
          VFD    6/0,18/100,18/M1SU,18/M1SL   *M1*
          VFD    6/0,18/1,18/M2SU,18/M2SL     *M2*
          VFD    6/0,18/1,18/M3SU,18/M3SL     *M3*
          VFD    6/0,18/1,18/M4SU,18/M4SL     *M4*
          VFD    6/0,18/1000,18/MASU,18/MASL  *AD*
          SPACE  4
**        TDSM - TABLE OF DEFAULT SRU MULTIPLIERS IN POSITION FOR 
*         F10.3 DISPLAY CONVERSION. 
  
  
 TDSM     BSS    0
          CON    M1SR*100    *M1* 
          CON    M2SR        *M2* 
          CON    M3SR        *M3* 
          CON    M4SR        *M4* 
          CON    ADSR*1000   *AD* 
 UPC      SPACE  4,10 
**        UPC - UPDATE PROJECT COUNT. 
* 
*         PROJECT COUNT IN LEVEL-1 ENTRY IS INCREMENTED IF DIRECTIVE
*         IS *APN* AND DECREMENTED IF *DPN*.
* 
*         ENTRY  (X1) = TABLE INDEX.
* 
*         EXIT   (X4) = UPDATED PROJECT COUNT.
*                (X6) = UPDATED PROJECT COUNT WORD. 
*                (A2) = PROJECT COUNT WORD ADDRESS. 
* 
*         USES   X - 2, 3.
*                A - 3. 
*                B - 2. 
  
  
 UPC1     BX6    X3*X2       UPDATE PROJECT COUNT WORD
          BX6    X4+X6
          LX6    30 
  
 UPC      SUBR               ENTRY/EXIT 
          SA2    F.TAB1      EXTRACT CURRENT PROJECT COUNT
          SA3    T1IE 
          IX2    X2+X3
          SA2    X2+CSRW
          LX2    -30
          MX3    -12
          BX4    -X3*X2 
          SX4    X4+B1       PRESET INCREMENT OF PROJECT COUNT
          SB2    X1-XAPN
          ZR     B2,UPC1     IF *APN* 
          SX4    X4-2        DECREMENT PROJECT COUNT
          PL     X4,UPC1     IF NO ERROR
          JP     ERD3 
 VMU      SPACE  4,10 
**        VMU - VALIDATE FOR MASTER USER. 
* 
*         VALIDATE USER,S ACCESS TO CHARGE NUMBER.
* 
*         ENTRY  (X3) = FWA OF CHARGE ENTRY.
* 
*         EXIT   (X1) = 0, IF VALIDATION OK.
* 
*         USES   X - 2. 
*                A - 1, 2.
  
  
 VMU1     SX1    0           VALIDATION OK
  
 VMU      SUBR               ENTRY/EXIT 
          SA1    ACCC        ACCESS CLASSIFICATION
          SX1    X1-2 
          NG     X1,VMU1     IF NO NEED TO CHECK FOR MASTER USER
          SA1    X3+CMUW
          MX2    42 
          BX1    X2*X1
          SA2    UN 
          BX1    X1-X2
          EQ     VMUX 
 WDL      SPACE  4,10 
**        WDL - WRITE DATA LEVEL (LEVEL-3). 
* 
*         ENTRY  (FUP3) .NE. 0, IF UPDATE OF LEVEL-3 NECESSARY. 
*                (RA3) = 0, IF WRITE AT EOI.
*                      = RANDOM ADDRESS FOR WRITE, ELSE.
*                (T3IE) = TABLE 3 INDEX OF ENTRY. 
*                (T2IE) = TABLE 2 INDEX OF ENTRY. 
* 
*         EXIT   LEVEL-2 TO LEVEL-3 LINK AND LEVEL-3 *FULL* 
*                FLAG SET, IF NECESSARY.
* 
*         CALLS  WNB, WOB, WTW. 
* 
*         USES   ALL REGISTERS. 
  
  
 WDL      SUBR               ENTRY/EXIT 
          SA1    FUP3 
          ZR     X1,WDLX     IF NO LEVEL-3 UPDATE NEEDED
          BX6    X6-X6       CLEAR LEVEL-3 UPDATE FLAG
          SA6    A1 
          RJ     WOB         WRITE OVERFLOW BLOCKS
          SA5    F.TAB3 
          SA2    OP 
          SX2    X2-COPT
          ZR     X2,WDL1     IF *CREATE* OPTION 
          SA1    T3IE        UPDATE LAST CHANGE DATE
          IX1    X1+X5
          SA1    X1+PCGW
          LX1    -36
          MX2    42 
          BX1    X2*X1
          SA2    PD 
          BX6    X1+X2
          LX6    36 
          SA6    A1 
 WDL1     SA1    RA3
          MX2    1           PRESET FET REWRITE BIT 
          LX2    30 
          BX7    X1+X2
          NZ     X1,WDL2     IF REWRITE 
          SX7    RA3         WRITE AT EOI 
 WDL2     RECALL P
          SA7    P+6
          WRITEW P,X5,PRUS
          WRITER P,R
          SA1    F.TAB2      CHECK LEVEL-2 TO LEVEL-3 LINK
          SA2    T2IE 
          IX3    X1+X2
          SA1    X3+C.TAB2-1
          NZ     X1,WDLX     IF LINK ALREADY PRESENT
          SA2    RA3         SET LINK 
          SA3    T3IE 
          ZR     X3,WDL3     IF DO NOT SET *FULL* FLAG
          MX3    1
 WDL3     BX6    X2+X3
          SA6    A1 
          EQ     WDLX 
 WOB      SPACE  4,10 
**        WOB - WRITE LEVEL-3 OVERFLOW BLOCKS.
* 
*         BLOCKS ARE WRITTEN IN REVERSE ORDER FROM WHEN READ IN.
*         APPROPRIATE LINK UPDATED WHEN BLOCK WRITTEN AT EOI. 
* 
*         ENTRY  (T3IE) = TABLE 3 INDEX OF ENTRY. 
* 
*         CALLS  WNB, WTW.
* 
*         USES   ALL REGISTERS. 
  
  
 WOB      SUBR               ENTRY/EXIT 
 WOB1     SA2    L.TAB3 
          SB2    X2-PRUS
          ZR     B2,WOBX     IF THRU ALL OVERFLOW BLOCKS
          NG     B2,ERD16    IF ERROR 
          SA1    F.TAB3 
          SA2    B2+X1       BLOCK,S CONTROL WORD 
          MX3    12 
          BX3    X3*X2
          SA4    =2LOV
          BX4    X3-X4
          NZ     X4,ERD17    IF NOT OVERFLOW BLOCK
          SB3    B2-PRUS     CHECK PRECEDING BLOCK,S LINK 
          NG     B3,ERD18    IF ERROR 
          SA5    B3+X1       PRESET 
          NZ     B3,WOB2     IF NOT FIRST LEVEL-3 BLOCK 
          SA3    T3IE 
          IX3    X1+X3
          SA5    X3 
 WOB2     SX3    X5 
          MX4    1           PRESET FET REWRITE BIT 
          LX4    30 
          BX7    X3+X4
          NZ     X3,WOB3     IF REWRITE 
          SX7    WOBA        WRITE AT EOI 
 WOB3     RECALL P
          SA7    P+6
          WRITEW P,A2,PRUS
          WRITER P,R
          SA1    L.TAB3      UPDATE TABLE 3 LENGTH
          SX6    X1-PRUS
          SA6    A1 
          SA2    WOBA 
          ZR     X2,WOB1     IF NO UPDATE OF LINK NEEDED
          BX6    X2+X5
          SA6    A5 
          BX6    X6-X6       CLEAR RETURN LOCATION
          SA6    A2 
          EQ     WOB1        LOOP 
  
 WOBA     CON    0           RANDOM ADDRESS RETURN LOCATION OF WRITE
 WPL      SPACE  4,10 
**        WPL - WRITE PROJECT LEVEL (LEVEL-2).
* 
*         ENTRY  (FUP2) .NE. 0, IF UPDATE OF LEVEL-2 NECESSARY. 
*                (T1IE) = TABLE 1 INDEX OF ENTRY. 
* 
*         EXIT   LEVEL-1 TO LEVEL-2 LINK SET, IF NECESSARY. 
* 
*         CALLS  WTB. 
* 
*         USES   ALL REGISTERS. 
  
  
 WPL      SUBR               ENTRY/EXIT 
          SA1    FUP2 
          ZR     X1,WPLX     IF NO LEVEL-2 UPDATE NEEDED
          BX6    X6-X6       CLEAR LEVEL-2 UPDATE FLAG
          SA6    A1 
          SA0    B1+B1
          SX5    P
          FUNC   WTBT        WRITE TABLE 2
          SA1    F.TAB1      CHECK LEVEL-1 TO LEVEL-2 LINK
          SA2    T1IE 
          IX3    X1+X2
          SA1    X3+C.TAB1-1
          SX2    X1 
          NZ     X2,WPLX     IF LINK ALREADY PRESENT
          SA2    RA2+1       SET LINK 
          BX6    X1+X2
          SA6    A1 
          EQ     WPLX 
          TITLE  ERROR SUBROUTINES. 
 ERD      SPACE  4,10 
**        ERD - DATA BASE ERROR.
  
  
 ERD      BSS    0
 ERD1     SX1    2R01 
          EQ     ERD50
 ERD2     SX1    2R02 
          EQ     ERD50
 ERD3     SX1    2R03 
          EQ     ERD50
 ERD4     SX1    2R04 
          EQ     ERD50
 ERD5     SX1    2R05 
          EQ     ERD50
 ERD6     SX1    2R06 
          EQ     ERD50
 ERD7     SX1    2R07 
          EQ     ERD50
 ERD8     SX1    2R08 
          EQ     ERD50
 ERD9     SX1    2R09 
          EQ     ERD50
 ERD10    SX1    2R10 
          EQ     ERD50
 ERD11    SX1    2R11 
          EQ     ERD50
 ERD13    SX1    2R13 
          EQ     ERD50
 ERD14    SX1    2R14 
          EQ     ERD50
 ERD15    SX1    2R15 
          EQ     ERD50
 ERD16    SX1    2R16 
          EQ     ERD50
 ERD17    SX1    2R17 
          EQ     ERD50
 ERD18    SX1    2R18 
          EQ     ERD50
 ERD19    SX1    2R19 
          EQ     ERD50
 ERD20    SX1    2R20 
          EQ     ERD50
 ERD21    SX1    2R21 
          EQ     ERD50
 ERD22    SX1    2R22 
          EQ     ERD50
 ERD23    SX1    2R23 
          EQ     ERD50
 ERD24    SX1    2R24 
          EQ     ERD50
 ERD25    SX1    2R25 
          EQ     ERD50
 ERD26    SX1    2R26 
          EQ     ERD50
 ERD27    SX1    2R27 
          EQ     ERD50
 ERD30    SX1    2R30 
          EQ     ERD50
 ERD31    SX1    2R31 
          EQ     ERD50
 ERD32    SX1    2R32 
          EQ     ERD50
 ERD33    SX1    2R33 
          EQ     ERD50
 ERD34    SX1    2R34 
          EQ     ERD50
 ERD38    SX1    2R38 
          EQ     ERD50
 ERD39    SX1    2R39 
          EQ     ERD50
 ERD40    SX1    2R40 
          EQ     ERD50
 ERD41    SX1    2R41 
          EQ     ERD50
 ERD42    SX1    2R42 
          EQ     ERD50
 ERD43    SX1    2R43 
          EQ     ERD50
 ERD45    SX1    2R45 
  
 ERD50    SA2    ERDA+1      MERGE ERROR NUMBER INTO MESSAGE
          MX3    -12
          BX3    X3*X2
          BX6    X1+X3
          SA6    A2 
          SX2    ERDA 
          JP     ABT         ABORT EXIT 
  
 ERDA     DATA   L* DATA BASE ERROR     - NOTIFY ANALYST.*
 ERU      SPACE  4,10 
**        ERU - USER ERROR. 
* 
*         IF *K-DISPLAY* OPTION, ERROR MESSAGE DISPLAYED ON K-DISPLAY.
*         ELSE ERROR MESSAGE OUTPUTTED TO OUTPUT FILE. IN ADDITION, 
*              IF NOT A TERMINAL JOB, ANY CURRENT CHARGE-PROJECT
*              NUMBERS AND THE STRING BUFFER ARE OUTPUTTED. 
* 
*         ENTRY  (B3) = ERROR MESSAGE ADDRESS.
* 
*         USES   A - 1, 2, 3, 6.
*                B - 2. 
*                X - 1, 2, 3, 6.
* 
*         CALLS  GES. 
* 
*         MACROS MOVE, WRITES.
  
  
 ERU2     SA4    M1 
          MOVE   4,B3,X4     MESSAGE TO K-DISPLAY BUFFER
          SX6    B1          INDICATE DIRECTIVE ERROR 
          SA6    FDER 
  
 ERU      SUBR               ENTRY/EXIT 
          SA1    OP 
          SX1    X1-KOPT
          ZR     X1,ERU2     IF *K-DISPLAY* OPTION
          SA1    PO 
          SB2    B1 
          ZR     X1,ERU1     IF TERMINAL OUTPUT 
          SA3    FCNP 
          ZR     X3,ERU1     IF NO CHARGE NUMBER PRESENT
          SA1    FPNP 
          SB2    B2+B1
          ZR     X1,ERU1     IF NO PROJECT NUMBER PRESENT 
          SB2    B2+B1
 ERU1     RJ     GES         GENERATE ERROR SUMMARY 
          SA1    PIOA 
          NZ     X1,ERUX     IF COMMAND INQUIRE 
          SA1    SB          OUTPUT STRING BUFFER 
          SA2    SM 
          IX3    X2-X1
          WRITES O,X1-1,X3+B1 
          EQ     ERUX        RETURN 
  
  
 ERUA     DIS    4, **** INCORRECT DIRECTIVE. 
 ERUB     DIS    4, **** TOO MANY CHARACTERS IN VALUE.
 ERUC     DIS    4, **** DIRECTIVE NOT AUTHORIZED.
 ERUD     DIS    4, **** CHARGE NUMBER ACTIVE.
 ERUE     DIS    4, **** CHARGE NUMBER DOES NOT EXIST.
 ERUF     DIS    4, **** CHARGE NUMBER INACTIVE.
 ERUG     DIS    4, **** NOT MASTER USER. 
 ERUH     DIS    4, **** NO CHARGE NUMBER IN EFFECT.
 ERUI     DIS    4, **** PROJECT NUMBER DOES NOT EXIST. 
 ERUJ     DIS    4, **** PROJECT NUMBER ACTIVE. 
 ERUK     DIS    4, **** INCORRECT VALUE. 
 ERUL     DIS    4, **** DELETE NON-EXISTENT USER NAME. 
 ERUM     DIS    4, **** NO PROJECT NUMBER IN EFFECT. 
 ERUN     DIS    4, **** PROJECT COUNT LIMIT EXCEEDED.
 ERUO     DIS    4, **** PROJECT NUMBER INACTIVE. 
 ERUP     DIS    4, **** DUPLICATE USER NAME. 
 ERUQ     DIS    4, **** MISSING VALUE. 
 ERUR     DIS    4, **** DUPLICATE CHARGE NUMBER. 
 ERUS     DIS    4, **** DUPLICATE PROJECT NUMBER.
 ERUT     DATA   40H **** USER NAME LIMIT.
 GES      SPACE 4,15
**        GES - GENERATE ERROR SUMMARY. 
* 
*         ENTRY  (B3) = ERROR MESSAGE ADDRESS.
*                (B2) = NUMBER OF MESSAGES IN ERROR SUMMARY.
* 
*         USES   A - 1, 3, 6, 7.
*                X - 1, 3, 6, 7.
* 
*         CALLS  SFN. 
* 
*         MACROS WRITH. 
  
  
 GES      SUBR               ENTRY/EXIT 
          SA1    OP 
          SX1    X1-KOPT
          ZR     X1,GESX     IF *K-DISPLAY* OPTION
          SX7    B1 
          SX6    B2-B1
          SA7    FDER        INDICATE DIRECTIVE ERRORS
          SA6    GESA 
          WRITH  O,B3,4      WRITE ERROR MESSAGE
          SA1    GESA 
          ZR     X1,GESX     IF LAST MESSAGE IN SUMMARY 
          SA3    CN 
          BX6    X3 
          SA6    GESB+2 
          WRITH  X2,GESB,3   WRITE CHARGE NUMBER
          SA3    GESA 
          SX6    X3-2 
          NG     X6,GESX     IF LAST MESSAGE IN SUMMARY 
          SA6    A3 
          SA1    PN 
          RJ     SFN         SPACE FILL PROJECT NUMBER
          SA1    A1+B1
          SA6    GESC+2 
          BX7    X1 
          SA7    A6+B1
          WRITH  X2,GESC,4   WRITE PROJECT NUMBER 
          SA1    GESA 
          ZR     X1,GESX     IF LAST MESSAGE IN SUMMARY 
          SA1    UNUM 
          BX6    X1 
          SA6    GESD+2 
          WRITH  X2,GESD,3   WRITE USER NAME
          EQ     GESX        RETURN 
  
  
 GESA     BSS    1           NUMBER OF MESSAGES TO GENERATE 
 GESB     DATA   H* CHARGE NUMBER    = *
          BSS    1
 GESC     DATA   H* PROJECT NUMBER   = *
          BSS    2
 GESD     DATA   H* USER NAME      = *
          BSS    1
 DSA      SPACE  4
*         DISPLAY AREA. 
  
  
 KBUF     BSS    8           KEYBOARD BUFFER
          TITLE  K-DISPLAY AREA.
 DISPLAY  SPACE  4,10 
 KIA      VFD    6/4B,18/KBUF,18/DSD,18/DSA 
 KPAG     VFD    60/SPTA     ADDRESS OF CURRENT PAGE TABLE
 KTIT     DATA   C*PROFILE.*  K-DISPLAY TITLE 
  
          NOREF  K
 PAGE1    SPACE  4,10 
*         K-DISPLAY LEFT SCREEN PAGE 1. 
  
 DSA      VFD    10/0,1/0,1/0,1/0,5/0,18/KTIT,24/0  BUFFER CONTROL WORD 
 MESA     KDL    1,M,(                                              ) 
 INPA     KDL    1,I,(
,      )
          KDL    1,T,(PROFILE)
          KDL    1,,("PPFN")
 DSCD     KDL    8,,(       CREATED             ) 
 DSMD     KDL    39,H,( LAST MODIFIED     ) 
 DSCN     KDL    1,H,(CHARGE NUMBER    )
 DSCC     KDL    2,,(CREATION DATE    ) 
          KDL    35,,(E)
 DSCE     KDL    36,K,(XPIRATION DATE         ) 
          KDL    2,,(ENTRY) 
 DSCA     KDL    13,,(                ) 
          KDL    35,,(PROJECT COUN) 
 DSCO     EQU    *-1
          KDL    47,H,(T                ) 
 DSMU     KDL    2,,(MU =   ) 
 DSPL     KDL    35,K,(PCL =  ) 
 DSM1     KDL    2,,(M1 =             ) 
 DSM2     KDL    35,K,(M2 =             ) 
 DSM3     KDL    2,,(M3 =             ) 
 DSM4     KDL    35,K,(M4 =             ) 
 DSAD     KDL    2,,(AD =             ) 
 DSSL     KDL    35,H,(ISL =            ) 
 DSR1     KDL    2,,(IR1 =            ) 
 DSR2     KDL    35,K,(IR2 =            ) 
 DSR3     KDL    2,,(IR3 =            ) 
 DSR4     KDL    35,K,(IR4 =            ) 
 DSR5     KDL    2,,(IR5 =            ) 
 DSR6     KDL    35,K,(IR6 =            ) 
 DSR7     KDL    2,,(IR7 =            ) 
 DSR8     KDL    35,K,(IR8 =            ) 
 KPLN     KDL    48,T,(      PAGE 1 OF 3) 
          CON    0           END OF DISPLAY 
 PAGE2    SPACE  4,10 
*         K-DISPLAY LEFT SCREEN PAGE 2. 
  
 DSB      VFD    10/0,1/0,1/0,1/0,5/0,18/KTIT,24/0  BUFFER CONTROL WORD 
 MESB     KDL    1,M,(                                              ) 
 INPB     KDL    1,I,(
,      )
          KDL    1,T,(PROFILE)
          KDL    54,T,(PAGE 2 OF 3) 
 DSPN     KDL    1,H,(PROJECT NUMBER             )
          KDL    2,,(CR)
 DSPC     KDL    4,,(EATION DATE       )
          KDL    35,,(LA) 
 DSLC     KDL    37,K,(ST CHANGE DATE          )
          KDL    2,,(LA)
 DSUD     KDL    4,,(ST UPDATE DATE           ) 
          KDL    35,,(LA) 
 DSUT     KDL    37,K,(ST UPDATE TIME           ) 
          KDL    2,,(ENTRY) 
 DSPA     KDL    15,,(                ) 
          KDL    35,,(EX) 
 DSPE     KDL    37,H,(PIRATION DATE         )
 DSIN     KDL    2,,(TI =   ) 
 DSOF     KDL    35,K,(TO =   ) 
 DSPF     KDL    2,,(PFN =            ) 
 DSEF     KDL    35,K,(EFN =            ) 
 DSPU     KDL    2,,(PUN =            ) 
 DSEU     KDL    35,K,(EUN =            ) 
 DSPP     KDL    2,,(PPW =            ) 
 DSEP     KDL    35,K,(EPW =            ) 
 DSPO     KDL    2,,(PCR =            ) 
 DSSV     KDL    35,K,(ISV =            ) 
 DSML     KDL    2,,(SML =  ) 
 DSMA     KDL    35,K,(SMA =  ) 
          CON    0           END OF DISPLAY 
 PAGE3    SPACE  4,10 
*         K-DISPLAY LEFT SCREEN PAGE 3. 
  
 DSC      VFD    10/0,1/0,1/0,1/0,5/0,18/KTIT,24/0  BUFFER CONTROL WORD 
 MESC     KDL    1,M,(                                              ) 
 INPC     KDL    1,I,(
,      )
          KDL    1,T,(PROFILE)
          KDL    54,T,(PAGE 3 OF 3) 
 DSP2     KDL    1,H,(PROJECT NUMBER             )
 DSIL     KDL    2,,(SIL =  ) 
 DSIA     KDL    35,K,(SIA =  ) 
 DSL1     KDL    2,,(LR1 =  ) 
 DSA1     KDL    35,K,(AR1 =  ) 
 DSL2     KDL    2,,(LR2 =  ) 
 DSA2     KDL    35,K,(AR2 =  ) 
 DSL3     KDL    2,,(LR3 =  ) 
 DSA3     KDL    35,K,(AR3 =  ) 
 DSL4     KDL    2,,(LR4 =  ) 
 DSA4     KDL    35,H,(AR4 =  ) 
 DSL5     KDL    2,,(LR5 =  ) 
 DSA5     KDL    35,K,(AR5 =  ) 
 DSL6     KDL    2,,(LR6 =  ) 
 DSA6     KDL    35,K,(AR6 =  ) 
 DSL7     KDL    2,,(LR7 =  ) 
 DSA7     KDL    35,K,(AR7 =  ) 
 DSL8     KDL    2,,(LR8 =  ) 
 DSA8     KDL    35,K,(AR8 =  ) 
          CON    0           END OF DISPLAY 
 PAGE1R   SPACE  4,10 
*         K-DISPLAY RIGHT SCREEN. 
  
 DSD      VFD    10/0,1/0,1/0,1/0,5/0,18/KTIT,24/0  BUFFER CONTROL WORD 
  KDL 1,T,(                   PROFILE K DISPLAY COMMANDS) 
  KDL 1,K,(DROP          DROP DIRECTIVES ENTERED SINCE CHARGE OR PROJECT
,.) 
  KDL 1,K,(END           UPDATE PROFILE FILE AND TERMINATE CURRENT CHARG
,E.)
  KDL 1,K,(STOP          TERMINATE PROCESSING.) 
  KDL 1,K,(+             PAGE LEFT SCREEN FORWARD.) 
  KDL 1,H,(-             PAGE LEFT SCREEN BACKWARD.)
 K        SET    K+1
  KDL 1,H,(                       PROFILE DIRECTIVES) 
  KDL 1,K,(ACN=CHARN     ADD OR ACTIVATE CHARGE.) 
  KDL 1,K,(APN=PROJN     ADD OR ACTIVATE PROJECT.)
  KDL 1,K,(CN=CHARN      SET CHARGE NUMBER, ACTIVE CHARGE MUST EXIST.)
  KDL 1,H,(DCN=CHARN     DEACTIVATE CHARGE.)
  KDL 1,K,(DPN=PROJN     DEACTIVATE PROJECT.) 
  KDL 1,K,(PN=PROJN      SET PROJECT NUMBER, ACTIVE PROJECT MUST EXIST.)
  KDL 1,K,(/CHARN        SET CHARGE NUMBER, ACTIVE CHARGE MUST EXIST.)
          CON    0           END OF DISPLAY 
          TITLE  COMMON DECKS, LITERALS AND BUFFERS.
          SPACE  4
*CALL     COMCCOD 
*CALL     COMCCFD 
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCCPM 
 SLI$     SET    1           DEFINE SRU LIMIT CONVERSION
*CALL     COMCCVI 
*CALL     COMCDXB 
*CALL     COMCEDT 
*CALL     COMCLFM 
*CALL     COMCMTP 
*CALL     COMCMVE 
*CALL     COMCPFM 
*CALL     COMCRDW 
*CALL     COMCSFN 
*CALL     COMCSYS 
*CALL     COMCUSB 
*CALL     COMCVDT 
*CALL     COMCWTH 
*CALL     COMCWTS 
*CALL     COMCWTW 
  
  
          USE LITERALS
          SPACE  4
**        BUFFER AREA.
  
 PBUF     BSS    0           PROFILA BUFFER 
 IBUF     EQU    PBUF+PBUFL  INPUT AND SOURCE BUFFER
 OBUF     EQU    IBUF+IBUFL  OUTPUT BUFFER
 NBUF     EQU    OBUF+IBUFL  NEWPRO BUFFER
 OUTB     EQU    NBUF+PBUFL+5  OUTPUT LINE BUFFER 
 MEML     EQU    OUTB+6 
 RFL=     EQU    MEML+1000B 
 ARG=     EQU    *
          TITLE  PRESET.
          ORG    PBUF 
 PROFILE  SB1    1
          SX6    KIA
          SA6    KD 
          SETFET N,(ERA=EBUF) 
          SETFET P,(ERA=EBUF) 
          MX6    30          SET VALIDATED FL RETURN
          SX7    TOV         SET TABLE OVERFLOW PROCESSOR ADDRESS 
          SA6    FLM
          SA7    TO 
          MEMORY CM,A6,R,,NA
          SA1    FLM         POSITION MAXIMUM FIELD LENGTH
          LX1    30 
          SX6    X1-FLIN
          SA6    FLM
          EREXIT ABE         SET ERROR EXIT 
          PDATE  PD          SET DATE 
          SA1    PD 
          AX1    18 
          BX6    X1 
          SA6    A1 
          LX6    -18         PLACE DATE IN DEFAULT ENTRIES
          SA6    D1AA+CDTW
          SA6    D3AA+PCDW
          SA1    JOPR        SET ORIGIN TYPE
          MX6    -12
          AX1    24 
          SA2    SSJ=+AACS   USER ACCESS CONTROL WORD 
          BX6    -X6*X1 
          MX0    42 
          SA6    OT 
          SA1    SSJ=+UIDS   USER NAME
          SX6    X6-SYOT
          ZR     X6,PRS1     IF SYSTEM ORIGIN 
          SX6    B1          SET SPECIAL ACCOUNTING USER CLASSIFICATION 
          LX2    59-CSAP
          NG     X2,PRS1     IF SPECIAL ACCOUNTING USER 
          SX7    2RFM        SET FULL MASTER USER LIST OPTION 
          SX6    B1+B1       SET MASTER USER CLASSIFICATION 
          LX7    -12
          SA7    LO 
 PRS1     SA6    ACCC        ACCESS CLASSIFICATION
          BX1    X0*X1
          BX6    X1 
          SA6    UN 
          RJ     SFN
          SA6    HDRE+2 
          SX3    B1          CLEAR ERROR PROCESSING 
          LX3    44 
          SA1    I+1
          SA2    O+1
          BX6    -X3*X1 
          BX7    -X3*X2 
          SA6    A1 
          SA7    A2 
          SB2    CCDR 
          RJ     USB         UNPACK DATA TO STRING BUFFER 
 PRS2     RJ     POP         PICK OUT PARAMETER 
          NG     B5,PRS3     IF ERROR ENCOUNTERED 
          ZR     B6,PRS4     IF NO ARGUMENTS
          ZR     X6,PRS2     IF SPECIAL CHARACTER 
          LX6    6
          SX1    X6-1R0 
          PL     X1,PRS2     IF NOT ALPHA 
          SA1    PRSB+UOPT
          BX6    X1 
          SA6    OP 
          SB3    PRSA 
          RJ     ARM         ARGUMENT PROCESSOR 
          ZR     X1,PRS6     IF NO ERROR
 PRS3     SX2    =C* ERROR IN PROFILE ARGUMENTS.* 
          EQ     ABT
  
 PRS4     SA1    OT 
          SA5    PRSB+UOPT   SET UPDATE OPTION
          NZ     X1,PRS5     IF NOT SYSTEM
          SETRNR NOROLL      PREVENT JOB ROLLOUT
          SA5    PRSB+KOPT   SET K-DISPLAY OPTION 
 PRS5     BX6    X5 
          SA6    OP 
 PRS6     SA1    O           SET OUTPUT POINTER IN RA+2 
          MX0    42 
          BX6    X0*X1
          SX1    A1 
          BX6    X6+X1
          SA6    ARGR 
          GETPP  *,LL,PDEN   GET PAGE SIZE PARAMETERS 
          SX2    I           CHECK INPUT FILE 
          RJ     STF
          SA6    PI 
          SX2    O           CHECK OUTPUT FILE
          RJ     STF
          SA6    PO 
          WRITEW O,PDEN,X6   CONDITIONALLY WRITE FORMAT EFFECTOR
          WRITE  O,*         PRESET WRITE FUNCTION
          DATE   HDRH        SET DATE AND TIME IN HEADER LINE 
          CLOCK  HDRH+1 
          SA5    OP 
          RJ     CAF         CHECK ALTERNATE FAMILY 
          NZ     X6,PRS3     IF FAMILY CHANGE NOT ALLOWED 
          SA4    ALF
          SB3    -1 
          ZR     X4,PRS7     IF NO ALTERNATE FILE SPECIFIED 
          BX6    X4 
          MX0    42 
          SA6    P+CFPN      SET NEW PF NAME
          SA6    N+CFPN 
          BX1    X0*X4
          SA2    DSCD 
          MX0    24 
          LX1    36 
          BX6    X0*X2
          BX2    -X0*X1 
          BX6    X2+X6
          SA6    A2 
          SA2    A2+B1
          MX0    6
          BX6    -X0*X2 
          BX2    X0*X1
          BX6    X2+X6
          SA6    A2 
          LX1    24 
          MX0    54 
          RJ     SFN         SPACE FILL NAME
          LX6    54 
          SX1    1R1
          BX7    X0*X6
          BX7    X7+X1
          LX7    54 
          SA7    HDRA 
 PRS7     SB3    B3+B1
          SA3    PRSB+B3     SEARCH FOR OPTION
          ZR     X3,PRS3     ERROR - IF END OF TABLE
          BX2    X5-X3
          SX6    B3 
          NZ     X2,PRS7     IF NOT CHARACTER 
          BX5    X6 
          SA6    A5 
          SA1    OT 
          SX2    X5-IOPT
          NZ     X2,PRS10    IF NOT INQUIRE OPTION
          SA1    CN 
          NZ     X1,PRS8     IF CHARGE NUMBER PARAMETER SPECIFIED 
          SA2    PN 
          NZ     X2,PRS3     IF PROJECT NUMBER PARAMETER SPECIFIED
 PRS8     SA3    ACCC        ACCESS CLASSIFICATION
          SB2    X3 
          LE     B2,B1,PRS11 IF SYOT OR SPECIAL ACCOUNTING USER 
          SA3    UN 
          NZ     X3,PRS11    IF USER NAME PRESENT 
 PRS9     SX2    =C* MASTER USER NAME REQUIRED.*
          EQ     ABT
  
 PRS10    SA3    CN 
          NZ     X3,PRS3     IF CHARGE NUMBER SPECIFIED 
          SA3    PN 
          NZ     X3,PRS3     IF PROJECT NUMBER SPECIFIED
          SX2    X5-LOPT
          ZR     X2,PRS22    IF LIST OPTION 
          SX2    X5-UOPT
          ZR     X2,PRS10.1  IF UPDATE
          SX2    X5-TOPT
          ZR     X2,PRS10.1  IF INTERACTIVE UPDATE
          NZ     X1,PRS3     IF NOT SYSTEM ORIGIN 
          SX2    X5-COPT
          ZR     X2,PRS16    IF CREATE
          SX2    X5-ROPT
          ZR     X2,PRS16    IF REFORMAT
 PRS10.1  SA1    ALF
          ZR     X1,PRS11    IF NO ALTERNATE FILE SPECIFIED 
          ATTACH N,,,,RM,,,IP,FA
          SB2    N
          RJ     CFS         CHECK FILE STATUS
          NZ     X2,PRS11    IF FILE NOT FAST-ATTACH
          SX2    =C* FAST-ATTACH ALTERNATE FILE NOT ALLOWED.* 
          EQ     ABT         ABORT
  
 PRS11    ATTACH N,,,,RM,,,IP,MA
          SB2    N
          RJ     CFS         CHECK FILE STATUS
          NZ     X2,ABT3     IF *PFM* ERROR 
 PRS12    READ   N
          READW  N,CW,3 
          ZR     X1,PRS14    IF TRANSFER COMPLETE 
 PRS13    SX2    =C* PROFILE FILE DATA BASE ERROR.* 
          EQ     ABT
  
 PRS14    SA1    CW 
          MX0    12 
          BX1    X0*X1
          NZ     X1,PRS13    IF NOT LEVEL-0 
          READW  N,PRBF,2 
          NZ     X1,PRS13    IF CHARGE NUMBER MISSING 
          SA1    PRBF+1 
          SX1    X1 
          ZR     X1,PRS13    IF NO LEVEL-1 LINK 
          REWIND N,R
          SX6    X5-ROPT
          ZR     X6,PRS18    IF REFORMAT
          SX6    X5-KOPT
          NZ     X6,PRS19    IF NOT K-DISPLAY 
          SX3    PRSD 
          RJ     PRK         PRESET K-DISPLAY BUFFER
          SA1    KPLN        DISABLE PAGE LINE
          BX7    X1 
          SA7    KSAV 
          BX6    X6-X6
          SA6    A1 
          SA1    DSCN        DISABLE CHARGE DISPLAY 
          BX7    X1 
          SA7    A7+B1
          SA6    A1 
          MX0    -18
          SA5    CW+1 
          BX1    -X0*X5 
          EDATE  X1 
          SA6    DSMD+2 
          AX5    18 
          BX1    -X0*X5 
          EDATE  X1 
          SA6    DSCD+2 
          EQ     PRS19
  
 PRS16    SETUI  SYUI 
          SX2    X5-COPT
          BX6    X6-X6
          SA6    P+CFOU 
          ZR     X2,PRS18    IF CREATE
          MX0    42 
          SA1    N+CFPN 
          ATTACH N,X1,,,W,,,IP,FA  REFORMAT - CHECK FILE NOT FAST-ATTACH
          SB2    N
          RJ     CFS         CHECK FILE STATUS
          NZ     X2,PRS17    IF FILE NOT FAST-ATTACH
          SX2    =C* FAST-ATTACH PROFILE FILE INCORRECT.* 
          EQ     ABT
  
 PRS17    SX3    X2-2 
          NZ     X3,ABT3     IF NOT *PFM* ERROR *FILE NOT FOUND*
          SA1    N+CFPN      CLEAR *FA* PFM PARAMETER 
          BX6    X0*X1
          SA6    A1 
          ATTACH N,,,,W,,,IP,MA 
          SB2    N
          RJ     CFS         CHECK FILE STATUS
          NZ     X2,ABT3     IF *PFM* ERROR 
          EVICT  P
          SA1    =C*SCR*     SET NEW PF NAME
          BX6    X1 
          SA6    P+CFPN 
          EQ     PRS12       CHECK EMPTY PROJECT FILE 
  
 PRS18    DEFINE P,,,,,P,,,,IP
          SB2    P
          RJ     CFS         CHECK FILE STATUS
          NZ     X2,ABT3     IF *PFM* ERROR 
          WRITER P,R         POSITION PAST FIRST PRU
          SX2    X5-COPT
          NZ     X2,PRS19    IF NOT CREATE
          ATTACH P,,,,M,,,IP,NF 
          SB2    P
          RJ     CFS         CHECK FILE STATUS
          NZ     X2,ABT3     IF *PFM* ERROR 
          ATTACH N,,,,RM,,,IP,NF
          SB2    N
          RJ     CFS         CHECK FILE STATUS
          NZ     X2,ABT3     IF *PFM* ERROR 
 PRS19    BSS    0
 PRS21    OVERLAY =0LSFS,100B,S  LOAD *SFS* 
          EQ     PRO         EXIT TO MAIN LOOP
  
 PRS22    SA3    LO 
          SB3    -1 
 PRS23    SB3    B3+B1       SEARCH FOR OPTION
          SA4    PRSC+B3
          ZR     X4,PRS3     ERROR - IF END OF TABLE
          BX4    X4-X3
          SX6    B3 
          NZ     X4,PRS23    IF NOT OPTION
          SA6    LO 
          SA3    HDRL 
          SX2    X6-FMLO
          NG     X2,PRS24    IF NOT MASTER USER LIST
          SA1    UN 
          ZR     X1,PRS9     IF USER NAME MISSING 
          EQ     PRS25
  
 PRS24    SA1    ACCC        CHECK ACCESS CLASSIFICATION
          SB2    X1+
          GT     B2,B1,PRS3  IF NOT SYOT OR SPECIAL ACCOUNTING USER 
          SX2    X6-FSLO
          NZ     X2,PRS11    IF NOT FULL LIST 
 PRS25    BX6    X3          CLEAR MASTER USER FROM HEADER LINE 
          SA6    HDRG+3 
          SA6    A6+B1
          EQ     PRS11
  
 ALF      CON    0           ALTERNATE PROJECT PROFILE FILE NAME
  
 PRBF     BSSZ   3           PRESET BUFFER
          SPACE  4
*         COMMAND PARAMETERS. 
  
  
 PRSA     BSS    0
 I        ARG    I,I,400B     INPUT FILE
 L        ARG    O,O,400B     OUTPUT FILE 
 P        ARG    P,ALF,400B   PROFILE FILE
 S        ARG    S,S,400B     SOURCE FILE 
 OP       ARG    OP,OP        OPTIONS 
 FM       ARG    FN,FN,400B   ALTERNATE FAMILY
 CN       ARG    CN,CN,400B,1 CHARGE NUMBER 
 PN       ARG    PN,PN,400B,2 PROJECT NUMBER
 CV       ARG    -=1,CV       FILE CONVERSION 
 LO       ARG    LO,LO        LIST OPTION 
          CON    0
          SPACE  4
**        OPTIONS.
  
  
 PRSB     INDEX  CON,8,( )
          INDEX  ,KOPT,(/1LK/)     K-DISPLAY
          INDEX  ,COPT,(/1LC/)     CREATE 
          INDEX  ,UOPT,(/1LU/)     UPDATE 
          INDEX  ,ROPT,(/1LR/)     REFORMAT 
          INDEX  ,SOPT,(/1LS/)     SOURCE 
          INDEX  ,IOPT,(/1LI/)     INQUIRE
          INDEX  ,TOPT,(/1LT/)     TIME-SHARING UPDATE
          INDEX  ,LOPT,(/1LL/)     LIST OPTION
          CON 
          SPACE  4
**        LIST OPTIONS. 
  
  
 PRSC     INDEX  CON,6,( )
          INDEX  ,FSLO,(/1LF/)   FULL LIST
          INDEX  ,PSLO,(/1LP/)   PROJECT NUMBER LIST
          INDEX  ,CSLO,(/1LC/)   CHARGE NUMBER LIST 
          INDEX  ,FMLO,(/2LFM/)  MASTER USER FULL LIST
          INDEX  ,PMLO,(/2LPM/)  MASTER USER PROJECT NUMBER LIST
          INDEX  ,CMLO,(/2LCM/)  MASTER USER CHARGE NUMBER LIST 
          CON 
          SPACE  4
*         Y-COORDINATE TABLE. 
  
  
 PRSD     KDL    *
  
 PRK      HERE               REMOTE BLOCK FROM *COMCDCP*
          SPACE  4
*CALL     COMCARM 
*CALL     COMCOVL 
*CALL     COMCPOP 
*CALL     COMCSTF 
          END 
