- 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