{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: BEXTSJ84)}}
====== BEXTSJ84 ======
(George Source)
**Macros used:** [[george:macro:ALTLEND|ALTLEND]], [[george:macro:BC|BC]], [[george:macro:BUDGINCX|BUDGINCX]], [[george:macro:BUDGUSEN|BUDGUSEN]], [[george:macro:CAPCA|CAPCA]], [[george:macro:CHEKPRIV|CHEKPRIV]], [[george:macro:CLOSE|CLOSE]], [[george:macro:DICTJL|DICTJL]], [[george:macro:DICTJOB|DICTJOB]], [[george:macro:DICTWELL|DICTWELL]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETWORD|GETWORD]], [[george:macro:HUNTW|HUNTW]], [[george:macro:ILLEGAL|ILLEGAL]], [[george:macro:INSERT|INSERT]], [[george:macro:JBC|JBC]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[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:PHOTO|PHOTO]], [[george:macro:PICKREP|PICKREP]], [[george:macro:PROGBRKIN|PROGBRKIN]], [[george:macro:PUTREP2|PUTREP2]], [[george:macro:READ|READ]], [[george:macro:READDICT|READDICT]], [[george:macro:READDICU|READDICU]], [[george:macro:REPLACE|REPLACE]], [[george:macro:RUNPROG|RUNPROG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SWAPOUT|SWAPOUT]], [[george:macro:TESTMOVE|TESTMOVE]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTREPNOT|TESTREPNOT]], [[george:macro:TRACE|TRACE]], [[george:macro:WORDFIN|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