COMCCHG 
COMMON
          CTEXT  COMCCHG - JOB PROFILE CHARGE VALIDATION. 
          SPACE  4,10 
          IF     -DEF,QUAL$,1 
          QUAL   COMCCHG
          BASE   D
          SPACE  4,10 
* COMMENT COMCCHG - VALIDATE JOB PROFILE CHARGE INFORMATION.
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       COMCCHG - VALIDATE CHARGE/PROJECT NUMBERS.
* 
*         R.P. ROHRBOUGH     72/09/08.
*         G.R. GREENFIELD    75/11/25. (MODIFIED) 
*         P.C. SMITH         81/06/09. (COMMON DECK CREATED)
          SPACE  4,15 
***       *COMCCHG* VALIDATES A CHARGE/PROJECT NUMBER PAIR, ACCORDING 
*         TO THE INFORMATION IN THE PROJECT PROFILE FILE. 
*         *COMCCHG* CONTAINS FOUR EXTERNALLY-CALLABLE ENTRY POINTS -
* 
*         *BAB* - BEGIN ACCOUNT BLOCK.
*                 CALLS *CPM* TO TERMINATE THE CURRENT ACCOUNT BLOCK
*                 (IF NECESSARY) AND BEGIN A NEW ONE.  *CPM* ISSUES 
*                 THE APPROPRIATE ACCOUNT FILE MESSAGES AND CLEARS
*                 THE *CHARGE REQUIRED* BIT IN THE CONTROL POINT AREA.
* 
*         *CHG* - VALIDATE CHARGE/PROJECT AND BEGIN ACCOUNT BLOCK.
*                 CALLS ROUTINE *VCP* FOLLOWED BY *BAB*.
* 
*         *RPE* - READ PROFILE ENTRY. 
*                 READS THE PROFILE ENTRY FOR THE CURRENT CHARGE AND
*                 PROJECT FROM THE *PROFILB* FILE.
* 
*         *VCP* - VALIDATE CHARGE AND PROJECT NUMBERS.
*                 CHECKS IF THE SPECIFIED CHARGE AND PROJECT NUMBERS
*                 ARE VALID, ARE ALLOWED FOR THE SPECIFIED USER NAME, 
*                 AND ARE ALLOWED FOR THE CURRENT TIME OF DAY.
*                 DEPENDING ON THE VALUE OF THE *LIM$* ASSEMBLY OPTION, 
*                 IT ALSO CHECKS IF THE CURRENT SRU LIMITS OF THE 
*                 CALLING JOB ARE WITHIN THE RANGE ALLOWED FOR THE
*                 SPECIFIED CHARGE AND PROJECT NUMBERS. 
* 
*         THE FOLLOWING ENTRY CONDITIONS ARE REQUIRED FOR ALL OF THE
*         ENTRY POINTS.  ADDITIONAL ENTRY AND EXIT CONDITIONS ARE 
*         DOCUMENTED IN THE INDIVIDUAL ROUTINES.
* 
*         ENTRY  (SSJ=) = ADDRESS OF *SSJ=* PARAMETER BLOCK.
*                (SRUM - SRUM+9) = ACCOUNTING INFORMATION BLOCK.
* 
*T,SRUM   60/ CONTROL POINT SRUS. 
*T,SRUM+1 6/ A, 30/ 0,  6/ B, 18/ C 
*T,SRUM+2 60/ CHARGE NUMBER (1 - 10 CHARACTERS) 
*T,SRUM+3 60/ PROJECT 
*T,SRUM+4 60/   NUMBER  (1 - 20 CHARACTERS) 
*T,SRUM+5 60/ ACCOUNT 
*T,SRUM+6 60/  FILE 
*T,SRUM+7 60/   MESSAGE 
*T,SRUM+8 60/    AREA 
*T,SRUM+9 60/     (1 - 50 CHARACTERS) 
* 
*         WHERE  A = SRU VALIDATION LIMIT INDEX.
*                B = 0, IF PROJECT IS FIRST ENTRY IN LEVEL-3 BLOCK. 
*                 .NE. 0, IF PROJECT IS SECOND ENTRY IN LEVEL-3 BLOCK.
*                C = LEVEL-3 RANDOM ADDRESS.
* 
*         THE CHARGE NUMBER AND PROJECT NUMBER, AS WELL 
*         AS THE PRECEDING 2 FIELDS, MUST BE SET ON ENTRY.
          SPACE  4,15 
***       ACCOUNT FILE MESSAGES.
* 
* 
*         *ABCN, CHARGENUMBR, PROJECT NUMBER.*
*                IF FIRST *CHARGE* COMMAND IN THIS JOB. 
* 
*         *ACCN, CHARGENUMBR, PROJECTNUMBER.* 
*                IF NOT FIRST *CHARGE* COMMAND IN THIS JOB. 
* 
*                THIS CHARGE-PROJECT NUMBER COMBINATION WILL BE USED
*                FOR ACCOUNTING PURPOSES FOR THIS JOB UNTIL ANOTHER 
*                CHARGE ENTRY OCCURS OR UNTIL JOB TERMINATION.
          SPACE  4,40 
