(George Source)
Macros used: BC, BUDGCHAR, BUDGUSE, BUDGUSEN, BUDGWRITE, BXE, BXU, CHNUMCON, CJOBLOCK, CLOSE, CLOSETOP, DICTJL, DICTWELL, ERROR, ERRORX, FINDNAME, FNORM, FREECORE, GEOERR, HUNT, HUNT2, JBC, KEEPREP, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, NAME, NAMETOP, OPEN, PARAPASS, PHOTO, PUTREP, PUTREP2, READDICT, REPLACE, SEG, SEGENTRY, SETNCORE, STEP, TESTMOVE, TESTREP2, TESTRPN2, TRACE, UP, UPPLUS, USERNORM, VFREEW
22FL ... SEG BUDGTWO 23YG SEGENTRY K1BUDGTWO,QK1BUDGTWO 24D6 SEGENTRY K2BUDGTWO,QK2BUDGTWO 24XQ SEGENTRY K3BUDGTWO,QK3BUDGTWO 25CB SEGENTRY K4BUDGTWO,QK4BUDGTWO 25X2 SEGENTRY K5BUDGTWO,QK5BUDGTWO 26BL SEGENTRY K7BUDGTWO,QK7BUDGTWO 26W= SEGENTRY K9BUDGTWO,QK9BUDGTWO 27*W SEGENTRY K10BUDGTWO,QK10BUDGTWO 27TG SEGENTRY K11BUDGTWO,QK11BUDGTWO 28*6 SEGENTRY K12BUDGTWO,QK12BUDGTWO 28SQ SEGENTRY K31BUDGTWO,QK31BUDGTWO 29#B # 29S2 # THIS CHAPTER CONTAINS THE SUBROUTINES USED BY THE FOLLOWING 2=?L # BUDGET MACROS: 2=R= # BUDGERASE,BUDGCHAR,OPENBUDG,CLOSBUDG,CLOSBINC 2?=W # BUDGSTART 2?QG # 2#=6 MGCLASS +GCLASS [MASK FOR CLASSIFICATION 2#PQ MGPOR +GPOR [PRIVILEGE IDENTIFICATION 2*9B MGTOR +GTOR [TRANSIENT BUDGET IDENTIFICATION 2*P2 MGWORDS +GWORDS [NO. OF INFORMATION WORDS IN B.R. 2B8L NB +10 2BN= 12HMASTER 2C7W 12HDICTIONARY 2CMG +0 2D76 +1 2DLQ +0 2F6B #DEF UNAMED=A1 2FL2 #DEF UCURRENT=UNAMED+3 2G5L #DEF UTYPE=UCURRENT+3 2GK= #DEF UCHANGE=UTYPE+1 2H4W XJUSNA +JUSNA [USERNAME 2HJG XJBUDTYPE +JBUDTYPE [BUDGET TYPE 2J46 XJBUDCHAN +JBUDCHAN [BUDGET CHANGE 2JHQ XJPARMIS +JPARMIS [%C PARAMETER MISSING 2K3B XJNOPAR +JNOPAR [NO PARAMETERS 2KH2 XERB1 +ERB1 [NO SUCH BUDGET TYPE AS %C 2L2L XERB11 +ERB11 [%C IS NOT A TRANSIENT BUDGET 2LG= XJZPRIV +JZPRIV [PRIVILEGE SHOULD BE FOLLOWED 2L^W [ BY GIVE OR TAKE 2M74 ...#UNSET FTS1 2M#= ...XUSERF +ERUSERFORM [ERROR IN USERNAME 2MFG XGIVE 4HGIVE 2M^6 XTAKE 4HTAKE 2NDQ MAN 12HMANAGER 2NYB # 2PD2 # ROUTINE CALLED BY THE BUDGERASE MACRO,WHICH RETURNS THE BUDGETS 2PXL # OF A USER WHO IS BEING ERASED TO HIS IMMEDIATE SUPERIOR. 2QC= # THE SUPERIOR'S ENTRY IS REWRITTEN,BUT THE INFERIOR'S IS NOT. 2QWW # IT IS ASSUMED THAT THE INFERIOR USER HAS NO INFERIORS OTHER 2RBG # THAN PSUEDO-USERS. 2RW6 # ON ENTRY: 2S*Q # THE DICTIONARY IS OPEN,AND THE ENTRY FOR THE USER BEING ERASED 2STB # IS IN THE FIRST FILE,ADICTENT IN THE CHAIN. 2T*2 QK1BUDGTWO 2TSL MHUNTW 3,FILE,ADICTENT 2W#= LDX 7 CNUMQ(3) [SELECT NO. OF BUDGETS HELD BY INFERIOR 2WRW #SKI K6BMACROS>999-999 2X?G TRACE CNUMQ(3),GB Q001 2XR6 BZE 7 Q990 [IF ZERO,NO PROCESSING IS NECESSARY 2Y=Q LDX 5 CSUPUSER(3) [LOAD NAME OF THE 2YQB LDX 6 CSUPUSER+1(3) [SUPERIOR USER 2^=2 LDX 4 CSUPUSER+2(3) 2^PL TXU 5 MAN(1) [IF SUPERIOR USER IS MANAGER, 329= TXU 6 MAN+1(1) [NO UPDATE OF BUDGET REQUIRED 32NW TXU 4 MAN+2(1) 338G BCC Q990 33N6 SETNCORE 3,6,FILE,ADICT 347Q MHUNTW 3,FILE,ADICTENT 34MB LDN 5 CSUPUSER(3) 3572 ADN 6 A1 35LL MOVE 5 3 366= PHOTO 4 [OTHERWISE READ HIS SUPERIOR'S ENTRY 36KW READDICT 375G TESTREP2 OK,Q0035 37K6 GEOERR 1,NO SUPER 384Q Q0035 38JB TESTMOVE 4,Q004 3942 MHUNTW 3,FILE,ADICTENT [THE ENTRY FOR THE USER BEING ERASED 39HL HUNT2 3,FILE,ADICTENT [NOW IN THE SECOND FILE ADICTENT 3=3= Q004 3=GW STOZ 6 [X6 IS USED AS A MODIFIER FOR B.R.'S ; 3?2G Q1 SMO 6 3?G6 LDX 5 CQUANT(3) [SELECT NEXT BUDGET BIT PATTERN 3?^Q PHOTO 4 3#FB BUDGUSE 5 [READ SUPERIOR'S BUDGET RECORD 3#^2 #SKI K6BMACROS>150-150 3*DL TRACE 5,GBUDG Q1 3*Y= TESTREP2 OK,Q3 [IF SUPERIOR HAS NO SUCH BUDGET RECOR 3BCW SETNCORE GWORDS+1,2,JBUDGET,JBUDGUSER 3BXG STOZ A1+1(2) [SET UP A DUMMY B.R. FOR HIM 3CC6 LDN 0 A1+1(2) 3CWQ LDN 1 A1+2(2) 3DBB MOVE 0 GWORDS-1 [CLEARING ALL WORDS BUT THE BIT PATTERN 3DW2 LDX 1 FX1 3F*L STO 5 JBITS(2) 3FT= LDX 0 MGWORDS(1) 3G#W ANDX 0 5 3GSG STO 0 A1(2) 3H#6 #SKI K6BMACROS>999-999 3HRQ TRACE 5,GBUDNOBR 3J?B BRN Q301 3JR2 Q3 HUNT 2,JBUDGET,JBUDGUSER 3K=L Q301 TESTMOVE 4,Q303 3KQ= MHUNTW 3,FILE,ADICTENT [FIND SECOND DICTIONARY ENTRY 3L9W HUNT2 3,FILE,ADICTENT 3LPG Q303 ADX 3 6 3M96 LDX 0 MGWORDS(1) 3MNQ ANDX 0 5 3N8B TXL 0 A1(2) [NEW B.R.TO BE THE SAME SIZE AS THE 3NN2 BCS Q305 [LARGER OF THE OLD ONES 3P7L STO 0 A1(2) [ASSUMED BLOCK TO BE ZERO-FILLED 3PM= Q305 LDX 0 MGCLASS(1) 3Q6W ANDX 0 5 [SELECT BUDGET CLASSIFICATION 3QLG TXU 0 MGTOR(1) 3R66 BCC Q5 3RKQ # STABLE BUDGET RECORDS: 3S5B # RATION' (SUPERIOR) =RATION (SUP) +RATION (INFERIOR) 3SK2 # AMT.USED' (SUP) =AMT.USED (SUP) [NO CHANGE 3T4L # AMT.CONSUMED' (SUP) =AMT.CONSUMED(SUP) +AMT.CONSUMED(INF) 3TJ= LDX 0 CQUANT+JRATION-JBITS(3) 3W3W ADS 0 JRATION(2) [INCREMENT RATION 3WHG LDXC 0 CQUANT+JCONSUMED-JBITS+1(3) 3X36 ADSC 0 JCONSUMED+1(2) 3XGQ LDX 0 CQUANT+JCONSUMED-JBITS(3) 3Y2B ADS 0 JCONSUMED(2) [INCREMENT DOUBLE LENGTH AMT.CONSUMED 3YG2 LDX 1 MGWORDS(1) 3Y^L ANDX 1 5 3^F= SBN 1 5 3^YW BRN Q503 42DG # TRANSIENT BUDGETS 42Y6 # FOR EACH WORD IN THE TRANSIENT BUDGET RECORD (EXCLUDING BIT 43CQ # PATTERN) : 43XB # SUPERIOR'S NEW ENTRY = HIS OLD ENTRY + HIS INFERIOR'S ENTRY 44C2 Q5 LDX 0 CQUANT+JRATION-JBITS(3) 44WL ADS 0 JRATION(2) [INCREMENT RATION 45B= LDX 0 CQUANT+JALLOWED-JBITS(3) 45TW ADS 0 JALLOWED(2) 46*G LDX 0 JCONSUMED-JBITS+CQUANT(3) 46T6 ADS 0 JCONSUMED(2) 47#Q LDX 1 MGWORDS(1) 47SB ANDX 1 5 48#2 SBN 1 4 48RL Q503 BZE 1 Q6 49?= Q505 SMO 1 49QW LDX 0 CQUANT+4(3) 4==G SMO 1 [INCREMENT NON-STANDARD WORDS (IF ANY) 4=Q6 ADS 0 JBITS+4(2) 4?9Q BCT 1 Q505 4?PB Q6 BUDGWRITE [REWRITE SUPERIOR'S BUDGET RECORD 4#92 #SKI K6BMACROS>999-999 4#NL TRACE EXEC3(2),GBUDG Q6 4*8= SBX 3 6 [RESTORE POINTER IN X3 4*MW TESTMOVE 4,Q603 4B7G MHUNTW 3,FILE,ADICTENT 4BM6 HUNT2 3,FILE,ADICTENT [FIND INFERIOR'S ENTRY 4C6Q Q603 ANDX 5 MGWORDS(1) 4CLB ADX 6 5 4D62 MFREEW JBUDGET,JBUDGUSER 4DKL #SKI K6BMACROS>150-150 4F5= TRACE 7,GB Q606 4FJW BCT 7 Q1 4G4G MHUNTW 2,FILE,ADICTENT 4GJ6 NAME 2,FILE,FWB 4H3Q REPLACE 4HHB MFREEW FILE,FWB 4J32 Q990 4JGL #SKI K6BMACROS>999-999 4K2= TRACE K9,GIVEBDG7 4KFW UP 4K^G # 4LF6 # 4LYQ # BUDGCHAR SUBROUTINE 4MDB # THIS SUBROUTINE SETS UP A JBUDGET,JLINE BLOCK CONTAINING 4MY2 # THAT LINE FROM THE BUDGET DESCRIPTION LIST 4NCL # WHOSE CHARACTER STRING NAME MATCHES THE CHARACTER STRING NAME 4NX= # IN APARA OF THE FIRST CPB,CUNI BLOCK IN THE CHAIN. 4PBW QK2BUDGTWO 4PWG SETNCORE IZLINE,3,JBUDGET,JLINE 4QB6 STEP [READ BUDGET DESCRIPTION LIST 4QTQ HUNT 2,CPB,CUNI 4R*B #SKI K6BMACROS>99-99 4RT2 ( 4S#L BZE 3 R00 [MUST BE POSITIONED AT FIRST 4SS= LDX 0 CUSER-A1(3) 4T?W ADX 0 CUSER+1-A1(3) 4TRG ADX 0 CUSER+2-A1(3) 4W?6 BNZ 0 R00 4WQQ BPZ 2 R01 4X=B R00 GEOERR 1,BUDGCHAR 4XQ2 R01 TRACE APARA(2),B CHAR01 4Y9L ) 4YP= LDX 0 ANUM(2) 4^8W BNG 0 R03 [ERROR IF NO PARAMETER 4^NG BZE 0 R03 [OR VULL PARAMETER 5286 ANDN 0 #7777 52MQ SBN 0 9 537B BPZ 0 R03 [J IF MORE THAN 8 CHASRS 53M2 LDX 4 APARA(2) 546L LDX 5 APARA+1(2) 54L= ADN 0 4 555W BPZ 0 R010 [J IF MORE THAN 4 CHARS 55KG LDX 5 ACES 5656 R010 56JQ LDX 0 IZCOUNT-A1(3) [NO OF BUDGETS IN LIST 574B BZE 0 R03 57J2 R02 583L TXU 4 IZLIST+1-A1(3) [SEEK MATCHING CHARACTER STRING 58H= TXU 5 IZLIST+2-A1(3) 592W BCC R04 59GG ADN 3 IZLINE 5=26 BCT 0 R02 5=FQ R03 5=^B #SKI K6BMACROS>99-99 5?F2 TRACE 5,BCNOTYPE 5?YL VFREEW JBUDGET,JLINE 5#D= KEEPREP 7,NOSUCH 5#XW BRN R05 5*CG R04 MHUNTW 2,JBUDGET,JLINE 5*X6 LDN 5 JPATTERN(2) 5BBQ LDN 4 IZLIST-A1(3) [STORE BUDGET DESCRIPTION LINE 5BWB MOVE 4 IZLINE [IN JBUDGET BLOCK 5CB2 #SKI K6BMACROS>99-99 5CTL TRACE JPATTERN(2),BCHAR OK 5D*= KEEPREP 7,OK 5DSW R05 PUTREP 7 5F#G UP 5FS6 # 5G?Q # ROUTINE TO OPEN THE DICTIONARY AND READ THE PROPER USER'S ENTRY 5GRB # CALLED BY OPENBUDG 5H?2 QK3BUDGTWO 5HQL SETNCORE 10,5,FILE,FABSNB 5J== LDN 4 NB(1) 5JPW ADN 5 A1 5K9G MOVE 4 10 5KP6 OPEN XBREAK,GENERAL 5L8Q HUNT 3,FILE,FABSNB 5LNB NAME 3,FILE,ADICT 5M82 CJOBLOCK 2 5MML ADN 2 JUSER 5N7= ADN 3 A1 5NLW MOVE 2 3 5P6G READDICT 5PL6 #SKI K6BMACROS>101-101 5Q5Q TRACE EXEC3(2),OPENBUDG 5QKB UPPLUS 1 5R52 XBREAK 5RJL GEOERR 1,BUDGBRK 5S4= # 5SHW # ROUTINE TO OPEN THE DICT.(GENERAL) AND READ THE ENTRY FOR THE OWNE 5T3G # OF FILES IN THE DIRECTORY SPECIFIED BY THE INPUT FABSBN, 5TH6 # WHICH MUST BE 4 WORDS ONLY 5W2Q QK31BUDGTWO 5WGB #SKI K6BMACROS>99-99 5X22 ( 5XFL MHUNT 1,FILE,FABSNB 5X^= LDN 0 4 5YDW SBX 0 ALOGLEN(1) 5YYG BZE 0 ST00 5^D6 WRNG GEOERR 1,ABSWRONG 5^XQ ST00 62CB ) 62X2 FINDNAME [EXPAND PABSNB 63BL TESTRPN2 OK,ST30 63W= MHUNT 1,FILE,FABSNB 6427 ... LDN 0 4 6464 ... SBX 0 ALOGLEN(1) 649^ ... BZE 0 ST30 64*W LDX 2 A1(1) 64TG ADX 2 1 65*6 ST10 65SQ LDX 0 A1-2(2) 66#B BPZ 0 ST20 [J IF NOT PSEUDO 66S2 SBN 2 6 67?L BRN ST10 [LOOK AT NEXT USER UP 67R= ST20 68=W ADN 2 A1-5 68QG LDN 3 A1(1) 69=6 MOVE 2 3 [MOVE USERNAME TO TOP OF BLOCK 69PQ NAME 1,FILE,ADICT [& NAME IT AN ADICT 6=9B SETNCORE 10,2,FILE,FABSNB 6=P2 LDN 1 NB(1) 6?8L ADN 2 A1 6?N= MOVE 1 10 6#7W OPEN XBREAK,GENERAL [DICT. 6#MG MFREE FILE,FABSNB 6*76 READDICT 6*LQ TESTREP2 OK,ST31 6*WJ ... TESTREP2 NOUSER,ST30A 6B6B GEOERR 1,B2WRONG 6BL2 ST31 6C5L UPPLUS 1 6C=S ...ST30A 6CD2 ... CLOSE 6CK= ST30 6D4W UP 6DJG # 6F46 # CLOSBUDG 6FHQ # ROUTINE TO RE-WRITE ENTRY AND CLOSE THE DICTIONARY 6G3B QK4BUDGTWO 6GH2 QK5BUDGTWO 6H2L MHUNTW 2,FILE,ADICTENT 6H4J ... JBC NOUP,2,BMONCS [J IF MONEY NOT CHANGED SIGN 6H5H ... BC 2,BMONCS 6H6G ... BUDGUSEN GMONEY [GET MONEY BUDGET RECORD 6H8D ... MHUNTW 3,JBUDGET,JBUDGUSER 6H=B ... MHUNTW 2,FILE,ADICTENT 6H?* ... LDX 7 JALLOWED(3) 6H## ... SBX 7 JCONSUMED(3) 6H*? ... DICTWELL CUSER(2),MONEY,7 [UPDATE JOBLIST ETC 6HB= ... MFREEW JBUDGET,JBUDGUSER 6HD8 ...NOUP MHUNTW 2,FILE,ADICTENT 6HG= NAME 2,FILE,FWB 6H^W REPLACE 6JFG MFREEW FILE,FWB 6J^6 CLOSE 6K6# ...#UNSET FTS1 6K?G ... DICTJL 6KDQ #SKI K6BMACROS>101-101 6KYB TRACE K7,CLOSBUDG 6LD2 UP 6LXL # 6MC= # 6MWW # BUDGSTART ROUTINE 6NBG # THE BUDGSTART ROUTINE CHECKS THAT A USER IS NOT OVERDRAWN ON 6NW6 # HIS MONEY BUDGET. 6P*Q QK7BUDGTWO 6PTB BUDGUSEN GMONEY 6Q*2 #SKI K6BMACROS>101-101 6QSL TRACE EXEC3(2),BUDGSTAR 6R#= KEEPREP 7,OK [IF THE USER HAS NO MONEY BUDGET RECORD, 6RRW TESTRPN2 OK,W06 [HE MAY CONTINUE(AS HE IS NOT OVERDRAWN) 6S?G MHUNTW 3,JBUDGET,JBUDGUSER 6SR6 LDX 6 JALLOWED(3) [IF THE USER HAS CONSUMED MORE MONEY 6T=Q SBX 6 JCONSUMED(3) [THAN HE HAS AVAILABLE, 6TQB #SKI K6BMACROS>90-90 6W=2 TRACE 6,MONEYLFT 6WPL BPZ 6 W04 6X9= KEEPREP 7,NOTENUF [THE REPLY IS NOTENUF 6XNW W04 FREECORE 3 6Y8G W06 PUTREP2 7 6YN6 UP 6^7Q # 6^MB QK9BUDGTWO 7272 LDN 4 0 72LL LDX 5 GSIGN 736= BRN QIN 73KW QK10BUDGTWO 745G LDN 4 0 74K6 LDN 5 0 754Q BRN QIN 75JB QK11BUDGTWO 7642 LDX 4 GSIGN 76HL LDN 5 0 773= QIN LDN 6 0 77GW LDN 7 0 782G LDN 3 2 78G6 S1 SPARAPASS 78^Q HUNT 1,CPB,CUNI 79FB NGX 0 ANUM(1) 79^2 BPZ 7 S6 [J. UNLESS USERNAME ALREADY FOUND 7=DL BPZ 0 QR1 [J. IF PARAMETER MISSING 7=Y= S2 BNG 6 QR3 [J IF USERNAME NOT FOUND 7?CW SETNCORE 10,2,FILE,FABSNB 7?XG ADN 2 A1 7#C6 ADN 1 NB 7#WQ MOVE 1 10 7*BB OPEN SBREAK,READ,QUERY 7*W2 TESTREPN OK,QR10 7B*L BUDGCHAR 7BT= TESTREP2 NOSUCH,QR7 7C#W CLOSETOP 7CJN ... MFREE FILE,FABSNB [FREE :MASTER'S FABSNB 7CSG ORX 6 GSIGN [SET BUDGET TYPE FOUND MARK 7D#6 BPZ 5 S25 [J. UNLESS BQ 7DRQ MFREE CPB,CUNI 7F?B BRN S11 7FR2 S25 MHUNTW 2,JBUDGET,JLINE 7G=L LDX 0 4 7GQ= LDX 4 JPATTERN(2) 7H9W BNG 0 S14 [J. IF ALLOWANCE COMMAND 7HPG S3 MFREE CPB,CUNI 7J96 PARAPASS 7JNQ HUNT 2,CPB,CUNI 7K8B NGX 0 ANUM(2) 7KN2 ANDX 4 MGCLASS(1) 7L7L BXU 4 MGPOR(1),S5 [J. UNLESS PRIVILEGE 7LM= ADN 0 4 7M6W BNZ 0 QR5 [J. IF NOT 4 CH IN PARAMETER 7MLG LDN 4 1 7N66 LDX 0 APARA(2) 7NKQ BXE 0 XGIVE(1),S4 [J IF GIVE X4=1 7P5B LDN 4 0 7PK2 BXU 0 XTAKE(1),QR5 [J. IF NOT GIVE OR TAKE 7Q4L S4 MFREE CPB,CUNI 7QJ= SETNCORE 15,2,ADATA,CSTORE 7R3W ADN 2 1+A1 7RHG LDX 1 2 7S36 SBN 1 1 7SGQ STOZ 0(1) 7T2B MOVE 1 14 7TG2 SBN 2 A1+1 7T^L STO 4 UCHANGE(2) 7WF= MHUNTW 1,JBUDGET,JLINE 7WYW LDX 4 JPATTERN(1) 7XDG STO 4 UTYPE(2) 7XY6 BRN S11 7YCQ S5 BPZ 0 QR4 7YXB CHNUMCON 7^C2 TESTREP2 CHNUMERR,QR9 7^WL MHUNTW 1,CPAR,GNUMCON 82B= LDX 4 A1+1(1) 82TW FREECORE 1 83*G BRN S4 83T6 S6 BNZ 0 S8 [J. UNLESS NULL PARAMETER 84#Q MFREE CPB,CUNI 84SB BPZ 5 QR3 [J. UNLESS BUDGETQVERY COMMAND 85#2 S7 SETNCORE 3,2,FILE,ADICT 85RL CJOBLOCK 1 86?= LDX 2 FPTR(2) 86QW ADN 1 JUSER 87=G ADN 2 A1 87Q6 MOVE 1 3 889Q BRN S10 88PB S8 BNG 0 S9 [J. UNLESS NONEXISTANT PARAMETER 8992 MFREE CPB,CUNI 89NL BPZ 6 QR2 [J. UNLESS BUDGET TYPE ALREADY FOUND 8=8= BNG 5 S7 [J. IF BUDGETQUERY COMMAND 8=MW BRN QR3 [ERROR: USERNAME PARAMETER MISSING 8?7G S9 LDCH 0 APARA(1) 8?M6 SBN 0 #12 8?TB ... BNZ 0 S2 [J UNLESS 1ST CHAR IS A COLON 8#3L ...#UNSET FTS1 8#9W ...#SKI 8#D6 ...( 8#LB USERNORM ATYPE(1) [B15-23 HOLD THE PARAMETER NUMBER 8*62 TESTREP2 USERFORM,QR8 8*6S ...) 8*7L ...#UNSET FTS1 8*8D ...( 8*9= ... NAMETOP 1,FILE,FNAME 8*=4 ... FNORM 1 [USERNAME 8*=W ... TESTREP2 NAMEFORM,QR6A 8*?N ... MHUNT 1,FILE,FNAME 8*#G ... NAMETOP 1,CPB,CUNI 8**# ... MHUNT 1,FILE,FABSNB 8*B6 ... LDX 0 A1(1) [FABSNB 8*BY ... SBN 0 4 [MUST BE 8*CQ ... BNZ 0 QR6A [4 WORDS LONG 8*DJ ... SETNCORE 3,2,FILE,ADICT 8*FB ... MHUNT 1,FILE,FABSNB 8*G8 ... ADN 1 A1+1 [MOVE USER 8*H2 ... ADN 2 A1 [NAME INTO 8*HS ... MOVE 1 3 [ADICT 8*JL ...) 8*KL S10 ORX 7 GSIGN [SET'USE-5AME FOUND' MARK 8B5= S11 BCT 3 S1 [LOOP ON COUNT 8BJW BNG 5 S13 [J. IF BUDGETQUERY COMMAND 8C4G MHUNTW 1,FILE,ADICT 8CJ6 MHUNTW 2,ADATA,CSTORE 8D3Q ADN 1 A1 8DHB ADN 2 UNAMED 8F32 MOVE 1 3 8FGL S12 SETNCORE 3,2,FILE,ADICT 8G2= CJOBLOCK 1 8GFW LDX 2 FPTR(2) 8G^G ADN 1 JUSER 8HF6 ADN 2 A1 8HYQ MOVE 1 3 8JDB MHUNTW 2,ADATA,CSTORE 8JY2 ADN 2 UCURRENT 8KCL MOVE 1 3 8KX= SETNCORE 3,2,FILE,ADICT 8LBW MHUNTW 1,ADATA,CSTORE 8LWG ADN 2 A1 8MB6 ADN 1 UNAMED 8MTQ MOVE 1 3 8N2Y ...S13 SETNCORE 10,2,FILE,FABSNB [LEAVE :MASTER'S FABSNB 8N86 ... ADN 2 A1 [FOR LATER SEGMENTS 8N*# ... ADN 1 NB 8NGG ... MOVE 1 10 8NMN ... UPPLUS 2 8NT2 S14 LDX 0 4 8P#L ANDX 0 MGCLASS(1) 8PS= BXU 0 MGTOR(1),QR6 8Q?W BRN S3 8QRG QR1 SMO FX1 8R?6 LDX 6 XJBUDTYPE 8RQQ BRN QRA 8S=B QR3 LDX 1 FX1 8SQ2 LDX 6 XJUSNA(1) 8T9L BRN QRA 8TP= QR4 SMO FX1 8W8W LDX 6 XJBUDCHAN 8WNG QRA SMO FX1 8X86 LDX 5 XJPARMIS 8XMQ QRA1 ERRORX 5,6 8Y7B BRN QR 8YM2 QR2 LDX 5 XJNOPAR(1) 8^6L BRN QRB 8^L= QR5 LDX 5 XJZPRIV(1) 925W BRN QRB 92KG QR6 LDX 5 XERB11(1) 9356 BRN QRB 9393 ...QR6A SMO FX1 93#Y ... LDX 5 XUSERF 93DT ... BRN QRB 93JQ QR7 CLOSETOP 944B LDX 5 XERB1(1) 94J2 QRB ERRORX 5 953L QR8 95H= QR9 962W QR TRACE 1,ERRR 96GG UPPLUS 1 9726 SBREAK UP 97FQ QR10 ERROR ERSYSCLUDG,FDIC 97^B BRN QR 98F2 # BUDGCON MACRO 98YL # THIS ROUTINE OPENS THE DICT.(READ),GETS THE BIT PATTERN FOR THE 99D= # CHAR. STRING IN THE FIRST CPB/CUNI BLOCK IN THE CHAIN, AND CLOSES 99XW # DICT. AGAIN . NOSUCH IF CHARS. IN ERROR. 9=CG QK12BUDGTWO 9=X6 MHUNT 3,CPB,CUNI 9?BQ LDX 0 ANUM(3) 9?WB BZE 0 U7A 9#B2 BNG 0 U7A 9#TL ANDN 0 #7777 [NO. OF CHARS. 9**= SBN 0 9 9*SW BPZ 0 U7A [MAX 8 CHS 9B#G LDX 4 APARA(3) 9BS6 LDX 5 APARA+1(3) 9C?Q ADN 0 4 9CRB BPZ 0 U1 9D?2 LDX 5 ACES [SPACES IN 2ND WD. IF <5 CHARS. 9DQL U1 9F== SETNCORE 10,3,FILE,FABSNB 9FPW LDN 2 NB(1) 9G9G ADN 3 A1 9GP6 MOVE 2 10 [FOR OPENING CICT 9H8Q OPEN U8,READ 9HNB TESTRPN2 OK,U8 9J82 MFREEW FILE,FABSNB 9JML STEP 9K7= #SKI K6BMACROS>99-99 9KLW ( 9L6G BNZ 3 U3 [THE FIRST RECORD SHOULD BE THE ONE 9LL6 U2 [WE WANT 9M5Q GEOERR 1,BUDGCON 9MKB U3 9N52 LDN 0 0 9NJL TXU 0 CUSER-A1(3) 9P4= TXU 0 CUSER+1-A1(3) 9PHW TXU 0 CUSER+2-A1(3) 9Q3G BCS U2 9QH6 ) 9R2Q LDX 0 IZCOUNT-A1(3) [NO. OF DESCRIPTION LINES 9RGB BZE 0 U5 9S22 U4 9SFL TXU 4 IZLIST+1-A1(3) 9S^= TXU 5 IZLIST+2-A1(3) 9TDW BCC U6 [J.IF CHARS. SAME 9TYG ADN 3 IZLINE 9WD6 BCT 0 U4 9WXQ U5 9XCB LDN 3 0 [NOT FOUND 9XX2 BRN U7 9YBL U6 9YW= LDX 3 IZLIST-A1(3) [BIT PATTERN 9^*W STO 3 ACOMMUNE1(2) 9^TG LDN 3 1 =2*6 U7 =2SQ CLOSETOP [DICTIONARY =3#B BZE 3 U7A [J IF GICT NOT FOUND =3S2 UPPLUS 1 =4?L U7A =4R= #SKI K6BMACROS>99-99 =5=W TRACE 4,BDGNOSUC =5QG UP =6=6 U8 =6PQ GEOERR 1,BUDGBRK =79B MENDAREA 50,K99BUDGTWO =7P2 #END ^^^^ ...76223126000600000000