17 22FL #LIS K0BMACROS>K0BUDGES>K0ALLGEO>K0GREATGEO 16 22_= ...#SEG BUDGONE83 [HUGH SIMMONS 7 23DW ... 8HBUDGONE8 12 23YG SEGENTRY K1BUDGONE,QK1BUDGONE 12 24D6 SEGENTRY K2BUDGONE,QK2BUDGONE 12 24XQ SEGENTRY K3BUDGONE,QK3BUDGONE 12 25CB SEGENTRY K4BUDGONE,QK4BUDGONE 12 25X2 SEGENTRY K5BUDGONE,QK5BUDGONE 4 26BL # 17 26W= # THIS CHAPTER CONTAINS THE SUBROUTINES USED BY THE 11 27*W # FOLLOWING BUDGET MACROS: 21 27TG # BUDGUSE,BUDGUSEN,BUDGBITS,BUDGBITX,BUDGINCR,BUDGINCX AND BUDGDEL 4 28*6 # 17 28SQ #DEF TCOUNT=IZCOUNT-A1 [NO. OF BUDGETS IN LIST 15 29#B #DEF TLIST=IZLIST-A1 [START OF LIST 21 29S2 #DEF TRANS=JCONSUMED-A1-1 [AMOUNT CONSUMED FOR TRANSIENT BUDGETS 20 2=?L #DEF STABL=JALLOWED-A1-1 [AMOUNT BEING USED FOR STABLE BUDGETS 15 2=R= # MASKS FOR BUDGET BIT PATTERN BREAK-DOWN 10 2?34 ...MGMONEY +GMONEY&GMASK 17 2?=W MGCLASS +GCLASS [BUDGET CLASSIFICATION 18 2?QG MGMASK +GMASK [UNIQUE PART OF BIT PATTERN 19 2#=6 MGWORDS +GWORDS [NO OF INFORMATION WORDS REQUIRED 17 2#PQ MGPOR +GPOR [PRIVILEGE IDENTIFICATION 19 2*9B MGTOR +GTOR [TRANSIENT BUDGET IDENTIFICATION 18 2*P2 MGSOR +GSOR [STABLE BUDGET IDENTIFICATION 4 2B8L # 10 2BN= # BUDGUSE AND BUDGUSEN 20 2C7W # THE FOLLOWING ROUTINE READS A USER'S BUDGET RECORD AND STORES IT 11 2CMG # IN A JBUDGET,JBUDGUSER BLOCK 6 2D76 QK1BUDGONE 17 2DLQ LDX 6 EXEC1(2) [BUDGET TYPE BIT PATTERN 11 2F6B #SKI K6BMACROS>99-99 11 2FL2 TRACE EXEC1(2),BUDGONE 14 2G5L SETNCORE GWORDS+1,3,JBUDGET,JBUDGUSER 14 2GK= STOZ A1(3) [ SET UP AND 19 2H4W LDN 4 A1(3) [CLEAR JBUDGET,JBUDGUSER BLOCK 18 2HJG LDN 5 A1+1(3) [OF MAXIMUM NECESSARY SIZE 9 2J46 MOVE 4 GWORDS 9 2JHQ STO 6 JBITS(3) 11 2K3B MHUNTW 2,FILE,ADICTENT 9 2KH2 #SKI K6BMACROS>10-10 4 2L2L ( 17 2LG= R01 LDX 4 MGCLASS(1) [BUDGET CLASSIFICATION 21 2L_W ANDX 4 6 [ & BUDGET TYPE BITS GIVE CLASSIFICATION 20 2MFG TXU 4 MGPOR(1) [OF BUDGET TYPE.IF IT IS A PRIVILEGE, 19 2M_6 BCS R02 [THE JBUDGET BLOCK WILL BE FREED 10 2NDQ GEOERR 1,PRIVILEG 4 2NYB R02 4 2PD2 ) 20 2PXL STO 2 4 [KEEP POINTER TO FILE ADICTENT BLOCK 9 2QC= #SKI K6BMACROS>999-999 9 2QWW TRACE 6,BONER02 18 2RBG CALL 7 SR0A [FIND BUDGET RECORD VIA SR0 21 2RW6 BRN RENC [IF NO SUCH B R,GO TO RELEASE JBUDGET BL. 9 2S*Q R05 LDX 7 CQUANT(2) 17 2STB ANDX 7 MGWORDS(1) [NO OF INFORMATION WORDS 9 2T*2 LDN 4 CQUANT(2) 9 2TSL LDN 5 JBITS(3) 7 2W#= SMO 7 7 2WRW MOVE 4 0 8 2X?G STO 7 A1(3) 11 2XR6 #SKI K6BMACROS>999-999 11 2Y=Q TRACE A1+1(3),BUDGEND1 8 2YQB SETREP OK 5 2_=2 UP 9 2_PL RENC KEEPREP 7,NOTYPE 4 329= REND 9 32NW #SKI K6BMACROS>999-999 12 338G TRACE CQUANT-4(2),BONEREND 7 33N6 FREECORE 3 7 347Q PUTREP 7 5 34MB UP 4 3572 # 10 35LL # BUDBITS AND BUDBITX 21 366= # BUDGET CONVERSION:THIS SECTION SETS UP A JBUDGET,JLINE BLOCK TO MATCH 11 36KW # THE BIT PATTERN HELD IN EXEC1 6 375G QK2BUDGONE 18 37K6 LDX 4 EXEC1(2) [BIT PATTERN OF BUDGET TYPE 9 384Q #SKI K6BMACROS>999-999 9 38JB TRACE 4,BONE K2 13 3942 SETNCORE IZLINE,5,JBUDGET,JLINE 7 39HL PHOTO 6 6 3=3= STEP 7 3=GW LDX 2 5 8 3?2G TESTMOVE 6,S0 11 3?G6 MHUNTW 2,JBUDGET,JLINE 4 3?_Q S0 7 3#FB LDX 7 4 10 3#_2 ANDX 7 MGCLASS(1) 9 3*DL SBX 7 MGPOR(1) 8 3*Y= BZE 7 S00 17 3BCW # (PRIVILEGES DO NOT HAVE A WORD COUNT ) 18 3BXG ANDX 4 MGMASK(1) [SELECT UNIQUE BIT PATTERN 18 3CC6 S00 LDX 5 TCOUNT(3) [UNLESS BUDGET IS A PRIVILEGE 20 3CWQ S01 LDX 6 TLIST(3) [BUDGET TYPE FROM DESCRIPTION LIST 8 3DBB BZE 7 S010 9 3DW2 ANDX 6 MGMASK(1) 4 3F*L S010 8 3FT= BXE 4 6,S02 19 3G#W ADN 3 IZLINE [SET POINTER TO NEXT BUDGET LINE 8 3GSG BCT 5 S01 7 3H#6 FREECORE 2 9 3HRQ SETREP2 NOSUCH 11 3J?B #SKI K6BMACROS>999-999 10 3JR2 TRACE 4,MBNOTYPE 5 3K=L UP 8 3KQ= S02 LDN 5 A1(2) 9 3L9W LDN 4 TLIST(3) 9 3LPG MOVE 4 IZLINE 8 3M96 SETREP OK 11 3MNQ #SKI K6BMACROS>999-999 10 3N8B TRACE A1(2),BFOUND 5 3NN2 UP 4 3P7L # 17 3PM= # BUDGET RECORD INCREMENTING (BUDGINCX & BUDGINCR) 12 3Q6W # EXEC1 CONTAINS THE BUDGET TYPE 12 3QLG # EXEC2 CONTAINS THE INCREMENT 6 3R66 QK3BUDGONE 9 3RKQ LDX 7 EXEC1(2) 18 3S5B ANDX 7 MGCLASS(1) [SELECT BUDGET CLASSIFICATION 7 3SK2 #SKI K6BMACROS 4 3T4L ( 9 3TJ= #SKI K6BMACROS>99-99 11 3W3W TRACE EXEC1(2),BUDGINC 18 3WHG BXU 7 MGPOR(1),T01 [MUST NOT BE A PRIVILEGE 10 3X36 GEOERR 1,BINCPRIV 4 3XGQ T01 4 3Y2B ) 20 3YG2 LDN 3 TRANS [SET POINTER FOR TRANSIENT INCREMENTS 21 3Y_L BXE 7 MGTOR(1),T010 [OR, IF NECESSARY, FOR STABLE BUDGETS 8 3_F= LDN 3 STABL 16 3_YW T010 LDX 6 EXEC1(2) [SELECT BUDGET TYPE 16 42DG LDX 4 EXEC2(2) [KEEP INCREMENT IN X4 11 42Y6 MHUNTW 2,FILE,ADICTENT 8 43CQ SMO FX2 8 43XB STO 2 EXEC3 9 44C2 #SKI K6BMACROS>999-999 10 44WL TRACE 6,BONET011 18 45B= CALL 7 SR0A [GO TO FIND THE BUDGET RECORD 19 45TW BRN T03 [IF ABSENT,GO TO MAKE NEW ENTRY 8 45WH ... LDN 0 STABL 7 45X8 ... SBX 0 3 17 45XT ... BZE 0 NOTRAN [J IF STABLE BUDGET 8 45YG ... SMO FX2 15 45_7 ... LDX 0 EXEC1 [BUDGET TYPE 9 45_K ... ANDX 0 MGMASK(1) 10 4623 ... TXU 0 MGMONEY(1) 18 462F ... BCS NOTMON [J IF NOT MONEY BUDGET 14 4636 ...[ THIS IS A MONEY BUDGET UPDATE 14 463R ...[ CHECKS ARE NOW MADE TO SEE IF 14 464D ...[ THE SIGN OF THE MONEY CHANGES 11 4655 ... MHUNTW 3,FILE,ADICTENT 20 465Q ... BC 3,BMONCS [CLEAR 'MONEY CHANGED SIGN' BIT 15 4668 ... LDX 0 CQUANT-1+TRANS(2) [JALLOWED 16 466L ... SBX 0 CQUANT+TRANS(2) [-JCONSUMED=LEFT 17 4674 ... BNG 0 NGI [J IF INITIALLY -VE 7 467P ... ADX 0 4 19 468B ... BNG 0 SETBC [J IF CHANGED FROM +VE TO -VE 7 4693 ...NGI ADX 0 4 16 469N ... BNG 0 NOTMON [J IF STILL -VE 19 46=* ...SETBC BS 3,BMONCS [SET 'MONEY CHANGED SIGN' BIT 5 46?2 ...NOTMON 8 46?M ... LDN 3 TRANS 5 46## ...NOTRAN 18 46*G ADX 2 3 [ADD REQUIRED INCREMENT TO 17 46T6 ADS 4 CQUANT(2) [JALLOWED OR JCONSUMED 8 47#Q KEEPREP 7,OK 21 47SB LDX 6 CQUANT-1(2) [CALCULATE RESULTANT AMT.AVAILABLE , AN 21 48#2 SBX 6 CQUANT(2) [SET REPLY 'OVERDRAWN','NOMORE',OR 'OK' 18 48RL # FOR STABLE BUDGETS ANT AVAILABLE = RATION - AMT USED 21 49?= # FOR TRANSIENT BUDGETS, AMT AVAILABLE = ALLOWANCE - AMT CONSUMED 9 49QW #SKI K6BMACROS>999-999 10 4==G TRACE 6,BONT011A 8 4=Q6 BPZ 6 TZ01 9 4?9Q KEEPREP 7,ODRAWN 8 4?PB BRN TZZ 8 4#92 TZ01 BNZ 6 TZZ 9 4#NL KEEPREP 7,NOMORE 7 4*8= TZZ PUTREP 7 9 4*MW #SKI K6BMACROS>999-999 9 4B7G TRACE 7,BONETZZ 8 4BM6 SMO FX2 17 4C6Q STO 6 ACOMMUNE3 [PASS UP AMT AVALABLE 5 4CLB UP 20 4D62 # IF THE USER HAS NONE OF THIS BUDGET TYPE, A NEW BUDGET RECORD 13 4DKL # IS APPENDED TO HIS FILE,ADICTENT BLOCK 8 4F5= T03 SMO FX2 19 4FJW LDX 7 EXEC1 [SELECT BUDGET TYPE BIT PATTERN 8 4G4G SMO FX2 18 4GJ6 SBX 2 EXEC3 [KEEP DISTANCE OF NEW RECORD 16 4H3Q STO 2 5 [FROM START OF BLOCK 9 4HHB #SKI K6BMACROS>999-999 9 4J32 TRACE 5,BONET03 7 4JGL LDX 6 7 10 4K2= ANDX 6 MGWORDS(1) 8 4KFW SMO FX2 21 4K_G LDX 3 EXEC3 [RESTORE POINTER TO FILE,ADICTENT BLOCK 20 4LF6 ADX 6 A1(3) [SET NO OF WORDS REQ'D IN NEW BLOCK 8 4LYQ STO 6 A1(3) 7 4MDB STO 3 2 10 4MY2 LDX 0 ALOGLEN(3) 9 4NCL BXGE 0 6,T03A 17 4NX= ALTLEN 3,6,FILE,ADICTENT [INCREASE BLOCK SIZE 11 4PBW MHUNTW 2,FILE,ADICTENT 4 4PWG T03A 16 4QB6 LDX 6 7 [BUDGET TYPE TO X6 11 4QTQ #SKI K6BMACROS>999-999 10 4R*B TRACE 6,BINCRTYP 21 4RT2 ANDX 6 MGWORDS(1) [SELECT NO. OF INFORMATION WORDS REQD. 18 4S#L SBN 6 1 [COUNT OF WORDS TO BE CLEARED 9 4SS= #SKI K6BMACROS>99-99 4 4T?W ( 8 4TRG BNG 6 ZONK 8 4W?6 BNZ 6 ZOK 9 4WQQ ZONK GEOERR 1,BUDGINC 4 4X=B ZOK 4 4XQ2 ) 7 4Y9L LDN 0 1 20 4YP= ADS 0 CNUMQ(2) [INCREMENT QUANTITATIVE BUDGET COUNT 9 4_8W #SKI K6BMACROS>999-999 11 4_NG TRACE CNUMQ(2),BONET03A 20 5286 ADX 2 5 [RESTORE POINTER TO NEW BUDGET RECORD 9 52MQ STO 7 CQUANT(2) 7 537B T030 SMO 6 18 53M2 STOZ CQUANT(2) [CLEAR BUDGET RECORD AREA 8 546L BCT 6 T030 10 54L= ANDX 7 MGCLASS(1) 8 555W LDN 3 TRANS 10 55KG BXE 7 MGTOR(1),T031 8 5656 LDN 3 STABL 7 56JQ T031 ADX 2 3 16 574B STO 4 CQUANT(2) [JALLOWED OR JCONSUMED 11 57J2 #SKI K6BMACROS>999-999 12 583L TRACE CQUANT(2),BINCT031 10 58H= KEEPREP 7,INCREASE 17 592W NGX 6 4 [AMT AVAILABLE IN X6 8 594S ... SMO FX2 8 596Q ... LDX 0 EXEC1 9 598N ... ANDX 0 MGMASK(1) 16 59=L ... BXU 0 MGMONEY(1),TZZ [J IF NOT MONEY 19 59#J ... BPZ 6 TZZ [J IF ^LEFT^ NOT GOING -VE. 11 59BG ... MHUNTW 2,FILE,ADICTENT 17 59DD ... BS 2,BMONCS [DO DICTWELL LATER 8 59GG BRN TZZ 4 5=26 # 4 5=FQ # 7 5=_B # BUDGWRITE 20 5?F2 # WRITES THE BUDGET RECORD SUPPLIED IN A JBUDGET,JBUDGUSER BLOCK 11 5?YL # TO THE FILE,ADICTENT BLOCK 6 5#D= QK4BUDGONE 12 5#XW MHUNTW 3,JBUDGET,JBUDGUSER 11 5*CG MHUNTW 2,FILE,ADICTENT 19 5*X6 LDX 6 JBITS(3) [BIT PATTERN BUDGET TYPE TO X6 20 5BBQ STO 2 4 [KEEP POINTER TO FILE,ADICTENT BLOCK 9 5BWB #SKI K6BMACROS>999-999 10 5CB2 TRACE 6,BONEQ002 20 5CTL CALL 7 SR0A [FIND BUDGET RECORD IN FILE,ADICTENT 17 5D*= BRN Q4 [GO TO Q4 IF NONE FOUND 21 5DSW LDX 6 CQUANT(2) [OTHERWISE TEST FOR ALTERATION IN SIXE 15 5F#G ANDX 6 MGWORDS(1) [OF BUDGET RECORD 8 5FS6 SBX 6 A1(3) 19 5G?Q BZE 6 Q300 [GO TO Q300 IF NO CHANGE IN SIZE 16 5GRB BPZ 6 Q2 [ Q2 IF NEW OLD) : 7 5HQL Q1 NGX 6 6 19 5J== STO 6 7 [AMOUNT OF INCREASE TO X6 AND X7 7 5JPW STO 4 3 21 5K9G SBX 2 4 [SET POINTER IN X3 TO FILE,ADICTENT,AND 21 5KP6 STO 2 4 [POINTER TO BUDGET RECORD IN X4(REL CPRIV 19 5L8Q ADX 6 A1(3) [REQUIRED SIZE OF NEW BLOCK IN X6 21 5LNB TXL 6 BSBS [RECORD MAY OVERFLOW : IF THIS OCCURS, 17 5M82 BCC QLONG [THERE IS AN ERROR 10 5MML LDX 0 ALOGLEN(3) 9 5N7= BXGE 0 6,Q101 7 5NLW PHOTO 5 16 5P6G ALTLEN 3,6,FILE,ADICTENT [LENGTHEN BLOCK 9 5PL6 TESTMOVE 5,Q101 11 5Q5Q MHUNTW 3,FILE,ADICTENT 7 5QKB Q101 LDX 5 6 20 5R52 CALL 0 QA [SET UP STEERING INFORMATION OOR MOVE 21 5RJL STO 5 A1(3) [STORE NEW NO. OF WORDS IN FILE,ADICTENT 9 5S4= #SKI K6BMACROS>999-999 4 5SHW ( 10 5T3G TRACE 2,BONEQ101 10 5TH6 TRACE 6,BONEQ101 10 5W2Q TRACE 7,BONEQ101 4 5WGB ) 8 5X22 BZE 2 Q3 7 5XFL SBN 6 1 19 5X_= ADX 7 6 [STARTING FROM THE RIGHTMOST END, 17 5YDW Q102 SMO 6 [MOVE OLD INFORMATION UP 19 5YYG LDX 0 0(2) [ (TO MAKE ROOM FOR NEW RECORD) 7 5_D6 SMO 7 8 5_XQ STO 0 0(2) 8 62CB BCT 2 Q102 8 62X2 BRN Q3 17 63BL # IF BUDGET RECORD HAS DECREASED IN SIZE (NEW < OLD) 17 63W= Q2 STO 6 7 [AMOUNT OF INCREASE TO X7 20 64*W STO 4 3 [SET POINTER IN X3 TO FILE,ADICTENT 7 64TG SBX 2 4 21 65*6 STO 2 4 [POINTER TO BUDGET RECORD IN X4 (REL CPRI 21 65SQ CALL 0 QA [SET UP STEERING INFORMATION FOR ^MOVE^ 9 66#B #SKI K6BMACROS>999-999 4 66S2 ( 9 67?L TRACE 2,BONEQ2 9 67R= TRACE 6,BONEQ2 9 68=W TRACE 7,BONEQ2 4 68QG ) 7 69=6 LDX 5 6 21 69PQ SBX 6 7 [MOVE OLD INFORMATION BACK TO FILL GAP 8 6=9B BZE 2 Q201 19 6=P2 SMO 2 [LEFT BY CONTRACTED BUDGET RECORD 7 6?8L MOVE 5 0 4 6?N= Q201 8 6#7W SBS 7 A1(3) 8 6#MG LDX 7 A1(3) 10 6*76 LDX 0 ALOGLEN(3) 9 6*LQ BXE 0 BSBS,Q3 7 6B6B PHOTO 5 11 6BL2 ALTLEN 3,7,FILE,ADICTENT 8 6C5L TESTMOVE 5,Q3 11 6CK= MHUNTW 3,FILE,ADICTENT 17 6D4W # IF THE FILE,ADICTENT BLOCK HAS BEEN ALTERED IN SIZE : 7 6DJG Q3 STO 3 2 7 6F46 ADX 2 4 12 6FHQ MHUNTW 3,JBUDGET,JBUDGUSER 9 6G3B LDX 0 JBITS(3) 9 6GH2 ANDX 0 MGMASK(1) 8 6H2L ORX 0 A1(3) 9 6HG= STO 0 JBITS(3) 4 6H_W Q300 9 6J2_ ... LDX 0 JBITS(3) 9 6J44 ... ANDX 0 MGMASK(1) 10 6J57 ... SBX 0 MGMONEY(1) 15 6J6= ... BNZ 0 Q3NM [J IF NOT MONEY 10 6J7* ... LDX 0 JALLOWED(3) 15 6J8D ... SBX 0 JCONSUMED(3) [WHAT'S LEFT NOW 11 6J9H ... LDX 1 CQUANT+TRANS-1(2) 15 6J=L ... SBX 1 CQUANT+TRANS(2) [WHAT WAS LEFT 7 6J?P ... ERX 0 1 17 6J#S ... BPZ 0 Q3NM [J IF NO CHANGE OF SIGN 11 6J*X ... MHUNTW 1,FILE,ADICTENT 9 6JC2 ... BS 1,BMONCS 4 6JD5 ...Q3NM 9 6JFG LDN 1 JBITS(3) 9 6J_6 ADN 2 CQUANT 8 6KDQ SMO A1(3) 7 6KYB MOVE 1 0 9 6LD2 #SKI K6BMACROS>999-999 4 6LXL ( 10 6MC= TRACE 0(2),BONEQ300 10 6MWW TRACE 1(2),BONEQ300 10 6NBG TRACE 7,BONEQ300 10 6NW6 TRACE 4,BONEQ300 4 6P*Q ) 4 6PTB Q302 8 6Q*2 SETREP OK 5 6QSL UP 14 6R#= # IF NO SUCH BUDGET RECORD HAS BEEN FOUND 19 6RRW Q4 LDX 6 A1(3) [SELECT NO OF WORDS IN NEW RECORD 20 6S?G STO 4 3 [SET POINTER IN X3 TO FILE,ADICTENT 20 6SR6 SBX 2 4 [KEEP DISTANCE OF BUDGET RECORD AREA 18 6T=Q STO 2 4 [FROM START OF BLOCK IN X4 8 6TQB ADX 6 A1(3) 8 6W=2 LDX 0 BSBS 7 6WPL TXL 0 6 8 6X9= BCS QLONG 8 6XNW STO 6 A1(3) 10 6Y8G TXU 0 ALOGLEN(3) 8 6YN6 BCC Q401 7 6_7Q PHOTO 5 11 6_MB ALTLEN 3,6,FILE,ADICTENT 9 7272 TESTMOVE 5,Q401 11 72LL MHUNTW 3,FILE,ADICTENT 7 736= Q401 LDN 0 1 9 73KW ADS 0 CNUMQ(3) 9 745G #SKI K6BMACROS>999-999 9 74K6 TRACE CNUMQ(3) 8 754Q BRN Q3 5 75JB QLONG 9 7642 SETREP TOOLONG 5 76HL UP 15 773= # THIS SUBROUTINE SETS UP POINTERS FOR Q1 AND Q2 17 77GW # ON ENTRY: X0=LINK ACCUMULATOR X1=FX1 16 782G # X3 POINTS TO FILE,ADICTENT BLOCK 20 78G6 # X7=NO. OF WORDS BY WHICH BLOCK SIZE HAS INCREASED 15 78_Q # ( OR WILL DECREASE) 20 79FB # AND CQUANT(X4+X3) IS THE START OF THE BUDGET RECORD 15 79_2 # IN THE FILE,ADICTENT BLOCK. 15 7=DL # ON EXIT: X2=NO. OF WORDS TO BE MOVED 18 7=Y= # X6=LOC'N FROM WHICH WORDS ARE TO BE MOVED 7 7?CW QA SMO 4 18 7?XG LDX 2 CQUANT(3) [BIT PATTERN OF BUDGET TYPE 17 7#C6 ANDX 2 MGWORDS(1) [NO. OF INFORMATION WORDS 7 7#WQ STO 2 6 20 7*BB ADN 2 CQUANT-A1 [ADD DISTANCE OF THIS BUDGET RECORD 13 7*W2 ADX 2 4 [FROM A1 20 7B*L SBX 2 A1(3) [AND SUBTRACT THIS AMOUNT FROM THE 21 7BT= NGX 2 2 [TOTAL NO. OF WORDS IN THE FILE,ADICTENT 19 7C#W SMO 4 [ADD THIS RECORD ADDRESS TO THE 20 7CSG ADN 6 CQUANT(3) [NO. WF WORDS IN THIS CURRENT RECORD 10 7D#6 #SKI K6BMACROS>99999-99999 9 7DRQ TRACE 2,BUDG QA 7 7F?B EXIT 0 0 4 7FR2 # 19 7G=L # SUBROUTINE TO SET A POINTER TO A SPECIFIED BUDGET RECORD 12 7GQ= # FROM THE FIRST FILE,ADICTENT BLOCK 14 7H9W # ON ENTRY : X6=BUDGET TYPE BIT PATTERN 12 7HPG # X7=LINK ACCUMULATOR 21 7J96 # ON EXIT : CQUANT(2) IS THE FIRST WORD OF THE BUDGET RECORD,IF FOUND 19 7JNQ # OTHERWISE,IT IS THE FIRST UNUSED WORD AFTER THE Q.B. LIST 14 7K8B # X1=FX1 THROUGHOUT SUBROUTINE 13 7KN2 # X3 AND X4 ARE NOT USED 11 7L7L SR0 MHUNTW 2,FILE,ADICTENT 18 7LM= SR0A ANDX 6 MGMASK(1) [SELECT UNIQUE BIT PATTERN 18 7M6W LDX 0 CNUMQ(2) [NO. OF QUANTITATIVE BUDGETS 8 7MLG BNZ 0 R001 7 7N66 EXIT 7 0 19 7NKQ R001 LDX 5 CQUANT(2) [SEEK MATCHING BUDGET BIT PATTERN 9 7P5B ANDX 5 MGMASK(1) 7 7PK2 TXU 5 6 8 7Q4L BCS R002 16 7QJ= EXIT 7 1 [EXIT - BUDGET FOUND 20 7R3W R002 LDX 5 CQUANT(2) [SET POINTER PO NEXT BUDGET RECORD 10 7RHG ANDX 5 MGWORDS(1) 7 7S36 ADX 2 5 8 7SGQ BCT 0 R001 16 7T2B EXIT 7 0 [ SUCH BUDGET RECORD 4 7TG2 # 15 7T_L # SUBROUTINE TO DEAL WITH THE ^BUDGDEL^ MACRO 18 7WF= # DELETES THE BUDGET RECORD IN A JBUDGET,JBUDGUSER BLOCK 10 7WYW # FROM THE FILE,ADICTENT 6 7XDG QK5BUDGONE 12 7XY6 MHUNTW 3,JBUDGET,JBUDGUSER 11 7YCQ MHUNTW 2,FILE,ADICTENT 9 7YXB #SKI K6BMACROS>99-99 11 7_C2 TRACE JBITS(3),BUDGDEL 20 7_WL STO 2 4 [KEEP POINTER TO FILE,ADICTENT IN X4 19 82B= LDX 6 JBITS(3) [BUDGET TYPE BIT PATTERN TO X6 20 82TW CALL 7 SR0A [SEEK BUDGET RECORD IN FILE ADICTENT 19 83*G BRN V5 [IF NOT FOUND,SET REPLY NO TYPE 17 83T6 # IF THE BUDGET RECORD IS PRESENT IN THE FILE,ADICTENT# 11 84#Q # CHECK THAT IT IS UNCHANGED. 9 84SB LDX 5 JBITS(3) 10 85#2 ANDX 5 MGWORDS(1) 8 85RL TXU 5 A1(3) 8 86?= BCS V4 7 86QW LDX 7 5 7 87=G V1 SBN 7 1 7 87Q6 SMO 7 9 889Q LDX 6 JBITS(3) 7 88PB SMO 7 9 8992 TXU 6 CQUANT(2) 17 89NL BCS V4 [DO NOT DELETE IF CHANGED 8 8=8= BCT 5 V1 21 8=MW NGX 5 A1(3) [NEGATIVE COUNT OF WORDS IN BUDGET RECORD 20 8?7G STO 4 3 [KEEP IN X3 POINTER TO FILE,ADICTENT 21 8?M6 LDN 7 CQUANT(2) [AND IN X7 A POINTER TO THE BUDGET RECORD 7 8#6Q SBX 2 4 7 8#LB STO 2 4 19 8*62 CALL 0 QA [SET UP PARAMETERS,AND MOVE 16 8*KL BZE 2 V3 [ANY SUBSEQUEBT 20 8B5= SMO 2 [BUDGET RECORDS BACK,OVERWRITING THE 19 8BJW MOVE 6 0 [RECORD WHICH IS BEING DELETED 4 8C4G V3 20 8CJ6 ADX 5 A1(3) [DECREMENT NO.OF WORDS IN THIS RECORD 8 8D3Q STO 5 A1(3) 7 8DHB LDN 0 1 19 8F32 SBS 0 CNUMQ(3) [AND NO. OF QUANTITATIVE BUDGETS 10 8FGL LDX 0 ALOGLEN(3) 8 8G2= TXU 0 BSBS 8 8GFW BCC V501 17 8G_G ALTLEN 3,5 [SHORTEN DICTIONARY ENTRY 8 8HF6 KEEPREP 7,OK 8 8HYQ BRN V501 9 8JDB V4 KEEPREP 7,CHANGED 8 8JY2 BRN V501 9 8KCL V5 KEEPREP 7,NOTYPE 7 8KX= V501 PUTREP 7 5 8LBW UP 10 8LWG MENDAREA 50,K99BUDGONE 4 8MB6 #END 8 ____ ...41024710000600000000