***       ERROR MESSAGES. 
* 
*         ADDRESS OF THE ERROR MESSAGE RETURNED IN B6.
* 
*         * CHARGE FILE BUSY.* - FILE IS NOT AVAILABLE FOR CHARGE 
*                PURPOSES.  WAIT AND TRY AGAIN. 
* 
*         * CHARGE NOT VALID AT THIS HOUR.* - THIS PROJECT NUMBER 
*                CANNOT BE USED AT THIS TIME OF DAY.
* 
*         * CHARGE NUMBER EXPIRED.* - CHARGE NUMBER EXPIRATION DATE 
*                HAS OCCURRED.
* 
*         * CUMULATIVE LIMIT EXCEEDED.* - ONE OF THE INSTALLATION 
*                DEFINED RESOURCE USAGE ACCUMULATORS FOR THIS PROJECT 
*                EXCEEDS MAXIMUM VALUE ALLOWED. 
* 
*         * CUMULATIVE SRU LIMIT EXCEEDED.* - SRU ACCUMULATOR FOR THIS
*                PROJECT EXCEEDS MAXIMUM VALUE ALLOWED. 
* 
*         * DATA BASE ERROR.* - ERROR IN PROFILE FILE STRUCTURE 
*                DETECTED.
* 
*         * CHARGE NOT VALID.* -
*             1. CHARGE OR PROJECT NUMBER DOES NOT EXIST. 
*             2. PROJECT NUMBER IS NOT AVAILABLE TO A USER WITH THIS
*                ACCOUNT NUMBER.
*             3. CHARGE OR PROJECT NUMBER EXITS, BUT IS INACTIVE. 
* 
*         * DEFAULT CHARGE NOT VALID.* - SAME AS *CHARGE NOT VALID*,
*                EXCEPT THAT THE DEFAULT CHARGE INFORMATION WAS USED
*                FOR PROCESSING.
* 
*         * PROJECT NUMBER EXPIRED.* - PROJECT NUMBER EXPIRATION DATE 
*                HAS OCCURRED.
          TITLE  COMCCHG - PROGRAM EQUIVALENCES.
***       ASSEMBLY OPTIONS. 
* 
*         LIM$ EQU 0 - FULL CHECKING- CHARGE PERFORMS ALL CHECKS
*                      CORRESPONDING TO THE ABOVE ERROR MESSAGE 
*                      DOCUMENTATION. 
*         LIM$ EQU 1 - SUPPRESSES CHECKING OF SRU ACCUMULATORS AND
*                      INSTALLATION DEFINED RESOURCE USAGE
*                      ACCUMULATORS, BUT RETAINS ALL OTHER CHECKING.
*         RPE$ DEFINED - ASSEMBLE CODE TO PERFORM RANDOM READ OF LEVEL
*                        3 BLOCK. 
  
          IF     -DEF,LIM$,1
 LIM$     EQU    0
          TITLE  COMCCHG - MACRO DEFINITIONS. 
 ERROR    SPACE  4,10 
**        ERROR - RETURN ERROR MESSAGE. 
* 
*         RETURN AN ERROR MESSAGE TO THE CALLING PROGRAM. 
* 
*         ERROR  MSG
* 
*                MSG = ADDRESS OF ERROR MESSAGE.
  
  
          PURGMAC  ERROR
  
 ERROR    MACRO  MSG
          R=     B6,MSG 
          EQ     ERR
          ENDM
 LIMIT    SPACE  4,20 
**        LIMIT - DEFINE USER ACCESS LIMIT. 
* 
* 
*         LIMIT  PROG,CV,LB,UB,ERR
* 
*                PROG        PROCESSOR ADDRESS. 
*                CV          CURRENT VALUE. 
*                LB          LOWER BOUND. 
*                UB          UPPER BOUND. 
*                ERR         ADDRESS OF ERROR MESSAGE.
* 
*         CREATES TWO-WORD ENTRY IN LIMIT PROCESSOR TABLE AS FOLLOWS: 
* 
*T         6/OPEN,12/ UB,12/ LB,12/ CV,18/ PROG 
*T         42/ OPEN,18/ERROR ADDRESS
  
  
          PURGMAC  LIMIT
  
 LIMIT    MACRO  PROG,CV,LB,UB,ERR
          VFD    6/0,12/UB,12/LB,12/CV,18/PROG
 .2       IFC    NE,#ERR##
          VFD    42/0,18/ERR
 .2       ELSE
          ERR                MISSING *ERR* PARAMETER
 .2       ENDIF 
          ENDM
          SPACE  4,10 
***       COMMON DECKS REQUIRED.
* 
*         COMCMAC - CPU SYSTEM MACROS.
*         COMSPFM - PERMANENT FILE EQUIVALENCES.
*         COMSPRO - PROJECT PROFILE FILE STRUCTURE. 
*         COMSSRU - DEFINE SRU PARAMETERS.
*         COMSSSJ - SPECIAL SYSTEM JOB PARAMETERS.
          SPACE  4,10 
**        PROGRAM EQUATES.
  
  
 PBUFL    EQU    101B        PROFILE FILE CIO BUFFER LENGTH 
          SPACE  4,10 
**        PROFILE FILE MICROS.
  
  
 PF       MICRO  1,, "PPFN"  PROFILE FILE NAME
 PW       MICRO  1,, "PPWD"  PASSWORD 
 UN       MICRO  1,, "PUSN"  USER NAME
          TITLE  COMCCHG - DATA AREA. 
 FETS     SPACE  4,10 
**        FETS. 
  
  
 P        BSS    0
 SCR      RFILEB PBUF,PBUFL,(PFN="PF"),(USN="UN"),(PWD="PW"),EPR
 TSRM     SPACE  4,10 
**        TSRM   TABLE OF SRU CONSTANTS.
* 
*T,TSRM   VFD    6/0,18/UPPER LIMIT,18/LOWER LIMIT,18/DEFAULT 
  
  
 TSRM     BSS    0
          VFD    6/0,18/M1SU,18/M1SL,18/M1SR
          VFD    6/0,18/M2SU,18/M2SL,18/M2SR
          VFD    6/0,18/M3SU,18/M3SL,18/M3SR
          VFD    6/0,18/M4SU,18/M4SL,18/M4SR
          VFD    6/0,18/MASU,18/MASL,18/ADSR
          TITLE  COMCCHG - MAIN ROUTINES. 
 BAB      SPACE  4,15 
**        BAB - BEGIN ACCOUNT BLOCK.
* 
*         EXIT   ACCOUNTING INFORMATION ISSUED TO ACCOUNT AND USER
*                DAYFILES.
*                CHARGE REQUIRED FLAG CLEARED.
* 
*         USES   X - ALL. 
*                A - 1, 2, 6. 
*                B - 1, 2, 5. 
* 
*         CALLS  SNM. 
* 
*         MACROS BEGINAB, RECALL. 
  
  
 BAB      SUBR               ENTRY/EXIT 
          IF     -DEF,B1=1,1
          SB1    1
  
