{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: BUDGET84)}}
====== BUDGET84 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[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:ENDCOM|ENDCOM]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT|HUNT]], [[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:PARANOTX|PARANOTX]], [[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:WRONG|WRONG]]
22FL #LIS K0BUDGET>K0BUDGES>K0COMMAND>K0ALLGEO
22^= #SEG BUDGET1 [M.B.KINGHAM
23DW 8HBUDGET1
23YG SEGENTRY K1BUDGET,QK1BUDGET
24D6 SEGENTRY K2BUDGET,QK2BUDGET
24XQ #
25CB # 1 THE BUDGET COMMAND CHANGES THE BUDGET RATION OF A NAMED USER
25X2 # 1 BY THE ADDITION OF A SPECIFIED AMOUNT OF A SPECIFIED BUDGET TYPE,
26BL # 1 THE AMOUNT OF CHANGE BEING SUBTRACTED FROM THE BUDGET RATION
26W= # 1 OF THE CURRENT PROPER USER.PRIVILEGES ARE DEALT WITH BY
27*W # 1 THE PRIVLEG CHAPTER
27TG #
28*6 # THE DICTIONARY IS OPENED AND THE COMMAND PARAMETERS ARE CHECKED
28SQ # FOR VALIDITY AND LEGALITY.IF ALL IS IN ORDER THE ALTERATIONS
29#B # ARE MADE,THE DICTIONARY IS CLOSED,AND A RETURN IS MADE TO THE
29S2 # COMMAND PROCESSOR.
2=?L #
2=R= NUM13 +13
2?=W # MONITORING FILE MESSAGES
2?QG XJPARMIS +JPARMIS
2#=6 XAPFERR +APFERR
2#PQ XERB1 +ERB1
2#^J ...XERB4 +ERB4
2*9B XERB5 +ERB5
2*P2 XERB3 +ERB3
2B8L XERB7 +ERB7
2BN= XERB22 +ERB22 [YOU MAY REDUCE RATIONS OF ONLY YOUR
2C7W [IMMEDIATE INFERIORS
2CMG XERB23 +ERB23 [YOU MAY INCREASE RATIONS OF ONLY YOUR..
2D76 XERB24 +ERB24 [YOU MAY NOT CHANGE YOUR OWN RATIONS
2DLQ XERB25 +ERB25 [YOU MAY CHANGE PRIVILEGES OF ONLY
2F6B [YOUR INFERIORS
2F?J ...XERB27 +ERB27 [YOU MAY NOT CHANGE MANAGERS PRIVS
2FDQ ...XERB28 +ERB28 [YOU MAY NOT REDUCE MANAGERS BUDGETS
2FL2 MAN 12HMANAGER
2G5L #
2GK= # NOTE THAT NAMEB IS USED BOTH FOR SETTING UP THE FILE FABSNB FOR
2H4W # OPENING THE DICTIONARY AND FOR THE CHARACTER STRING "MASTER"
2HJG # WHICH IT CONTAINS.
2HS# ...#
2J46 NAMEB +10
2JHQ 12HMASTER
2K3B 12HDICTIONARY
2KH2 +0
2L2L +1
2LG= +0
2LQ4 ...#
2L^W # MASKS FOR STANDARD BUDGETARY CLASSIFICATIONS FROM BUDGET TYPE WORDS
2M9N ...#
2MFG MGWORDS +GWORDS [GENERAL- NO. OF INFORMATION WORDS
2M^6 MGMASK +GMASK [UNIQUE PART OF BIT PATTERN
2NDQ MGCLASS +GCLASS [BUDGET CLASSIFICATION BITS
2NYB MGPAND +GPAND [PRIVILEGES
2PD2 MGPOR +GPOR
2PXL MGSAND +GSAND [STABLE BUDGETS
2QC= MGSOR +GSOR
2QWW MGTAND +GTAND [TRANSIENT BUDGETS
2RBG MGTOR +GTOR
2RL# ...#
2RW6 # MESSAGES FOR PRIVILEGES
2S5Y ...#
2S*Q XGIVE 4HGIVE
2STB XTAKE 4HTAKE
2T58 ...#
2T*2 ...# DEFINITIONS FOR THE ADATA,CSTORE BLOCK
2TJS ...#
2TSL #DEF UNAMED=A1 [USERNAME OF NAMED USER
2W#= #DEF UCURRENT=UNAMED+3 [USERNAME OF CURRENT PROPER USER
2WRW #DEF UTYPE=UCURRENT+3 [BUDGET TYPE BIT PATTERN
2X?G #DEF UCHANGE=UTYPE+1 [CHANGE AMOUNT
2XR6 #DEF UCMARK=UCHANGE+1 [INCREASE MARKER FOR CURRENT USER
2Y=Q #DEF UNMARK=UCMARK+1 [INCREASE MARKER FOR NAMED USER
2YQB #DEF UCREMAINS=UNMARK+1 [CURRENT USER'S REMAINDER
2^=2 #DEF UNREMAINS=UCREMAINS+1 [NAMED USER'S REMAINDER
2^PL #DEF UNUIS=UNREMAINS+1 [1 IF NU=IS ; 0 OTHERWISE
329= #DEF URCMARK=UNUIS+1 [0 OR CURRENT USER'S OVERDRAFT (STABLE
32NW #DEF URNMARK=URCMARK+1 [0 OR NAMED USER'S OVERDRAFT(BUDGETS ONLY
338G ...#
39HL QK1BUDGET
39W3 ... STOZ AWORK3(2) [ZERO 'MANAGER IS NAMED USER' FLAG
3=8D ... STOZ AWORK4(2) [ZERO 'MANAGER IS 'PROPER USER' FLAG
3=GW BUDGPAR BT,MBREAK,QR
3?2G OPEN MBREAK,GENERAL,QUERY
3?G6 TESTREPN OK,OPENERR
3?^Q READDICT [FOR NAMED USER
3#FB TESTERR NOUSER,WOE3 [IF NOT FOUND,THERE IS A COMMAND ERROE
3#P8 ...#
3#^2 # THE NAMED USER'S DICTIONARY ENTRY IS NOW IN A FILE,ADICTENT BLOCK
3*8S ...#
3*DL HUNT 2,FILE,ADICTENT
3*Y= LDX 0 CPSEU(2)
3BCW LDX 6 XERB7(1) [IF THE NAMED USER IS A PSEUDO USER,HE
3BXG BNG 0 WRONG [HAS NO BUDGETS,SO THERE IS AN ERROR
3CC6 HUNT 2,ADATA,CSTORE
3CWQ HUNT 3,FILE,ADICTENT
3DBB LDX 0 UTYPE(2) [BUDGET TYPE BIT PATTERN
3DW2 ANDX 0 MGCLASS(1) [SELECT BUDGET CLASSIFICATION
3DXC ... LDX 4 CUSER(3)
3DYS ... LDX 5 CUSER+1(3)
3F29 ... LDX 6 CUSER+2(3)
3F3L ... TXU 4 MAN(1)
3F53 ... TXU 5 MAN+1(1)
3F6D ... TXU 6 MAN+2(1)
3F7T ... BCS NMANNU [J IF MANAGER NOT NAMED USER
3F9= ... SMO FX2
3F=M ... STO 4 AWORK3 [SET 'MANAGER IS NAMED USER' FLAG
3F#4 ...NMANNU
3F*L LDX 4 UCURRENT(2)
3FT= LDX 5 UCURRENT+1(2)
3G#W LDX 6 UCURRENT+2(2)
3GSG TXU 4 MAN(1)
3H#6 TXU 5 MAN+1(1)
3HRQ TXU 6 MAN+2(1)
3J?B BCS M009A
3JR2 SMO FX2
3K=L STO 4 AWORK4
3KQ= M009A
3L9W TXU 4 CUSER(3)
3LPG TXU 5 CUSER+1(3)
3M96 TXU 6 CUSER+2(3)
3MNQ BCS M009 [J UNLESS PROPER USER IS NAMED USER
3N8B LDX 6 XERB24(1) [IF SO,ERROR
3NN2 BRN WRONG
3P7L M009
3PM= TXU 4 CSUPUSER(3)
3Q6W TXU 5 CSUPUSER+1(3)
3QLG TXU 6 CSUPUSER+2(3)
3R66 BCS M101 [J UNLESS PROPER USER IS IMMED. SUPER
3S5B TRACE UCURRENT(2),BUDUC=IS
3SK2 M100
3T4L TXU 0 MGPOR(1) [IS THIS BUDGET A PRIVILEGE?
3TJ= BCS Q001
3TS4 ...#
3W3W # IF SO, GO TO THE "CHECKED" ENTRY POINT IN THE PRIVLEG CHAPTER ;
3WHG # IF NOT, CONTINUE IN THIS CHAPTER
3WR# ...#
3X36 ACROSS PRIVLEG,2
3XGQ M101
3XQJ ...#
3Y2B # THE USER :MANAGER HAS THE SPECIAL POWER OF PERFORMING
3YG2 # BUDGET TRANSACTIONS WHICH ALTER THE BUDGETS OF HIS SIBLINGS
3^YW TXU 4 MAN(1) [IF THE ANSWER TO BOTH QUESTIONS IS YES,
42DG TXU 5 MAN+1(1) [NO FURTHER CHECKING IS NECESSARY
42Y6 TXU 6 MAN+2(1)
43CQ BCC M100
43FL ... MFREE FILE,FABSNB [FREE :MANAGER'S FABSNB
43G= ... CHECKOWNER [ADDITIONAL OWNERSHIP CHECKS
43GW ... HUNT 2,ADATA,CSTORE
43HG ... HUNT 3,FILE,ADICTENT
43J6 ... TESTREPN OK,M1015 [J IF PROPER USER DOES NOT HAVE
43JQ ... [ACCESS TO NAMED USER
43KB ... LDX 0 UTYPE(2)
43L2 ... ANDX 0 MGCLASS(1) [SELECT BUDGET CLASSIFICATION
43LL ... LDX 4 CUSER(3)
43M= ... LDX 5 CUSER+1(3)
43MW ... LDX 6 CUSER+2(3)
43NG ... TXU 4 MAN(1)
43P6 ... TXU 5 MAN+1(1)
43PQ ... TXU 6 MAN+2(1)
43QB ... BCS M100 [J IF NAMED USER NOT MANAGER
43R2 ... LDX 6 XERB27(1)
43RL ... TXU 0 MGPOR(1)
43S= ... BCC WRONG [CANNOT CHANGE MANAGER'S PRIVELEGES
43SW ... LDX 6 XERB28(1)
43TG ... LDX 7 UCHANGE(2)
43W6 ... BNG 7 WRONG [CANNOT REDUCE MANAGER'S BUDGET
43XB M1015
43^^ ...#UNSET FTS1
444J ...(
4477 ... LDX 0 UTYPE(2)
449Q ... ANDX 0 MGCLASS(1) [SELECT BUDGET CLASSIFICATION
44#* ...)
44C2 TXU 0 MGPOR(1)
44WL BCS M103 [IS THE BUDGET A PRIVILEGE?
45B= # IF SO,GO TO THE "UNCHECKED" ENTRY POINT IN THE PRIVLEG CHAPTER.
45TW LDX 4 CSUPUSER(3)
46*G LDX 5 CSUPUSER+1(3)
46T6 LDX 6 CSUPUSER+2(3)
47#Q ACROSS PRIVLEG,1
47SB M103
48#2 LDN 0 1 [SET MARKER- NAMED USER IS IMMEDIATE
48RL STO 0 UNUIS(2) [SUPERIOR OF CURRENT USER UNLESS UNVIS=0
49?= #SKI K6BUDGET>9999-9999
49QW TRACE CUSER(3),BUNV=IS?
4==G LDX 6 XERB22(1) [THEREFORE,THE TRANSACTION IS
4=Q6 LDX 7 UCHANGE(2)
4?9Q BNG 7 WRONG [ILLEGAL IF THE CHANGE IS NEGATIVE
4?PB LDX 4 CUSER(3)
4#92 LDX 5 CUSER+1(3)
4#NL LDX 6 CUSER+2(3)
4*8= READDICT [READ CURRENT USER'S ENTRY
4*MW HUNT 3,FILE,ADICTENT
4B7G TXU 4 CSUPUSER(3)
4BM6 TXU 5 CSUPUSER+1(3) [IS THE NAMED USER
4C6Q TXU 6 CSUPUSER+2(3) [HIS IMMEDIATE SUPERIOR ?
4CLB BCC Q002
4D62 LDX 6 XERB23(1) [IF NOT,THE TRANSACTION IS ILLEGAL
4DKL BRN WRONG
4F5= Q001 READDICT [READ THE CURRENT USER'S ENTRY
4FJW # THIS SECTION DEALS WITH QUANTITATIVE BUDGETS
4G4G # THE CURRENT PROPER USER'S DICTIONARY ENTRY IS IN THE FIRST
4GJ6 # FILE,ADICTENT IN THE CHAIN; THE NAMED USER'S ENTRY IN IN THE NEXT
4H3Q Q002
4HHB MHUNT 3,ADATA,CSTORE
4J32 SMO FX2
4JGL LDX 0 AWORK4
4K2= BZE 0 Q002A
4KFW LDN 5 0
4K^G BUDGUSE UTYPE(3) [READ APPROPRIATE BUDGET RECORD
4LF6 TESTREPN OK,Q002B
4LYQ MHUNT 1,JBUDGET,JBUDGUSER
4MDB LDX 5 JRATION(1)
4MY2 FREECORE 1
4NCL Q002B
4NX= MHUNT 3,ADATA,CSTORE
4PBW STOZ URCMARK(3)
4PWG STO 5 UCREMAINS(3)
4QB6 MFREE FILE,ADICTENT
4QTQ BRN Q2
4R*B Q002A
4RT2 NGX 4 UCHANGE(3)
4S#L LDX 5 UTYPE(3) [FOR CURRENT USER
4SS= BUDGUSE UTYPE(3) [READ APPROPRIATE BUDGET RECORD
4T?W TESTREP2 OK,QF
4TRG # IF THE CURRENT USER HAS NO SUCH BUDGET RECORD
4W?6 QN CALL 7 QSRN [X5=BUDGET TYPE,X4=-VE CHANGE
4WQQ # QSRN SETS UP THE REQ'D BUDGET RECORD,AND WRITES IT TO THE
4X=B # FILE,ADICTENT,UNLESS THE CHANGE IS PESITIVE.
4XQ2 STO 4 UCREMAINS(3) [STORE CHANGE AMOUNT AS REMAINDER
4Y9L #SKI K6BUDGET>9999-9999
4YP= TRACE UCREMAINS(3),BUDGQN
4^8W HUNT 2,FILE,ADICTENT
4^NG NAME 2,FILE,FWB
5286 BRN Q2
52MQ # IF THE QUANTITATIVE BUDGET RECORD WAS FOUND:
537B QF CALL 7 QSRF [X5=BUDGET TYPE,X4=-VE CHANGE
53M2 # QSRF MAKES THE NECESSARY CHECKS AND ALTERATIONS TO THE BUDGET RECORD
546L # AND WRITES IT BACK TO THE FILE,ADICTENT.
54L= STO 6 URCMARK(3) [OVERDRAFT(IF NOT 0).
555W STO 5 UCREMAINS(3) [CURRENT USER'S REMAINING RATION
55KG #SKI K6BUDGET>9999-9999
5656 TRACE UCREMAINS(3),BUDGQF
56JQ HUNT 2,FILE,ADICTENT
574B NAME 2,FILE,FWB [RENAME BLOCK FOR REWRITING IN SITU
57J2 # AT THIS POINT THE CURRENT USER'S ENTRY HAS BEEN CHECKED AND ALTERED,
583L # BUT THE FILE HAS NOT BEEN CHANGED
58H= # THE DICTIONARY ENTRY FOR THE NAMED USER IS NOW IN THE
592W # FIRST FILE,ADICTENT.
59GG Q2 LDX 5 UTYPE(3)
5=26 LDX 4 UCHANGE(3)
5=FQ BUDGUSE 5
5=^B TESTREP2 OK,Q2F
5?F2 # IF THE NAMED USER HAS NO SUCH RECORD:
5?YL Q2N CALL 7 QSRN
5#D= #SKI K6BUDGET>9999-9999
5#XW TRACE 4,BUDGQ2N
5*CG BRN Q3
5*X6 # IF THE NAMED USER'S RECORD HAS BEEN FOUND
5BBQ Q2F CALL 7 QSRF
5BWB STO 6 URNMARK(3) [OVERDRAFT (IF NOT NOUGHT)
5CB2 STO 5 UNREMAINS(3) [REMAINDER OF NAMED USER'S RATION
5CTL #SKI K6BUDGET>9999-9999
5D*= TRACE URNMARK(3),BUDGQ2F
5DSW Q3
5F#G SMO FX2
5FS6 LDX 0 AWORK4
5G?Q BNZ 0 Q4 [DONT UPDATE MANAGERS BUDGET
5GRB REPLACE [CURRENT USERS ENTRY
5H?2 MFREE FILE,FWB
5HQL Q4
5HTQ ... SMO FX2
5HYW ... LDX 0 AWORK3
5J42 ... BNZ 0 Q5 [DON'T REPLACE IF MANAGER IS NAMED...
5J76 ... [...USER
5J== READDICT [POSITION DICTIONARY ON NAMED USER
5JPW MFREE FILE,ADICTENT
5K9G HUNT 2,FILE,ADICTENT
5KP6 NAME 2,FILE,FWB
5L8Q REPLACE [NAMED USERS ENTRY
5LNB MFREE FILE,FWB
5M82 Q5 CLOSE [CLOSE DICTIONARY
5MML # SET UP MESSAGES FOR MONITORING FILE
5N7= HUNT 2,ADATA,CSTORE
5NLW LDX 7 URCMARK(2) [IS THE CURRENT USER OVERDRAWN?
5P6G BZE 7 Q501
5PL6 # IF THE CURRENT USER IS OVERDRAWN -SEND MESSAGE
5Q5Q # "%A OVERDRAWN BY %B;REMAINING RATION %C"
5QKB LDX 6 UCREMAINS(2) [SELECT C.U. REMAINDER
5R52 LDN 5 12
5RJL LDN 0 10
5S4= OUTBLOCK 0
5SHW OUTPARAM 5,UCURRENT,ADATA,CSTORE
5T3G OUTNUM 7,0
5TH6 OUTNUM 6,0
5W2Q MONOUT ERBOK2
5WGB HUNT 2,ADATA,CSTORE
5X22 LDX 7 URNMARK(2) [IS THE NAMED USER OVERDRAWN?
5XFL BNZ 7 Q502
5X^= Q500
5YDW #SKI K6BUDGET>999-999
5YYG (
5^D6 TRACE 6,BUDGEND1
5^XQ TRACE 7,BUDGEND2
62CB TRACE UNAMED(2),BUDGEND3
62X2 )
63BL ENDCOM
63W= Q501 LDX 7 URNMARK(2)
64*W BZE 7 Q5025
64TG Q502 LDX 4 UNUIS(2) [NO INFORMATION MUST BE OUTPUT ABOUT
65*6 BNZ 4 Q503 [THE NAMED USER'S ENTRY IF THE NAMED USER
65SQ LDX 6 UNREMAINS(2) [IS A SUPERIOR OF THE CURRENT USER
66#B LDN 5 12
66S2 LDN 0 10
67?L OUTBLOCK 0
67R= OUTPARAM 5,UNAMED,ADATA,CSTORE
68=W OUTNUM 7,0
68QG OUTNUM 6,0
69=6 MONOUT ERBOK2
69PQ HUNT 2,ADATA,CSTORE
6=9B Q5025
6=P2 LDX 7 URCMARK(2) [CURRENT USER'S REMAINDER MUST BE
6?8L BNZ 7 Q500 [PRINTED OUT AT SOME STAGE
6?N= Q503 LDX 6 UCREMAINS(2)
6#7W OUTNUM 6,0 [OUTPUT "OK: YOUR RATION IS NOW %A"
6#MG MONOUT ERBRAT [TO MONITORING FILE IF PROPER USER'S
6*76 BRN Q500 [REMAINDER NOT ALREADY OUTPUT
6*LQ [
6B6B [
6BL2 [
6C5L QK2BUDGET
6CK= WRONG LDX 1 FX1
6CQD ... TXU 6 XERB4(1) [DO NOT HAVE ... PRIVILEGE?
6CXL ... BCC XCITA
6D4W TXU 6 XERB22(1)
6DJG BCC WOE1
6F46 TXU 6 XERB23(1)
6FHQ BCC WOE1
6G3B TXU 6 XERB24(1)
6GH2 BCC WOE1
6H2L TXU 6 XERB25(1)
6H8D ... BCC WOE1
6H=B ... TXU 6 XERB27(1)
6H## ... BCC WOE1
6HB= ... TXU 6 XERB28(1)
6HG= BCC WOE1 [FOR MESSAGES WHICH DO NOT USE A
6H^W TXU 6 XERB5(1) [PARAMETER BLOCK,ALL CPB,CUNI BLOCKS
6JFG BCS WOE2 [SHOULD BE FREED
6J^6 WOE1 UNIFREE [FREE CPB,CUNI BLOCKS UP TO CPB,CALAS
6KDQ WOE2 CLOSE
6KYB COMERRX 6
6LD2 WOE3 CLOSE [IF ERROR HAS ALREADY BEEN REPORTED
6LXL QR ENDCOM
6L^* ...XCITA MHUNT 3,CPB,CUNI [THIS ROUTINE FINDS THE APPROPRIATE
6M34 ... LDX 5 JPARNUM(3) [CUNI BLOCK CONTAINING THE PRIVILEGE
6M4R ... FREECORE 3 [NAME FOR THE ERROR MESSAGE '...DO NO
6M6G ... LDN 4 1 [HOLD NNNNN PRIVILEGE'.
6M89 ... BCT 5 XCITB [
6M9Y ... ADN 4 1 [
6M?M ...XCITB PARANOTX 4 [GET APPROPRIATE PARAMETER
6M*B ... BRN WOE2
6MC= OPENERR
6MWW TESTREP CLUDGE,OP1
6NBG GEOERR 1,OPENREP
6NW6 OP1
6P*Q UNIFREE
6PTB COMERR ERSYSCLUDG,FDIC
6Q*2 # THIS SUBROUTINE ALTERS THE BUDGET RECORD,WHICH HAS BEEN FOUND
6QSL QSRF SBX 7 FX1
6R#= HUNT 2,JBUDGET,JBUDGUSER
6RRW ADS 4 JRATION(2) [ADD CHANGE TO USER'S RATION
6S?G LDX 4 JRATION(2)
6SR6 LDX 6 XERB3(1)
6T=Q BNG 4 WRONG [ERROR IF RESULT IS NEGATIVE
6TQB STOZ 6
6W=2 LDX 0 5 [SELECT BUDGET TYPE
6WPL ANDX 0 MGCLASS(1) [IS IT A TRANSIENT BUDGET?
6X9= TXU 0 MGSOR(1)
6XNW BCS QSRF1
6Y8G # FOR TRANSIENT BUDGETS,THE TRANSACTION IS OK IF JRATION IS NOT -VE ;
6YN6 # BUT FOR STABLE BUDGETS,MUST CHECK ALSO THAT (JRATION-JALLOWED) IS
6^7Q # NOT -VE, AND SET UP A MESSAGE IF THERE IS AN OVERDRAFT.
6^MB SBX 4 JALLOWED(2)
7272 BPZ 4 QSRF1 [IF OVERDRAWN,
72LL NGS 4 6 [STORE DIFFERENCE OF JRATION AND JALLOWED
736= QSRF1 LDX 5 JRATION(2)
73KW BUDGWRITE
745G HUNT 3,ADATA,CSTORE
74K6 ADX 7 FX1
754Q EXIT 7 0
75JB # IF THE BUDGET RECORD WAS NOT FOUND,QSRN IS CALLED.
7642 # THIS SUBROUTINE SETS UP A NEW BUDGET RECORD
76HL QSRN SBX 7 FX1
773= LDX 6 XERB3(1) [CHECK THAT CHANGE AMOUNT
77GW BNG 4 WRONG [ IS CORRECTLY SIGNED
782G LDX 6 5
78G6 ANDX 6 MGWORDS(1) [FIND NO. OF INFORMATION WORDS REQ'D
78^Q ADN 6 1 [BY THIS BUDGET TYPE
79FB SETUPCORE 6,3,JBUDGET,JBUDGUSER
79^2 SBN 6 1
7=DL STO 6 A1(3) [SET UP BUDGET RECORD
7=Y= STO 5 JBITS(3)
7?CW STO 4 JRATION(3)
7?XG SBN 6 2
7#C6 QSRN1 SMO 6 [CLEARING THE NON-STANDARD WORDS
7#WQ STOZ JRATION(3) [AS WELL AS JALLOWED AND JCONSUMED
7*BB BCT 6 QSRN1
7*W2 BUDGWRITE [WRITE BUDGET RECORD TO FILE,ADICTENT
7B*L HUNT 3,ADATA,CSTORE
7BT= ADX 7 FX1
7C#W EXIT 7 0
7CSG #
7D#6 MBREAK COMBRKIN [IF BROKEN IN
7DRQ #
7F?B MENDAREA 50,K99BUDGET
7FR2 #END
^^^^ ...23245424000300000000