source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTLKKSCH.m@ 711

Last change on this file since 711 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1XTLKKSCH ; IHS/OHPRD/ACC,SFISC/JC - "AND"ING INVERTED LIST SEARCH ;07/22/93 15:45
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3 ; XTLKNWDS,XTLKREF1,XTLKREF4,XTLKWORD() ARE PASSED IN AND
4 ; SHOULD NOT BE KILLED
5 K ^TMP("XTLKHITS",$J) S ^TMP("XTLKHITS",$J)=0
6 I $D(XTLKHLIM) S XTLKHLM1=XTLKHLIM+1
7 E S XTLKHLM1=0
8 S XTLKCMAX=XTLKDFN(1) F XTLKI=1:1:XTLKNWDS S:XTLKDFN(XTLKI)<XTLKCMAX XTLKCMAX=XTLKDFN(XTLKI)
9RESTRT ;
10 S XTLKI=0,XTLKEMTY=0
11SCLOOP ;
12 S XTLKI=XTLKI+1
13 G:XTLKI>XTLKNWDS!(XTLKEMTY) ENDCHK
14CMP S XTLKLOW=XTLKDFN(XTLKI)<XTLKCMAX,XTLKHIGH=XTLKDFN(XTLKI)>XTLKCMAX
15 I XTLKLOW D INCSTK:XTLKPRTL(XTLKI),INCONE:'XTLKPRTL(XTLKI) G:'XTLKEMTY CMP
16 I XTLKHIGH S XTLKCMAX=XTLKDFN(XTLKI),XTLKI=0
17 G SCLOOP
18ENDCHK ;
19 G:XTLKEMTY EXIT
20 D NOTCHK W:XTLKSAY=1 "." D:'XTLKELIM CHKSCRN
21 I 'XTLKELIM S ^TMP("XTLKHITS",$J)=^TMP("XTLKHITS",$J)+1,^TMP("XTLKHITS",$J,^TMP("XTLKHITS",$J))=XTLKCMAX,XTLKHLM1=XTLKHLM1-1 G:XTLKHLM1=0 STOP
22 S XTLKCMAX=XTLKCMAX+1
23 G RESTRT
24STOP W !,"Too many terms meet your criteria; please refine your search.",! K ^TMP("XTLKHITS",$J) S ^TMP("XTLKHITS",$J)=0
25EXIT K XTLKEMTY,XTLKHIGH,XTLKLOW,XTLKMDFN,XTLKNUM,XTLKCMAX,XTLKHLM1
26 K XTLKPRTL,XTLKWORD,XTLKAWRD,XTLKDFN,XTLKADFN,XTLKELIM
27 K XTLKWD,XTLKD,XTLKI,XTLKJ,XTLKQ
28 Q
29 ;
30NOTCHK ; CHECK POSSIBLE HIT FOR ELIMINATION BY "NOT"
31 S XTLKELIM=0,XTLKD=XTLKCMAX
32 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
33 Q
34 ;
35CHKSCRN ; CHECK SCREEN
36 S Y=XTLKCMAX I $D(@(XTLKREF1_"Y,0)")) X:$D(DIC("S")) DIC("S") E S XTLKELIM=1
37 Q
38 ;
39INCONE ; ADVANCE DFN FOR EXACT MATCH CASE
40 S XTLKD=XTLKDFN(XTLKI),XTLKWD=XTLKWORD(XTLKI)
41 S:XTLKD<XTLKCMAX XTLKD=XTLKCMAX-1
42 F XTLKQ=0:0 S XTLKD=$O(@XTLKREF4) Q:XTLKD=""!(XTLKD'<XTLKCMAX)
43 S XTLKDFN(XTLKI)=XTLKD
44 S:XTLKD="" XTLKEMTY=1
45 Q
46 ;
47INCSTK ; ADVANCE COMPOSITE DFN FOR PARTIAL MATCH CASE
48 S XTLKJ=0
49 F XTLKQ=0:0 S XTLKJ=$O(^TMP($J,"AWRD",XTLKI,XTLKJ)) Q:XTLKJ="" D INC1 Q:XTLKD'=""
50 I XTLKJ="" S (XTLKD,XTLKDFN(XTLKI))="",XTLKEMTY=1 Q
51 S XTLKMDFN=XTLKD
52 F XTLKQ=0:0 S XTLKJ=$O(^TMP($J,"AWRD",XTLKI,XTLKJ)) Q:XTLKJ="" D INC1 S:XTLKD'=""&(XTLKD<XTLKMDFN) XTLKMDFN=XTLKD
53 S XTLKDFN(XTLKI)=XTLKMDFN
54 Q
55INC1 ;
56 S XTLKD=^TMP($J,"ADFN",XTLKI,XTLKJ),XTLKWD=^TMP($J,"AWRD",XTLKI,XTLKJ)
57 Q:^TMP($J,"ADFN",XTLKI,XTLKJ)'<XTLKCMAX
58 S XTLKD=XTLKCMAX-1
59 F XTLKQ=0:0 S XTLKD=$O(@XTLKREF4) Q:XTLKD=""!(XTLKD'<XTLKCMAX)
60 S:XTLKD'="" ^TMP($J,"ADFN",XTLKI,XTLKJ)=XTLKD
61 K:XTLKD="" ^TMP($J,"AWRD",XTLKI,XTLKJ),^TMP($J,"ADFN",XTLKI,XTLKJ)
62 Q
Note: See TracBrowser for help on using the repository browser.