*         BUILD ACCOUNTING MESSAGE. 
  
          SA1    SRUM+2      READ CHARGE NUMBER 
          SB5    -BABA       MESSAGE TEMPLATE ADDRESS 
          SB3    SRUM+5      ASSEMBLY BUFFER ADDRESS
          SB2    1R?
          RJ     SNM         SET CHARGE NUMBER
          SA1    SRUM+3      SET PROJECT NUMBER WORD ONE
          SB2    1R!
          SB5    SRUM+5 
          RJ     SNM
          SA1    SRUM+4      SET PROJECT NUMBER WORD TWO
          SB2    1R&
          RJ     SNM
  
*         SET SRU MULTIPLIERS.
  
          SA1    SRM         SRU INDICES
          SA2    TSRM 
          LX1    30 
          MX0    -6 
          BX6    X6-X6
          SB2    5
 BAB1     LX1    6
          BX3    -X0*X1      INDEX FROM *PROFILA*  (I)
          SX7    X2          DEFAULT MULTIPLIER 
          SX5    X3-77B 
          ZR     X5,BAB2     IF DEFAULT SET 
          BX7    X7-X7
          ZR     X3,BAB2     IF ZERO INDEX
  
*         CONVERT INDEX TO VALUE.  V = (I*(U-L)/64) + L.
  
          AX2    18 
          SX4    X2          LOWER BOUND (L)
          AX2    18 
          SX5    X2          UPPER BOUND (U)
          IX7    X5-X4       UPPER - LOWER
          SX5    64 
          IX3    X7*X3       (U - L) * I
          IX5    X3/X5       (U - L) * I/64 
          IX7    X5+X4       (U - L) * I/64  +  L 
 BAB2     LX6    12          MERGE IN WITH REST OF VALUES 
          BX6    X6+X7
          SA2    A2+B1       READ NEXT TABLE ENTRY
          SB2    B2-B1
          GT     B2,B0,BAB1  IF NOT LAST INDEX
          SA6    SRUM 
          RECALL P
  
*         BEGIN ACCOUNT BLOCK.
  
          BEGINAB  SRUM      BEGIN ACCOUNT BLOCK
          EQ     BABX        RETURN 
  
  
 BABA     DATA   C*ACCN, ??????????, !!!!!!!!!!&&&&&&&&&&.* 
 CHG      SPACE  4,15 
**        CHG - VALIDATE CHARGE/PROJECT NUMBER AND BEGIN ACCOUNT BLOCK. 
* 
*         ENTRY  (X2) = DEFAULT CHARGE FLAG.
*                (X3) = USER NAME.
* 
*         EXIT   (B5) = LEVEL 3 ENTRY BUFFER ADDRESS. 
*                (B6) = ERROR MESSAGE ADDRESS, IF NON-ZERO. 
* 
*         USES   A - 0. 
*                B - 5, 6.
* 
*         CALLS  BAB, VCN.
  
  
 CHG      SUBR               ENTRY/EXIT 
          RJ     VCN         VALIDATE CHARGE AND PROJECT NUMBER 
          NZ     B6,CHGX     IF ERROR 
          SA0    B5          PRESERVE LEVEL 3 ENTRY BUFFER ADDRESS
          RJ     BAB         BEGIN ACCOUNT BLOCK
          SB5    A0          RESTRORE LEVEL 3 ENTRY BUFFER ADDRESS
          SB6    B0          SET *NO ERROR* STATUS
          EQ     CHGX        RETURN 
          SPACE  4,10 
 RPE$     IF     DEF,RPE$ 
 RPE      SPACE  4,17 
**        RPE - READ PROFILE ENTRY. 
* 
*         ENTRY  (X1) = 25/, 1/EI, 24/RI
*                EI = PROFILE FILE LEVEL-3 BLOCK ENTRY INDEX. 
*                RI = PROFILE FILE LEVEL-3 BLOCK RANDOM INDEX.
* 
*         EXIT   PROFILE FILE LEVEL-3 BLOCK READ TO BUFFER. 
*                (B5) = LEVEL-3 ENTRY BUFFER ADDRESS. 
*                (B6) = ERROR MESSAGE ADDRESS, IF NON-ZERO. 
* 
*         USES   X - 0, 2, 5, 6.
*                A - 2, 6.
*                B - 1, 5, 6. 
* 
*         CALLS  APR, RPR.
* 
*         MACROS RETURN.
  
  
 RPE      SUBR               ENTRY/EXIT 
          IF     -DEF,B1=1,1
          SB1    1
          SA2    RPEX        SET RETURN ADDRESS FOR ERROR PROCESSING
          BX6    X2 
          SA6    ERRX 
          BX5    X1 
          RJ     APR         ATTACH PROFILE FILE
          MX0    -24
          BX2    -X0*X5 
          RJ     RPR         READ PHYSICAL RECORD 
          RETURN P
          LX5    59-24       GET ENTRY INDEX
          SB5    PBUF        SET LEVEL-3 ENTRY BUFFER ADDRESS 
          PL     X5,RPE1     IF FIRST ENTRY 
          SB5    B5+PMWE
 RPE1     SB6    B0          SET *NO ERROR* STATUS
          EQ     RPEX        RETURN 
          SPACE  4,10 
 RPE$     ENDIF 
 VCN      SPACE  4,15 
