(George Source)
Macros used: CLOSE, DELETE, FINDCORE, FREECORE, GEOERR, GETCOREN, LONGSET, MASK, MENDAREA, MHUNT, NAME, OPEN, PHOTO, READ, SEGENTRY, TESTMOVE, TESTREP, UP, UPPLUS
22FL #LIS K0FINDOC>K0COMMAND>K0ALLGEO>K0GREATGEO 22^= #SEG FINDOC8 [A C PUTMAN 2394 ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983. 23DW 8HFINDOC 23YG SEGENTRY K1FINDOC,XFINDOC1 24D6 # 24XQ # THIS SEGMENT IS CALLED BY A ROUTINE WHICH IT IS TRYING TO LOCATE 25CB # THE DOCUMENT REQUIRED. IT SEARCHES THROUGH THE SYSTEM FILE DOCUMEN 25X2 # TO SEE IF THERE IS A RECORD FOR THIS PARTICULAR DOCUMENT NAME. A 26BL # BLOCK IS PASSED BACK TO THE CALLING ROUTINE CONTAINING THE 26W= # INFORMATION AS FOLLOWS. IF DOCUMENT HAS BEEN LOADED A COPY OF THE 27*W # RECORD IS PASSED BACK. IF NO DOCUMENT HAS BEEN LOADED THE BLOCK 27TG # WITH A ZERO RECORD IS PASSED BACK. 28*6 # 28SQ WHDR 4HHDDR 29#B WD4 +4 29S2 WDOC +16 2=?L 12HMASTER 2=R= 12HSYSTEM 2?=W +1 2?QG +1 2#=6 +0 2#PQ 12HDOCUMENT 2*9B +1 2*P2 +1 2B8L +0 2BN= #SKI GENIE 2C7W MASK #77700000 2CMG # THIS SUBROUTINE OPENS THE DOCUMENT FILE IN THE GENERAL MODE 2D76 XOPN SBX 7 FX1 2DLQ GETCOREN 16,1 [CORE FOR NAME BLOCK 2F6B FINDCORE 3 2FL2 NAME 3,FILE,FABSNB 2G5L ADN 3 A1 2GK= LDN 2 WDOC(1) 2H4W MOVE 2 16 [INSERT NAME IN BLOCK 2HJG LDX 2 FX2 2J46 OPEN OK1,GENERAL 2JHQ TESTREP OPEN,OK 2K3B GEOERR 1,FNOPN [ERROR IF FILE NOT OPENED 2KH2 OK ADX 7 FX1 2L2L EXIT 7 0 2LG= OK1 UP 2L^W # THIS SUBROUTINE CHECKS TO SEE IF 2 NAMES ARE EQUAL 2MFG TEQUAL 2M^6 SBX 7 FX1 2NDQ NWD TXL 4 WD4(1) 2NYB BCS NCH [J IF ODD CHS. ONLY LEFT 2PD2 LDX 5 A1+3(2) [OTHERWISE CHECK WORD 2PXL TXU 5 APARA(3) 2QC= BCS NXT [J IF NAMES DIFFERENT 2QWW ADN 3 1 2RBG ADN 2 1 2RW6 SBN 4 3 2S*Q BCT 4 NWD [J IF MORE CHS. LEFT 2STB BRN XDONE [OTHERWISE NAMES EQUAL 2T*2 NCH LDCH 5 A1+3(2) 2TSL LDCH 0 APARA(3) 2W#= TXU 0 5 2WRW BCS NXT [J IF NAMES NOT THE SAME 2X?G BCHX 3 £ 2XR6 BCHX 2 £ 2Y=Q BCT 4 NCH 2YQB XDONE ADX 7 FX1 2^=2 EXIT 7 1 [EXIT +1 IF THE SAME 2^PL NXT ADX 7 FX1 329= EXIT 7 0 [EXIT 0 IF NAMES DIFFER 32NW XFINDOC1 338G # THIS ENTRY POINT LOCATES AN ENTRY IN THE DOCUMENT FILE WITH GIVEN 33N6 # DOC. NAME, AND PASSES IT BACK IN A BLOCK TYPE/SUBTYPE ADATA/ADOC 347Q CALL 7 XOPN [OPEN DOC. FILE 34MB MHUNT 3,CPB,CUNI [LOCATE BLOCK WITH REQD. NAME 3572 LDCH 4 APARA(3) [GET 1ST CH. 35LL SBN 4 #12 [COLON 366= BNZ 4 SINGLE [J IF NO COLON: SINGLE FORM OF NAME 36KW NXTRD PHOTO 5 375G READ 37K6 MHUNT 2,FILE,FRB [LOCATE RECORD 384Q LDX 4 A1(2) 38JB BZE 4 NOREC [J IF ZERO REC: END OF FILE 3942 TESTMOVE 5,OK2 39HL MHUNT 3,CPB,CUNI 3=3= OK2 LDX 4 A1+1(2) 3=GW TXU 4 WHDR(1) 3?2G BCC NXTR1 3?G6 SMO FX2 3?^Q STO 2 AWORK3 [PRESERVE S.A. RECORD BLOCK 3#FB SMO FX2 [PRESERVE ADDRESS OF PARAM. BL. 3#^2 STO 3 AWORK2 3*DL LDCH 4 A1+3(2) 3*Y= SBN 4 #12 3BCW BNZ 4 NXTR [J IF NAME IN REC. NOT IN FULL FORM 3BXG LDX 4 ANUM(3) 3CC6 ANDN 4 #7777 3CWQ TXU 4 A1+2(2) 3DBB BCS NXTR [J IF NAMES HAVE DIFFERENT NO. OF CHS 3DW2 CALL 7 TEQUAL 3F*L BRN NXTR 3FT= SMO FX2 3G#W LDX 2 AWORK3 [X2=PTR. TO DOC.BLK. 3GSG SMO FX2 3H#6 LDX 7 AWORK1 [LOAD ONLINE TYPE PERI 3HRQ ANDX 7 MASK(1) 3J?B LDX 1 A1(2) 3JR2 SMO 2 3K=L LDX 6 A1-2(1) [LOAD DOC. TYPE PERI 3KQ= SMO FX1 3L9W ANDX 6 MASK 3LPG TXU 7 6 3M96 BCS NXTR [BRANCH IF THE PERI'S UNEQUAL 3MNQ NDB SMO FX2 3N8B LDX 2 AWORK3 [ADDRESS OF REC. BLOCK 3NN2 NAME 2,ADATA,ADOC 3P7L NDA LDX 2 FX2 3PM= DELETE [DELETE REC. FD. FROM FILE 3Q6W ND CLOSE 3QLG MHUNT 3,FILE,FABSNB 3R66 FREECORE 3 3RKQ UPPLUS 1 3S5B NOREC NAME 2,ADATA,ADOC [PASS BACK ZERO RECORD 3SK2 LONGSET #60,XERR 3T4L LDX 2 FX2 3TJ= BRN ND 3W3W NXTR SMO FX2 3WHG LDX 2 AWORK3 3X36 SMO FX2 3XGQ LDX 3 AWORK2 [GET ADDRESS OF PARAM. BL. 3Y2B NXTR1 FREECORE 2 3YG2 BRN NXTRD [GET NEXT REC. 3Y^L XERR GEOERR 1,LONGDOC 3^F= SINGLE 3^YW PHOTO 5 42DG READ 42Y6 MHUNT 2,FILE,FRB 43CQ TESTMOVE 5,OK3 43XB MHUNT 3,CPB,CUNI 44C2 OK3 SMO FX2 44WL STO 3 AWORK2 [PRESERVE ADDRESS OF PARAM. BL. 45B= LDX 4 A1(2) 45TW BZE 4 NOREC [J IF ZERO RECORD: END OF FILE 46*G SMO FX2 46T6 STO 2 AWORK3 47#Q LDCH 4 A1+3(2) 47SB SBN 4 #12 48#2 BNZ 4 S1 [J IF RECORD SINGLE 48RL LDN 5 12 49?= NCH1 BCHX 2 £ 49QW LDCH 0 A1+3(2) 4==G SBN 0 #36 [SCAN FOR STOP CH. 4=Q6 BZE 0 XFD 4?9Q BCT 5 NCH1 4?PB GEOERR 1,DNERROR [ERROR IN NAME IF NOT FOUND 4#92 XFD LDX 4 ANUM(3) 4#NL ANDN 4 #7777 4*8= NCHA BCHX 2 £ 4*MW LDCH 5 A1+3(2) 4B7G LDCH 0 APARA(3) 4BM6 TXU 0 5 4C6Q BCS NXTS [J IF NAMES NOT EQUAL 4CLB BCHX 3 £ 4D62 BCT 4 NCHA [J TO COMPARE NEXT CH. 4DKL BCHX 2 £ 4F5= SMO FX2 4FJW LDX 3 AWORK3 [S.A. OF REC. BLOCK. 4G4G SBX 2 3 [X2 CONTAINS NO. OF WDS. TO POSN.IN B 4GJ6 SLC 2 2 [CONVERT TO CHS. 4H3Q TXU 2 A1+2(3) 4HHB BCS NXTS [J IF NOT EQUAL TO TOTAL NO. OF CHS. 4J32 NCHB SMO FX2 4JGL LDX 7 AWORK1 [LOAD ONLINE TYPE PERI 4K2= ANDX 7 MASK(1) 4KFW LDX 1 A1(3) 4K^G SMO 3 4LF6 LDX 6 A1-2(1) [LOAD DOC. TYPE PERI 4LYQ SMO FX1 4MDB ANDX 6 MASK 4MY2 TXU 7 6 4NCL BCS NXTS [BRANCH IF THE INCORRECT TYPE 4NX= NAME 3,ADATA,ADOC 4PBW BRN NDA 4PWG NXTS SMO FX2 4QB6 LDX 2 AWORK3 4QTQ FREECORE 2 [FREE REC. BLOCK 4R*B SMO FX2 4RT2 LDX 3 AWORK2 [GET ADD. OF PARAM. BL. 4S#L BRN SINGLE [GET NEXT RECORD 4SS= S1 LDX 4 ANUM(3) 4T?W ANDN 4 #7777 4TRG TXU 4 A1+2(2) 4W?6 BCS NXTS [J IF NOT THE SAME NO. OF CHS. 4WQQ CALL 7 TEQUAL [COMPARE NAMES 4X=B BRN NXTS [J IF UNEQUAL: GET NEXT REC. 4XQ2 SMO FX2 [OTHERWISE RECORD FOUND 4Y9L LDX 3 AWORK3 4YP= BRN NCHB [GO BACK AND CHECK PERI'S CORRECT 4^8W MENDAREA 20,K99FINDOC 4^NG #END ^^^^ ...35404557000100000000