(George Source)
Macros used: ALTLEND, BC, BUDGINCX, BUDGUSEN, CAPCA, CHEKPRIV, CLOSE, DICTJL, DICTJOB, DICTWELL, ERRORX, FREECORE, GEOERR, GETWORD, HUNTW, ILLEGAL, INSERT, JBC, MENDAREA, MFREEW, MHUNTW, MONOUT, NAME, OPEN, OUTBLOCK, OUTNUM, OUTPARAM, PHOTO, PICKREP, PROGBRKIN, PUTREP2, READ, READDICT, READDICU, REPLACE, RUNPROG, SEGENTRY, SETNCORE, SETREP, SETUPCORE, SWAPOUT, TESTMOVE, TESTREP, TESTREP2, TESTREPNOT, TRACE, WORDFIN
22FL ...#SEG BEXTSJ [L. BASU 22^= #LIS K0BEXTSJ>K0ALLGEO>0 23DW ... 8HBEXTSJ 23YG SEGENTRY K1BEXTSJ,QK1BEXTSJ 24D6 SEGENTRY K2BEXTSJ,QK2BEXTSJ 24XQ # 25CB # THIS CHAPTER PROCESSES THE BUDGET EXTRACODES REQUIRED FOR 25X2 # THE SYSTEM JOURNAL AND MAY BEGISSUED BY ANY OBJECT PROGRAM 26BL # RUNNING UNDER THE USER :MANAGER. IF THE OBJECT PROGRAM ISSUING 26W= # THE EXTRACODE IS RUNNING UNDER ANY OTHER USER, THE REPLY WORD 27*W # WILL BE SET NEGATIVE AND THE EXTRACODE FLAGGED ILLEGAL 27TG # THESE ARE PERI TYPE 60 EXTRACODES 28*6 # MODE #76 READS A DICTIONARY UPDATE RECORD TO THE CONTROL AREA 28SQ # MODE #77 UPDATES THE DICTIONARY ENTRIES OF POSSIBLY SEVERAL 29#B # USERS AT ONCE 29S2 # BOTH EXTRACODES ARE OBEYED IN A PROGRAM CONTROL ACTIVITY ALTHOUGH 2=?L # MOST OF THE PROCESSING IS DONE IN THE COMMAND PROCESSING ACTIVITY 2=R= # THE SEGMENT SHOULD NORMALLY BE ENTERED FROM OPCA 2?=W # 2?QG # GENERAL DEFINITIONS 2#=6 #DEF ZRECLEN=13 2#PQ #DEF ZLENGTH=17 2*9B # DEFINITIONS FOR JBUDGET/JEXTRA 2*P2 #DEF ZTYPEM=A1 2B8L #DEF ZREPLY=ZTYPEM+1 2BN= #DEF ZRES=ZREPLY+1 2C7W #DEF ZPROGNAME=ZRES+1 2CMG #DEF ZTIME=ZPROGNAME+2 2D76 #DEF ZDATE=ZTIME+1 2DLQ #DEF ZPAIRNO=ZPROGNAME+ZRECLEN 2F6B # DEFINITIONS FOR 6 WORD ENTRIES 2FL2 #DEF ZUSER=0 2G5L #DEF ZBTYPE=3 2GK= #DEF ZBUPDAMT=5 2H4W # PRESET DATA FOR FILE/FABSNB 2HJG NAMED +10 2J46 12HMASTER 2JHQ 12HDICTIONARY 2K3B +1 2KH2 +1 2L2L 4HB1 2LG= # PRESET CHARACTERS FOR UPDATE RECORD 2L^W UPDPSD 8H*UPDATE 2MFG # PRESET CHARACTERS TO VERIFY JOB USER NAME 2M^6 # ERROR MESSAGES FOR MONITORINGFILE 2NDQ ...XERB7 +ERB7A 2NYB XERNO +ERNOUSER 2PD2 ZBUDG 8HBUDGEXT 2PXL # 2QC= # 2QWW # 2RBG QK1BEXTSJ 2RW6 CHEKPRIV JOB,ZBUDG(1),RII,NOTOPEN 2S*Q QK2BEXTSJ 2STB LDX 3 EVENT2(2) [PICK UP ADDRESS OF CONTROL AREA 2T*2 # [RELATIVE TO OBJECT PROGRAM IN X3 2TSL N1 STO 3 AWORK1(2) [REMEMBER ADDRESS OF CONTROL AREA 2W#= CAPCA [CHANGE ACTIVITY FROM MCA TO PCA 2WRW # SET UP JBUDGET/JEXTRA TO HOLD THE CONTROL AREA 2X?G SETNCORE ZLENGTH,1,JBUDGET,JEXTRA 2XR6 LDN 7 A1 2Y=Q LDX 4 AWORK1(2) [PICK A(CONTROL AREA) REL TO OBJ PRO 2YQB LDN 5 ZLENGTH [PICK UP LENGTH OF CONTROL AREA 2^=2 LDN 3 0 2^PL N2 CALL 6 SRGWR [USE SUBROUTINE TO FIND OUT HOW MANY 329= # [WORDS ARE GRANTED BY GETWORD READ 32NW TESTREPNOT OK,R20 [J TO ILLEGAL ERROR ROUTINE IF NOT 338G MHUNTW 1,JBUDGET,JEXTRA [RE-HUNT JBUDGET/JEXTRA 33N6 N3 ADX 1 7 [MOVE ACCESSABLE PART OF CONTROL 347Q LDX 0 ACOMMUNE4(2) 34MB MOVE 0 0(3) 3572 TXU 5 3 35LL BCS N2 366= WORDFIN [TERMINATE GETWORD SEQUENCE 36KW [ [I E FREE DATA BLOCKS 375G MHUNTW 3,JBUDGET,JEXTRA [RE HUNT JBUDGET/JEXTRA 37K6 LDX 4 BSP16 [PICK UP #77777 384Q ANDX 4 ZTYPEM(3) [ISOLATE MODE 38JB SBN 4 #76 3942 BZE 4 RO1 [J IF READ I.E. MODE #76 EXTRACODE 39HL SBN 4 1 [IF MODE MODE 3=3= BNZ 4 RIM [NOT RECOGNIZE J TO ILL.ER ROUTINE 3=GW LDX 6 ZPAIRNO(3) [REMEMBER 3?2G LDN 7 256 3?G6 TXL 6 7 3?^Q BCS N32 3#FB FREECORE 3 3#^2 BRN RIC 3*DL N32 3*Y= STO 6 AWORK4(2) [NUMBER OF WORD PAIRS IN AWORK4 3BCW BNZ 6 N35 [J TO CALC. NO. OF WORD PAIRS REQD. 3BXG LDCT 7 #400 [INDICATE MODE#77 & NO WORD PAIRS 3CC6 BRN RMO 3CWQ N35 LDX 5 6 [CALCULATE NO. OF WORDS REQUIRED 3DBB ADX 5 5 [TO HOLD WORD PAIRS 3DW2 SWAPOUT [SWAPOUT OBJECT PROGRAM 3F*L SETUPCORE 5,6,ADATA,BUDGCAWP [SET UP BLOCK FOR C.A. WORD PAIRS 3FT= LDX 4 AWORK1(2) [ALIGN POINTER 3G#W ADN 4 ZLENGTH [AT FIRST WORD PAIR 3GSG LDN 7 A1 3H#6 LDN 3 0 3HRQ N4 CALL 6 SRGWR [FIND OUT NO. OF WDS READ ACCESSIBLE 3J?B TESTREPNOT OK,R15 3JR2 MHUNTW 1,ADATA,BUDGCAWP 3K=L N5 ADX 1 7 3KQ= LDX 0 ACOMMUNE4(2) 3L9W MOVE 0 0(3) 3LPG TXU 5 3 3M96 BCS N4 3MNQ # ROUTINE TO CALCULATEGCUMULATIVE SIZE OF DATA AREAS 3N8B # AND CHECK FOR OVERLAPPING DATA AREAS 3NN2 SBX 1 7 [RE-ALIGN POINTER AT START OF 3P7L # ADATA BUDGCAWP 3PM= LDX 3 ALOGLEN(1) 3Q6W ADN 3 17 3QLG STO 3 ACOMMUNE4(2) [REMEMBER SIZE OF CONTROL AREA 3R66 # +WORD PAIRS 3RKQ LDX 5 AWORK4(2) [SET COUNT OF WORD PAIRS 3S5B ADN 1 A1 3SK2 LDX 3 1 3T4L STO 1 AWORK2(2) 3TJ= LDX 7 0(1) 3W3W SBN 5 1 3WHG RC1 3WMC ... LDX 0 0(3) [CHECK DATA 3WPQ ... BZE 0 RIC 3WS5 ...RC1A SBN 0 6 [AREA SIZE 3WWD ... BNG 0 RIC 3WYR ... BNZ 0 RC1A [IS 6 WORDS 3X36 LDX 4 1(3) [SET X4=AI 3XGQ # CHECK DATA AREA DOES NOT OVERLAP WITH CONTROL AREA 3Y2B LDX 6 AWORK1(2) [PICK UP CONTROL AREA ADDRESS 3YG2 TXL 4 6 3Y^L BCS RCA1 3^F= TXU 4 6 3^YW BCC R15 42DG ADX 6 ACOMMUNE4(2) 42Y6 TXL 4 6 43CQ BCS R15 43XB BRN RCA2 44C2 RCA1 44WL SBX 6 0(3) 45B= TXL 6 4 45TW BCS R15 46*G RCA2 46T6 BZE 5 RMDT 47#Q TXU 1 3 47SB BCS RC2 [J IF NOT FIRST WORD PAIR 48#2 ADN 3 2 48RL BRN RC1 49?= RC2 49QW LDX 6 1(1) [SET X6=AR 4==G TXL 4 6 [ AI < AR ? 4=Q6 BCS RC3 [J IF AI < AR 4?9Q TXU 4 6 [ AI = AR ? 4?PB BCC R15 4#92 ADX 6 0(1) [SET X6 = AR +.XR 4#NL TXL 4 6 [ AI < AR + XR 4*8= BCS R15 4*MW BRN RC4 [J TO UPDATE SECOND MODIFIER - (R) 4B7G RC3 SBX 6 0(3) [SET X6 = AR - XI 4BM6 TXL 6 4 [ AR < AI + XI ? 4C6Q BCS R15 [J TO OVERLAPPING DATA AREAS E.R. 4CLB RC4 ADN 1 2 [UPDATE SECOND MODIFIER (R) 4D62 TXU 1 3 4DKL BCS RC2 4F5= # [WORD PAIRS CHECKED AGAINST 4FJW #SKIP K6BEXTSJ>599-599 4G4G ( 4GJ6 TRACE 7,BEXTDS 4H3Q ) 4HHB ADX 7 0(3) [UPDATE TOT NO. OF WDS IN DATA AREAS 4J32 ADN 3 2 [UPDATE FIRST MODIFIER 4JGL LDX 1 AWORK2(2) 4K2= BCT 5 RC1 [LOOP TILL ALL WORD PAIRS VERIFIED 4KFW # ROUTINE TO MOVE ALL THE DATA SPECIFIED BY THE WORD PAIRS 4K^G # INTO AN ADATA/BUDGDBLB BLOCK USING THE GETWORD SYSTEM 4LF6 RMDT 4LYQ LDX 5 BIT11 4MDB TXL 5 7 4MY2 BCC RMD [J IF CUMULATIVE SIZE OF DATA AREAS 4NCL # < 4095 WDS 4NX= MFREEW JBUDGET,JEXTRA 4PBW MFREEW ADATA,BUDGCAWP 4PWG WORDFIN 4QB6 BRN RII 4QTQ RMD 4R*B SETUPCORE 7,5,ADATA,BUDGDBLB [SET UP AN ADATA/BUDGDBLB BLOCK 4RT2 LDN 1 A1 4S#L LDN 7 A1 4SS= STO 1 AWORK2(2) 4T?W LDX 5 AWORK4(2) 4TRG LDN 3 0 4W?6 RMD1 4WQQ MHUNTW 1,ADATA,BUDGCAWP 4X=B ADX 1 AWORK2(2) 4XQ2 LDX 4 1(1) 4Y9L ... STO 5 AWORK4(2) 4YP= LDX 5 0(1) 4^8W RMD2 4^NG CALL 6 SRGWR 5286 TESTREPNOT OK,R10 52MQ MHUNTW 1,ADATA,BUDGDBLB 537B ADX 1 7 53M2 LDX 0 ACOMMUNE4(2) 546L STO 3 AWORK3(2) 54L= BZE 3 RMD3 555W RMD22 55KG LDN 6 512 5656 ... TXL 6 3 56JQ ... BCC RMD25 574B MOVE 0 0 57J2 ADN 1 512 583L ADN 0 512 58H= SBN 3 512 592W BRN RMD22 59GG RMD25 5=26 MOVE 0 0(3) 5=FQ LDX 3 AWORK3(2) 5=^B TXU 5 3 5?F2 BCS RMD2 [J IF NOT ALL WDS ACCESSED BY GETWD 5?YL RMD3 5#D= LDN 1 2 5#XW ADX 7 3 5*CG LDN 3 0 5*X6 ADS 1 AWORK2(2) 5BBQ ... LDX 5 AWORK4(2) 5BWB BCT 5 RMD1 [LOOP TO FETCH DATA AREAS 5CB2 # UNTIL ALL ARE EXHAUSTED 5CTL # DICTIONARY 5C^H ... MHUNTW 1,JBUDGET,JEXTRA 5D5D ... LDX 7 ZPAIRNO(1) [RE-SET AWORK4 TO CONTAIN COUNT 5D9* ... STO 7 AWORK4(2) [OF WORD PAIRS 5D*= MFREEW ADATA,BUDGCAWP [FREE BLOCK CONTAINING WORD PAIRS 5DSW WORDFIN [TERMINATE GETWORD SEQUENCE 5F#G # [I.E. FREE ANY BLOCKS SET UP 5FS6 #SKI K6BEXTSJ>599-599 5G?Q ( 5GRB TRACE 7,TR1 [TRACE POINTER IN ADATA/BUDGDBLB 5H?2 TRACE 6,TR2 5HQL ) 5J== BRN RMO 5JPW RO1 LDN 7 0 [SET MODE #76 INDICATOR IN X7 5K9G LDX 4 ZPROGNAME(3) 5KP6 BNZ 4 RMO 5L8Q FREECORE 3 5LNB BRN RII 5M82 RMO 5MML SETNCORE 10,3,FILE,FABSNB [SET UP FILE/FABSNB TO OPEN 5N7= # DICTIONARY 5NLW ADN 3 A1 5P6G LDN 2 NAMED(1) 5PL6 MOVE 2 10 5Q5Q PHOTO 6 5QKB OPEN RFF,GENERAL,CAREFUL [IN GENERAL,CAREFUL MODE 5R52 TESTREPNOT OK,RS [J IF REPLY NOT OK TO ERROR ROUTINE 5RJL TESTMOVE 6,MFO15 5S4= MHUNTW 3,FILE,FABSNB [RE-HUNT FILE/FABSNB IF NECESSARY 5SHW ADN 3 A1 5T3G MFO15 5TH6 SBN 3 A1 5W2Q FREECORE 3 [FREE FILE/FABSNB 5WGB BZE 7 MFO18 [J IF MODE #76 EXTRACODE PROCESSED 5X22 BNG 7 MFO18 5XFL READ [READ 1ST RECORD IN DICTIONARY 5X^= MHUNTW 3,FILE,FRB [GET POINTER TO FILE/FRB IMPLICITLY 5YDW # [SET UP BY READ MACRO 5YYG NAME 3,JBUDGET,JSTORE [RENAME UPDATE RECORD JBUDGET/JSTORE 5^D6 MFO18 MHUNTW 3,JBUDGET,JEXTRA 5^XQ LDX 6 ZPROGNAME(3) 62CB BZE 6 UPD2 62X2 MFO20 63BL READDICU ,6 [TRY AND LOCATE UPDATE RECORD IF 63W= # IT EXISTS 64*W TESTREPNOT OK,UPD1 [J IF NOT RECORD FOUND 64TG MHUNTW 3,FILE,ADICTENT [GET POINTER TO UPDATE RECORD IN X3 65*6 BZE 7 UPDIA [J IF MODE #76 65SQ NAME 3,FILE,FWB 66#B LDX 5 ALOGLEN(3) 66S2 ERN 5 ZRECLEN+4 67?L BZE 5 UP1 [J IF BLOCK LENGTH AS REQUIRED 67R= ALTLEND 3,ZRECLEN+4,FILE,FWB [ALTER SIZE AND 68=W MHUNTW 3,FILE,FWB [RELOCATE POINTER TO FILE/FWB 68QG UP1 CALL 4 SRMPD [MOVE IN RECORD FROM JBUDGET/JEXTRA 69=6 PHOTO 4 69PQ REPLACE [RE-WRITE DICTIONARY ENTRY 6=9B BRN UPCK1 [J TO CHECK REPLY 6=P2 UPD1 BZE 7 UPDIB [J IF MODE #76 EXTRACODE PROCESSED 6?8L SETNCORE ZRECLEN+4,3,FILE,FWB [SET UP A FILE/FWB BLOCK 6?N= CALL 4 SRMPD 6#7W # FOR RECORD 6#MG PHOTO 4 6*76 INSERT [INSERT NEW RECORD IN DICTIONARY 6*LQ UPCK1 TESTREP FILEFULL,RFF [J TO GEOERR IF FILEFULL 6B6B TESTMOVE 4,UPCK2 6BL2 MHUNTW 3,FILE,FWB [RE-HUNT FILE/FWB IF NECESSARY 6C5L ADN 3 A1+4 6CK= UPCK2 6D4W SBN 3 A1+4 [RE-ALIGN POINTER AT BLOCK BEGINNING 6DJG FREECORE 3 [FREE FILE/FWB 6F46 UPD2 SMO FX2 6FHQ LDX 4 AWORK4 6G3B BZE 4 TUPD1 [J IF NO WORK PAIRS & MODE #77 6GH2 MHUNTW 2,ADATA,BUDGDBLB [RE-HUNT ADATA/BUDGDBLB 6H2L LDX 4 ALOGLEN(2) 6HG= LDN 5 6 6H^W LDN 3 0 6JFG DVS 3 5 [SET X4=NO. OF 6 WORD ENTRIES 6J^6 LDX 2 FX2 6KDQ LDN 3 A1 6KYB STO 3 AWORK3(2) [SET POINTER IN ADATA/BUDGDBLB 6LD2 VBT1 SMO FX2 6LXL STO 4 AWORK4 [REMEMBER COUNT IN AWORK4 6MC= # ROUTINE TO VERIFY 6 WORD ENTRY 6MWW MHUNTW 2,ADATA,BUDGDBLB [RE-LOCATE ADATA/BUDGDBLB 6NBG SMO FX2 6NW6 ADX 2 AWORK3 [ALIGN POINTER AT CORRECT 6 WD ENTRY 6P*Q LDX 5 ZBTYPE(2) [PICK UP BUDGET TYPE OF NXT 6WD ENT 6PTB BNG 5 VBT2 [J IF STANDARD BUDGET ENTRY 6Q*2 TXU 5 ZBTYPE+1(2) 6QSL BCS ROIF [J IF 6 WORD ENTRY NOT RECOGNIZED 6R#= SBN 5 1 6RRW BZE 5 VBT5 [J TO CHECK IF FILE/ADICTENT EXISTS 6S?G ROIF MHUNTW 2,JBUDGET,JEXTRA [RE-HUNT JBUDGET/JEXTRA 6SR6 ROIF1 LDCT 5 #400 6T=Q STO 5 ZREPLY(2) 6TQB BRN TUPC 6W=2 # CHECK IF BUDGET AMONG PERMITTED TYPES IN JBUDGET/JSTORE 6WPL VBT2 MHUNTW 3,JBUDGET,JSTORE 6X9= LDX 0 IZCOUNT(3) [SET COUNT OF PERMITTED BUDGET TYPES 6XNW LDX 5 3(2) [PICK UP 6 WORD ENTRY BUDGET TYPE 6Y8G LDX 6 4(2) 6YN6 VBT3 6^7Q TXU 5 IZCOUNT+3(3) [COMPARE BUDGET TYPE WITH NEXT 6^MB TXU 6 IZCOUNT+4(3) [PERMITTED TYPE IN JBUDGET/JSTORE 7272 BCC VBT4 72LL ADN 3 IZLINE [UPDATE POINTER IN JBUDGET/JSTORE 736= BCT 0 VBT3 [LOOP TILL ALL BUDGET TYPES CHECKED 73KW BRN ROIF [J IF INVALID BUDGET TYPE 745G VBT4 74K6 LDX 6 IZCOUNT+2(3) 754Q SMO FX2 75JB STO 6 AWORK2 [AND IN AWORK2 7642 VBT5 76HL HUNTW 3,FILE,ADICTENT 773= BNG 3 SUFAD [J IF FILE/ADICTENT DOES NOT EXIST 77GW LDX 4 CUSER(3) 782G LDX 5 CUSER+1(3) [CHECK IF FILE/ADICTENT BLOCK 78G6 LDX 7 CUSER+2(3) 78^Q TXU 4 ZUSER(2) 79FB TXU 5 ZUSER+1(2) [ALREADY SET UP FOR USER 79^2 TXU 7 ZUSER+2(2) 7=DL BCS VBT6 7=GJ ... LDX 0 CPSEU(3) 7=JG ... BPZ 0 VBT5A 7=LD ... SETREP PSEUDO 7=NB ... LDX 2 FX2 7=Q# ... LDX 1 FX1 7=S= ... BRN RERU 7=W8 ...VBT5A 7=Y= LDX 4 ZBTYPE(2) 7?CW BNG 4 PBAL [J TO UPDATE BUDGET USING EXISTING 7?XG # FILE/ADICTENT BLOCK 7#C6 VBT6 CALL 4 RP [REPLACE UPDATE RECORD 7#WQ SUFAD 7*BB SETNCORE 3,3,FILE,ADICT 7*W2 MHUNTW 2,ADATA,BUDGDBLB [RE-HUNT DATA AREAS IF NECESSARY 7B*L SMO FX2 7BT= ADX 2 AWORK3 [RESET POINTER IN ADATA/BUDGDBLB 7C#W SUFAD1 7CSG ADN 3 A1 7D#6 MOVE 2 3 [MOVE IN USER NAME TO FILE/ADICT BLK 7DRQ LDX 4 3(2) [WAS B0 SET IN WORD 3? 7F?B BNG 4 SEAR1 [J IF STANDARD 6 WORD BUDGET ENTRY 7FR2 DICTJOB 5,ZBUPDAMT(2) 7G=L TESTREP2 OK,TUPC,NOTENUF,ROIF,NOUSER,RERU,UNJOB,RERU 7GQ= BRN TUPC 7H9W SEAR1 READDICT 7HPG TESTREPNOT OK,RERU 7J96 MHUNTW 3,FILE,ADICTENT [RE-HUNT FILE/ADICTENT BLOCK 7JNQ LDX 4 CPSEU(3) 7K8B BNG 4 RERU [J TO E.R. FOR INVALID USER 7KN2 PBAL1 7L7L MHUNTW 2,ADATA,BUDGDBLB [RE-HUNT ADATA/BUDGDBLB IF NECESSARY 7LM= SMO FX2 7M6W ADX 2 AWORK3 [RESET POINTER WITHIN BLOCK 7MLG PBAL 7N66 SMO FX2 7NKQ LDX 7 AWORK2 7P5B LDX 5 ZBUPDAMT(2) [PICK UP AMOUNT FOR UPDATING 7PK2 BUDGINCX 7,5 7Q4L TESTREP ODRAWN,ROD 7QJ= TUPC SMO FX2 7R3W LDX 4 AWORK4 7RHG LDN 5 6 7S36 SMO FX2 7SGQ ADS 5 AWORK3 7T2B BCT 4 VBT1 [LOOP UNTIL ALL ENTRIES UPDATED 7TG2 HUNTW 3,FILE,ADICTENT 7T^L BNG 3 TUP2 7WF= TUP1 CALL 4 RP [REPLACE RECORD IN DICTIONARY 7WYW TUP2 7XDG MFREEW ADATA,BUDGDBLB [FREE DATA AREAS 7XY6 MFREEW JBUDGET,JSTORE [FREE BUDGET DESCRIPTION LIST 7YCQ TUPD1 LDN 5 0 [SET X5=0 TO INDICATE ONLY REP WD 7YXB TCL CLOSE [CLOSE THE MASTER DICTIONARY 7^4J ...#UNSET FTS1 7^9Q ... DICTJL [UPDATE JOBLIST FILES 7^C2 LDX 4 AWORK1(2) [GET ADDRESS OF CONTROL AREA 7^WL ADN 4 ZREPLY-A1 82B= ... GETWORD 4,2,WRITE,,,XGWBRKIN 82TW TESTREPNOT OK,R20 83*G MHUNTW 3,JBUDGET,JEXTRA 83T6 LDX 7 ZREPLY(3) 84#Q STO 7 0(2) 84SB BZE 5 WFN 85#2 ADN 3 2 85RL ADN 4 3 86?= LDN 6 ZRECLEN-1 86QW LDN 5 0 87=G LDN 7 A1+4 87Q6 WRU1 ADX 7 5 [UPDATE POINTER WITHIN JBUDGET/JEXTR 87^Y ... ADX 4 5 [UPDATE POINTER TO AREA TO BE ACCSD 889Q ... GETWORD 4,2,WRITE,5,6,XGWBRKIN 88PB TESTREPNOT OK,R20 8992 TXL 6 5 89NL BCC WRU2 8=8= LDX 5 6 8=MW WRU2 8?7G SBX 6 5 8?M6 MHUNTW 1,JBUDGET,JEXTRA 8#6Q ADX 1 7 [RESET POINTER WITHIN JBUDGET/JEXTRA 8#LB SMO 5 8*62 MOVE 1 0 8*KL BNZ 6 WRU1 8B5= SBX 1 7 8BJW LDX 3 1 [RESET X3 TO BEGINNING OF BLOCK 8C4G WFN 8CJ6 PHOTO 4 8D3Q WORDFIN [TERMINATE GETWORD (WRITE) SEQUENCES 8DHB TESTMOVE 4,WFN1 8F32 MHUNTW 3,JBUDGET,JEXTRA 8FGL WFN1 FREECORE 3 8G2= RUNPROG [RESTART OBJECT PROGRAM 8GFW # END OF MAIN PROGRAM 8G^G #PAGE 8HF6 # SUBROUTINES 8HYQ UPDIA MHUNTW 2,JBUDGET,JEXTRA 8JDB STOZ ZPAIRNO(2) 8JY2 STOZ ZREPLY(2) 8KCL ADN 2 ZPROGNAME 8KX= LDX 4 2 8LBW ADN 3 CUSER+2 [SKIP OVER *UPDATE 8LWG MOVE 3 ZRECLEN [MOVE RECORD INTO JBUDGET/JEXTRA 8MB6 MFREEW FILE,ADICTENT 8MTQ LDN 5 1 [SET INDICATOR 8N*B # RECORD TO BE WRITTENPTO CONTROL AREA 8NT2 BRN TCL 8P#L UPDIB MHUNTW 3,JBUDGET,JEXTRA 8PS= LDCT 4 #400 8Q?W ADN 4 1 8QRG STO 4 ZREPLY(3) [SET REPLY WD NEGATIVE 8R?6 LDN 5 0 [REPLY WD ONLY TO BE WRITTEN 8RQQ BRN TUPD1 8S=B # SUBROUTINE TO DO GETWORD READS 8SQ2 SRGWR SBX 6 FX1 8T9L ADX 7 3 8TP= SBX 5 3 [SUBTRACT NO. ALREADY ACCESSED 8W8W ... GETWORD 4,0,READ,3,5,XGWBRKIN 8WNG STO 0 ACOMMUNE4(2) 8X86 ADX 4 3 8XMQ TXL 3 5 8Y7B BCS SGWR1 8YM2 LDX 3 5 8^6L SGWR1 8^L= ADX 6 FX1 [REDATUMISE LINK 925W EXIT 6 0 92KG # SUBROUTINE TO COPY BUDGET UPDATE RECORD FROM JBUDGET/JEXTRA 9356 # INTO FILE/FWB BLOCK 93JQ SRMPD MHUNTW 2,JBUDGET,JEXTRA 944B LDN 6 ZRECLEN+4 94J2 STO 6 A1(3) 953L LDX 6 UPDPSD(1) [MOVE IN PRESET CHARACTERS TO 95H= LDX 5 UPDPSD+1(1) [UPDATE RECORD 962W STO 6 CUSER(3) 96GG STO 5 CUSER+1(3) 9726 LDN 5 2 97FQ STO 5 CNEWZ(3) 97^B LDX 5 EDATE 98F2 STO 5 ZDATE(2) 98YL LDX 5 CLEANCT 99D= LDN 6 1000 99XW MPY 5 6 9=CG LDN 7 K9 9=X6 DVR 5 7 9?BQ STO 6 ZTIME(2) 9?WB ADN 3 CUSER+2 9#B2 ADN 2 ZPROGNAME 9#TL MOVE 2 ZRECLEN [MOVE IN UPDATE RECORD 9**= EXIT 4 0 9*SW # 9B#G # SUBROUTINE TO REPLACE BUDGET UPDATE RECORD IN DICTIONARY 9BS6 # 9C?Q RP SBX 4 FX1 9CRB MHUNTW 3,FILE,ADICTENT 9CSC ...#SKI JWPHASE2 9CTD ...( 9CWF ... JBC RPNCH,3,BMONCS 9CXG ... BC 3,BMONCS 9CYH ... BUDGUSEN GMONEY 9C^J ... MHUNTW 3,JBUDGET,JBUDGUSER 9D2K ... MHUNTW 2,FILE,ADICTENT 9D3L ... LDX 7 JALLOWED(3) 9D4M ... SBX 7 JCONSUMED(3) 9D5N ... DICTWELL CUSER(2),MONEY,7 9D6P ... MFREEW JBUDGET,JBUDGUSER 9D7Q ... MHUNTW 3,FILE,ADICTENT 9D8R ...RPNCH 9D9S ...) 9D?2 NAME 3,FILE,FWB 9DQL PHOTO 7 9F== REPLACE [REPLACE THE UPDATE RECORD 9FPW TESTREP FILEFULL,RFF 9G9G TESTMOVE 7,RP1 9GP6 MHUNTW 3,FILE,FWB [RE-HUNT FILE/FWB IF NECESSARY 9H8Q RP1 FREECORE 3 [FREE FILE/FWB 9HNB ADX 4 FX1 [REDATUMISE CHAPTER LINK 9J82 EXIT 4 0 9JML #PAGE 9K7= # ERROR ROUTINES 9KLW # ILLEGAL ERROR ROUTINES 9L6G # A UNSUCCESSFUL GETWORDFREAD ERROR ROUTINE 9LL6 # B ERROR ROUTINE FOR OVERLAPPING DATA AREAS 9M5Q R10 MFREEW ADATA,BUDGDBLB 9MKB R15 MFREEW ADATA,BUDGCAWP 9N52 R20 MFREEW JBUDGET,JEXTRA 9NJL PICKREP 7 9P4= WORDFIN 9PHW PUTREP2 7 9Q3G TESTREP NOCORE,RGNC 9QH6 TESTREP RESVIOL,RVIO 9R2Q ILLEGAL OVERLAP 9RGB RGNC GEOERR 0,NOCORE 9S22 RVIO ILLEGAL RESVIOL 9SFL # C ERROR ROUTINE FOR UNRECOGNIZED MODE 9S^= RIM MFREEW JBUDGET,JEXTRA 9TDW ILLEGAL MNOTREC 9TYG RII 9WD6 ILLEGAL 9WXQ RIC 9XCB ILLEGAL COUNT 9XX2 # GEOERRS WHEN OPENING DICTIONARY 9YBL RFF GEOERR 0,FILEFULL 9YW= RS GEOERR 0,BUDGBRK 9^*W RERU [ERROR IN USER NAME 9^TG SETNCORE 8,4,ADATA,CSTORE =2*6 ADN 4 A1 =2SQ MHUNTW 3,ADATA,BUDGDBLB =3#B ADX 3 AWORK3(2) [POINTER TO USER NAME =3S2 MOVE 3 3 =4?L LDX 6 XERNO(1) =4R= TESTREP2 NOUSER,RERU1 =5=W LDX 6 XERB7(1) =6=6 LDN 5 12 =6PQ OUTPARAM 5,A1,ADATA,CSTORE =79B ...RERU1 ERRORX 6 =7P2 MHUNTW 2,JBUDGET,JEXTRA =88L LDCT 5 #400 =8N= STO 5 ZREPLY(2) =97W BRN ROD1 =9MG ROD [E. R. FOR OVERDRAWN BUDGET ==76 # ==LQ SETNCORE 5,4,ADATA,CSTORE =?6B LDX 7 ACOMMUNE3(2) =?L2 MHUNTW 3,ADATA,BUDGDBLB =#5L ADX 3 AWORK3(2) [RE-ALIGN POINTER AT CORRECT 6 WORDS =#K= ADN 4 A1 =*4W MOVE 3 5 [MOVE IN USER NAME AND BUDGET TYPE =*JG LDN 5 9 =B46 OUTBLOCK 5 =BHQ LDN 5 12 =C3B OUTPARAM 5,A1,ADATA,CSTORE [SET UP USER NAME PARAMETER =CH2 LDN 5 8 =D2L OUTPARAM 5,A1+3,ADATA,CSTORE [SET UP BUDGET TYPE PARAMETER =DG= NGX 7 7 =D^W OUTNUM 7,0 [SET UP OVERDRAWN AMOUNT PARAMETER. =FFG MONOUT ERBOK5 [OUTPUT OVERDRAWN BUDGET MESSAGE =F^6 ROD1 =GDQ MFREEW ADATA,CSTORE =GYB BRN TUPC [J TO CHECK IF ANY MORE 6 WD ENTRIES =H4? ...XGWBRKIN =H88 ... WORDFIN =H#5 ... PROGBRKIN =HD2 MENDAREA 1023-0?,K99BEXTSJ =HXL #END ^^^^ ...57073627000500000000