**        VCN - VALIDATE CHARGE/PROJECT NUMBER. 
* 
*         ENTRY  (X2) = DEFAULT CHARGE FLAG.
*                (X3) = USER NAME.
* 
*         EXIT   (B5) = LEVEL 3 ENTRY BUFFER ADDRESS. 
*                (B6) = ERROR MESSAGE ADDRESS, IF NON-ZERO. 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2.
*                B - 1, 2, 6. 
* 
*         CALLS  APR, CLT, CVU, SPI.
* 
*         MACROS ERROR, PDATE, RETURN, RPHR.
  
  
 VCN      SUBR               ENTRY/EXIT 
          IF     -DEF,B1=1,1
          SB1    1
          SA1    VCNX        SET RETURN ADDRESS FOR ERROR PROCESSING
          BX6    X1 
          SA6    ERRX 
          MX0    42          SAVE USER NAME 
          BX6    X0*X3
          SA6    CUN
          BX6    X2          SAVE DEFAULT CHARGE FLAG 
          SA6    DCF
          RJ     APR         ATTACH PROFILE FILE
          PDATE  CDT         CURRENT DATE AND TIME
          RPHR   P,R
          SX0    7754B
          SA2    P
          BX1    X0*X2
          NZ     X1,VCN3     IF END OF FILE 
          RJ     SPI         SEARCH FOR PROJECT INFORMATION 
          SX6    LIMT        PROCESS LIMIT TABLE
          RJ     CLT
          RJ     CVU         CHECK VALID USER NAME
          RETURN P
          SB5    EBUF        SET LEVEL 3 ENTRY ADDRESS
          SB6    B0+         SET *NO ERROR* STATUS
          EQ     VCNX        RETURN 
  
 VCN3     ERROR  ERRE        * DATA BASE ERROR.*
 LIMT     SPACE  4,20 
**        LIMT - TABLE OF LIMIT PROCESSORS. 
  
  
 LIMT     BSS    0
          LIMIT  TOD,CDT,PTMW,PTMW,ERRA 
 .CHG1    IFEQ   LIM$,0 
          LIMIT  GLP,PMSW,0,PMSW,ERRB 
          LIMIT  GLP,PISW,0,PISW,ERRB 
          LIMIT  GLP,PIRW-1+1,0,PIRW-1+1,ERRC 
          LIMIT  GLP,PIRW-1+2,0,PIRW-1+2,ERRC 
          LIMIT  GLP,PIRW-1+3,0,PIRW-1+3,ERRC 
          LIMIT  GLP,PIRW-1+4,0,PIRW-1+4,ERRC 
          LIMIT  GLP,PIRW-1+5,0,PIRW-1+5,ERRC 
          LIMIT  GLP,PIRW-1+6,0,PIRW-1+6,ERRC 
          LIMIT  GLP,PIRW-1+7,0,PIRW-1+7,ERRC 
          LIMIT  GLP,PIRW-1+8,0,PIRW-1+8,ERRC 
 .CHG1    ENDIF 
          CON    0           END OF TABLE 
          TITLE  COMCCHG - VALIDATION ROUTINES. 
 CCE      SPACE  4,20 
**        CCE - CHECK CHARGE NUMBER ENTRY.
* 
*         THE CHARGE ENTRY IS CHECKED TO SEE IF ACTIVE AND NOT EXPIRED. 
* 
*         ENTRY  (B2) = ADDRESS OF NEXT ENTRY.
*                (X2) = LAST WORD OF ENTRY. 
* 
*         EXIT   (MUN) = MASTER USER NAME.
*                (SRM) = SRU MULTIPLIER INDICES.
* 
*         USES   X - 3, 4, 5, 6.
*                A - 3, 4, 5, 6.
* 
*         MACROS ERROR. 
  
  
 CCE2     MX4    42          SAVE MASTER USER AND SRU INDICES 
          BX6    X2*X4
          SA6    MUN
          BX6    X3 
          SA6    SRM
  
 CCE      SUBR               ENTRY/EXIT 
          SA3    B2-CMWE+CSRW 
          NG     X3,CCE1     IF CHARGE NUMBER INACTIVE
          SA4    B2-CMWE+CDTW  CHECK EXPIRATION DATE
          LX4    -24
          SX4    X4 
          ZR     X4,CCE2     IF NO RESTRICTION
          SA5    CDT
          AX5    18 
          IX4    X4-X5
          PL     X4,CCE2     IF CHARGE NUMBER NOT EXPIRED 
          ERROR  ERRG        * CHARGE NUMBER EXPIRED.*
  
 CCE1     ERROR  ERRD        * CHARGE NOT VALID.* 
 CPE      SPACE  4,20 
**        CPE - CHECK PROJECT NUMBER ENTRY. 
* 
*         THE PROJECT ENTRY IS FOUND, AND THEN CHECKED TO SEE 
*         IF ACTIVE AND NOT EXPIRED.
* 
*         ENTRY  (SRUM+1) = LEVEL-3 RANDOM ADDRESS. 
* 
*         EXIT   (B5) = ADDRESS OF PROJECT ENTRY. 
*                (SRUM+1) = 6/A,30/,6/B,18/C
*                WHERE
*                A = SRU VALIDATION LIMIT INDEX.
*                B = 0, IF PROJECT IS FIRST ENTRY IN LEVEL-3 BLOCK. 
*                  .NE. O, IF PROJECT IS SECOND ENTRY IN LEVEL-3 BLOCK. 
*                C = LEVEL-3 RANDOM ADDRESS.
* 
*         USES   A - 1, 2, 3, 4, 6. 
*                X - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 5.
* 
*         MACROS ERROR, MOVE. 
  
  
 CPE5     SA1    B5+PCGW     (SRUM+1) 
          MX2    6
          BX3    X2*X1       CHARGE/PROJECT SRU VALIDATION
          SB2    6
          SA4    SSJ=+ALMS   ACCOUNT LIMIT INDEX WORD 
          LX1    X3,B2
          BX7    X2*X4
          LX5    X7,B2
          LX4    30 
          NZ     X7,CPE5.1   IF ORIGINAL SRU VALIDATION LIMIT SET 
          BX7    X2*X4       GET CURRENT SRU VALIDATION LIMIT 
          LX5    X7,B2
 CPE5.1   IX2    X1-X5       COMPARE VALUES 
          NG     X2,CPE6     IF CHARGE/PROJECT LIMIT SMALLEST 
          BX3    X7          USE USER LIMIT IF SMALLEST 
 CPE6     SA4    SRUM+1 
          SX6    B5-PBUF     SET FIRST LEVEL-3 BLOCK FLAG 
          LX6    18 
          BX6    X3+X6       MERGE SRU VALIDATON INDEX
          BX6    X4+X6       MERGE LEVEL-3 BLOCK ADDRESS
          SA6    A4 
          MOVE   PMWE,B5,EBUF  SET LEVEL 3 ENTRY
  
 CPE      SUBR               ENTRY/EXIT 
          SB5    PBUF 
          MX1    -12
 CPE1     SA2    B5 
          LX2    12 
          BX3    -X1*X2 
          SX3    X3-3 
          NZ     X3,CPE3     IF NOT LEVEL-3 BLOCK 
          SA3    B5+PRJW     CHECK PROJECT NUMBER 
          SA4    SRUM+3      GET PROJECT NUMBER 
          BX3    X3-X4
          NZ     X3,CPE2     IF NO MATCH
          SA3    A3+B1
          SA4    A4+B1
          BX3    X3-X4
          NZ     X3,CPE2     IF NO MATCH
          SA3    B5+PCHW     CHECK CHARGE NUMBER
          SA4    SRUM+2      GET CHARGE NUMBER
          BX3    X3-X4
          NZ     X3,CPE3     IF NO MATCH
          SA3    B5+PTMW
          NG     X3,CPE4     IF PROJECT NUMBER INACTIVE 
          SA3    B5+PCDW     CHECK EXPIRATION DATE
          LX3    -24
          SX3    X3 
          ZR     X3,CPE5     IF NO RESTRICTION
          SA4    CDT
          AX4    18 
          IX3    X3-X4
          PL     X3,CPE5     IF PROJECT NUMBER NOT EXPIRED
          ERROR  ERRH        * PROJECT NUMBER EXPIRED.* 
  
 CPE2     LX2    12          ADVANCE FOR NEXT ENTRY 
          BX3    -X1*X2 
          SB5    B5+X3
          SX3    B5-PBUF-PRUS 
          NG     X3,CPE1     IF ANOTHER ENTRY 
 CPE3     ERROR  ERRE        * DATA BASE ERROR.*
  
 CPE4     ERROR  ERRD        * CHARGE NOT VALID.* 
 CVU      SPACE  4,20 
