{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: PSPLIT82)}}
====== PSPLIT82 ======
(George Source)
**Macros used:** [[george:macro:CHARMOVE|CHARMOVE]], [[george:macro:CHNUMCOD|CHNUMCOD]], [[george:macro:ERROR|ERROR]], [[george:macro:HUNT|HUNT]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNT|MHUNT]], [[george:macro:P|P]], [[george:macro:PHOTO|PHOTO]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETREP|SETREP]], [[george:macro:TESTMOVE|TESTMOVE]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|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