AICDKWIC.m

AICDKWIC ; KWIC ROUTINE FOR LOOKUP ENGINE ;

 ;;4.0;AICD;;DEC 03, 2014;Build 7

S N AICDSWB,AICDOST,AICDST,AICDLLEN,AICDC,AICDD,AICDI,AICDJ,AICDWF,AICDWS,AICDWD,AICDWD2,AICDWL,AICDEND,AICDQ

 S AICDD=%,AICDL=X D TOKENIZE S AICDI="" F AICDJ=0:0 S AICDI=$O(AICDWT(AICDI)) Q:AICDI=""  I ^DD("KWIC")'[("^"_AICDI_"^") S @AICDD=""

 G QUIT

K N AICDSWB,AICDOST,AICDST,AICDLLEN,AICDC,AICDD,AICDI,AICDJ,AICDWF,AICDWS,AICDWD,AICDWD2,AICDWL,AICDEND,AICDQ

 S AICDD=%,AICDL=X D TOKENIZE S AICDI="" F AICDJ=0:0 S AICDI=$O(AICDWT(AICDI)) Q:AICDI=""  I ^DD("KWIC")'[("^"_AICDI_"^") K:'($D(@AICDD)\10) @AICDD

QUIT K AICDL,AICDWT,AICDI,AICDJ Q

TOKENIZE ; CONVERT INPUT LINE TO TOKENS ; [ 03/20/86  12:44 PM ]

 K AICDWT

 D CONVERT

 K AICDSWB,AICDOST,AICDST,AICDLLEN,AICDC,AICDI,AICDJ,AICDWF,AICDWS,AICDWD,AICDWD2,AICDWL,AICDEND,AICDQ

 Q

 ;

CONVERT ; DO ACTUAL CONVERSION

 S AICDSWB="",AICDST="SKIP",AICDI=0,AICDLLEN=$L(AICDL)

CHLOOP S AICDI=AICDI+1

 I AICDI>AICDLLEN S AICDEND=1 D:AICDST="SCAN" ENDWORD Q

 S AICDC=$E(AICDL,AICDI)

 S AICDOST=AICDST

 I AICDOST="SKIP",AICDC'?1P S AICDST="SCAN",AICDWS=AICDI

 I AICDOST="SCAN",AICDC?1P,AICDC'="-",AICDC'="'" S AICDEND=0 D ENDWORD S AICDST="SKIP"

 G CHLOOP

ENDWORD S AICDWL=AICDI-AICDWS,AICDWD=$E(AICDL,AICDWS,AICDI-1)

 I AICDWL=1 S AICDSWB=AICDSWB_AICDWD I AICDEND S AICDWD=AICDSWB D STOREWD

 I AICDWL>1 D STOREWD I AICDSWB'="" S AICDWD=AICDSWB,AICDSWB="" D STOREWD

 Q

STOREWD ;

REMQT S AICDJ=$F(AICDWD,"'") I AICDJ>0 S AICDWD=$E(AICDWD,1,AICDJ-2)_$E(AICDWD,AICDJ,255) G REMQT

 I AICDWD'["-" D STOREWD2 Q

 S AICDWD2="" F AICDJ=1:1 S AICDWF=$P(AICDWD,"-",AICDJ) Q:AICDWF=""  Q:$L(AICDWF)>2  S AICDWD2=AICDWD2_AICDWF

 I AICDWF="" S AICDWD=AICDWD2 D STOREWD2 Q

 S AICDWD2=AICDWD F AICDJ=1:1 S AICDWF=$P(AICDWD2,"-",AICDJ) Q:AICDWF=""  S AICDWD=AICDWF D STOREWD2

 Q