**        CVU - CHECK VALID USER NAME.
* 
*         THE USER IS VALIDATED TO USE THIS PROJECT IF ONE OF 
*         THE FOLLOWING IS TRUE-
*                1. USER IS MASTER USER OF PROJECT. 
*                2. PROJECT SPECIFIES NO USER NAME LIST.
*                3. USER IS SPECIFIED IN PROJECT,S USER NAME LIST.
* 
*         ENTRY  (B5) = ADDRESS OF PROJECT ENTRY. 
* 
*         USES   A - 1, 2, 3. 
*                X - 1, 2, 3, 4.
*                B - 2, 3.
* 
*         CALLS  RPR, SUR.
* 
*         MACROS ERROR. 
  
  
 CVU      SUBR               ENTRY/EXIT 
          SA2    B5 
          MX3    12 
          LX3    -24
          BX3    X3*X2
          ZR     X3,CVUX     IF NO USER NAME LIST SPECIFIED 
          SA1    CUN
          SA3    MUN
          BX3    X1-X3
          ZR     X3,CVUX     IF USER IS MASTER USER 
          SB2    B5+PUNW     SEARCH FIRST LEVEL-3 BLOCK 
          SB3    B2+NUNS
 CVU1     RJ     SUR         SEARCH USER NAME RANGE 
          ZR     X4,CVUX     IF USER NAME IN LIST 
          SX4    X4-1 
          ZR     X4,CVU2     IF USER NAME NOT IN LIST 
          SX2    X2 
          ZR     X2,CVU2     IF NO MORE OVERFLOW BLOCKS 
          RJ     RPR         READ OVERFLOW BLOCK
          SA2    PBUF 
          SA1    CUN         SEARCH OVERFLOW BLOCK
          SB2    PBUF+1 
          SB3    PBUF+PRUS
          EQ     CVU1        LOOP 
  
 CVU2     ERROR  ERRD        * CHARGE NOT VALID.* 
 SIB      SPACE  4,20 
**        SIB - SEARCH INDEX BLOCK. 
* 
*         ENTRY  (A0) = LEVEL NUMBER. 
*                (B6) = ADDRESS OF VALIDATION NUMBER. 
* 
*         EXIT   (X2),(B2)   VALIDATION STATUS. ***** 
* 
*         USES   A - 1. 
*                X - 0, 1, 2, 3, 5. 
*                B - 2, 3, 4, 7.
* 
*         CALLS  MWS. 
* 
*         MACROS ERROR. 
  
  
 SIB      SUBR               ENTRY/EXIT 
          SA1    PBUF        CHECK INDEX LEVEL
          SB2    A0 
          MX0    12 
          BX2    X0*X1
          LX2    12 
          SB7    X2+
          NE     B2,B7,SIB2  IF LEVEL NUMBER BAD
          LX0    12          SET CALL TO TABLE SEARCH 
          BX2    X0*X1
          SB2    X2+PBUF     FWA TABLE
          LX1    -24
          BX3    X1*X0
          LX1    -12
          BX2    X1*X0
          SB3    X2+PBUF     LWA+1 TABLE
          SB7    X3          NUMBER OF WORDS/ENTRY
          SB4    A0+         CHECK BLOCK LEVEL
          SX5    B7-B1
          NE     B1,B4,SIB1  IF NOT LEVEL-1 
          SX5    1
 SIB1     RJ     MWS         SEARCH THIS BLOCK
          EQ     SIBX        EXIT 
  
 SIB2     ERROR  ERRE        * DATA BASE ERROR.*
