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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTLKKWL1 3680 printed Apr 09, 2024@21:42:22 Page 2
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
