Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AICDKWL1

AICDKWL1.m

Go to the documentation of this file.
  1. AICDKWL1 ; IHS/OHPRD/ACC - PART 2 OF LOOKUP CONTROL PROGRAM FOR "AND"ING INVERTED SEARCH ;
  1. ;;4.0;AICD;;DEC 03, 2014;Build 7
  1. NOTSHRT D ^AICDTOKN
  1. D CHKREP
  1. K AICDWORD,AICDDFN,AICDAWRD,AICDADFN,AICDNUSE S AICDNUSE=0
  1. D PREPSCH^AICDKWL2
  1. I AICDNWDS=0 W:AICDASK "Narrative contained no useable words.",! G:'AICDNUSE NOTSHRTX
  1. I AICDNUSE,AICDNWDS W:AICDASK !,"The following word",$S(AICDNUSE=1:" was",1:"s were")," not used in this search:",! S AICDWD="" F AICDQ=0:0 S AICDWD=$O(AICDNUSE(AICDWD)) Q:AICDWD="" W:AICDASK ?5,AICDWD,!
  1. NOTSHRTX K AICDNUSE
  1. K ^UTILITY("AICDHITS",$J) S ^UTILITY("AICDHITS",$J)=0 D:AICDNWDS ^AICDKSCH
  1. I ^UTILITY("AICDHITS",$J)=0 W:AICDASK "Search was unsuccessful.",! S Y=-1 G EXIT
  1. G VERIFY
  1. CHKREP ;
  1. S AICDWORD="" F S AICDWORD=$O(AICDWT(AICDWORD)) Q:AICDWORD="" S AICDDFN=$O(^AICDKWLC(AICDKWCT,2,"B",AICDWORD,0)) D:AICDDFN CHKREP2
  1. K AICDREP,AICDREPT
  1. Q
  1. CHKREP2 K AICDWT(AICDWORD)
  1. S AICDREP=$P(^AICDKWLC(AICDKWCT,2,AICDDFN,0),U,2)
  1. F D CHKREP3 Q:AICDREPT="" S AICDWT(AICDREPT)=""
  1. Q
  1. CHKREP3 F Q:$E(AICDREP)'=" " S AICDREP=$E(AICDREP,2,$L(AICDREP))
  1. S AICDREPI=$F(AICDREP," ")
  1. I AICDREPI S AICDREPT=$E(AICDREP,1,AICDREPI-2),AICDREP=$E(AICDREP,AICDREPI,$L(AICDREP))
  1. E S AICDREPT=AICDREP,AICDREP=""
  1. Q
  1. VERIFY ;
  1. S Y=-1
  1. I ^UTILITY("AICDHITS",$J)=1 D ASKONE G VERIFY2
  1. D:AICDASK ASKSEL:^UTILITY("AICDHITS",$J)>1
  1. VERIFY2 I +Y>0,$D(^DD(+$P(@(AICDGBL_"0)"),U,2),0,"ACT")) X ^("ACT")
  1. I +Y>0,$D(@(AICDREF1_(+Y)_",0)"))#2 S Y=+Y_U_$P(^(0),U,1)
  1. EXIT ;
  1. ;IHS/BAO/TMD - 3/13/2005 - modified next line to not kill hits
  1. ;K ^UTILITY("AICDHITS",$J)
  1. EXIT2 ;
  1. K AICDWD,AICDNWDS,AICDKWCT,AICDI,AICDQ
  1. K AICDREF,AICDREF0,AICDREF1,AICDREF2,AICDREF3,AICDREF4
  1. K AICDGBL,AICDT,AICDL,AICDKSCH,AICDX,AICDASK
  1. S X=AICDXSAV K AICDXSAV
  1. Q
  1. ;
  1. ASKONE ; ASK IF SINGLE HIT IS ACCEPTABLE
  1. I $P(@(AICDKSCH("GBL")_"0)"),U,2)'["O" G ASKONEOK
  1. G:'AICDASK ASKONEOK
  1. W !
  1. S AICDH=1,AICDMULT=0
  1. D DSPLY
  1. F AICDQ=0:0 R " OK? Y// ",X:$S($D(DTIME):DTIME,1:300),! S:'$T X="^" S X=$E(X_"Y") S:X?1L X=$C($A(X)-32) Q:"^YN"[X W $C(7)
  1. K Y
  1. I "^N"[X S Y=-1 G ASKONEX
  1. ASKONEOK S Y=^UTILITY("AICDHITS",$J,1) I $D(DIC(0))#2,DIC(0)["Z" S AICDH=1,Y(0)=@AICDREF3 ;*4*
  1. ASKONEX K AICDH,AICDMULT,AICDDESC,AICDF
  1. Q
  1. ;
  1. ASKSEL ; ASK FOR SELECTION AMONG HITS
  1. W !!,"The following matches were found:",!!
  1. S AICDMULT=1,AICDGRP=1
  1. DSPGRP S AICDH2=$S((AICDGRP+4)'>^UTILITY("AICDHITS",$J):AICDGRP+4,1:^UTILITY("AICDHITS",$J))
  1. F AICDH=AICDGRP:1:AICDH2 D DSPLY
  1. W !
  1. F AICDQ=0:0 W "Select 1-",^UTILITY("AICDHITS",$J),": " R X:$S($D(DTIME):DTIME,1:300),! S:'$T X="^" Q:X["^"!(X="")!(X="-") Q:X?1N.N&(X>0)&(X'>^UTILITY("AICDHITS",$J)) W $C(7)
  1. I X="" S AICDGRP=$S((AICDGRP+5)'>^UTILITY("AICDHITS",$J):AICDGRP+5,1:1) G DSPGRP
  1. I X="-" S AICDGRP=$S(AICDGRP'=1:AICDGRP-5,1:^UTILITY("AICDHITS",$J)-1\5*5+1) G DSPGRP
  1. I X?1"^"1N.N S AICDI=($E(X,2,255)-1)\5*5+1 I AICDI'>^UTILITY("AICDHITS",$J) S AICDGRP=AICDI G DSPGRP
  1. I X["^" S Y=-1
  1. E S AICDH=X,Y=^UTILITY("AICDHITS",$J,AICDH) I $D(DIC(0))#2,DIC(0)["Z" S Y(0)=@AICDREF3
  1. K AICDH,AICDMULT,AICDH2,AICDGRP,AICDDESC,AICDF
  1. Q
  1. ;
  1. DSPLY ; DISPLAY CODE AND TEXT
  1. S AICDI=^UTILITY("AICDHITS",$J,AICDH)
  1. S AICDREF0=AICDREF1_AICDI_",0)"
  1. I $D(AICDKSCH("DSPLY")) D @AICDKSCH("DSPLY") Q
  1. W:AICDMULT $J(AICDH,4),": "
  1. W $P(@(AICDREF1_"AICDI,0)"),"^",1),!
  1. S AICDDESC="<display protocol not provided>"
  1. DSPDESC F %=0:0 Q:AICDDESC="" D GETFRAG W:AICDMULT ?7 W AICDF,!
  1. W !
  1. K AICDC,AICDF
  1. Q
  1. GETFRAG I $L(AICDDESC)<72 S AICDF=AICDDESC,AICDDESC="" Q
  1. F AICDC=73:-1:1 Q:$E(AICDDESC,AICDC)=" "
  1. S AICDF=$E(AICDDESC,1,AICDC-1),AICDDESC=$E(AICDDESC,AICDC+1,255)
  1. Q