SPI       SPACE  4,10 
**        SPI - SEARCH FOR PROJECT PROFILE INFORMATION. 
* 
*         USES   A - 0, 2, 3, 6.
*                X - 0, 2, 3, 6.
*                B - 3, 6.
* 
*         CALLS  CPE, RPR, SIB. 
* 
*         MACROS ERROR. 
  
  
 SPI      SUBR               ENTRY/EXIT 
 SPI1     SA0    B0+         SEARCH LEVEL-0 BLOCK 
          SB6    SRUM+2      ADDRESS OF CHARGE NUMBER 
          RJ     SIB
          NZ     X2,SPI4     IF POINTER FOUND 
          SA2    PBUF        CHECK POSITION IN BLOCK
          SX0    7777B
          LX2    -36
          BX3    X0*X2
          SB3    X3+PBUF+1
          LT     B2,B3,SPI3  IF NOT EOB 
          SA2    PBUF+2 
          ZR     X2,SPI2     IF NO MORE BLOCKS
          SA3    B2-B1
          ZR     X3,SPI9     IF NO RANDOM ADDRESS 
          BX6    X3 
          SA6    SPIA 
          RJ     RPR
          EQ     SPI1        SEARCH LEVEL-0 BLOCK 
  
 SPI2     SA2    B2-B1
          EQ     SPI4        READ LEVEL-1 BLOCK 
  
 SPI3     SA2    SPIA 
          ZR     X2,SPI8     IF PRECEDES VERY FIRST NUMBER
 SPI4     RJ     RPR         READ BLOCK 
          SA0    B1+
          SB6    SRUM+2      ADDRESS OF CHARGE NUMBER 
          RJ     SIB         SEARCH LEVEL-1 BLOCK 
          NZ     X2,SPI5     IF HIT 
          SA2    PBUF+2 
          ZR     X2,SPI8     IF NO MORE BLOCKS
          EQ     SPI4        READ NEXT BLOCK
  
 SPI5     RJ     CCE         CHECK CHARGE ENTRY 
          SX2    X2 
          ZR     X2,SPI8     IF NO LEVEL-2 CHAIN
 SPI6     RJ     RPR         READ LEVEL-2 BLOCK 
          SA0    2           SEARCH LEVEL-2 BLOCK 
          SB6    SRUM+3      ADDRESS OF PROJECT NUMBER
          RJ     SIB
          NZ     X2,SPI7     IF HIT 
          SA2    PBUF 
          MX0    -12
          BX3    -X0*X2 
          SA2    X3+PBUF-1
          ZR     X2,SPI8     IF NO MORE BLOCKS
          EQ     SPI6        READ NEXT LEVEL-2 BLOCK
  
 SPI7     MX6    -18         SET LEVEL-3 BLOCK RANDOM ADDRESS 
          BX6    -X6*X2 
          SA6    SRUM+1 
          RJ     RPR         READ FIRST LEVEL-3 BLOCK 
          RJ     CPE         CHECK PROJECT ENTRY
          EQ     SPIX        RETURN 
  
 SPI8     ERROR  ERRD        * CHARGE NOT VALID.* 
  
 SPI9     ERROR  ERRE        * DATA BASE ERROR.*
  
 SPIA     CON    0           PREVIOUS RANDOM INDEX TO NEXT LEVEL
          TITLE  COMCCHG - USER LIMIT PROCESSORS. 
 CLT      SPACE  4,15 
**        CLT - CHECK USER LIMITS.
* 
*         ENTRY  (X6) = ADDRESS OF LIMIT TABLE. 
* 
*         USES   A - 1, 5, 6. 
*                X - 0, 1, 2, 3, 4, 5, 6. 
*                B - 7. 
* 
*         CALLS  EIS. 
  
  
 CLT      SUBR               ENTRY/EXIT 
 CLT1     SA1    X6+         READ TABLE ENTRY 
          ZR     X1,CLTX     IF END OF TABLE
          SA6    CLTA        SAVE CURRENT ADDRESS 
          SB7    X1+         CRACK TABLE ENTRY
          SX0    7777B
          LX1    -18
          BX2    X0*X1       CURRENT VALUE
          LX1    -12
          BX3    X0*X1       LOWER LIMIT
          LX1    -12
          BX4    X0*X1       UPPER LIMIT
          SA5    X6+B1       ERROR MESSAGE
          RJ     EIS         EXECUTE PROCESSOR
          SA1    CLTA 
          SX6    X1+2 
          EQ     CLT1        PROCESS NEXT TABLE ENTRY 
  
 CLTA     BSS    1           CURRENT TABLE ENTRY
 GLP      SPACE  4,20 
**        GLP - GENERAL LIMIT PROCESSOR.
* 
*         THE LOWER 30 BITS AT THE CURRENT VALUE ADDRESS ARE COMPARED 
*         WITH THE UPPER 30 BITS AT THE UPPER LIMIT ADDRESS. THE
*         CORRESPONDING RESOURCE IS CONSIDERED EXPENDED FOR THE 
*         PROJECT IF THE FORMER EXCEEDS THE LATTER. HOWEVER, A LIMIT
*         OR LIMIT ADDRESS (RELATIVE) OF 0 IMPLIES NO RESTRICTION.
* 
*         ENTRY  (X2) = CURRENT VALUE (RELATIVE) ADDRESS. 
*                (X4) = UPPER LIMIT (RELATIVE) ADDRESS. 
*                (X5) = ERROR MESSAGE (ABSOLUTE) ADDRESS. 
*                (B5) = ADDRESS OF PROJECT ENTRY. 
* 
*         USES   X - 1, 2, 4. 
*                A - 2, 4.
*                B - 6. 
* 
*         MACROS ERROR. 
  
  
 GLP      SUBR               ENTRY/EXIT 
          ZR     X4,GLPX     IF NO RESTRICTION
          SA4    B5+X4       UPPER LIMIT
          LX4    30 
          MX1    -30
          BX4    -X1*X4 
          ZR     X4,GLPX     IF NO RESTRICTION
          SA2    B5+X2       CURRENT VALUE
          BX2    -X1*X2 
          IX1    X4-X2
          PL     X1,GLPX     IF LIMIT NOT EXCEEDED
          SB6    X5 
          ERROR  B6          RETURN SPECIFIED ERROR 
 TOD      SPACE  4,20 
