(George Source)
Macros used: CHARMOVE, CHNUMCOD, ERROR, HUNT, MENDAREA, MHUNT, P, PHOTO, SEGENTRY, SETREP, TESTMOVE, TESTREP, TRACE, UP
22FL #LIS K0PSPLIT>K0ALLGEO>K0GREATGEO 22^= #SEG PSPLIT [ BILL IZATT : CENT 23DW 8HPSPLIT 23YG [ ENTRY POINT. THIS LOCATION MUST REMAIN FIXED 24D6 SEGENTRY K1PSPLIT,QENTRY1 24XQ [ 25CB [ 0 25X2 [ 1 26BL [ 1 PSPLIT SEGMENT IMPLEMENTS PARSPLIT MACRO 26W= [ 1 TAKE A PARAMETER IN FIRST CPB/CUNIAFTER CPAT AND SEPARATE 27*W [ 1 LETTER-STRING FROM AN ARITH.EXPRESSION.PASS THE LETTER ST 27TG [ 1 (LEFT-JUSTIFIED AND SPACE-FILLED IF NECESSARY) ACROSS IN 28*6 [ 1 IF NO LETTER-STRING SET EXEC1=0.PASS THE RESULT OF EVALUA 28SQ [ 1 THE EXPRESSION BY CHNUMCON ACROSS IN EXEC2 29#B [ 3 OUTPUT 1.EXEC1 = LETTER STRING (LEFT-JUSTIFIED AND SPACE-FILLED, 29S2 [ 3 OR = 0 IF NO LETTERS 2=?L [ 3 OR = 1 IF NULL PARAMETER 2=R= [ 3 OR = 2 IF PARAMETER ABSENT 2?=W [ 3 OR = 3 IF PARAMETER FORMAT ERROR 2?QG [ 3 2.EXEC2 = RESULT OF EVALUATING EXPRESSION BY CHNUMCON 2#=6 [ 3 OR = UNDEFINED IF FORMAT ERROR 2#PQ [ 3 3.EXEC3 = REPLY WORD,SET BY SETREP,=OK,NULL,NONEX,OR FORM 2*9B [ 3 2*P2 [ 4 ERROR ACTION -ERROR FOUND BY CHNUMCON -> SET EXEC1=3 AND O/P ERROR 2B8L [ 4 ERROR %B %A:'ARITH.EXPR.'IS NOT A VALID NUMBER FORMAT 2BN= [ 4 - ERROR FOUND BY PSPLIT-> SET EXEC1=3 AND O/P ERROR M 2C7W [ 4 ERROR %B %A:FORMAT ERROR:'PARAMETER' 2CMG [ 4 NULL PARAMETER-SETREP NULL 2D76 [ 4 ABSENT -DO- -SETREP NONEX 2DLQ [ 4 GEORGE ERROR IF NO CPB/CUNI BLOCK 2F6B [ 4 2FL2 ZA #41 [LETTER'A' 2G5L ZZ #73 2GK= QENTRY1 2H4W #SKI K6PSPLIT>99-99 2HJG TRACE 0,PSPLIT 2J46 MHUNT 3,CPB,CUNI [HUNT FOR CPB/CUNI BLOCK.GEOERR IF AB 2JHQ LDX 5 ANUM(3) 2K3B BNG 5 PABS 2KH2 BZE 5 PNULL 2L2L ANDN 5 #7777 2LG= STO 5 AWORK1(2) [PRESERVE CHARACTER COUNT 2L^W STO 3 AWORK2(2) [PRESERVE UNIBLOCK DATUM 2MFG LDN 7 0 2M^6 LDCH 0 APARA(3) [EXAMINE 1ST CHARACTER 2NDQ TXL 0 ZA(1) [IS 1ST CH.A LETTER? 2NYB BCS XPRFIRST [BRN IF NOT LETTER 2PD2 TXL 0 ZZ(1) 2PXL BCC XPRFIRST [NOT A LETTER 2QC= [ LETTER STRING IS SPLIT OFF AND LOADED INTO X7,LEFT-JUSTIFIED 2QWW [ AND SPACE-FILLED IF NECESSARY 2RBG LDN 6 4 [MAX OF 4 LETTERS IN LETTER STRING 2RW6 LDN 3 APARA(3) 2S*Q BRN PLOOP2 [X0 ALREADY HOLDS 1ST LETTER 2STB PLOOP1 2T*2 LDCH 0 0(3) 2TSL TXL 0 ZA(1) [LETTER? 2W#= BCS SPFILL3 2WRW TXL 0 ZZ(1) 2X?G BCC SPFILL3 [NOT A LETTER 2XR6 PLOOP2 ['LETTERS-FIRST'FLAG IS SET 2Y=Q SLL 7 6 [LETTER STRING IS ASSEMBLED IN X7 2YQB ORX 7 0 2^=2 SBN 5 1 2^PL BZE 5 PFERR [ERROR IF NO NUMBERS 329= [SET,LETTER STRING ONLY.=> PARAM.FORM 32NW BCHX 3 £ [MOVE UP THE CHARACTER POINTER 338G BCT 6 PLOOP1 33N6 [TO REACH HERE: 347Q [ 1) 4 LETTERS HAVE BEEN FOUND AND PUT INTO X7, 34MB [ 2) IT IS A'LETTERS-FIRST'PARAMETER 3572 [ 3) THERE IS AT LEAST ONE MORE CHARACTER 35LL LDCH 0 0(3) 366= TXL 0 ZA(1) [LETTER? 36KW BCS ZANUM [NOT A LETTER 375G TXL 0 ZZ(1) 37K6 BCS PFERR [A LETTER 384Q BRN ZANUM 38JB SPFILL3 3942 LDN 4 #20 [LOAD SPACE CH. 39HL SLL 7 6 [MAKE ROOM 3=3= ORX 7 4 ['OR'IT IN 3=GW BCT 6 SPFILL3+1 [AVOID REPEATING'LDN 4 #20' 3?2G [X7 NOW HOLDS LETTER STRING,LEFT JUSTIFIED AND SPACE-FILLED 3?G6 ZANUM LDX 1 AWORK2(2) [LOAD CPB/CUNI DATUM 3?^Q DSA 5 ANUM(1) [ADJUST ANUM FOR CHNUMCON 3#FB SBS 5 AWORK1(2) [AWORK1 NOW HOLDS NUMBER OF LETTERS 3#^2 LDN 4 APARA(1) 3*DL CHARMOVE 3,5 [X5 HOLDS LENGTH OF NUMBER STRING 3*Y= PHOTO 6 3BCW CHNUMCOD ,1 3BXG TESTMOVE 6,NHUNT 3CC6 HUNT 1,CPB,CUNI 3CLY ... STO 1 AWORK2(2) 3CWQ BRN NHUNTA 3DBB NHUNT 3DW2 LDX 1 AWORK2(2) 3F*L NHUNTA 3FT= [ THIS PERFORMANCE RECONSTITUTES THE CPB/CUNI BLOCK. 3G#W # 3GBN ... LDN 3 APARA(1) 3GDH ... SLL 3 2 3GJ8 ... ADX 3 5 3GMT ... SBN 3 1 3GRG ... LDX 1 3 3GX7 ... ADX 1 AWORK1(2) 3H2S ...MOVELOOP 3H6F ... SRC 3 2 3H=6 ... SRC 1 2 3H*R ... LDCH 0 0(3) 3HFD ... DCH 0 0(1) 3HK5 ... SLC 3 2 3HNQ ... SLC 1 2 3HSC ... SBN 3 1 3HY4 ... SBN 1 1 3J3P ... BCT 5 MOVELOOP 3J7B ... LDX 1 AWORK2(2) 3J?B LDN 3 7 3JR2 LDN 4 APARA(1) 3K=L CHARMOVE 3,AWORK1(2) 3LPG LDX 3 AWORK1(2) 3M96 ADS 3 ANUM(1) [RESET ANUM 3MNQ LDX 3 1 3N8B # 3NN2 PURPLE 3P7L TESTREP CHNUMERR,PFERR2 3PM= STO 7 ACOMMUNE2(2) 3Q6W SETREP OK 3QLG UP 3R66 [ 3RKQ XPRFIRST 3S5B SBN 5 1 3SK2 BZE 5 XCONV 3T4L BCHX 3 £ [ADVANCE CH.PTR. 3TJ= LDCH 0 APARA(3) [EXAMINE NEXT CH. 3W3W TXL 0 ZA(1) [LETTER? 3WHG BCS XPRFIRST [CONTINUE IF NOT END OF NUMBERS 3X36 TXL 0 ZZ(1) 3XGQ BCC XPRFIRST 3Y2B LDN 6 4 3YG2 TXL 6 5 3Y^L BCS PFERR [ERROR IF >4 LETTERS IN STRING 3^F= LDX 4 AWORK1(2) 3^YW SBX 4 5 42DG SMO AWORK2(2) 42Y6 DSA 4 ANUM 43CQ BRN SLL76 43XB PRUNE LDCH 0 APARA(3) 44C2 TXL 0 ZA(1) 44WL BCS RECON [NOT A LETTER 45B= TXL 0 ZZ(1) 45TW BCC RECON [NOT A LETTER 46*G SLL76 46T6 SLL 7 6 47#Q ORX 7 0 47SB BCT 5 ONON 48#2 BRN XDROP 48RL ONON BCHX 3 £ 49?= BCT 6 PRUNE 49QW RECON LDX 5 AWORK1(2) 4==G LDX 3 AWORK2(2) 4=Q6 DSA 5 ANUM(3) [RECONSTITUTE CPB/CUNI BLOCK 4?9Q BRN PFERR 4?PB SLLL LDN 0 #20 4#92 SLL 7 6 4#NL ORX 7 0 4*8= XDROP BCT 6 SLLL 4*MW XCONV 4B7G PHOTO 6 4BM6 LDX 3 AWORK2(2) 4C6Q CHNUMCOD ,3 4CLB TESTMOVE 6,NHUN 4D62 HUNT 3,CPB,CUNI 4DKL NHUN 4F5= BZE 7 PURPLE 4FJW [ RECONSITUTE CPB/CUNI BLOCK 4G4G LDX 5 AWORK1(2) 4GJ6 DSA 5 ANUM(3) 4H3Q BRN PURPLE 4HHB PABS 4J32 #SKI K6PSPLIT>99-99 4JGL TRACE 0,ABSENT P 4K2= SETREP NONEX 4KFW LDN 0 2 4K^G BRN STOR 4LF6 PNULL 4LYQ #SKI K6PSPLIT>99-99 4MDB TRACE 0,NULL P. 4MY2 SETREP NULL 4NCL LDN 0 1 4NX= BRN STOR 4PBW PFERR 4PWG ERROR APFERR [ERROR MESSAGE : PARAMETER FORMAT ERR 4QB6 PFERR2 4QTQ SETREP FORMAT 4R*B LDN 0 3 4RT2 STOR SMO FX2 4S#L STO 0 ACOMMUNE2 4SS= UP 4T?W MENDAREA 15,K99PSPLIT 4TRG #END ^^^^ ...04056022000500000000