- 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
