16 22FL #LIS K0ALLOW>K0BUDGES>K0COMMAND>K0GREATGEO>K0ALLGEO 15 22_= #SEG ALLOW1 [M.B.KINGHAM 7 23DW 8HALLOW1 11 23YG SEGENTRY K1ALLOW,QK1ALLOW 20 24D6 # 1 THE ALLOWANCE COMMAND INCREASES A TRANSIENT BUDGET ALLOWANCE 19 24XQ # 1 OF A NAMED USER OR REDUCES A TRANSIENT BUDGET ALLOWANCE 16 25CB # 1 OF AN IMMEDIATE INFERIOR OF THE PROPER USER 4 25X2 # 21 26BL # THE REQUIRED BLOCKS OF CORE ARE SET UP; THE DICTIONARY IS OPENED; 20 26W= # AND THE PARAMETERS ARE CHECKED. IF THERE ARE NO ERRORS, THE 20 27*W # CHANGES CAUSED BY THE TRANSACTION ARE MADE; THE DICTIONARY IS 20 27TG # CLOSED; A MESSAGE IS SENT TO THE MONITORING FILE, AND CONTROL 13 28*6 # RETURNS TO THE COMMAND PROCESSOR 4 28SQ # 13 29#B # MESSAGES FOR THE MONITORING FILE 14 29S2 YERB7 +ERB7 [PSEUDO USER 21 2=?L YERB20 +ERB20 [YOU MAY REDUCE ALLOWANCES OF ONLY YOUR 16 2=R= [IMMEDIATE INFERIORS 21 2?=W YERB21 +ERB21 [YOU MAY NOT CHANGE YOUR OWN ALLOWANCES 6 2?*F ...#UNSET FTS1 4 2?D4 ...( 19 2?GM ...YERB29 +ERB29 [YOU MAY NOT REDUCE MANAGER'S 15 2?K= ... [ALLOWANCE 4 2?MT ...) 8 2?QG YERB3 +ERB3 8 2#=6 YERB5 +ERB5 10 2#PQ MAN 12HMANAGER 4 2*9B # 21 2*P2 # MASKS FOR STANDARD BUDGETARY CLASSIFICATIONS FROM BUDGET TYPE WORDS 20 2B8L MGWORDS +GWORDS [GENERAL- NO. OF INFORMATION WORDS 18 2BN= MGMASK +GMASK [UNIQUE PART OF BIT PATTERN 18 2C7W MGCLASS +GCLASS [BUDGET CLASSIFICATION BITS 14 2CMG MGPAND +GPAND [PRIVILEGES 8 2D76 MGPOR +GPOR 15 2DLQ MGSAND +GSAND [STABLE BUDGETS 8 2F6B MGSOR +GSOR 16 2FL2 MGTAND +GTAND [TRANSIENT BUDGETS 8 2G5L MGTOR +GTOR 13 2GK= # DEFINITIONS FOR THE ADATA,CSTORE BLOCK 17 2H4W #DEF UNAMED=A1 [USERNAME OF NAMED USER 19 2HJG #DEF UCURRENT=UNAMED+3 [USERNAME OF CURRENT PROPER USER 17 2J46 #DEF UTYPE=UCURRENT+3 [BUDGET TYPE BIT PATTERN 15 2JHQ #DEF UCHANGE=UTYPE+1 [CHANGE AMOUNT 19 2K3B #DEF UCMARK=UCHANGE+1 [INCREASE MARKER FOR CURRENT USER 19 2KH2 #DEF UNMARK=UCMARK+1 [INCREASE MARKER FOR NAMED USER 17 2L2L #DEF UCREMAINS=UNMARK+1 [CURRENT USER'S REMAINDER 17 2LG= #DEF UNREMAINS=UCREMAINS+1 [NAMED USER'S REMAINDER 17 2L_W #DEF UNUIS=UNREMAINS+1 [1 IF NU=IS ; 0 OTHERWISE 19 2MFG #DEF URCMARK=UNUIS+1 [0 OR CURRENT USER'S OVERDRAFT 21 2M_6 #DEF URNMARK=URCMARK+1 [0 OR NAMED USER'S OVERDRAFT(BUDGETS ONLY 5 2NDQ QK1ALLOW 20 2NKY ... STOZ AWORK1(2) [CLEAR 'PROPER/NAMED' USER IS... 17 2NR6 ... [ ...MANAGER' FLAG 10 2NYB BUDGPAR AW,MBREAK,QR 11 2PD2 OPEN MBREAK,GENERAL,QUERY 10 2PXL TESTREPN OK,OPENERR 15 2QC= READDICT [FOR NAMED USER 19 2QWW TESTERR NOUSER,WOE3 [IF NOT FOUND,NO SUCH USER EXISTS 20 2RBG # THE NAMED USER'S DICTIONARY ENTRY IS NOW IN A FILE,ADICTENT BLOCK 11 2RW6 HUNT 2,FILE,ADICTENT 9 2S*Q LDX 0 CPSEU(2) 21 2STB LDX 6 YERB7(1) [IF THE NAMED USER IS A PSEUDO USER, HE 20 2T*2 BNG 0 WRONG [HAS NO BUDGETS,SO THERE IS AN ERROR 21 2TSL # THE BUDGET DESCRIPTION LIST IS IN THE FIRST RECORD OF THE DICTIONARY 21 2W#= # THE SECOND PARAMETER IS THE BUDGET TYPE AS AN EIGHT CHARACTER STRING 11 2WRW HUNT 2,ADATA,CSTORE 11 2X?G HUNT 3,FILE,ADICTENT 9 2X#R ... LDX 4 CUSER(3) 10 2XB4 ... LDX 5 CUSER+1(3) 10 2XC* ... LDX 6 CUSER+2(3) 9 2XDL ... TXU 4 MAN(1) 9 2XFX ... TXU 5 MAN+1(1) 9 2XH8 ... TXU 6 MAN+2(1) 9 2XJF ... BCS NMANNU 7 2XKQ ... LDN 7 1 8 2XM3 ... SMO FX2 18 2XN# ... NGS 7 AWORK1 [NAMED USER IS MANAGER 5 2XPK ...NMANNU 10 2XR6 LDX 4 UCURRENT(2) 19 2Y=Q LDX 5 UCURRENT+1(2) [IS THE NAMED USER EQUAL TO THE 16 2YQB LDX 6 UCURRENT+2(2) [CURRENT PROPER USER? 9 2_=2 TXU 4 CUSER(3) 10 2_PL TXU 5 CUSER+1(3) 20 329= TXU 6 CUSER+2(3) [IF SO, THE TRANSACTION IS ILLEGAL 8 32NW BCS Q0 19 338G LDX 6 YERB21(1) [IF SO,SEND MESSAGE ^YOU MAY NOT 19 33N6 BRN WRONG [TO CHANGE YOUR OWN ALLOWANCES^ 4 347Q Q0 9 36KW TXU 4 MAN(1) 9 375G TXU 5 MAN+1(1) 9 37K6 TXU 6 MAN+2(1) 19 37LF ... BCS NINFERIOR [J IF PROPER USER NOT MANAGER 7 37MS ... LDN 7 1 8 37P7 ... SMO FX2 18 37QG ... STO 7 AWORK1 [PROPER USER IS MANAGER 8 37RT ... BRN Q001 6 37T8 ...NINFERIOR 10 37WH ... TXU 4 CSUPUSER(3) 10 37XW ... TXU 5 CSUPUSER+1(3) 19 37_9 ... TXU 6 CSUPUSER+2(3) [OK IF NAMED USER IS AN IMMEDIATE 17 382J ... BCC Q001 [INFERIOR OF PROPER USER 5 383X ...NMANPU 6 385H ...#UNSET FTS1 4 386# ...( 17 3875 ... MFREE FILE,FABSNB [FREE MASTERS' FABSNB 19 387W ... CHECKOWNER [OR HAS ACCESS VIA ALLACC OR 11 388M ... HUNT 2,ADATA,CSTORE 11 389D ... HUNT 3,FILE,ADICTENT 16 38=9 ... TESTREPN OK,M405 [INFACC PRIVILEGE 9 38?2 ... LDX 4 CUSER(3) 10 38?R ... LDX 5 CUSER+1(3) 10 38#J ... LDX 6 CUSER+2(3) 9 38** ... TXU 4 MAN(1) 9 38B6 ... TXU 5 MAN+1(1) 9 38BX ... TXU 6 MAN+2(1) 19 38CN ... BCS Q001 [J IF NAMED USER NOT MANAGER 9 38DF ... LDX 6 YERB29(1) 10 38F= ... LDX 7 UCHANGE(2) 21 38G3 ... BNG 7 WRONG [CANNAT REDUCE MANAGER'S ALLOWANCE 8 38GS ... BRN Q001 4 38HK ...) 4 38JB M405 9 3942 #SKI K6BUDGET>9999-9999 12 39HL TRACE UCURRENT(2),BUDUC=IS 20 3=3= LDN 0 1 [SET MARKER- NAMED USER IS IMMEDIATE 20 3=GW STO 0 UNUIS(2) [INFERIOR OF PROPER USER IF UNUIS=0 18 3?2G # (AND THUS INFORMATION ABOUT THE NAMED USER'S BUDGETS 12 3?G6 # MAY BE DISCLOSED IF UNUIS=0) 9 3?_Q #SKI K6BUDGET>9999-9999 11 3#FB TRACE CUSER(3),BUNV=IS? 9 3#_2 LDX 6 YERB20(1) 10 3*DL LDX 7 UCHANGE(2) 20 3*Y= BNG 7 WRONG [ILLEGAL IF THE CHANGE IS NEGATIVE 21 3BCW # MESSAGE: ^YOW MAY REDUCE ALLOWANCES OF ONLY YOUR IMMEDIATE INFERIORS 19 3BXG Q001 READDICT [READ THE CURRENT USER'S ENTRY 15 3CC6 # THIS SECTION DEALS WITH QUANTITATIVE BUDGETS 19 3CWQ # THE CURRENT PROPER USER'S DICTIONARY ENTRY IS IN THE FIRST 21 3DBB # FILE,ADICTENT IN THE CHAIN; THE NAMED USER'S ENTRY IN IN THE NEXT 11 3DW2 HUNT 3,ADATA,CSTORE 10 3F*L NGX 4 UCHANGE(3) 15 3FT= LDX 5 UTYPE(3) [FOR CURRENT USER 19 3G#W BUDGUSE UTYPE(3) [READ APPROPRIATE BUDGET RECORD 8 3GSG TESTREP2 OK,QF 15 3H#6 # IF THE CURRENT USER HAS NO SUCH BUDGET RECORD 20 3HRQ CALL 7 QSRN [X5=BUDGET TYPE,X4= -IVE CHANGE 18 3J?B # QSRN SETS UP THE REQ'D BUDGET RECORD,AND WRITES IT TO THE 16 3JR2 # FILE,ADICTENT,UNLESS THE CHANGE IS PESITIVE. 19 3K=L STO 4 UCREMAINS(3) [STORE CHANGE AMOUNT AS REMAINDER 9 3KQ= #SKI K6BUDGET>9999-9999 12 3L9W TRACE UCREMAINS(3),BUDGQN 11 3LPG HUNT 2,FILE,ADICTENT 10 3M96 NAME 2,FILE,FWB 8 3MNQ BRN Q2 15 3N8B # IF THE QUANTITATIVE BUDGET RECORD WAS FOUND: 18 3NN2 QF CALL 7 QSRF [X5=BUDGET TYPE,X4=-VE CHANGE 21 3P7L # QSRF MAKES THE NECESSARY CHECKS AND ALTERATIONS TO THE BUDGET RECORD 15 3PM= # AND WRITES IT BACK TO THE FILE,ADICTENT. 16 3Q6W STO 6 URCMARK(3) [OVERDRAFT(IF NOT 0). 19 3QLG STO 5 UCREMAINS(3) [CURRENT USER'S REMAINING RATION 9 3R66 #SKI K6BUDGET>9999-9999 12 3RKQ TRACE UCREMAINS(3),BUDGQF 11 3S5B HUNT 2,FILE,ADICTENT 20 3SK2 NAME 2,FILE,FWB [RENAME BLOCK FOR REWRITING IN SITU 21 3T4L # AT THIS POINT THE CURRENT USER'S ENTRY HAS BEEN CHECKED AND ALTERED, 12 3TJ= # BUT THE FILE HAS NOT BEEN CHANGED 17 3W3W # THE DICTIONARY ENTRY FOR THE NAMED USER IS NOW IN THE 10 3WHG # FIRST FILE,ADICTENT. 9 3X36 Q2 LDX 5 UTYPE(3) 10 3XGQ LDX 4 UCHANGE(3) 7 3Y2B BUDGUSE 5 9 3YG2 TESTREP2 OK,Q2F 13 3Y_L # IF THE NAMED USER HAS NO SUCH RECORD: 8 3_F= CALL 7 QSRN 9 3_YW #SKI K6BUDGET>9999-9999 9 42DG TRACE 4,BUDGQ2N 8 42Y6 BRN Q3 14 43CQ # IF THE NAMED USER'S RECORD HAS BEEN FOUND 8 43XB Q2F CALL 7 QSRF 18 44C2 STO 6 URNMARK(3) [OVERDRAFT (IF NOT NOUGHT) 19 44WL STO 5 UNREMAINS(3) [REMAINDER OF NAMED USER'S RATION 9 45B= #SKI K6BUDGET>9999-9999 12 45TW TRACE URNMARK(3),BUDGQ2F 4 46*G Q3 21 46FC ... SMO FX2 [AWORK1 => 1 IF MANAGER IS PROPER US 19 46K# ... LDX 0 AWORK1 [ => 0 IF NOT MANAGER 21 46P9 ... SBN 0 1 [ => -1 IF MANAGER IS NAMED USE 19 46T6 ... BZE 0 Q3MISS [J IF PROPER USER IS MANAGER 4 46_3 ...Q3DO 21 474Y ... REPLACE [REPLACE PROPER USER'S DICTIONARY ENT 5 478T ...Q3MISS 9 47#Q MFREE FILE,FWB 9 47SB #SKI K6BUDGET>9999-9999 9 48#2 TRACE 1,BUDGQ3 7 48RL READDICT 19 49?= VFREE FILE,ADICTENT [NAMED USER'S DICTIONARY ENTRY 11 49QW HUNT 2,FILE,ADICTENT 10 4==G NAME 2,FILE,FWB 7 4=#D ...#SKI JWPHASE2 4 4=BB ...( 10 4=D# ... JBC NDW,2,BMONCS 9 4=G= ... BC 2,BMONCS 11 4=J8 ... DICTWELL CUSER(2),MONEY,2 4 4=L6 ...NDW 4 4=N4 ...) 21 4=Q= ... SMO FX2 [AWORK1 => 1 IF MANAGER IS PROPER US 19 4=SD ... LDX 0 AWORK1 [ => 0 IF NOT MANAGER 21 4=WL ... ADN 0 1 [ => -1 IF MANAGER IS NAMED USE 19 4=YS ... BZE 0 Q5MISS [J IF NAMED USER IS MANAGER 4 4?32 ...Q5DO 21 4?58 ... REPLACE [REPLACE NAMED USER'S DICTIONARY ENTR 5 4?7B ...Q5MISS 9 4?9Q MFREE FILE,FWB 9 4?PB #SKI K6BUDGET>9999-9999 9 4#92 TRACE 1,BUDGQ4 15 4#NL Q5 CLOSE [CLOSE DICTIONARY 6 4#TS ...#UNSET FTS1 17 4*32 ... DICTJL [UPDATE JOBLIST FILES 13 4*8= # SET UP MESSAGES FOR MONITORING FILE 11 4*MW HUNT 2,ADATA,CSTORE 19 4B7G LDX 7 URCMARK(2) [IS THE CURRENT USER OVERDRAWN? 8 4BM6 BPZ 7 Q501 7 4C6Q NGX 7 7 15 4CLB # IF THE CURRENT USER IS OVERDRAWN -SEND MESSAGE 14 4D62 # ^%A OVERDRAWN BY %B;REMAINING ALLOWANCE%C^ 17 4DKL LDX 6 UCREMAINS(2) [SELECT C.U. REMAINDER 8 4F5= LDN 5 12 8 4FJW LDN 0 10 7 4G4G OUTBLOCK 0 13 4GJ6 OUTPARAM 5,UCURRENT,ADATA,CSTORE 8 4H3Q OUTNUM 7,0 8 4HHB OUTNUM 6,0 9 4J32 MONOUT ERBOK4 11 4JGL HUNT 2,ADATA,CSTORE 18 4K2= LDX 7 URNMARK(2) [IS THE NAMED USER OVERDRAWN? 8 4KFW BNG 7 Q502 4 4K_G Q500 9 4LF6 #SKI K6BUDGET>999-999 4 4LYQ ( 10 4MDB TRACE 6,BUDGEND1 10 4MY2 TRACE 7,BUDGEND2 12 4NCL TRACE UNAMED(2),BUDGEND3 4 4NX= ) 8 4PBW BRN QR 10 4PWG Q501 LDX 7 URNMARK(2) 19 4QB6 BPZ 7 Q503 [IS THE NAMED USER OVERDRAWN? 7 4QTQ Q502 NGX 7 7 21 4R*B LDX 4 UNUIS(2) [NO INFORMATION MUST BE OUTPUT ABOUT 21 4RT2 BNZ 4 Q503 [THE NAMED USER'S ENTRY IF THE NAMED USER 20 4S#L LDX 6 UNREMAINS(2) [IS A SUPERIOR OF THE CURRENT USER 8 4SS= LDN 5 12 8 4T?W LDN 0 10 7 4TRG OUTBLOCK 0 12 4W?6 OUTPARAM 5,UNAMED,ADATA,CSTORE 8 4WQQ OUTNUM 7,0 8 4X=B OUTNUM 6,0 9 4XQ2 MONOUT ERBOK4 11 4Y9L HUNT 2,ADATA,CSTORE 19 4YP= Q503 LDX 7 URCMARK(2) [IF PROPER USER NOT OVERDRAWN 18 4_8W BNG 7 Q500 [THEN OUTPUT OK METSAGE 7 4_NG NGX 7 7 21 4_RL ... SMO FX2 [AWORK1 => 1 IF MANAGER IS PROPER US 21 4_WQ ... LDX 0 AWORK1 [ => 0 IF USER IS NOT MANAGER 21 4__W ... SBN 0 1 [ => -1 IF MANAGER IS NAMED USE 19 5252 ... BZE 0 QMANOK [J IF PROPER USER IS MANAGER 16 5286 LDX 6 UCREMAINS(2) [X6=NEW ALLOWANCE 17 52MQ ADX 7 6 [X7=AMOUNT CONSUMED 7 537B LDN 0 6 7 53M2 OUTBLOCK 0 8 546L OUTNUM 6,0 8 54L= OUTNUM 7,0 18 555W MONOUT JOKAL [OK:YOUR AW IS:CONSUMED: 8 55KG BRN Q500 5 55PC ...QMANOK 21 55T# ... MONOUT ERBOK3 [OUTPUT MESSAGE 'OK' - PROPER USER IS 16 55_9 ... BRN Q500 [J TO 'ENDCOM' 8 5656 WRONG LDX 1 FX1 6 567P ...#UNSET FTS1 4 56=# ...( 9 56#X ... TXU 6 YERB29(1) 8 56CG ... BCC WOE1 4 56G5 ...) 9 56JQ TXU 6 YERB20(1) 8 574B BCC WOE1 19 57J2 TXU 6 YERB21(1) [FOR MESSAGES WHICH DO NOT USE A 20 583L BCC WOE1 [PARAMETER BLOCK, ALL CPB,CUNI BLOCKS 14 58H= TXU 6 YERB5(1) [ARE FREED 8 592W BCS WOE2 7 59GG WOE1 UNIFREE 6 5=26 WOE2 CLOSE 7 5=FQ COMERRX 6 6 5=_B WOE3 CLOSE 6 5?F2 QR ENDCOM 5 5?YL OPENERR 10 5#D= TESTREP CLUDGE,OP1 9 5#XW GEOERR 1,OPENREP 4 5*CG OP1 7 5*X6 UNIFREE 11 5BBQ COMERR ERSYSCLUDG,FDIC 4 5BWB # 19 5CB2 # THIS SUBROUTINE ALTERS THE BUDGET RECORD,WHICH HAS BEEN FOUND 12 5CTL QSRF MHUNT 2,JBUDGET,JBUDGUSER 10 5D*= ADS 4 JALLOWED(2) 10 5DSW LDX 5 JALLOWED(2) 9 5F#G LDX 6 YERB3(1) 21 5FS6 BNG 5 WRONG [ERROR IF NEW ALLOWANCE IS NEGATIVE 10 5G?Q NGX 6 JCONSUMED(2) 7 5GRB ADX 6 5 21 5H?2 BPZ 6 QSRF1 [ERROR IF NEW AW-CONSUMED IS NEGATIVE 21 5HQL BPZ 4 QSRF1 [AND THE CHANGE AMOUNT WAS ALSO -VE 9 5J== LDX 6 YERB3(1) 8 5JPW BRN WRONG 8 5K9G QSRF1 SBX 7 FX1 7 5KP6 BUDGWRITE 8 5L8Q ADX 7 FX1 11 5LNB MHUNT 3,ADATA,CSTORE 7 5M82 EXIT 7 0 16 5MML # IF THE BUDGET RECORD WAS NOT FOUND,QSRN IS CALLED. 15 5N7= # THIS SUBROUTINE SETS UP A NEW BUDGET RECORD 8 5NLW QSRN SBX 7 FX1 8 5P6G SMO FX1 8 5PL6 LDX 6 YERB3 16 5Q5Q BNG 4 WRONG [ IS CORRECTLY SIGNED 7 5QKB LDX 6 5 20 5R52 ANDX 6 MGWORDS(1) [FIND NO. OF INFORMATION WORDS REQ'D 16 5RJL ADN 6 1 [BY THIS BUDGET TYPE 13 5S4= SETUPCORE 6,3,JBUDGET,JBUDGUSER 7 5SHW SBN 6 1 16 5T3G STO 6 A1(3) [SET UP BUDGET RECORD 9 5TH6 STO 5 JBITS(3) 10 5W2Q STOZ JRATION(3) 10 5WGB STO 4 JALLOWED(3) 7 5X22 SBN 6 3 19 5XFL QSRN1 SMO 6 [CLEARING THE NON-STANDARD WORDS 19 5X_= STOZ JALLOWED(3) [AS WELL AS JRATION AND JCONSUMED 8 5YDW BCT 6 QSRN1 20 5YYG BUDGWRITE [WRITE BUDGET RECORD TO FILE,ADICTENT 11 5_D6 HUNT 3,ADATA,CSTORE 8 5_XQ ADX 7 FX1 7 62CB EXIT 7 0 4 62X2 # 5 63BL MBREAK 14 63W= COMBRKIN [IF BROKEN IN 4 64*W # 10 64TG MENDAREA 50,K99ALLOW 4 65*6 #END 8 ____ ...43447173000300000000