(George Source)
Macros used: ACROSS, BXE, CLOSE, DICTJL, DICTWELL, ENDCOM, FREECORE, GEOERR, HUNT, MENDAREA, MHUNTW, MONOUT, NAME, OFFPRIV, ONPRIV, READAGAIN, READDICT, REWIND, REWRITE, SEGENTRY, SETNCORE, SKIP, STEP, TESTPRIV, TESTREP2, TRACE, VFREE, WKPFIND, WKPTABLE, WRONG
22FL #LIS K0BUDGET>K0PRIVLEG>K0BUDGES>K0COMMAND>K0ALLGEO 22^= ...#SEG PRIVLEG83 [M.B.KINGHAM 23DW ... 8HPRIVLEG8 23YG SEGENTRY K1PRIVLEG,QK1PRIVLEG 24D6 SEGENTRY K2PRIVLEG,QK2PRIVLEG 24XQ # 25CB # 1 THIS CHAPTER IS ENTERED ONLY BY THE BUDGET CHAPTER 25X2 # 1 WHEN THE SPECIFIED BUDGET IN THE BUDGET COMMAND IS A PRIVELEGE 26BL # 26W= # IF THE NAMED USER IS NOT THE IMMEDIATE INFERIOR OF THE PROPER USER 27*W # A CHECK IS MADE THAT HE IS AN INFERIOR OF THE PROPER USER 27TG # AND THE NECESSARY CHANGES ARE MADE 28*6 # IF THE PRIVILEGE IS BEING RESCINDED,THE ROUTINE SEARCHES 28SQ # THE DICTIONARY AND RESCINDS IT IN ALL THE ENTRIES FOR 29#B # INFERIORS OF THE NAMED USER. 29S2 #SKI K6BUDGET>20-20 2=?L XUP 8H*UPDATE 2=R= XERB4 +ERB4 2?=W XERB25 +ERB25 [YOU MAY CHANGE PRIVILEGES OF ONLY YOUR 2?QG [IMMEDIATE INFERIORS 2#=6 MASTER 12HMASTER 2#FY ...WKPT WKPTABLE [TABLE OF WELL KNOWN PRIVILEGES 2#PQ # DEFINITIONS FOR THE ADATA,CSTORE BLOCK 2*9B #DEF UNAMED=A1 [USERNAME OF NAMED USER 2*P2 #DEF UCURRENT=UNAMED+3 [USERNAME OF CURRENT PROPER USER 2B8L #DEF UTYPE=UCURRENT+3 [BIT PATTERN OF BUDGET TYPE 2BN= #DEF UCHANGE=UTYPE+1 [CHANGE AMOUNT 2C7W # IF THE CURRENT PROPER USER IS NOT THE IMMEDIATE SUPERIOR OF THE 2CMG # NAMED USER, MUST SEARCH THE DICTIONARY (IN ORDER TO MAKE SURE THAT 2D76 # HE IS A SUPERIOR OF THE N. U. ). 2D8# ...[ 2D9G ...[ ROUTINE TO SET UP PARAMETER %C OF THE DICTWELL MACRO 2D?W ...WPF MHUNTW 3,JBUDGET,JLINE 2DB= ... WKPFIND JCHARS(3),WKPT(1),7,NWK [BIT SET IN X7 IF PRIV WELL KN 2DFS ... EXIT 4 1 2DJ? ...NWK EXIT 4 0 2DLQ QK1PRIVLEG 2F6B P1 SETNCORE 3,3,FILE,ADICT 2FL2 STO 4 A1(3) 2G5L STO 5 A1+1(3) 2GK= STO 6 A1+2(3) [READ THIS USER'S SUPERIOR'S DICTIONARY 2H4W READDICT [ENTRY.(READDICT FREES THE FILE,ADICT) 2HJG HUNT 3,FILE,ADICTENT 2J46 LDX 4 CSUPUSER(3) 2JHQ LDX 5 CSUPUSER+1(3) 2K3B LDX 6 CSUPUSER+2(3) 2KH2 #SKI K6BUDGET>9999-9999 2L2L TRACE 4,PRIVP2 2LG= FREECORE 3 2L^W HUNT 2,FILE,ADICT 2MFG TXU 4 A1(2) [IS THIS USER'S SUPERIOR THE CURRENT 2M^6 TXU 5 A1+1(2) [PROPER USER? 2NDQ TXU 6 A1+2(2) 2NYB BCC P2 2PD2 TXU 4 MASTER(1) [IF NOT, IS HE "MASTER" ? 2PXL TXU 5 MASTER+1(1) 2QC= TXU 6 MASTER+2(1) 2QWW BCS P1 2RBG # IF SO,THE SEARCH IS OVER,AND THE 2RW6 LDX 6 XERB25(1) [CURRENT USER MAY NOT INTERFERE WITH 2S*Q BRN WRONG [THE PRIVILEGES OF THE NAMED USER 2STB QK2PRIVLEG 2T*2 P2 READDICT [READ CURRENT USER'S DICTIONARY ENTRY 2TSL HUNT 2,ADATA,CSTORE 2W#= LDX 5 UTYPE(2) 2WRW LDX 4 UCHANGE(2) 2X?G HUNT 3,FILE,ADICTENT 2XR6 LDX 6 XERB4(1) 2Y=Q TESTPRIV 5,3 [ERROR IF CURRENT PROPER USER 2YQB BZE 0 WRONG [DOES NOT HOLD THIS PRIVILEGE 2^=2 FREECORE 3 2^PL HUNT 3,FILE,ADICTENT [IF CHANGE IS POSITIVE, 2^^D ... LDX 2 FX2 329= BZE 4 P20 32NW ONPRIV 5,3 [TURN ON APPROPRIATE PRIVILEGE BIT 32WH ...#SKI K6BUDGET>9999-9999 3348 ... TRACE CPRIV(3),ONPRIV 339T ... STO 5 AWORK1(2) 33CG ... CALL 4 WPF [SET UP %C OF DICTWELL 33K7 ... BRN NK1 [J IF PRIVILEGE NOT WELL KNOWN 33QS ... MHUNTW 3,FILE,ADICTENT 33YF ... DICTWELL CUSER(3),PRIV,7,ON [UPDATE JOBLIST ETC 3466 ...NK1 34?R ... MHUNTW 3,FILE,ADICTENT 34FD ... NAME 3,FILE,FWB 34MB READDICT 3572 REWRITE [AND WRITE ENTRY BACK TO DICTIONARY 35LL BRN P3 366= P20 OFFPRIV 5,3 [RESCIND PRIVILEGE 3688 ... STO 5 AWORK1(2) 36=6 ... CALL 4 WPF [SET UP %C OF DICTWELL 36#4 ... BRN NK2 [J IF PRIVILEGE NOT WELL KNOWN 36B2 ... MHUNTW 3,FILE,ADICTENT 36CY ... DICTWELL CUSER(3),PRIV,7,OFF [UPDATE JOBLIST ETC 36FW ...NK2 36HS ... MHUNTW 3,FILE,ADICTENT 36KW NAME 3,FILE,FWB 375G READDICT 37K6 REWRITE 384Q VFREE FILE,ADICTENT 38JB # THIS ROUTINE RESCINDS THE SPECIFIED PRIVILEGE OF ALL THE INFERIORS 3942 # OF THE NAMED USER 39HL SR4 SETNCORE 3,3,ADATA,CMARK [SET UP BOOKMARK BLOCK 3=3= HUNT 2,ADATA,CSTORE 3=GW LDX 4 UTYPE(2) 3?2G ADN 2 UNAMED [WITH ORIGINAL NAMED USER AS X 3?G6 ADN 3 A1 3?^Q MOVE 2 3 3#FB #SKIP K6BUDGET>99-99 3#^2 TRACE 4,BUDGET15 3*DL R400 REWIND [REWIND DICTIONARY 3*Y= SKIP 0,1 [SKIP FIRST RECORD 3BCW R401 HUNT 3,ADATA,CMARK [FIND X (USER NAME) 3BXG LDX 5 A1(3) 3CC6 LDX 6 A1+1(3) 3CWQ LDX 7 A1+2(3) 3DBB R402 STEP [SET POINTER TO NEXT RECORD 3DW2 BZE 3 SR5 [GO TO SR5 IF END FO DICTIONARY 3F*L SBN 3 A1 3FT= LDX 0 CPSEU(3) [IGNORE PSEUDO USERS 3G#W BNG 0 R402 3GSG LDX 0 XUP(1) 3H#6 BXE 0 CUSER(3),R402 [IGNORE DUMMY UPDATE RECORDS 3HRQ TXU 5 CSUPUSER(3) 3J?B TXU 6 CSUPUSER+1(3) [IS X THIS USER'S SUPERIOR 3JR2 TXU 7 CSUPUSER+2(3) 3K=L BCS R402 3KQ= TESTPRIV 4,3 3L9W LDX 5 CUSER(3) 3LPG LDX 6 CUSER+1(3) [IF SO, AND 3M96 LDX 7 CUSER+2(3) 3MNQ BZE 0 R403 [IF THIS USER HOLDS THE STATED PRIVILEGE, 3N8B READAGAIN 3NN2 HUNT 2,FILE,FRB 3P7L NAME 2,FILE,FWB 3PM= OFFPRIV 4,2 [RESCIND IT 3PNM ... LDX 2 FX2 3PQ4 ... STO 4 AWORK1(2) 3PRF ... STO 7 AWORK2(2) 3PSW ... CALL 4 WPF [SET UP %C OF DICTWELL 3PTS ... BRN NK4 [J IF PRIVILEGE NOT WELL KNOWN 3PWQ ... LDX 4 AWORK1(2) [REINSTATE PRIVILEGE TYPE 3PXN ... STO 7 AWORK1(2) 3Q2G ... DICTWELL 5,PRIV,AWORK1(2),OFF [UPDATE JOBLIST ETC 3Q3X ...NK3 3Q5# ... LDX 7 AWORK2(2) 3Q6W REWRITE 3QLG VFREE FILE,FWB 3R66 R403 SETNCORE 3,3,ADATA,CMARK 3RKQ STO 5 A1(3) 3S5B STO 6 A1+1(3) 3SK2 STO 7 A1+2(3) 3T4L #SKI K6BUDGET>99999-99999 3TJ= TRACE 5,PRIVR403 3W3W BRN R400 3W7R ...NK4 LDX 4 AWORK1(2) [REINSTATE PRIVILEGE TYPE 3W?N ... BRN NK3 [ 3WCK ...# 3WHG # SR5 IS ENTERED WHEN THE END OF THE DICTIONARY HAS BEEN REACHED 3X36 SR5 HUNT 3,ADATA,CMARK [PREPARE TO POSITION DICTIONARY AT 3XGQ NAME 3,FILE,ADICT [OLD 'X' USER 3Y2B HUNT 3,ADATA,CMARK [FIND NEXT NAME BLOCK 3YG2 HUNT 2,ADATA,CSTORE 3Y^L BNG 3 R503 3^F= LDX 5 A1(3) 3^YW #SKIP K6BUDGET>99-99 42DG TRACE 5,BUDGESR5 42Y6 LDX 6 A1+1(3) 43CQ LDX 7 A1+2(3) 43XB R501 READDICT [ASSUME FILE,ADICT BLOCK IS FREED 44C2 TESTREP2 OK,R502 44WL GEOERR 1,BUDGETNO 45B= R502 VFREE FILE,ADICTENT 45TW BRN R401 46*G R503 HUNT 3,FILE,ADICT [THIS SECTION IS ENTERED ONLY IF THE 46T6 LDX 5 A1(3) [NAMED USER TAS NO INFERIORS 47#Q LDX 6 A1+1(3) 47SB LDX 7 A1+2(3) 48#2 TXU 5 UNAMED(2) 48RL TXU 6 UNAMED+1(2) 49?= TXU 7 UNAMED+2(2) 49QW BCC R504 4==G GEOERR 1,BUDNOIOF [DICTIONARY FAILURE 4=Q6 R504 VFREE FILE,ADICT 4?9Q P3 CLOSE [CLOSE DICTIONARY 4?BY ...#UNSET FTS1 4?J6 ... DICTJL [UPDATE JOBLIST FILES 4?PB MONOUT ERBOK3 [MESSAGE OK 4#92 ENDCOM 4#NL WRONG ACROSS BUDGET,2 4*8= MENDAREA 50,K99PRIVLEG 4*MW #END ^^^^ ...60415744000200000000