{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: PERTYPNO840)}}
====== PERTYPNO840 ======
(George Source)
**Macros used:** [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:GEOERR|GEOERR]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:UP|UP]]
22FL #LIS K0PERTYPNO
22^= #SEG PERTYPNO6 [R H TERRY
23DW 8HPERTYPNO
23YG # THIS SEGMENT CONVERTS A PERIPHERAL TYPE & UNIT NUMBER TO A FOUR CH
24D6 # PERIPHERAL NAME [E.G.MT14 OR LP2 ].IT IS USED BY THE'PERTYPNO'MACR
24XQ # ON ENTRY EXEC3 OF THE CURRENT ACTIVITY BLOCK CONTAINS:-
25CB # UP TO MK6 : B0-5 TYPE NO ,B6-14 UNIT NO ,B15-23 UNDEFINED
25X2 # MK6.5 ON : B0-8 TYPE NO ,B9-23 UNIT NO
26BL # ON EXIT EXEC3 HOLDS THE PERIPHERAL NAME
26W= # IF THE TYPE DOES NOT CORRESPOND TO A REAL PERIPHERAL THE NAME
27*W # WILL START WITH'XX'.
27TG #
28*6 [ ENTRY POINTS
28SQ [
29#B SEGENTRY K1PERTYPNO,ZEP1 [ENTRY FOR FULL PERIPHERAL NAME CONVN
29S2 SEGENTRY K11PERTYPNO,ZEP11 [ENTRY FOR PERIPHERAL TYPE ONLY
2=3S ... SEGENTRY K2PERTYPNO,ZEP2 [ENTRYFROM MFPERTYPNO INMONOLITH
2=?L [
2=R= # THIS IS A TABLE CONTAINING THE TYPES IN CHARACTERS OF THE VARIOUS
2?34 ... SEGENTRY K80PERTYPNO
2?=W MNEM 28HTRTPLPCRCPMT****DDDRITMXCT**
2?QG ... 28HID1516171819GPGD22UDCC25**27
2#=6 28HPB29303132333435363738394041
2#FY #SKI JSKI19<1$1
2#PQ 28H4243444546474849FRFWGECOEMOI
2#WY #SKI JSKI19
2*46 28H4243444546474849FRFWFHCOEMOI
2*9B 16HOOCSRRETCI616263
2*P2 MAX +64
2B8L TEN +10
2BN= SPAC1 #77770000
2C7W UDAS 4H**00
2C?R ...ZEP2 STOZ AWORK1(2)
2CCN ... STO 1 AWORK2(2)
2CHK ... BRN XJOIN
2CMG ZEP11 [ENTRY FOR PERIPHERAL TYPE ONLY
2D76 NGNC 0 1
2DLQ ZEP1 [ENTRY FOR FULL PERIPHERAL NAME CONVN
2F6B NGN 0 0
2FL2 STO 0 AWORK1(2) [B0 SET FOR K11 ENTRY
2FR8 ... STOZ AWORK2(2)
2FYB ...XJOIN
2G5L LDX 5 EXEC3(2)
2GK= LDX 0 5 [ REMOVE
2H4W ANDX 0 ZFORMAT(1) [ THIS
2HJG BZE 0 ZFOK [ CHECK
2J46 GEOERR 1,PRLFRMAT [ IN
2JHQ ...ZFORMAT #70077400 [ MARK
2K3B ZFOK [ SEVEN
2KH2 LDN 4 0
2L2L SLL 45 9 [TYPE NO IN X4
2L=D ... LDX 6 4 [SAVE TTYPE
2LG= SRL 5 9 [UNIT NO IN X5
2L^W TXL 4 MAX(1) [TEST WHETHER TYPE NO. VALID
2MFG BCC ZER
2M^6 SRC 4 1
2NDQ SMO 4
2NYB LDX 0 MNEM(1) [LOADS CHARACTERS FROM TABLE
2PD2 BPZ 4 ZA
2PXL SLL 0 12
2QC= ZA ANDX 0 SPAC1(1)
2QWW STO 0 7
2RBG BXU 7 UDAS(1),NUDAS [J IF NOT UDAS TYPE
2RW6 LDX 7 FRED [ ELSE GET INSTALATION- CHOSEN
2S*Q ANDX 7 HALFTOP [ MNEMONIC
2STB NUDAS
2T*2 LDXC 0 AWORK1(2)
2TSL BCC ZD [J IF K1 ENTRY
2W#= ORN 7 #2020 [ ELSE SET SPACES IN UNIT NO FIELD
2WRW BRN ZE
2WT7 ...ZD SEGENTRY K90PERTYPNO [MANYDA MEND POINT
2WWD ... BRN XK91
2WXP ... LDX 0 AWORK2(2)
2W^2 ... BZE 0 XK91 [J UNLESS MONOLITH ENTRY
2X2? ... LDX 0 6
2X3J ... LDN 6 0 [MARKER
2X4T ... SBN 0 6
2X66 ... BNZ 0 XK91 [J UNLESS DA
2X7C ... LDN 0 100
2X8N ... BXL 5 0,XK91 [J IF UNIT NO <100
2X9^ ... DVS 4 0
2X?= ...[X4HAS REM,X5 RESULT
2X#H ... SRL 56 12
2X*S ... LDX 5 4
2XC5 ... DVS 4 TEN(1)
2XDB ... SLL 5 6 [X4 HAS UNITS,X5 TENS
2XFM ... ORX 6 5
2XGY ... ORX 6 4
2XJ9 ... BRN ZE
2XKG ...XK91
2XLR ... SEGENTRY K91PERTYPNO
2XN4 ...[IF X6 ZERO 4 CHARS OTYERWISE UNIT NO
2XP* ... DVS 4 TEN(1) [CONVERTS UNIT NO. TO CHARACTERS
2XR6 BZE 5 ZB
2Y=Q SLL 5 6
2YQB BRN ZC
2^=2 ZB SLL 4 6
2^PL LDN 5 #20 [INSERTS SPACE IF SINGLE CHARACTER
329= ZC ADX 5 4
32NW ADS 5 7
338G ZE STO 7 ACOMMUNE9(2)
33?R ... LDX 0 AWORK2(2)
33#W ...N BZE 0 XK93 [[J UNLESS K2 ENTRRY=MONOLITH
33*^ ... STO 7 ACOMMUNE8(2)
33C4 ... STOZ ACOMMUNE9(2) [SET FOR SHORT ANSWER
33CC ... SEGENTRY K92PERTYPNO
33CQ ... BRN XK93
33D7 ... BZE 6 XK93 [J IF SHORT
33F= ... LDX 7 ACES
33G* ... SRL 67 6
33HD ... ORS 6 ACOMMUNE8(2)
33JH ... STO 7 ACOMMUNE9(2)
33KL ...XK93
33LP ... SEGENTRY K93PERTYPNO
33N6 UP
347Q ZER LDN 7 #7070 [PLACE XX
34MB ZERA SLL 7 12
3572 BRN ZD
35LL MENDAREA 10
366= #END
^^^^ ...32630444000800000000