| [613] | 1 | XTLKKWL2 ; IHS/OHPRD/ACC,ALB/JLU,SFISC/JC- PART 3 OF LOOKUP CONTROL PROGRAM FOR "AND"ING INVERTED SEARCH ;07/22/93 15:47
|
|---|
| 2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
|---|
| 3 | ; XTLKKWCT,XTLKREF,XTLKREF2 ARE PASSED IN AND SHOULD NOT BE KILLED
|
|---|
| 4 | ; THE FOLLOWING ARE PASSED OUT AND SHOULD NOT BE KILLED:
|
|---|
| 5 | ; ^TMP($J,"ADFN"),^TMP($J,"AWRD"),XTLKDFN(),XTLKNUSE(),XTLKNWDS,
|
|---|
| 6 | ; XTLKPRTL(),XTLKWORD()
|
|---|
| 7 | ;
|
|---|
| 8 | PREPSCH ; PREPARE FOR SEARCH BY BUILDING WORD/DFN TABLES
|
|---|
| 9 | S XTLKNWDS=0
|
|---|
| 10 | G:$O(XTLKWT(""))="" PREPSCHX
|
|---|
| 11 | S XTLKNWS=^DD("KWIC")_"^IN^OF^AN^IS^AS^AT^IF^IT^ON^OR^BY^"
|
|---|
| 12 | W:XTLKSAY=1 "("
|
|---|
| 13 | S XTLKWD=""=0
|
|---|
| 14 | F XTLKQ=0:0 S XTLKWD=$O(XTLKWT(XTLKWD)) Q:XTLKWD="" D WDCHK
|
|---|
| 15 | W:XTLKSAY=1 " )",!
|
|---|
| 16 | PREPSCHX K XTLKWT,XTLKNWS,XTLKWD,XTLKQ
|
|---|
| 17 | K XTLKEXAC,XTLKPART,XTLKSYN,XTLKINCR
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | WDCHK ; DETERMINE IF PARTIAL OR EXACT MATCH
|
|---|
| 21 | S XTLKWSAV=XTLKWD
|
|---|
| 22 | S (XTLKISNT,XTLKFXAC)=0
|
|---|
| 23 | RECHK I $E(XTLKWD)="'" S XTLKISNT=1,XTLKWD=$E(XTLKWD,2,255) G RECHK
|
|---|
| 24 | I $E(XTLKWD)="~" S XTLKFXAC=1,XTLKWD=$E(XTLKWD,2,255) G RECHK
|
|---|
| 25 | I XTLKWD?1N.E!(XTLKNWS[("^"_XTLKWD_"^")) S XTLKNUSE=XTLKNUSE+1,XTLKNUSE(XTLKWD)="" G WDCHKX
|
|---|
| 26 | S XTLKINCR=0,XTLKSYN=$D(^XT(8984.3,"AC",$P(XTLKREF1,U,2),XTLKWD))
|
|---|
| 27 | I 'XTLKSYN D CKWD G WDCHKX
|
|---|
| 28 | S XTLKWDTX=$O(^XT(8984.3,"AC",$P(XTLKREF1,U,2),XTLKWD,0))
|
|---|
| 29 | S XTLKWX=XTLKWD,XTLKWDSX=0 F XTLKQ=0:0 S XTLKWDSX=$O(^XT(8984.3,XTLKWDTX,1,XTLKWDSX)) Q:'XTLKWDSX S XTLKWD=^(XTLKWDSX,0) D CKWD
|
|---|
| 30 | WDCHKX ;
|
|---|
| 31 | S XTLKWD=XTLKWSAV
|
|---|
| 32 | K XTLKWSAV,XTLKWX,XTLKISNT,XTLKFXAC,XTLKWDTX,XTLKWDSX
|
|---|
| 33 | K XTLKI,XTLKJ
|
|---|
| 34 | Q
|
|---|
| 35 | CK ;
|
|---|
| 36 | Q
|
|---|
| 37 | CKWD ;
|
|---|
| 38 | S XTLKEXAC=$S($D(@XTLKREF):1,1:0)
|
|---|
| 39 | S XTLKWD2=$O(@XTLKREF)
|
|---|
| 40 | S XTLKPART=('XTLKFXAC)&($L(XTLKWD)>2)&($S($E(XTLKWD2,1,$L(XTLKWD))=XTLKWD:1,1:0))
|
|---|
| 41 | I 'XTLKEXAC&('XTLKPART)&($L(XTLKWD)>2) S XTLKWD=$E(XTLKWD,1,($L(XTLKWD)-1)) G CKWD
|
|---|
| 42 | I 'XTLKEXAC,'XTLKPART S XTLKNUSE=XTLKNUSE+1,XTLKNUSE(XTLKWD)="" K XTLKWD2 Q
|
|---|
| 43 | CKNOT I XTLKISNT S XTLKINCX=XTLKINCR,XTLKNWDX=XTLKNWDS,XTLKINCR=1,XTLKNWDS=0 D CKWD2 S XTLKINCR=XTLKINCX,XTLKNWDS=XTLKNWDX K XTLKISNT,XTLKINCX,XTLKNWDX Q
|
|---|
| 44 | CKWD2 W:XTLKSAY=1 $S(XTLKSYN&XTLKINCR:"|",1:" ")_$S(XTLKFXAC:"~",1:"")_$S(XTLKISNT:"'",1:"")_XTLKWD ;W:PART&('FEXACT)&($E($O(@REF),1,$L(WD))=WD) "=>"
|
|---|
| 45 | I 'XTLKSYN,XTLKEXAC,'XTLKPART,'XTLKISNT S XTLKNWDS=XTLKNWDS+1,XTLKPRTL(XTLKNWDS)=0,XTLKWORD(XTLKNWDS)=XTLKWD,XTLKDFN(XTLKNWDS)=$O(@XTLKREF2) Q
|
|---|
| 46 | S:'XTLKINCR XTLKNWDS=XTLKNWDS+1,XTLKPRTL(XTLKNWDS)=1,XTLKWORD(XTLKNWDS)=XTLKWD
|
|---|
| 47 | S XTLKWD2=XTLKWD
|
|---|
| 48 | S XTLKN=0 S XTLKJ="" F XTLKQ=0:0 S XTLKJ=$O(^TMP($J,"AWRD",XTLKNWDS,XTLKJ)) Q:XTLKJ="" S XTLKN=XTLKJ
|
|---|
| 49 | S XTLKN=XTLKN+1
|
|---|
| 50 | I XTLKEXAC S ^TMP($J,"AWRD",XTLKNWDS,XTLKN)=XTLKWD,^TMP($J,"ADFN",XTLKNWDS,XTLKN)=$O(@XTLKREF2),XTLKN=XTLKN+1
|
|---|
| 51 | CKWD3 I 'XTLKFXAC F XTLKN=XTLKN:1 S XTLKWD=$O(@XTLKREF) Q:$E(XTLKWD,1,$L(XTLKWD2))'=XTLKWD2 S ^TMP($J,"AWRD",XTLKNWDS,XTLKN)=XTLKWD,^TMP($J,"ADFN",XTLKNWDS,XTLKN)=$O(@XTLKREF2) W:XTLKSAY=1 "/",XTLKWD
|
|---|
| 52 | S XTLKWD=XTLKWD2
|
|---|
| 53 | S XTLKN=XTLKN-1
|
|---|
| 54 | S XTLKD=^TMP($J,"ADFN",XTLKNWDS,1) F XTLKI=1:1:XTLKN S:^TMP($J,"ADFN",XTLKNWDS,XTLKI)<XTLKD XTLKD=^TMP($J,"ADFN",XTLKNWDS,XTLKI)
|
|---|
| 55 | S XTLKDFN(XTLKNWDS)=XTLKD
|
|---|
| 56 | I 'XTLKSYN,XTLKN=1 S XTLKPRTL(XTLKNWDS)=0,XTLKWORD(XTLKNWDS)=^TMP($J,"AWRD",XTLKNWDS,1),XTLKDFN(XTLKNWDS)=^TMP($J,"ADFN",XTLKNWDS,1)
|
|---|
| 57 | S XTLKINCR=1
|
|---|
| 58 | K XTLKN,XTLKWD2,XTLKD
|
|---|
| 59 | Q
|
|---|
