- XTLKKWL1 ; IHS/ISC STAFF/JC-PART 2 OF LOOKUP CONTROL PROGRAM FOR "AND"ING INVERTED SEARCH ;01/20/95 10:27
- ;;7.3;TOOLKIT;;Apr 25, 1995
- NOTSHRT D ^XTLKTOKN
- K XTLKWORD,XTLKDFN,XTLKAWRD,XTLKADFN,XTLKNUSE S XTLKNUSE=0
- D PREPSCH^XTLKKWL2
- I XTLKNWDS=0 W:XTLKSAY=1 "MTLU found no usable words.",! G:'XTLKNUSE NOTSHRTX
- I XTLKNUSE>0 W:XTLKSAY=1 !,"The following word",$S(XTLKNUSE=1:" was",1:"s were")," not used in this search:",! S XTLKWD="" F XTLKQ=0:0 S XTLKWD=$O(XTLKNUSE(XTLKWD)) Q:XTLKWD="" W:XTLKSAY=1 ?5,XTLKWD,!
- NOTSHRTX K XTLKNUSE
- K ^TMP("XTLKHITS",$J) S ^TMP("XTLKHITS",$J)=0 D:XTLKNWDS ^XTLKKSCH
- I ^TMP("XTLKHITS",$J)=0 S Y=-1 D EXIT Q
- VERIFY ;
- S:'XTLKASK Y=-1 N XTLKHELP
- I XTLKSAY'=-1 D:XTLKASK ASKONE:^TMP("XTLKHITS",$J)=1,ASKSEL:^TMP("XTLKHITS",$J)>1
- I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S Y=-1 G EXIT
- I +Y>0,$D(^DD(+$P(@(XTLKGBL_"0)"),U,2),0,"ACT")) X ^("ACT")
- I +Y>0,$D(@(XTLKREF1_(+Y)_",0)"))#2 S Y=+Y_U_$P(^(0),U,1)
- EXIT ;
- K ^TMP($J,"ADFN"),^TMP($J,"AWRD")
- K XTLKWD,XTLKNWDS,XTLKKWCT,XTLKI,XTLKQ,XTLKHLP
- K XTLKREF,XTLKREF0,XTLKREF1,XTLKREF2,XTLKREF3,XTLKREF4
- K XTLKGBL,XTLKT,XTLKL,XTLKASK,XTLKPC
- S X=XTLKXSAV K XTLKXSAV
- Q
- ;
- ASKONE ; ASK IF SINGLE HIT IS ACCEPTABLE
- ;;;G:@(XTLKKSCH("GBL")_"0)")'["O" ASKONEX
- S XTLKH=1,XTLKMULT=0
- I XTLKSAY'=-1 D
- .W !
- .D DSPLY S Y=-1
- .N DIR S DIR("?")="^D XHELP^XTLKKWL1",DIR(0)="Y",DIR("A")=" OK",DIR("B")="Y" D ^DIR K DIR
- I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(Y=0) S Y=-1 D ASKONEX Q
- I $D(^TMP("XTLKHITS",$J)) S X=$O(^($J,0)) I +X S Y=^(X) I $D(DIC(0))#2,DIC(0)["Z" S Y(0)=@XTLKREF3
- ASKONEX K XTLKH,XTLKMULT,XTLKDESC,XTLKF
- Q
- ;
- ASKSEL ; ASK FOR SELECTION AMONG HITS
- Q:XTLKSAY=-1
- W !!,"The following ",^TMP("XTLKHITS",$J)," matches were found:",!!
- S XTLKMULT=1,XTLKGRP=1
- DSPGRP S XTLKH2=$S((XTLKGRP+4)'>^TMP("XTLKHITS",$J):XTLKGRP+4,1:^TMP("XTLKHITS",$J))
- F XTLKH=XTLKGRP:1:XTLKH2 D DSPLY
- N DIR
- S DIR("A")="Press <RET> or Select 1-"_XTLKH_": "
- S DIR("?")="^D XHELP^XTLKKWL1"
- S DIR(0)="FAO" D ^DIR K DIR W !
- I X?1"^"1N.N K DUOUT
- I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S Y=-1 D EXSEL Q
- I X["?" D XHELP G DSPGRP
- I X="" S XTLKGRP=$S((XTLKGRP+5)'>^TMP("XTLKHITS",$J):XTLKGRP+5,1:0) G:XTLKGRP DSPGRP I 'XTLKGRP S Y=-1 D EXSEL Q
- I X="-" S XTLKGRP=$S(XTLKGRP'=1:XTLKGRP-5,1:^TMP("XTLKHITS",$J)-1\5*5+1) G DSPGRP
- I X?1"^"1N.N S XTLKI=($E(X,2,255)-1)\5*5+1 I XTLKI'>^TMP("XTLKHITS",$J) S XTLKGRP=XTLKI G DSPGRP
- I X?1"^"1N.N S XTLKI=($E(X,2,255)-1)\5*5+1 I XTLKI>^TMP("XTLKHITS",$J) S XTLKHELP=$S('$D(XTLKHLP):"W $C(7) D SELQ",1:XTLKHLP) X XTLKHELP G DSPGRP
- G:'$D(^TMP("XTLKHITS",$J,X)) DSPGRP
- S XTLKH=X,Y=^TMP("XTLKHITS",$J,XTLKH) I $D(DIC(0))#2,DIC(0)["Z" S Y(0)=@XTLKREF3
- EXSEL K XTLKH,XTLKMULT,XTLKH2,XTLKGRP,XTLKDESC,XTLKF
- Q
- ;
- DSPLY ; DISPLAY CODE AND TEXT
- Q:XTLKSAY=-1
- S (Y,XTLKI)=^TMP("XTLKHITS",$J,XTLKH)
- S XTLKREF0=XTLKREF1_XTLKI_",0)"
- I $D(XTLKKSCH("DSPLY")) D @XTLKKSCH("DSPLY") Q
- W:XTLKMULT $J(XTLKH,4),": "
- W $P(@(XTLKREF1_"XTLKI,0)"),"^",1),!
- S XTLKDESC="<display protocol not provided>"
- DSPDESC F XTLKPC=0:0 Q:XTLKDESC="" D GETFRAG W:XTLKMULT ?7 W XTLKF,!
- W !
- K XTLKC,XTLKF
- Q
- GETFRAG I $L(XTLKDESC)<72 S XTLKF=XTLKDESC,XTLKDESC="" Q
- F XTLKC=73:-1:1 Q:$E(XTLKDESC,XTLKC)=" "
- S XTLKF=$E(XTLKDESC,1,XTLKC-1),XTLKDESC=$E(XTLKDESC,XTLKC+1,255)
- Q
- XHELP ;
- I X["?" S XTLKHELP=$S('$D(XTLKHLP):"W $C(7) D SELQ",1:XTLKHLP) X XTLKHELP
- Q
- SELQ W !,"Answer with a number from 1 to ",XTLKH," or"
- W !,"'^' to quit the MTLU search and attempt a FILEMAN search, or"
- W !,"'^^' to quit and return to your menu, or"
- W !,"'^#' if you want to jump to any of the ",^TMP("XTLKHITS",$J)," allowable choices.",!
- Q
- XTLKKWL1 ; IHS/ISC STAFF/JC-PART 2 OF LOOKUP CONTROL PROGRAM FOR "AND"ING INVERTED SEARCH ;01/20/95 10:27
- +1 ;;7.3;TOOLKIT;;Apr 25, 1995
- NOTSHRT DO ^XTLKTOKN
- +1 KILL XTLKWORD,XTLKDFN,XTLKAWRD,XTLKADFN,XTLKNUSE
- SET XTLKNUSE=0
- +2 DO PREPSCH^XTLKKWL2
- +3 IF XTLKNWDS=0
- IF XTLKSAY=1
- WRITE "MTLU found no usable words.",!
- IF 'XTLKNUSE
- GOTO NOTSHRTX
- +4 IF XTLKNUSE>0
- IF XTLKSAY=1
- WRITE !,"The following word",$SELECT(XTLKNUSE=1:" was",1:"s were")," not used in this search:",!
- SET XTLKWD=""
- FOR XTLKQ=0:0
- SET XTLKWD=$ORDER(XTLKNUSE(XTLKWD))
- IF XTLKWD=""
- QUIT
- IF XTLKSAY=1
- WRITE ?5,XTLKWD,!
- NOTSHRTX KILL XTLKNUSE
- +1 KILL ^TMP("XTLKHITS",$JOB)
- SET ^TMP("XTLKHITS",$JOB)=0
- IF XTLKNWDS
- DO ^XTLKKSCH
- +2 IF ^TMP("XTLKHITS",$JOB)=0
- SET Y=-1
- DO EXIT
- QUIT
- VERIFY ;
- +1 IF 'XTLKASK
- SET Y=-1
- NEW XTLKHELP
- +2 IF XTLKSAY'=-1
- IF XTLKASK
- IF ^TMP("XTLKHITS",$JOB)=1
- DO ASKONE
- IF ^TMP("XTLKHITS",$JOB)>1
- DO ASKSEL
- +3 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
- SET Y=-1
- GOTO EXIT
- +4 IF +Y>0
- IF $DATA(^DD(+$PIECE(@(XTLKGBL_"0)"),U,2),0,"ACT"))
- XECUTE ^("ACT")
- +5 IF +Y>0
- IF $DATA(@(XTLKREF1_(+Y)_",0)"))#2
- SET Y=+Y_U_$PIECE(^(0),U,1)
- EXIT ;
- +1 KILL ^TMP($JOB,"ADFN"),^TMP($JOB,"AWRD")
- +2 KILL XTLKWD,XTLKNWDS,XTLKKWCT,XTLKI,XTLKQ,XTLKHLP
- +3 KILL XTLKREF,XTLKREF0,XTLKREF1,XTLKREF2,XTLKREF3,XTLKREF4
- +4 KILL XTLKGBL,XTLKT,XTLKL,XTLKASK,XTLKPC
- +5 SET X=XTLKXSAV
- KILL XTLKXSAV
- +6 QUIT
- +7 ;
- ASKONE ; ASK IF SINGLE HIT IS ACCEPTABLE
- +1 ;;;G:@(XTLKKSCH("GBL")_"0)")'["O" ASKONEX
- +2 SET XTLKH=1
- SET XTLKMULT=0
- +3 IF XTLKSAY'=-1
- Begin DoDot:1
- +4 WRITE !
- +5 DO DSPLY
- SET Y=-1
- +6 NEW DIR
- SET DIR("?")="^D XHELP^XTLKKWL1"
- SET DIR(0)="Y"
- SET DIR("A")=" OK"
- SET DIR("B")="Y"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +7 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))!(Y=0)
- SET Y=-1
- DO ASKONEX
- QUIT
- +8 IF $DATA(^TMP("XTLKHITS",$JOB))
- SET X=$ORDER(^($JOB,0))
- IF +X
- SET Y=^(X)
- IF $DATA(DIC(0))#2
- IF DIC(0)["Z"
- SET Y(0)=@XTLKREF3
- ASKONEX KILL XTLKH,XTLKMULT,XTLKDESC,XTLKF
- +1 QUIT
- +2 ;
- ASKSEL ; ASK FOR SELECTION AMONG HITS
- +1 IF XTLKSAY=-1
- QUIT
- +2 WRITE !!,"The following ",^TMP("XTLKHITS",$JOB)," matches were found:",!!
- +3 SET XTLKMULT=1
- SET XTLKGRP=1
- DSPGRP SET XTLKH2=$SELECT((XTLKGRP+4)'>^TMP("XTLKHITS",$JOB):XTLKGRP+4,1:^TMP("XTLKHITS",$JOB))
- +1 FOR XTLKH=XTLKGRP:1:XTLKH2
- DO DSPLY
- +2 NEW DIR
- +3 SET DIR("A")="Press <RET> or Select 1-"_XTLKH_": "
- +4 SET DIR("?")="^D XHELP^XTLKKWL1"
- +5 SET DIR(0)="FAO"
- DO ^DIR
- KILL DIR
- WRITE !
- +6 IF X?1"^"1N.N
- KILL DUOUT
- +7 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
- SET Y=-1
- DO EXSEL
- QUIT
- +8 IF X["?"
- DO XHELP
- GOTO DSPGRP
- +9 IF X=""
- SET XTLKGRP=$SELECT((XTLKGRP+5)'>^TMP("XTLKHITS",$JOB):XTLKGRP+5,1:0)
- IF XTLKGRP
- GOTO DSPGRP
- IF 'XTLKGRP
- SET Y=-1
- DO EXSEL
- QUIT
- +10 IF X="-"
- SET XTLKGRP=$SELECT(XTLKGRP'=1:XTLKGRP-5,1:^TMP("XTLKHITS",$JOB)-1\5*5+1)
- GOTO DSPGRP
- +11 IF X?1"^"1N.N
- SET XTLKI=($EXTRACT(X,2,255)-1)\5*5+1
- IF XTLKI'>^TMP("XTLKHITS",$JOB)
- SET XTLKGRP=XTLKI
- GOTO DSPGRP
- +12 IF X?1"^"1N.N
- SET XTLKI=($EXTRACT(X,2,255)-1)\5*5+1
- IF XTLKI>^TMP("XTLKHITS",$JOB)
- SET XTLKHELP=$SELECT('$DATA(XTLKHLP):"W $C(7) D SELQ",1:XTLKHLP)
- XECUTE XTLKHELP
- GOTO DSPGRP
- +13 IF '$DATA(^TMP("XTLKHITS",$JOB,X))
- GOTO DSPGRP
- +14 SET XTLKH=X
- SET Y=^TMP("XTLKHITS",$JOB,XTLKH)
- IF $DATA(DIC(0))#2
- IF DIC(0)["Z"
- SET Y(0)=@XTLKREF3
- EXSEL KILL XTLKH,XTLKMULT,XTLKH2,XTLKGRP,XTLKDESC,XTLKF
- +1 QUIT
- +2 ;
- DSPLY ; DISPLAY CODE AND TEXT
- +1 IF XTLKSAY=-1
- QUIT
- +2 SET (Y,XTLKI)=^TMP("XTLKHITS",$JOB,XTLKH)
- +3 SET XTLKREF0=XTLKREF1_XTLKI_",0)"
- +4 IF $DATA(XTLKKSCH("DSPLY"))
- DO @XTLKKSCH("DSPLY")
- QUIT
- +5 IF XTLKMULT
- WRITE $JUSTIFY(XTLKH,4),": "
- +6 WRITE $PIECE(@(XTLKREF1_"XTLKI,0)"),"^",1),!
- +7 SET XTLKDESC="<display protocol not provided>"
- DSPDESC FOR XTLKPC=0:0
- IF XTLKDESC=""
- QUIT
- DO GETFRAG
- IF XTLKMULT
- WRITE ?7
- WRITE XTLKF,!
- +1 WRITE !
- +2 KILL XTLKC,XTLKF
- +3 QUIT
- GETFRAG IF $LENGTH(XTLKDESC)<72
- SET XTLKF=XTLKDESC
- SET XTLKDESC=""
- QUIT
- +1 FOR XTLKC=73:-1:1
- IF $EXTRACT(XTLKDESC,XTLKC)=" "
- QUIT
- +2 SET XTLKF=$EXTRACT(XTLKDESC,1,XTLKC-1)
- SET XTLKDESC=$EXTRACT(XTLKDESC,XTLKC+1,255)
- +3 QUIT
- XHELP ;
- +1 IF X["?"
- SET XTLKHELP=$SELECT('$DATA(XTLKHLP):"W $C(7) D SELQ",1:XTLKHLP)
- XECUTE XTLKHELP
- +2 QUIT
- SELQ WRITE !,"Answer with a number from 1 to ",XTLKH," or"
- +1 WRITE !,"'^' to quit the MTLU search and attempt a FILEMAN search, or"
- +2 WRITE !,"'^^' to quit and return to your menu, or"
- +3 WRITE !,"'^#' if you want to jump to any of the ",^TMP("XTLKHITS",$JOB)," allowable choices.",!
- +4 QUIT