**        TOD - CHECK TIME OF DAY.
* 
*         CURRENT TIME IS COMPARED WITH THE VALUES AT THE LOWER 
*         (TIME ON) AND UPPER (TIME OFF) LIMIT ADDRESSES. THE 
*         PROJECT IS AVAILABLE FOR USE IF THE CURRENT TIME IS 
*         BETWEEN THE LIMIT VALUES. HOWEVER, TIME ON = TIME OFF 
*         IMPLIES NO RESTRICTION. 
* 
*         ENTRY  (X2) = CURRENT TIME (ABSOLUTE) ADDRESS.
*                (X3) = TIME ON - TIME OFF WORD (RELATIVE) ADDRESS. 
*                (X5) = ERROR MESSAGE (ABSOLUTE) ADDRESS. 
*                (B5) = ADDRESS OF PROJECT ENTRY. 
* 
*         USES   X - 1, 2, 3, 4, 6. 
*                A - 1, 2.
* 
*         MACROS ERROR. 
  
  
 TOD      SUBR               ENTRY/EXIT 
          SA1    B5+X3
          SA2    CDT
          SX2    X2 
          SX3    X1          TIME OFF 
          AX1    18          TIME ON
          SX1    X1 
          IX4    X3-X1
          ZR     X4,TODX     IF NO LIMIT SET
          NG     X4,TOD1     IF NIGHT TIME USAGE
          IX6    X2-X1       CHECK TIME ON
          NG     X6,TOD2     IF BEFORE
          IX6    X2-X3       CHECK TIME OFF 
          PL     X6,TOD2     IF AFTER 
          EQ     TODX        RETURN 
  
 TOD1     IX6    X2-X1       CHECK TIME ON
          PL     X6,TODX     IF AFTER 
          IX6    X2-X3       CHECK TIME OFF 
          NG     X6,TODX     IF BEFORE
 TOD2     ERROR  X5          RETURN SPECIFIED ERROR MESSAGE 
          TITLE  COMCCHG - MISCELLANEOUS ROUTINES.
 APR      SPACE  4,9
**        APR - ATTACH PROFILE FILE.
* 
*         EXIT   PROFILE FILE ATTACHED. 
*                TO *ERR* IF FILE NOT ATTACHED. 
* 
*         USES   A - 1, 2, 4, 6, 7. 
*                X - 0, 1, 2, 3, 4, 6, 7. 
* 
*         MACROS ATTACH, ERROR. 
  
  
 APR      SUBR               ENTRY/EXIT 
          SA2    P           SET FET ADDRESS
          SA1    A2+B1       REWIND FET POINTERS
          SX3    3
          SX7    ERRM        SET ERROR MESSAGE ADDRESS IN FET 
          SA4    P+CFPW 
          MX0    42 
          BX4    X0*X4
          BX7    X4+X7
          SA7    A4 
          BX6    X0*X2       CLEAR ALL EXCEPT LOCAL FILE NAME 
          BX6    X6+X3
          SA6    A2          SET FILENAME AND INITIAL STATUS
          MX7    0
          SA7    P+6         CLEAR RANDOM ADDRESS AND INDEX WORDS 
          SX6    X1 
          SA7    A7+B1
          SA6    A1+B1
          SA6    A6+B1
          ATTACH A2,,,,RM,,,IP,FA 
          SA2    X2          CHECK ATTACH STATUS
          MX1    -8 
          AX2    10 
          BX2    -X1*X2 
          ZR     X2,APRX     IF FILE ATTACHED 
 APR1     SX1    X2-/ERRMSG/FBS 
          NZ     X1,APR2     IF FILE NOT BUSY 
          ERROR  ERRF        * CHARGE FILE BUSY.* 
  
 APR2     SX1    X2-/ERRMSG/PFN 
          NZ     X1,APR3     IF NOT * DEVICE UNAVAILABLE.*
          ERROR  ERRD        * CHARGE NOT VALID.* 
  
 APR3     ERROR  ERRE        * DATA BASE ERROR.*
 EIS      SPACE  4,10 
**        EIS - EXECUTE INDEXED SUBROUTINE. 
* 
*         ENTRY  (B7) = ADDRESS OF ROUTINE. 
* 
*         EXIT   TO ROUTINE.
* 
*         USES   A - 1, 6.
*                X - 1, 6.
  
  
 EIS      SUBR               ENTRY
          SA1    EISX        SET RETURN ADDRESS 
          BX6    X1 
          SA6    B7 
          JP     B7+1        EXECUTE SUBROUTINE 
 ERR      SPACE  4,15 
**        ERR - ERROR EXIT. 
* 
*         ENTRY  (B6) = ERROR MESSAGE ADDRESS.
* 
*         EXIT   RETURN ERROR STATUS FROM COMMON DECK.
*                TO *VCNX* IF ENTERED FROM *VCN*. 
*                TO *RPEX* IF ENTERED FROM *RPE*. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2, 6. 
*                B - 6, 7.
* 
*         MACROS RETURN.
  
  
 ERR      BSS    0           ENTRY
          SA2    P           ENSURE COMPLETE BIT SET IN FET 
          SX6    B1 
          BX6    X2+X6
          SA6    A2 
          RETURN P
          SB7    ERRD 
          NE     B6,B7,ERR1  IF NOT *CHARGE NOT VALID.* 
          SA1    DCF
          ZR     X1,ERR1     IF NOT DEFAULT CHARGE
          SB6    ERRI        * DEFAULT CHARGE NOT VALID.* 
 ERR1     BSS    1           RETURN WITH ERROR STATUS 
*         EQ     VCNX        IF ENTERED FROM *VCN*
*         EQ     RPEX        IF ENTERED FROM *RPE*
 ERRX     EQU    *-1
  
  
 ERRA     DATA   C* CHARGE NOT VALID AT THIS HOUR.* 
 ERRB     DATA   C* CUMULATIVE SRU LIMIT EXCEEDED.* 
 ERRC     DATA   C* CUMULATIVE LIMIT EXCEEDED.* 
 ERRD     DATA   C* CHARGE NOT VALID.*
 ERRE     DATA   C* DATA BASE ERROR.* 
 ERRF     DATA   C* CHARGE FILE BUSY.*
 ERRG     DATA   C* CHARGE NUMBER EXPIRED.* 
 ERRH     DATA   C* PROJECT NUMBER EXPIRED.*
 ERRI     DATA   C* DEFAULT CHARGE NOT VALID.*
 MWS      SPACE  4,20 
