- XTLKKWL2 ; IHS/OHPRD/ACC,ALB/JLU,SFISC/JC- PART 3 OF LOOKUP CONTROL PROGRAM FOR "AND"ING INVERTED SEARCH ;07/22/93 15:47
- ;;7.3;TOOLKIT;;Apr 25, 1995
- ; XTLKKWCT,XTLKREF,XTLKREF2 ARE PASSED IN AND SHOULD NOT BE KILLED
- ; THE FOLLOWING ARE PASSED OUT AND SHOULD NOT BE KILLED:
- ; ^TMP($J,"ADFN"),^TMP($J,"AWRD"),XTLKDFN(),XTLKNUSE(),XTLKNWDS,
- ; XTLKPRTL(),XTLKWORD()
- ;
- PREPSCH ; PREPARE FOR SEARCH BY BUILDING WORD/DFN TABLES
- S XTLKNWDS=0
- G:$O(XTLKWT(""))="" PREPSCHX
- S XTLKNWS=^DD("KWIC")_"^IN^OF^AN^IS^AS^AT^IF^IT^ON^OR^BY^"
- W:XTLKSAY=1 "("
- S XTLKWD=""=0
- F XTLKQ=0:0 S XTLKWD=$O(XTLKWT(XTLKWD)) Q:XTLKWD="" D WDCHK
- W:XTLKSAY=1 " )",!
- PREPSCHX K XTLKWT,XTLKNWS,XTLKWD,XTLKQ
- K XTLKEXAC,XTLKPART,XTLKSYN,XTLKINCR
- Q
- ;
- WDCHK ; DETERMINE IF PARTIAL OR EXACT MATCH
- S XTLKWSAV=XTLKWD
- S (XTLKISNT,XTLKFXAC)=0
- RECHK I $E(XTLKWD)="'" S XTLKISNT=1,XTLKWD=$E(XTLKWD,2,255) G RECHK
- I $E(XTLKWD)="~" S XTLKFXAC=1,XTLKWD=$E(XTLKWD,2,255) G RECHK
- I XTLKWD?1N.E!(XTLKNWS[("^"_XTLKWD_"^")) S XTLKNUSE=XTLKNUSE+1,XTLKNUSE(XTLKWD)="" G WDCHKX
- S XTLKINCR=0,XTLKSYN=$D(^XT(8984.3,"AC",$P(XTLKREF1,U,2),XTLKWD))
- I 'XTLKSYN D CKWD G WDCHKX
- S XTLKWDTX=$O(^XT(8984.3,"AC",$P(XTLKREF1,U,2),XTLKWD,0))
- 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
- WDCHKX ;
- S XTLKWD=XTLKWSAV
- K XTLKWSAV,XTLKWX,XTLKISNT,XTLKFXAC,XTLKWDTX,XTLKWDSX
- K XTLKI,XTLKJ
- Q
- CK ;
- Q
- CKWD ;
- S XTLKEXAC=$S($D(@XTLKREF):1,1:0)
- S XTLKWD2=$O(@XTLKREF)
- S XTLKPART=('XTLKFXAC)&($L(XTLKWD)>2)&($S($E(XTLKWD2,1,$L(XTLKWD))=XTLKWD:1,1:0))
- I 'XTLKEXAC&('XTLKPART)&($L(XTLKWD)>2) S XTLKWD=$E(XTLKWD,1,($L(XTLKWD)-1)) G CKWD
- I 'XTLKEXAC,'XTLKPART S XTLKNUSE=XTLKNUSE+1,XTLKNUSE(XTLKWD)="" K XTLKWD2 Q
- CKNOT I XTLKISNT S XTLKINCX=XTLKINCR,XTLKNWDX=XTLKNWDS,XTLKINCR=1,XTLKNWDS=0 D CKWD2 S XTLKINCR=XTLKINCX,XTLKNWDS=XTLKNWDX K XTLKISNT,XTLKINCX,XTLKNWDX Q
- 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) "=>"
- I 'XTLKSYN,XTLKEXAC,'XTLKPART,'XTLKISNT S XTLKNWDS=XTLKNWDS+1,XTLKPRTL(XTLKNWDS)=0,XTLKWORD(XTLKNWDS)=XTLKWD,XTLKDFN(XTLKNWDS)=$O(@XTLKREF2) Q
- S:'XTLKINCR XTLKNWDS=XTLKNWDS+1,XTLKPRTL(XTLKNWDS)=1,XTLKWORD(XTLKNWDS)=XTLKWD
- S XTLKWD2=XTLKWD
- S XTLKN=0 S XTLKJ="" F XTLKQ=0:0 S XTLKJ=$O(^TMP($J,"AWRD",XTLKNWDS,XTLKJ)) Q:XTLKJ="" S XTLKN=XTLKJ
- S XTLKN=XTLKN+1
- I XTLKEXAC S ^TMP($J,"AWRD",XTLKNWDS,XTLKN)=XTLKWD,^TMP($J,"ADFN",XTLKNWDS,XTLKN)=$O(@XTLKREF2),XTLKN=XTLKN+1
- 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
- S XTLKWD=XTLKWD2
- S XTLKN=XTLKN-1
- 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)
- S XTLKDFN(XTLKNWDS)=XTLKD
- I 'XTLKSYN,XTLKN=1 S XTLKPRTL(XTLKNWDS)=0,XTLKWORD(XTLKNWDS)=^TMP($J,"AWRD",XTLKNWDS,1),XTLKDFN(XTLKNWDS)=^TMP($J,"ADFN",XTLKNWDS,1)
- S XTLKINCR=1
- K XTLKN,XTLKWD2,XTLKD
- Q
- XTLKKWL2 ; IHS/OHPRD/ACC,ALB/JLU,SFISC/JC- PART 3 OF LOOKUP CONTROL PROGRAM FOR "AND"ING INVERTED SEARCH ;07/22/93 15:47
- +1 ;;7.3;TOOLKIT;;Apr 25, 1995
- +2 ; XTLKKWCT,XTLKREF,XTLKREF2 ARE PASSED IN AND SHOULD NOT BE KILLED
- +3 ; THE FOLLOWING ARE PASSED OUT AND SHOULD NOT BE KILLED:
- +4 ; ^TMP($J,"ADFN"),^TMP($J,"AWRD"),XTLKDFN(),XTLKNUSE(),XTLKNWDS,
- +5 ; XTLKPRTL(),XTLKWORD()
- +6 ;
- PREPSCH ; PREPARE FOR SEARCH BY BUILDING WORD/DFN TABLES
- +1 SET XTLKNWDS=0
- +2 IF $ORDER(XTLKWT(""))=""
- GOTO PREPSCHX
- +3 SET XTLKNWS=^DD("KWIC")_"^IN^OF^AN^IS^AS^AT^IF^IT^ON^OR^BY^"
- +4 IF XTLKSAY=1
- WRITE "("
- +5 SET XTLKWD=""=0
- +6 FOR XTLKQ=0:0
- SET XTLKWD=$ORDER(XTLKWT(XTLKWD))
- IF XTLKWD=""
- QUIT
- DO WDCHK
- +7 IF XTLKSAY=1
- WRITE " )",!
- PREPSCHX KILL XTLKWT,XTLKNWS,XTLKWD,XTLKQ
- +1 KILL XTLKEXAC,XTLKPART,XTLKSYN,XTLKINCR
- +2 QUIT
- +3 ;
- WDCHK ; DETERMINE IF PARTIAL OR EXACT MATCH
- +1 SET XTLKWSAV=XTLKWD
- +2 SET (XTLKISNT,XTLKFXAC)=0
- RECHK IF $EXTRACT(XTLKWD)="'"
- SET XTLKISNT=1
- SET XTLKWD=$EXTRACT(XTLKWD,2,255)
- GOTO RECHK
- +1 IF $EXTRACT(XTLKWD)="~"
- SET XTLKFXAC=1
- SET XTLKWD=$EXTRACT(XTLKWD,2,255)
- GOTO RECHK
- +2 IF XTLKWD?1N.E!(XTLKNWS[("^"_XTLKWD_"^"))
- SET XTLKNUSE=XTLKNUSE+1
- SET XTLKNUSE(XTLKWD)=""
- GOTO WDCHKX
- +3 SET XTLKINCR=0
- SET XTLKSYN=$DATA(^XT(8984.3,"AC",$PIECE(XTLKREF1,U,2),XTLKWD))
- +4 IF 'XTLKSYN
- DO CKWD
- GOTO WDCHKX
- +5 SET XTLKWDTX=$ORDER(^XT(8984.3,"AC",$PIECE(XTLKREF1,U,2),XTLKWD,0))
- +6 SET XTLKWX=XTLKWD
- SET XTLKWDSX=0
- FOR XTLKQ=0:0
- SET XTLKWDSX=$ORDER(^XT(8984.3,XTLKWDTX,1,XTLKWDSX))
- IF 'XTLKWDSX
- QUIT
- SET XTLKWD=^(XTLKWDSX,0)
- DO CKWD
- WDCHKX ;
- +1 SET XTLKWD=XTLKWSAV
- +2 KILL XTLKWSAV,XTLKWX,XTLKISNT,XTLKFXAC,XTLKWDTX,XTLKWDSX
- +3 KILL XTLKI,XTLKJ
- +4 QUIT
- CK ;
- +1 QUIT
- CKWD ;
- +1 SET XTLKEXAC=$SELECT($DATA(@XTLKREF):1,1:0)
- +2 SET XTLKWD2=$ORDER(@XTLKREF)
- +3 SET XTLKPART=('XTLKFXAC)&($LENGTH(XTLKWD)>2)&($SELECT($EXTRACT(XTLKWD2,1,$LENGTH(XTLKWD))=XTLKWD:1,1:0))
- +4 IF 'XTLKEXAC&('XTLKPART)&($LENGTH(XTLKWD)>2)
- SET XTLKWD=$EXTRACT(XTLKWD,1,($LENGTH(XTLKWD)-1))
- GOTO CKWD
- +5 IF 'XTLKEXAC
- IF 'XTLKPART
- SET XTLKNUSE=XTLKNUSE+1
- SET XTLKNUSE(XTLKWD)=""
- KILL XTLKWD2
- QUIT
- CKNOT IF XTLKISNT
- SET XTLKINCX=XTLKINCR
- SET XTLKNWDX=XTLKNWDS
- SET XTLKINCR=1
- SET XTLKNWDS=0
- DO CKWD2
- SET XTLKINCR=XTLKINCX
- SET XTLKNWDS=XTLKNWDX
- KILL XTLKISNT,XTLKINCX,XTLKNWDX
- QUIT
- CKWD2 ;W:PART&('FEXACT)&($E($O(@REF),1,$L(WD))=WD) "=>"
- IF XTLKSAY=1
- WRITE $SELECT(XTLKSYN&XTLKINCR:"|",1:" ")_$SELECT(XTLKFXAC:"~",1:"")_$SELECT(XTLKISNT:"'",1:"")_XTLKWD
- +1 IF 'XTLKSYN
- IF XTLKEXAC
- IF 'XTLKPART
- IF 'XTLKISNT
- SET XTLKNWDS=XTLKNWDS+1
- SET XTLKPRTL(XTLKNWDS)=0
- SET XTLKWORD(XTLKNWDS)=XTLKWD
- SET XTLKDFN(XTLKNWDS)=$ORDER(@XTLKREF2)
- QUIT
- +2 IF 'XTLKINCR
- SET XTLKNWDS=XTLKNWDS+1
- SET XTLKPRTL(XTLKNWDS)=1
- SET XTLKWORD(XTLKNWDS)=XTLKWD
- +3 SET XTLKWD2=XTLKWD
- +4 SET XTLKN=0
- SET XTLKJ=""
- FOR XTLKQ=0:0
- SET XTLKJ=$ORDER(^TMP($JOB,"AWRD",XTLKNWDS,XTLKJ))
- IF XTLKJ=""
- QUIT
- SET XTLKN=XTLKJ
- +5 SET XTLKN=XTLKN+1
- +6 IF XTLKEXAC
- SET ^TMP($JOB,"AWRD",XTLKNWDS,XTLKN)=XTLKWD
- SET ^TMP($JOB,"ADFN",XTLKNWDS,XTLKN)=$ORDER(@XTLKREF2)
- SET XTLKN=XTLKN+1
- CKWD3 IF 'XTLKFXAC
- FOR XTLKN=XTLKN:1
- SET XTLKWD=$ORDER(@XTLKREF)
- IF $EXTRACT(XTLKWD,1,$LENGTH(XTLKWD2))'=XTLKWD2
- QUIT
- SET ^TMP($JOB,"AWRD",XTLKNWDS,XTLKN)=XTLKWD
- SET ^TMP($JOB,"ADFN",XTLKNWDS,XTLKN)=$ORDER(@XTLKREF2)
- IF XTLKSAY=1
- WRITE "/",XTLKWD
- +1 SET XTLKWD=XTLKWD2
- +2 SET XTLKN=XTLKN-1
- +3 SET XTLKD=^TMP($JOB,"ADFN",XTLKNWDS,1)
- FOR XTLKI=1:1:XTLKN
- IF ^TMP($JOB,"ADFN",XTLKNWDS,XTLKI)<XTLKD
- SET XTLKD=^TMP($JOB,"ADFN",XTLKNWDS,XTLKI)
- +4 SET XTLKDFN(XTLKNWDS)=XTLKD
- +5 IF 'XTLKSYN
- IF XTLKN=1
- SET XTLKPRTL(XTLKNWDS)=0
- SET XTLKWORD(XTLKNWDS)=^TMP($JOB,"AWRD",XTLKNWDS,1)
- SET XTLKDFN(XTLKNWDS)=^TMP($JOB,"ADFN",XTLKNWDS,1)
- +6 SET XTLKINCR=1
- +7 KILL XTLKN,XTLKWD2,XTLKD
- +8 QUIT
