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