STOREWD2 ;

 Q:(AICDWD?1N.E)!(^DD("KWIC")[("^"_AICDWD_"^"))

 Q:$L(AICDWD)=2&("^IN^OF^AN^IS^AS^AT^IF^IT^ON^OR^BY^"[("^"_AICDWD_"^"))

 Q:AICDWD?1N.E

 S AICDWT(AICDWD)=""

 Q

AICDKWIC  ; KWIC ROUTINE FOR LOOKUP ENGINE ;

 +1       ;;4.0;AICD;;DEC 03, 2014;Build 7

S          NEW AICDSWB,AICDOST,AICDST,AICDLLEN,AICDC,AICDD,AICDI,AICDJ,AICDWF,AICDWS,AICDWD,AICDWD2,AICDWL,AICDEND,AICDQ

 +1        SET AICDD=%

           SET AICDL=X

           DO TOKENIZE

           SET AICDI=""

           FOR AICDJ=0:0

               SET AICDI=$ORDER(AICDWT(AICDI))

               IF AICDI=""

                   QUIT 

               IF ^DD("KWIC")'[("^"_AICDI_"^")

                   SET @AICDD=""

 +2        GOTO QUIT

K          NEW AICDSWB,AICDOST,AICDST,AICDLLEN,AICDC,AICDD,AICDI,AICDJ,AICDWF,AICDWS,AICDWD,AICDWD2,AICDWL,AICDEND,AICDQ

 +1        SET AICDD=%

           SET AICDL=X

           DO TOKENIZE

           SET AICDI=""

           FOR AICDJ=0:0

               SET AICDI=$ORDER(AICDWT(AICDI))

               IF AICDI=""

                   QUIT 

               IF ^DD("KWIC")'[("^"_AICDI_"^")

                   IF '($DATA(@AICDD)\10)

                       KILL @AICDD

QUIT       KILL AICDL,AICDWT,AICDI,AICDJ

           QUIT 

TOKENIZE  ; CONVERT INPUT LINE TO TOKENS ; [ 03/20/86  12:44 PM ]

 +1        KILL AICDWT

 +2        DO CONVERT

 +3        KILL AICDSWB,AICDOST,AICDST,AICDLLEN,AICDC,AICDI,AICDJ,AICDWF,AICDWS,AICDWD,AICDWD2,AICDWL,AICDEND,AICDQ

 +4        QUIT 

 +5       ;

CONVERT   ; DO ACTUAL CONVERSION

 +1        SET AICDSWB=""

           SET AICDST="SKIP"

           SET AICDI=0

           SET AICDLLEN=$LENGTH(AICDL)

CHLOOP     SET AICDI=AICDI+1

 +1        IF AICDI>AICDLLEN

               SET AICDEND=1

               IF AICDST="SCAN"

                   DO ENDWORD

               QUIT 

 +2        SET AICDC=$EXTRACT(AICDL,AICDI)

 +3        SET AICDOST=AICDST

 +4        IF AICDOST="SKIP"

               IF AICDC'?1P

                   SET AICDST="SCAN"

                   SET AICDWS=AICDI

 +5        IF AICDOST="SCAN"

               IF AICDC?1P

                   IF AICDC'="-"

                       IF AICDC'="'"

                           SET AICDEND=0

                           DO ENDWORD

                           SET AICDST="SKIP"

 +6        GOTO CHLOOP

ENDWORD    SET AICDWL=AICDI-AICDWS

           SET AICDWD=$EXTRACT(AICDL,AICDWS,AICDI-1)

 +1        IF AICDWL=1

               SET AICDSWB=AICDSWB_AICDWD

               IF AICDEND

                   SET AICDWD=AICDSWB

                   DO STOREWD

 +2        IF AICDWL>1

               DO STOREWD

               IF AICDSWB'=""

                   SET AICDWD=AICDSWB

                   SET AICDSWB=""

                   DO STOREWD

 +3        QUIT 

STOREWD   ;

REMQT      SET AICDJ=$FIND(AICDWD,"'")

           IF AICDJ>0

               SET AICDWD=$EXTRACT(AICDWD,1,AICDJ-2)_$EXTRACT(AICDWD,AICDJ,255)

               GOTO REMQT

 +1        IF AICDWD'["-"

               DO STOREWD2

               QUIT 

 +2        SET AICDWD2=""

           FOR AICDJ=1:1

               SET AICDWF=$PIECE(AICDWD,"-",AICDJ)

               IF AICDWF=""

                   QUIT 

               IF $LENGTH(AICDWF)>2

                   QUIT 

               SET AICDWD2=AICDWD2_AICDWF

 +3        IF AICDWF=""

               SET AICDWD=AICDWD2

               DO STOREWD2

               QUIT 

 +4        SET AICDWD2=AICDWD

           FOR AICDJ=1:1

               SET AICDWF=$PIECE(AICDWD2,"-",AICDJ)

               IF AICDWF=""

                   QUIT 

               SET AICDWD=AICDWF

               DO STOREWD2

 +5        QUIT 

STOREWD2  ;

 +1        IF (AICDWD?1N.E)!(^DD("KWIC")[("^"_AICDWD_"^"))

               QUIT 

 +2        IF $LENGTH(AICDWD)=2&("^IN^OF^AN^IS^AS^AT^IF^IT^ON^OR^BY^"[("^"_AICDWD_"^"))

               QUIT 

 +3        IF AICDWD?1N.E

               QUIT 

 +4        SET AICDWT(AICDWD)=""

 +5        QUIT