AICDKWL2 ; IHS/OHPRD/ACC - PART 3 OF LOOKUP CONTROL PROGRAM FOR "AND"ING INVERTED SEARCH ;
;;4.0;AICD;;DEC 03, 2014;Build 7
; AICDKWCT,AICDREF,AICDREF2 ARE PASSED IN AND SHOULD NOT BE KILLED
; THE FOLLOWING ARE PASSED OUT AND SHOULD NOT BE KILLED:
; AICDADFN(),AICDAWRD(),AICDDFN(),AICDNUSE(),AICDNWDS,
; AICDPRTL(),AICDWORD()
;
PREPSCH ; PREPARE FOR SEARCH BY BUILDING WORD/DFN TABLES
S AICDNWDS=0
G:$O(AICDWT(""))="" PREPSCHX
S AICDNWS=^DD("KWIC")_"IN^OF^AN^IS^AS^AT^IF^IT^ON^OR^BY^"
S AICDWD=""
F AICDQ=0:0 S AICDWD=$O(AICDWT(AICDWD)) Q:AICDWD="" D WDCHK
W:AICDASK&AICDNWDS " )",!
PREPSCHX K AICDWT,AICDNWS,AICDWD,AICDQ
K AICDEXAC,AICDPART,AICDSYN,AICDINCR
Q
;
WDCHK ; DETERMINE IF PARTIAL OR EXACT MATCH
S AICDWSAV=AICDWD
S (AICDISNT,AICDFXAC)=0
RECHK I $E(AICDWD)="'" S AICDISNT=1,AICDWD=$E(AICDWD,2,255) G RECHK
I $E(AICDWD)="~" S AICDFXAC=1,AICDWD=$E(AICDWD,2,255) G RECHK
I AICDWD?1N.E!(AICDNWS[("^"_AICDWD_"^")) S AICDNUSE=AICDNUSE+1,AICDNUSE(AICDWD)="" G WDCHKX
S AICDINCR=0,AICDSYN=$D(^AICDKWLC(AICDKWCT,1,"B",AICDWD))
I 'AICDSYN D CKWD G WDCHKX
S AICDWDTX=$O(^AICDKWLC(AICDKWCT,1,"B",AICDWD,0))
S AICDWX=AICDWD,AICDWDSX=0 F AICDQ=0:0 S AICDWDSX=$O(^AICDKWLC(AICDKWCT,1,AICDWDTX,1,AICDWDSX)) Q:AICDWDSX="" S AICDWD=^AICDKWLC(AICDKWCT,1,AICDWDTX,1,AICDWDSX,0) D CKWD
WDCHKX S AICDWD=AICDWSAV
K AICDWSAV,AICDWX,AICDISNT,AICDFXAC,AICDWDTX,AICDWDSX
K AICDI,AICDJ
Q
CKWD S AICDEXAC=$S($D(@AICDREF):1,1:0)
S AICDWD2=$O(@AICDREF)
S AICDPART=('AICDFXAC)&($L(AICDWD)>2)&($S($E(AICDWD2,1,$L(AICDWD))=AICDWD:1,1:0))
I 'AICDEXAC,'AICDPART S AICDNUSE=AICDNUSE+1,AICDNUSE(AICDWD)="" K AICDWD2 Q
CKNOT I AICDISNT S AICDINCX=AICDINCR,AICDNWDX=AICDNWDS,AICDINCR=1,AICDNWDS=0 D CKWD2 S AICDINCR=AICDINCX,AICDNWDS=AICDNWDX K AICDISNT,AICDINCX,AICDNWDX Q
CKWD2 I AICDASK W:'AICDNWDS "(" W $S(AICDSYN&AICDINCR:"|",1:" ")_$S(AICDFXAC:"~",1:"")_$S(AICDISNT:"'",1:"")_AICDWD
I 'AICDSYN,AICDEXAC,'AICDPART,'AICDISNT S AICDNWDS=AICDNWDS+1,AICDPRTL(AICDNWDS)=0,AICDWORD(AICDNWDS)=AICDWD,AICDDFN(AICDNWDS)=$O(@AICDREF2) Q
S:'AICDINCR AICDNWDS=AICDNWDS+1,AICDPRTL(AICDNWDS)=1,AICDWORD(AICDNWDS)=AICDWD
S AICDWD2=AICDWD
S AICDN=0 S AICDJ="" F AICDQ=0:0 S AICDJ=$O(AICDAWRD(AICDNWDS,AICDJ)) Q:AICDJ="" S AICDN=AICDJ
S AICDN=AICDN+1
I AICDEXAC S AICDAWRD(AICDNWDS,AICDN)=AICDWD,AICDADFN(AICDNWDS,AICDN)=$O(@AICDREF2),AICDN=AICDN+1
CKWD3 I 'AICDFXAC F AICDN=AICDN:1 S AICDWD=$O(@AICDREF) Q:$E(AICDWD,1,$L(AICDWD2))'=AICDWD2 S AICDAWRD(AICDNWDS,AICDN)=AICDWD,AICDADFN(AICDNWDS,AICDN)=$O(@AICDREF2) W:AICDASK "/",AICDWD
S AICDWD=AICDWD2
S AICDN=AICDN-1
S AICDD=AICDADFN(AICDNWDS,1) F AICDI=1:1:AICDN S:AICDADFN(AICDNWDS,AICDI)<AICDD AICDD=AICDADFN(AICDNWDS,AICDI)
S AICDDFN(AICDNWDS)=AICDD
I 'AICDSYN,AICDN=1 S AICDPRTL(AICDNWDS)=0,AICDWORD(AICDNWDS)=AICDAWRD(AICDNWDS,1),AICDDFN(AICDNWDS)=AICDADFN(AICDNWDS,1)
S AICDINCR=1
K AICDN,AICDWD2,AICDD
Q
AICDKWL2 ; IHS/OHPRD/ACC - PART 3 OF LOOKUP CONTROL PROGRAM FOR "AND"ING INVERTED SEARCH ;
+1 ;;4.0;AICD;;DEC 03, 2014;Build 7
+2 ; AICDKWCT,AICDREF,AICDREF2 ARE PASSED IN AND SHOULD NOT BE KILLED
+3 ; THE FOLLOWING ARE PASSED OUT AND SHOULD NOT BE KILLED:
+4 ; AICDADFN(),AICDAWRD(),AICDDFN(),AICDNUSE(),AICDNWDS,
+5 ; AICDPRTL(),AICDWORD()
+6 ;
PREPSCH ; PREPARE FOR SEARCH BY BUILDING WORD/DFN TABLES
+1 SET AICDNWDS=0
+2 IF $ORDER(AICDWT(""))=""
GOTO PREPSCHX
+3 SET AICDNWS=^DD("KWIC")_"IN^OF^AN^IS^AS^AT^IF^IT^ON^OR^BY^"
+4 SET AICDWD=""
+5 FOR AICDQ=0:0
SET AICDWD=$ORDER(AICDWT(AICDWD))
IF AICDWD=""
QUIT
DO WDCHK
+6 IF AICDASK&AICDNWDS
WRITE " )",!
PREPSCHX KILL AICDWT,AICDNWS,AICDWD,AICDQ
+1 KILL AICDEXAC,AICDPART,AICDSYN,AICDINCR
+2 QUIT
+3 ;
WDCHK ; DETERMINE IF PARTIAL OR EXACT MATCH
+1 SET AICDWSAV=AICDWD
+2 SET (AICDISNT,AICDFXAC)=0
RECHK IF $EXTRACT(AICDWD)="'"
SET AICDISNT=1
SET AICDWD=$EXTRACT(AICDWD,2,255)
GOTO RECHK
+1 IF $EXTRACT(AICDWD)="~"
SET AICDFXAC=1
SET AICDWD=$EXTRACT(AICDWD,2,255)
GOTO RECHK
+2 IF AICDWD?1N.E!(AICDNWS[("^"_AICDWD_"^"))
SET AICDNUSE=AICDNUSE+1
SET AICDNUSE(AICDWD)=""
GOTO WDCHKX
+3 SET AICDINCR=0
SET AICDSYN=$DATA(^AICDKWLC(AICDKWCT,1,"B",AICDWD))
+4 IF 'AICDSYN
DO CKWD
GOTO WDCHKX
+5 SET AICDWDTX=$ORDER(^AICDKWLC(AICDKWCT,1,"B",AICDWD,0))
+6 SET AICDWX=AICDWD
SET AICDWDSX=0
FOR AICDQ=0:0
SET AICDWDSX=$ORDER(^AICDKWLC(AICDKWCT,1,AICDWDTX,1,AICDWDSX))
IF AICDWDSX=""
QUIT
SET AICDWD=^AICDKWLC(AICDKWCT,1,AICDWDTX,1,AICDWDSX,0)
DO CKWD
WDCHKX SET AICDWD=AICDWSAV
+1 KILL AICDWSAV,AICDWX,AICDISNT,AICDFXAC,AICDWDTX,AICDWDSX
+2 KILL AICDI,AICDJ
+3 QUIT
CKWD SET AICDEXAC=$SELECT($DATA(@AICDREF):1,1:0)
+1 SET AICDWD2=$ORDER(@AICDREF)
+2 SET AICDPART=('AICDFXAC)&($LENGTH(AICDWD)>2)&($SELECT($EXTRACT(AICDWD2,1,$LENGTH(AICDWD))=AICDWD:1,1:0))
+3 IF 'AICDEXAC
IF 'AICDPART
SET AICDNUSE=AICDNUSE+1
SET AICDNUSE(AICDWD)=""
KILL AICDWD2
QUIT
CKNOT IF AICDISNT
SET AICDINCX=AICDINCR
SET AICDNWDX=AICDNWDS
SET AICDINCR=1
SET AICDNWDS=0
DO CKWD2
SET AICDINCR=AICDINCX
SET AICDNWDS=AICDNWDX
KILL AICDISNT,AICDINCX,AICDNWDX
QUIT
CKWD2 IF AICDASK
IF 'AICDNWDS
WRITE "("
WRITE $SELECT(AICDSYN&AICDINCR:"|",1:" ")_$SELECT(AICDFXAC:"~",1:"")_$SELECT(AICDISNT:"'",1:"")_AICDWD
+1 IF 'AICDSYN
IF AICDEXAC
IF 'AICDPART
IF 'AICDISNT
SET AICDNWDS=AICDNWDS+1
SET AICDPRTL(AICDNWDS)=0
SET AICDWORD(AICDNWDS)=AICDWD
SET AICDDFN(AICDNWDS)=$ORDER(@AICDREF2)
QUIT
+2 IF 'AICDINCR
SET AICDNWDS=AICDNWDS+1
SET AICDPRTL(AICDNWDS)=1
SET AICDWORD(AICDNWDS)=AICDWD
+3 SET AICDWD2=AICDWD
+4 SET AICDN=0
SET AICDJ=""
FOR AICDQ=0:0
SET AICDJ=$ORDER(AICDAWRD(AICDNWDS,AICDJ))
IF AICDJ=""
QUIT
SET AICDN=AICDJ
+5 SET AICDN=AICDN+1
+6 IF AICDEXAC
SET AICDAWRD(AICDNWDS,AICDN)=AICDWD
SET AICDADFN(AICDNWDS,AICDN)=$ORDER(@AICDREF2)
SET AICDN=AICDN+1
CKWD3 IF 'AICDFXAC
FOR AICDN=AICDN:1
SET AICDWD=$ORDER(@AICDREF)
IF $EXTRACT(AICDWD,1,$LENGTH(AICDWD2))'=AICDWD2
QUIT
SET AICDAWRD(AICDNWDS,AICDN)=AICDWD
SET AICDADFN(AICDNWDS,AICDN)=$ORDER(@AICDREF2)
IF AICDASK
WRITE "/",AICDWD
+1 SET AICDWD=AICDWD2
+2 SET AICDN=AICDN-1
+3 SET AICDD=AICDADFN(AICDNWDS,1)
FOR AICDI=1:1:AICDN
IF AICDADFN(AICDNWDS,AICDI)<AICDD
SET AICDD=AICDADFN(AICDNWDS,AICDI)
+4 SET AICDDFN(AICDNWDS)=AICDD
+5 IF 'AICDSYN
IF AICDN=1
SET AICDPRTL(AICDNWDS)=0
SET AICDWORD(AICDNWDS)=AICDAWRD(AICDNWDS,1)
SET AICDDFN(AICDNWDS)=AICDADFN(AICDNWDS,1)
+6 SET AICDINCR=1
+7 KILL AICDN,AICDWD2,AICDD
+8 QUIT
