- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTLKWIC 1511 printed Feb 19, 2025@00:07:57 Page 2
- 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