XTLKWIC.m

XTLKWIC ;IHS/OHPRD/ACC,ALB/JLU,SFISC/JC - KWIC ROUTINE FOR FILE MANAGER ;07/22/93  15:52

 ;;7.3;TOOLKIT;;Apr 25, 1995

S N SWB,OSTATE,STATE,LLEN,C,D,I,J,WF,WS,WD,WD2,WL,END,Q

 S D=%,L=$S($D(JLX):JLX,1:X) K JLX

 D TOKENIZE S I="" F J=0:0 S I=$O(WT(I)) Q:I=""  I ^DD("KWIC")'[("^"_I_"^") S @D=""

 G QUIT

K N SWB,OSTATE,STATE,LLEN,C,D,I,J,WF,WS,WD,WD2,WL,END,Q

 S D=%,L=$S($D(JLX):JLX,1:X) K JLX

 D TOKENIZE S I="" F J=0:0 S I=$O(WT(I)) Q:I=""  I ^DD("KWIC")'[("^"_I_"^") K:'($D(@D)\10) @D

QUIT K WT,I,J Q

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

 K WT

 D CONVERT

 K SWB,OSTATE,STATE,LLEN,C,I,J,WF,WS,WD,WD2,WL,END,Q

 Q

 ;

CONVERT ; DO ACTUAL CONVERSION

 S SWB="",STATE="SKIP",I=0,LLEN=$L(L)

CHLOOP S I=I+1

 I I>LLEN S END=1 D:STATE="SCAN" ENDWORD Q

 S C=$E(L,I)

 S OSTATE=STATE

 I OSTATE="SKIP",C'?1P S STATE="SCAN",WS=I

 I OSTATE="SCAN",C?1P,C'="-",C'="'" S END=0 D ENDWORD S STATE="SKIP"

 G CHLOOP

ENDWORD S WL=I-WS,WD=$E(L,WS,I-1)

 I WL=1 S SWB=SWB_WD I END S WD=SWB D STOREWD

 I WL>1 D STOREWD I SWB'="" S WD=SWB,SWB="" D STOREWD

 Q

STOREWD ;

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

 I WD'["-" D STOREWD2 Q

 S WD2="" F J=1:1 S WF=$P(WD,"-",J) Q:WF=""  Q:$L(WF)>2  S WD2=WD2_WF

 I WF="" S WD=WD2 D STOREWD2 Q

 S WD2=WD F J=1:1 S WF=$P(WD2,"-",J) Q:WF=""  S WD=WF D STOREWD2

 Q

STOREWD2 ;

 Q:(WD?1N.E)!(^DD("KWIC")[("^"_WD_"^"))

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

 Q:WD?1N.E

 S WT(WD)=""

 Q

XTLKWIC   ;IHS/OHPRD/ACC,ALB/JLU,SFISC/JC - KWIC ROUTINE FOR FILE MANAGER ;07/22/93  15:52

 +1       ;;7.3;TOOLKIT;;Apr 25, 1995

S          NEW SWB,OSTATE,STATE,LLEN,C,D,I,J,WF,WS,WD,WD2,WL,END,Q

 +1        SET D=%

           SET L=$SELECT($DATA(JLX):JLX,1:X)

           KILL JLX

 +2        DO TOKENIZE

           SET I=""

           FOR J=0:0

               SET I=$ORDER(WT(I))

               IF I=""

                   QUIT 

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

                   SET @D=""

 +3        GOTO QUIT

K          NEW SWB,OSTATE,STATE,LLEN,C,D,I,J,WF,WS,WD,WD2,WL,END,Q

 +1        SET D=%

           SET L=$SELECT($DATA(JLX):JLX,1:X)

           KILL JLX

 +2        DO TOKENIZE

           SET I=""

           FOR J=0:0

               SET I=$ORDER(WT(I))

               IF I=""

                   QUIT 

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

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

                       KILL @D

QUIT       KILL WT,I,J

           QUIT 

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

 +1        KILL WT

 +2        DO CONVERT

 +3        KILL SWB,OSTATE,STATE,LLEN,C,I,J,WF,WS,WD,WD2,WL,END,Q

 +4        QUIT 

 +5       ;

CONVERT   ; DO ACTUAL CONVERSION

 +1        SET SWB=""

           SET STATE="SKIP"

           SET I=0

           SET LLEN=$LENGTH(L)

CHLOOP     SET I=I+1

 +1        IF I>LLEN

               SET END=1

               IF STATE="SCAN"

                   DO ENDWORD

               QUIT 

 +2        SET C=$EXTRACT(L,I)

 +3        SET OSTATE=STATE

 +4        IF OSTATE="SKIP"

               IF C'?1P

                   SET STATE="SCAN"

                   SET WS=I

 +5        IF OSTATE="SCAN"

               IF C?1P

                   IF C'="-"

                       IF C'="'"

                           SET END=0

                           DO ENDWORD

                           SET STATE="SKIP"

 +6        GOTO CHLOOP

ENDWORD    SET WL=I-WS

           SET WD=$EXTRACT(L,WS,I-1)

 +1        IF WL=1

               SET SWB=SWB_WD

               IF END

                   SET WD=SWB

                   DO STOREWD

 +2        IF WL>1

               DO STOREWD

               IF SWB'=""

                   SET WD=SWB

                   SET SWB=""

                   DO STOREWD

 +3        QUIT 

STOREWD   ;

REMQT      SET J=$FIND(WD,"'")

           IF J>0

               SET WD=$EXTRACT(WD,1,J-2)_$EXTRACT(WD,J,255)

               GOTO REMQT

 +1        IF WD'["-"

               DO STOREWD2

               QUIT 

 +2        SET WD2=""

           FOR J=1:1

               SET WF=$PIECE(WD,"-",J)

               IF WF=""

                   QUIT 

               IF $LENGTH(WF)>2

                   QUIT 

               SET WD2=WD2_WF

 +3        IF WF=""

               SET WD=WD2

               DO STOREWD2

               QUIT 

 +4        SET WD2=WD

           FOR J=1:1

               SET WF=$PIECE(WD2,"-",J)

               IF WF=""

                   QUIT 

               SET WD=WF

               DO STOREWD2

 +5        QUIT 

STOREWD2  ;

 +1        IF (WD?1N.E)!(^DD("KWIC")[("^"_WD_"^"))

               QUIT 

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

               QUIT 

 +3        IF WD?1N.E

               QUIT 

 +4        SET WT(WD)=""

 +5        QUIT