Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCUKWL1

APCUKWL1.m

Go to the documentation of this file.
APCUKWL1 ; PART 2 OF LOOKUP DRIVER PROGRAM FOR "AND"ING INVERTED SEARCH ; [ 11/04/86  2:00 PM ]
 ;
PREPSCH ; PREPARE FOR SEARCH BY BUILDING WORD/DFN TABLES
 S NWS=^DD("KWIC")_"IN^OF^AN^IS^AS^AT^IF^IT^ON^OR^BY^"
 W "("
 S WD="",NWDS=0
 F Q=0:0 S WD=$O(WT(WD)) Q:WD=""  D WDCHK
 W " )",!
 K WT,NWS
 K EXACT,PART,SYN,INCR
 Q
 ;
WDCHK ; DETERMINE IF PARTIAL OR EXACT MATCH
 S WSAVE=WD
 S (ISNOT,FEXACT)=0
RECHK I $E(WD)="'" S ISNOT=1,WD=$E(WD,2,255) G RECHK
 I $E(WD)="~" S FEXACT=1,WD=$E(WD,2,255) G RECHK
 I WD?1N.E!(NWS[("^"_WD_"^")) S UNUSED=UNUSED+1,UNUSED(WD)="" G WDCHKX
 S INCR=0,SYN=$D(^APCUKWLC(KWCT,1,"B",WD))
 I 'SYN D CKWD G WDCHKX
 S WDTX=$O(^APCUKWLC(KWCT,1,"B",WD,0))
 S WX=WD,WDSX=0 F Q=0:0 S WDSX=$O(^APCUKWLC(KWCT,1,WDTX,1,WDSX)) Q:WDSX=""  S WD=^APCUKWLC(KWCT,1,WDTX,1,WDSX,0) D CKWD
WDCHKX S WD=WSAVE
 K WSAVE,WX,ISNOT,FEXACT,WDTX,WDSX
 Q
CKWD S EXACT=$S($D(@REF):1,1:0)
 S WD2=$O(@REF)
 S PART=('FEXACT)&($L(WD)>2)&($S($E(WD2,1,$L(WD))=WD:1,1:0))
 I 'EXACT,'PART S UNUSED=UNUSED+1,UNUSED(WD)="" K WD2 Q
CKNOT I ISNOT S INCRX=INCR,NWDSX=NWDS,INCR=1,NWDS=0 D CKWD2 S INCR=INCRX,NWDS=NWDSX K ISNOT,INCRX,NWDSX Q
CKWD2 W $S(SYN&INCR:"|",1:" ")_$S(FEXACT:"~",1:"")_$S(ISNOT:"'",1:"")_WD ;W:PART&('FEXACT)&($E($O(@REF),1,$L(WD))=WD) "=>"
 I 'SYN,EXACT,'PART,'ISNOT S NWDS=NWDS+1,PARTIAL(NWDS)=0,WORD(NWDS)=WD,DFN(NWDS)=$O(@REF2) Q
 S:'INCR NWDS=NWDS+1,PARTIAL(NWDS)=1,WORD(NWDS)=WD 
 S WD2=WD
 S N=0 S J="" F Q=0:0 S J=$O(AWORD(NWDS,J)) Q:J=""  S N=J
 S N=N+1
 I EXACT S AWORD(NWDS,N)=WD,ADFN(NWDS,N)=$O(@REF2),N=N+1
CKWD3 I 'FEXACT F N=N:1 S WD=$O(@REF) Q:$E(WD,1,$L(WD2))'=WD2  S AWORD(NWDS,N)=WD,ADFN(NWDS,N)=$O(@REF2) W "/",WD
 S WD=WD2
 S N=N-1
 S D=ADFN(NWDS,1) F I=1:1:N S:ADFN(NWDS,I)<D D=ADFN(NWDS,I)
 S DFN(NWDS)=D
 I 'SYN,N=1 S PARTIAL(NWDS)=0,WORD(NWDS)=AWORD(NWDS,1),DFN(NWDS)=ADFN(NWDS,1)
 S INCR=1
 K N,WD2,D
 Q