**        MWS - MULTIPLE WORD TABLE SEARCH. 
* 
*         ENTRY  (A0) = BLOCK LEVEL.
*                (B2) = FWA TABLE.
*                (B3) = LIMIT OF TABLE (FWA+LENGTH).
*                (B6) = ENTRY BLOCK ADDRESS.
*                (B7) = WORD COUNT/ENTRY. 
*                (X5) = WORD COUNT/ ENTRY FOR COMPARE.
* 
*         ENTRY  (X2) = (LAST WORD IN MATCHED ENTRY). 
*                (X2) = 0 IF ENTRY NOT FOUND. 
*                (B2) = NEXT TABLE ENTRY. 
*                (B3) = LIMIT OF TABLE. 
* 
*         USES   A - 0, 1, 2. 
*                X - 0, 1, 2, 3, 5. 
*                B - 2, 3, 4, 5.
  
  
 MWS8     SB3    A0-B2
          MX2    0           SET ERROR
          ZR     B3,MWSX     IF FIRST ENTRY 
          ZR     X0,MWS6     IF LEVEL-0 
  
 MWS      SUBR               ENTRY/EXIT 
          EQ     B2,B3,MWS7  IF NULL TABLE
          BX5    -X5
          SX0    A0 
          SX5    X5+B7
          SA0    B2+
          BX5    -X5
          EQ     MWS2        ENTER SEARCH LOOP
  
 MWS1     PL     X3,MWS8     IF PAST NUMBER 
          SB2    B2+B7       INCREMENT TABLE ENTRY
          MX2    0           SET ERROR
          GE     B2,B3,MWSX  IF END OF TABLE
 MWS2     SB5    B0+         INITIALIZE COMPARE 
          SB4    B7+X5
 MWS3     SA2    B2+B5
          SA1    B6+B5
          NG     X2,MWS4     IF AT LEAST ONE NEGATIVE 
          PL     X1,MWS5     IF BOTH POSITIVE 
          SX3    -B1         SET ENTRY NOT REACHED
          EQ     MWS1        CONTINUE SEARCH
  
 MWS4     NG     X1,MWS5     IF BOTH NEGATIVE 
          SX3    B1          SET PAST ENTRY 
          EQ     MWS1        CONTINUE SEARCH
  
 MWS5     IX3    X2-X1
          NZ     X3,MWS1     IF NO MATCH
          SB5    B5+B1
          LT     B5,B4,MWS3  IF NOT END OF COMPARE
          SB2    B2+B7
 MWS6     SA2    B2-B1       SET LAST WORD OF ENTRY 
          EQ     MWSX        RETURN 
  
 MWS7     MX2    0           SET ERROR
          EQ     MWSX        RETURN 
 RPR      SPACE  4,15 
**        RPR - READ PHYSICAL RECORD. 
* 
*         ENTRY  (X2) = RANDOM ADDRESS OF RECORD (BITS 0 - 17). 
* 
*         EXIT   RECORD IN PROFILO BUFFER.
* 
*         USES   A - 2, 3, 6, 7.
*                X - 0, 2, 3, 6, 7. 
* 
*         MACROS ERROR, RPHR. 
  
  
 RPR      SUBR               ENTRY/EXIT 
          SA3    P+1
          SX6    X3 
          SA6    A3+B1
          SA6    A6+B1
          SX7    X2 
          SA7    P+6
          RPHR   P,R
          SA2    X2 
          MX0    -8 
          LX0    10 
          BX3    -X0*X2 
          ZR     X3,RPRX     IF NO ERROR
          ERROR  ERRE        * DATA BASE ERROR.*
 SUR      SPACE  4,20 
**        SUR - SEARCH USER NAME RANGE. 
* 
*         ENTRY  (X1) = USER NAME TO SEARCH FOR.
*                (B2) = LOWER RANGE ADDRESS.
*                (B3) = UPPER RANGE ADDRESS + 1.
* 
*         EXIT   (X4) = 0, IF MATCH.
*                (X4) = 1, IF USER NAME NOT IN LIST (LOWER 18 
*                          BITS OF USER NAME ENTRY EQUALS 1). 
*                (X4) = OTHER, IF END OF RANGE ENCOUNTERED
*                              (NOTE - NOT NECESSARILY END OF LIST).
* 
*         USES   X - 3, 4.
*                A - 3. 
*                B - 2. 
  
  
 SUR      SUBR               ENTRY/EXIT 
 SUR1     SA3    B2 
          SX4    X3 
          NZ     X4,SURX     IF USER NAME NOT IN LIST 
          BX4    X1-X3
          ZR     X4,SURX     IF MATCH 
          SB2    B2+B1
          LT     B2,B3,SUR1  IF ANOTHER USER NAME IN RANGE
          EQ     SURX        RETURN 
          TITLE  COMCCHG - TABLES AND BUFFERS.
          SPACE  4,10 
*         DATA AREA.
  
  
*         THE FOLLOWING TWO DEFINITIONS MUST BE CONTIGUOUS. 
  
 DCF      BSSN   1           DEFAULT CHARGE FLAG
 SRM      BSSN   1           SRU MULTIPLIER INDICES 
 CDT      BSSN   1           CURRENT DATA AND TIME
  
 CUN      BSSN   1           CURRENT USER NAME
 MUN      BSSN   1           MASTER USER NAME 
  
 ERRM     BSSN   5           PFM ERROR MESSAGE
 BUFFERS  SPACE  4,10 
*         BUFFERS.
  
  
 PBUF     BSSN   PBUFL       PROFILE FILE BUFFER
 EBUF     BSSN   PMWE        LEVEL 3 ENTRY BUFFER 
 BUFE     BSSN   0           END OF BUFFERS 
 END      BSSN
  
 CHGL     EQU    BUFE        END OF *COMCCHG* 
          SPACE  4,10 
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 BAB      EQU    /COMCCHG/BAB 
 CHG      EQU    /COMCCHG/CHG 
 CHGL     EQU    /COMCCHG/CHGL
          IF     DEF,RPE$,1 
 RPE      EQU    /COMCCHG/RPE 
 VCN      EQU    /COMCCHG/VCN 
 QUAL$    ENDIF 
          BASE   *
          SPACE  4
          ENDX
