63 lines
2.4 KiB
Mathematica
63 lines
2.4 KiB
Mathematica
XTLKKSCH ; IHS/OHPRD/ACC,SFISC/JC - "AND"ING INVERTED LIST SEARCH ;07/22/93 15:45
|
|
;;7.3;TOOLKIT;;Apr 25, 1995
|
|
; XTLKNWDS,XTLKREF1,XTLKREF4,XTLKWORD() ARE PASSED IN AND
|
|
; SHOULD NOT BE KILLED
|
|
K ^TMP("XTLKHITS",$J) S ^TMP("XTLKHITS",$J)=0
|
|
I $D(XTLKHLIM) S XTLKHLM1=XTLKHLIM+1
|
|
E S XTLKHLM1=0
|
|
S XTLKCMAX=XTLKDFN(1) F XTLKI=1:1:XTLKNWDS S:XTLKDFN(XTLKI)<XTLKCMAX XTLKCMAX=XTLKDFN(XTLKI)
|
|
RESTRT ;
|
|
S XTLKI=0,XTLKEMTY=0
|
|
SCLOOP ;
|
|
S XTLKI=XTLKI+1
|
|
G:XTLKI>XTLKNWDS!(XTLKEMTY) ENDCHK
|
|
CMP S XTLKLOW=XTLKDFN(XTLKI)<XTLKCMAX,XTLKHIGH=XTLKDFN(XTLKI)>XTLKCMAX
|
|
I XTLKLOW D INCSTK:XTLKPRTL(XTLKI),INCONE:'XTLKPRTL(XTLKI) G:'XTLKEMTY CMP
|
|
I XTLKHIGH S XTLKCMAX=XTLKDFN(XTLKI),XTLKI=0
|
|
G SCLOOP
|
|
ENDCHK ;
|
|
G:XTLKEMTY EXIT
|
|
D NOTCHK W:XTLKSAY=1 "." D:'XTLKELIM CHKSCRN
|
|
I 'XTLKELIM S ^TMP("XTLKHITS",$J)=^TMP("XTLKHITS",$J)+1,^TMP("XTLKHITS",$J,^TMP("XTLKHITS",$J))=XTLKCMAX,XTLKHLM1=XTLKHLM1-1 G:XTLKHLM1=0 STOP
|
|
S XTLKCMAX=XTLKCMAX+1
|
|
G RESTRT
|
|
STOP W !,"Too many terms meet your criteria; please refine your search.",! K ^TMP("XTLKHITS",$J) S ^TMP("XTLKHITS",$J)=0
|
|
EXIT K XTLKEMTY,XTLKHIGH,XTLKLOW,XTLKMDFN,XTLKNUM,XTLKCMAX,XTLKHLM1
|
|
K XTLKPRTL,XTLKWORD,XTLKAWRD,XTLKDFN,XTLKADFN,XTLKELIM
|
|
K XTLKWD,XTLKD,XTLKI,XTLKJ,XTLKQ
|
|
Q
|
|
;
|
|
NOTCHK ; CHECK POSSIBLE HIT FOR ELIMINATION BY "NOT"
|
|
S XTLKELIM=0,XTLKD=XTLKCMAX
|
|
S XTLKJ="" F XTLKQ=0:0 S XTLKJ=$O(^TMP($J,"AWRD",0,XTLKJ)) Q:XTLKJ="" S XTLKWD=^TMP($J,"AWRD",0,XTLKJ) I $D(@XTLKREF4) S XTLKELIM=1 Q
|
|
Q
|
|
;
|
|
CHKSCRN ; CHECK SCREEN
|
|
S Y=XTLKCMAX I $D(@(XTLKREF1_"Y,0)")) X:$D(DIC("S")) DIC("S") E S XTLKELIM=1
|
|
Q
|
|
;
|
|
INCONE ; ADVANCE DFN FOR EXACT MATCH CASE
|
|
S XTLKD=XTLKDFN(XTLKI),XTLKWD=XTLKWORD(XTLKI)
|
|
S:XTLKD<XTLKCMAX XTLKD=XTLKCMAX-1
|
|
F XTLKQ=0:0 S XTLKD=$O(@XTLKREF4) Q:XTLKD=""!(XTLKD'<XTLKCMAX)
|
|
S XTLKDFN(XTLKI)=XTLKD
|
|
S:XTLKD="" XTLKEMTY=1
|
|
Q
|
|
;
|
|
INCSTK ; ADVANCE COMPOSITE DFN FOR PARTIAL MATCH CASE
|
|
S XTLKJ=0
|
|
F XTLKQ=0:0 S XTLKJ=$O(^TMP($J,"AWRD",XTLKI,XTLKJ)) Q:XTLKJ="" D INC1 Q:XTLKD'=""
|
|
I XTLKJ="" S (XTLKD,XTLKDFN(XTLKI))="",XTLKEMTY=1 Q
|
|
S XTLKMDFN=XTLKD
|
|
F XTLKQ=0:0 S XTLKJ=$O(^TMP($J,"AWRD",XTLKI,XTLKJ)) Q:XTLKJ="" D INC1 S:XTLKD'=""&(XTLKD<XTLKMDFN) XTLKMDFN=XTLKD
|
|
S XTLKDFN(XTLKI)=XTLKMDFN
|
|
Q
|
|
INC1 ;
|
|
S XTLKD=^TMP($J,"ADFN",XTLKI,XTLKJ),XTLKWD=^TMP($J,"AWRD",XTLKI,XTLKJ)
|
|
Q:^TMP($J,"ADFN",XTLKI,XTLKJ)'<XTLKCMAX
|
|
S XTLKD=XTLKCMAX-1
|
|
F XTLKQ=0:0 S XTLKD=$O(@XTLKREF4) Q:XTLKD=""!(XTLKD'<XTLKCMAX)
|
|
S:XTLKD'="" ^TMP($J,"ADFN",XTLKI,XTLKJ)=XTLKD
|
|
K:XTLKD="" ^TMP($J,"AWRD",XTLKI,XTLKJ),^TMP($J,"ADFN",XTLKI,XTLKJ)
|
|
Q
|