LEXAR ;ISL/KER - Look-up (Interpret User Response) ;04/21/2014
;;2.0;LEXICON UTILITY;**3,19,25,55,80**;Sep 23, 1996;Build 1
;
; Global Variables
; ^TMP("LEXFND" SACC 2.3.2.5.1
; ^TMP("LEXHIT" SACC 2.3.2.5.1
; ^TMP("LEXSCH" SACC 2.3.2.5.1
;
; External References
; None
;
; User Responses
;
; Numeric -----------------------------------------------
;
; # Select Entry
;
; Numeric^Comment ----------------------------------------
;
; IEN^COMMENT Application comment about term
;
; Up-Arrow -----------------------------------------------
;
; ^# Jump to # on list
; ^ End dialog with the user
; ^^ End dialog with the application
;
; Question -----------------------------------------------
;
; ? Standard help in LEX("HLP")
; ?? Extended help in LEX("HLP")
; ?# Definition for # in LEX("HLP")
;
; Null ---------------------------------------------------
;
; Advance the selection list
;
; String -------------------------------------------------
;
; Narrative Return and store Unresolved Narrative
;
; --------------------------------------------------------
EN(LEXUR,LEXVDT) ; Interpret user response
D VDT^LEXU I '$D(LEX) D APN Q
K LEX("HLP")
N LEXLL,LEXMAX
I $D(LEX("LIST",0)),+$G(^TMP("LEXSCH",$J,"NUM",0))>0 D
.S LEX=+$G(^TMP("LEXSCH",$J,"NUM",0))
I LEXUR="END",+LEX>0 S LEXUR="^"_LEX
S LEXLL=+$G(^TMP("LEXSCH",$J,"LEN",0))
S:LEXLL=0 LEXLL=5
S LEXMAX=+$G(^TMP("LEXSCH",$J,"LST",0))
S LEXUR=$G(LEXUR)
S (LEX("RES"),^TMP("LEXSCH",$J,"RES",0))=LEXUR
S ^TMP("LEXSCH",$J,"RES",1)="User Response"
; Timed out/Quit
I LEXUR="DTOUT"!(LEXUR="QUIT") D EDA Q
; Yes/No response list has one entry
I $G(LEX)=1,+LEXUR=0,LEXUR'["^" D
.I $E(LEXUR,1)="Y"!($E(LEXUR,1)="y") S LEXUR=1 Q
.I LEXUR["?" D HLP^LEXAR3 Q
.S LEXUR=""
; Null (Page Down)
I LEXUR="" D NULL^LEXAR2 D END Q
; Minus (Page Up)
I $E(LEXUR,1)="-" D LIST^LEXAL2("PGUP") D END Q
; Help
I LEXUR["?" D HLP^LEXAR3 D END Q
; Up Arrow
I LEXUR["^",$D(^TMP("LEXSCH",$J)) D UPA^LEXAR2(LEXUR) D END Q
; Select
I +LEXUR>0,+LEXUR'>LEXMAX D SEL^LEXAR4(+LEXUR,$G(LEXVDT)) D END Q
; User Unresolved Narrative
I LEXUR=$G(^TMP("LEXSCH",$J,"NAR",0)),+$G(^TMP("LEXSCH",$J,"UNR",0))=1 D D END Q
.D SAVE^LEXAR6
APN ; Application Unresolved Narrative
I LEXUR["^",'$D(^TMP("LEXSCH",$J)),+LEXUR>0,$D(^LEX(757.01,+LEXUR,0)),$L($P(LEXUR,"^",2)) D Q
.K LEX
.D COM^LEXAR6(LEXUR)
D END
Q
END ; End of Interpretation of the Users Response
I $D(^TMP("LEXSCH",$J)) D
.S (LEX("RES"),^TMP("LEXSCH",$J,"RES",0))=LEXUR
.S ^TMP("LEXSCH",$J,"RES",1)="User Response"
I $D(LEX("LIST",0)),+$G(^TMP("LEXSCH",$J,"NUM",0))>0 D
.S LEX=+$G(^TMP("LEXSCH",$J,"NUM",0))
Q
SEL ; Selection made
K LEX("RES"),LEX("ERR"),LEX("LIST"),LEX("MIN"),LEX("MAX"),LEX("MAT"),LEX("HLP")
D NAR,EMF,KLST,KSCH
S:$D(LEX("SEL")) LEX=0
Q
EDU ; End Dialog with the User
D NAR,EMF,KLST,KARL,KSCH
S LEX=0
Q
EDA ; End Dialog with the Application
K LEX
D KLST,KSCH
Q
LST ; List exist
D NAR,MAX,MIN,MAT,EML
Q
;
KLST ; Kill Global List
; ^TMP("LEXFND",$J)
; ^TMP("LEXHIT",$J)
K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J)
Q
KSCH ; Kill Search Variables
; ^TMP("LEXSCH",$J)
; PCH 55 - The only way to kill ^TMP("LEXSCH",$J) is exiting LEXA1
Q
KARL ; Kill Array List and supporting variables
; LEX("LIST"),LEX("MAT"),LEX("MIN"),LEX("MAX")
K LEX("LIST"),LEX("MAT"),LEX("MIN"),LEX("MAX")
K LEX("EXC"),LEX("EXM")
Q
LEX ; Set LEX to the number of entries on the list
S:+$G(^TMP("LEXSCH",$J,"NUM",0))>0 LEX=+$G(^TMP("LEXSCH",$J,"NUM",0))
Q
NAR ; Set LEX("NAR") to the user narrative
K LEX("NAR")
S:$L($G(^TMP("LEXSCH",$J,"NAR",0))) LEX("NAR")=$G(^TMP("LEXSCH",$J,"NAR",0))
Q
MAX ; Set LEX("MAX") to the last entry reviewed by the user
K LEX("MAX")
S:+$G(^TMP("LEXSCH",$J,"LST",0))>0 LEX("MAX")=+$G(^TMP("LEXSCH",$J,"LST",0))
Q
MIN ; Set LEX("MIN") to the first entry reviewed by the user
K LEX("MIN")
S:+$G(LEX("MAX"))>0 LEX("MIN")=1
Q
EML ; Set LEX("EXM") post-selection IEN^Expression text
K LEX("EXM")
S:$L($G(^TMP("LEXSCH",$J,"EXM",2))) LEX("EXM")=$G(^TMP("LEXSCH",$J,"EXM",2))
Q
EMF ; Set LEX("EXM") pre-selection LIST#^Expression text
K LEX("EXM")
I $L($G(^TMP("LEXSCH",$J,"EXM",0))),$L($G(^TMP("LEXSCH",$J,"EXM",1))) D
.S LEX("EXM")=$G(^TMP("LEXSCH",$J,"EXM",0))_"^"_$G(^TMP("LEXSCH",$J,"EXM",1))
Q
MAT ; Set "matches found" string and top of list flag
; LEX("MAT") # Matches found
; ^TMP("LEXSCH",$J,"TOL",0) 1 - Top of list
; 0 - Not top of list
K LEX("MAT")
I $D(LEX("SEL"))!('$D(^TMP("LEXSCH",$J)))!('$D(LEX("LIST"))) Q
N LEXOL,LEXL
S LEXOL=$G(^TMP("LEXSCH",$J,"TOL",0))
S LEXL=$O(LEX("LIST",0))
I LEXOL'=0,LEXL=1 S ^TMP("LEXSCH",$J,"TOL",0)=1
I LEXOL'=0,LEXL'=1 S ^TMP("LEXSCH",$J,"TOL",0)=0
I LEXOL=1,$L($G(^TMP("LEXSCH",$J,"MAT",0))) D
.S LEX("MAT")=$G(^TMP("LEXSCH",$J,"MAT",0))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXAR 5214 printed Dec 13, 2024@02:07 Page 2
LEXAR ;ISL/KER - Look-up (Interpret User Response) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**3,19,25,55,80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXFND" SACC 2.3.2.5.1
+5 ; ^TMP("LEXHIT" SACC 2.3.2.5.1
+6 ; ^TMP("LEXSCH" SACC 2.3.2.5.1
+7 ;
+8 ; External References
+9 ; None
+10 ;
+11 ; User Responses
+12 ;
+13 ; Numeric -----------------------------------------------
+14 ;
+15 ; # Select Entry
+16 ;
+17 ; Numeric^Comment ----------------------------------------
+18 ;
+19 ; IEN^COMMENT Application comment about term
+20 ;
+21 ; Up-Arrow -----------------------------------------------
+22 ;
+23 ; ^# Jump to # on list
+24 ; ^ End dialog with the user
+25 ; ^^ End dialog with the application
+26 ;
+27 ; Question -----------------------------------------------
+28 ;
+29 ; ? Standard help in LEX("HLP")
+30 ; ?? Extended help in LEX("HLP")
+31 ; ?# Definition for # in LEX("HLP")
+32 ;
+33 ; Null ---------------------------------------------------
+34 ;
+35 ; Advance the selection list
+36 ;
+37 ; String -------------------------------------------------
+38 ;
+39 ; Narrative Return and store Unresolved Narrative
+40 ;
+41 ; --------------------------------------------------------
EN(LEXUR,LEXVDT) ; Interpret user response
+1 DO VDT^LEXU
IF '$DATA(LEX)
DO APN
QUIT
+2 KILL LEX("HLP")
+3 NEW LEXLL,LEXMAX
+4 IF $DATA(LEX("LIST",0))
IF +$GET(^TMP("LEXSCH",$JOB,"NUM",0))>0
Begin DoDot:1
+5 SET LEX=+$GET(^TMP("LEXSCH",$JOB,"NUM",0))
End DoDot:1
+6 IF LEXUR="END"
IF +LEX>0
SET LEXUR="^"_LEX
+7 SET LEXLL=+$GET(^TMP("LEXSCH",$JOB,"LEN",0))
+8 if LEXLL=0
SET LEXLL=5
+9 SET LEXMAX=+$GET(^TMP("LEXSCH",$JOB,"LST",0))
+10 SET LEXUR=$GET(LEXUR)
+11 SET (LEX("RES"),^TMP("LEXSCH",$JOB,"RES",0))=LEXUR
+12 SET ^TMP("LEXSCH",$JOB,"RES",1)="User Response"
+13 ; Timed out/Quit
+14 IF LEXUR="DTOUT"!(LEXUR="QUIT")
DO EDA
QUIT
+15 ; Yes/No response list has one entry
+16 IF $GET(LEX)=1
IF +LEXUR=0
IF LEXUR'["^"
Begin DoDot:1
+17 IF $EXTRACT(LEXUR,1)="Y"!($EXTRACT(LEXUR,1)="y")
SET LEXUR=1
QUIT
+18 IF LEXUR["?"
DO HLP^LEXAR3
QUIT
+19 SET LEXUR=""
End DoDot:1
+20 ; Null (Page Down)
+21 IF LEXUR=""
DO NULL^LEXAR2
DO END
QUIT
+22 ; Minus (Page Up)
+23 IF $EXTRACT(LEXUR,1)="-"
DO LIST^LEXAL2("PGUP")
DO END
QUIT
+24 ; Help
+25 IF LEXUR["?"
DO HLP^LEXAR3
DO END
QUIT
+26 ; Up Arrow
+27 IF LEXUR["^"
IF $DATA(^TMP("LEXSCH",$JOB))
DO UPA^LEXAR2(LEXUR)
DO END
QUIT
+28 ; Select
+29 IF +LEXUR>0
IF +LEXUR'>LEXMAX
DO SEL^LEXAR4(+LEXUR,$GET(LEXVDT))
DO END
QUIT
+30 ; User Unresolved Narrative
+31 IF LEXUR=$GET(^TMP("LEXSCH",$JOB,"NAR",0))
IF +$GET(^TMP("LEXSCH",$JOB,"UNR",0))=1
Begin DoDot:1
+32 DO SAVE^LEXAR6
End DoDot:1
DO END
QUIT
APN ; Application Unresolved Narrative
+1 IF LEXUR["^"
IF '$DATA(^TMP("LEXSCH",$JOB))
IF +LEXUR>0
IF $DATA(^LEX(757.01,+LEXUR,0))
IF $LENGTH($PIECE(LEXUR,"^",2))
Begin DoDot:1
+2 KILL LEX
+3 DO COM^LEXAR6(LEXUR)
End DoDot:1
QUIT
+4 DO END
+5 QUIT
END ; End of Interpretation of the Users Response
+1 IF $DATA(^TMP("LEXSCH",$JOB))
Begin DoDot:1
+2 SET (LEX("RES"),^TMP("LEXSCH",$JOB,"RES",0))=LEXUR
+3 SET ^TMP("LEXSCH",$JOB,"RES",1)="User Response"
End DoDot:1
+4 IF $DATA(LEX("LIST",0))
IF +$GET(^TMP("LEXSCH",$JOB,"NUM",0))>0
Begin DoDot:1
+5 SET LEX=+$GET(^TMP("LEXSCH",$JOB,"NUM",0))
End DoDot:1
+6 QUIT
SEL ; Selection made
+1 KILL LEX("RES"),LEX("ERR"),LEX("LIST"),LEX("MIN"),LEX("MAX"),LEX("MAT"),LEX("HLP")
+2 DO NAR
DO EMF
DO KLST
DO KSCH
+3 if $DATA(LEX("SEL"))
SET LEX=0
+4 QUIT
EDU ; End Dialog with the User
+1 DO NAR
DO EMF
DO KLST
DO KARL
DO KSCH
+2 SET LEX=0
+3 QUIT
EDA ; End Dialog with the Application
+1 KILL LEX
+2 DO KLST
DO KSCH
+3 QUIT
LST ; List exist
+1 DO NAR
DO MAX
DO MIN
DO MAT
DO EML
+2 QUIT
+3 ;
KLST ; Kill Global List
+1 ; ^TMP("LEXFND",$J)
+2 ; ^TMP("LEXHIT",$J)
+3 KILL ^TMP("LEXFND",$JOB),^TMP("LEXHIT",$JOB)
+4 QUIT
KSCH ; Kill Search Variables
+1 ; ^TMP("LEXSCH",$J)
+2 ; PCH 55 - The only way to kill ^TMP("LEXSCH",$J) is exiting LEXA1
+3 QUIT
KARL ; Kill Array List and supporting variables
+1 ; LEX("LIST"),LEX("MAT"),LEX("MIN"),LEX("MAX")
+2 KILL LEX("LIST"),LEX("MAT"),LEX("MIN"),LEX("MAX")
+3 KILL LEX("EXC"),LEX("EXM")
+4 QUIT
LEX ; Set LEX to the number of entries on the list
+1 if +$GET(^TMP("LEXSCH",$JOB,"NUM",0))>0
SET LEX=+$GET(^TMP("LEXSCH",$JOB,"NUM",0))
+2 QUIT
NAR ; Set LEX("NAR") to the user narrative
+1 KILL LEX("NAR")
+2 if $LENGTH($GET(^TMP("LEXSCH",$JOB,"NAR",0)))
SET LEX("NAR")=$GET(^TMP("LEXSCH",$JOB,"NAR",0))
+3 QUIT
MAX ; Set LEX("MAX") to the last entry reviewed by the user
+1 KILL LEX("MAX")
+2 if +$GET(^TMP("LEXSCH",$JOB,"LST",0))>0
SET LEX("MAX")=+$GET(^TMP("LEXSCH",$JOB,"LST",0))
+3 QUIT
MIN ; Set LEX("MIN") to the first entry reviewed by the user
+1 KILL LEX("MIN")
+2 if +$GET(LEX("MAX"))>0
SET LEX("MIN")=1
+3 QUIT
EML ; Set LEX("EXM") post-selection IEN^Expression text
+1 KILL LEX("EXM")
+2 if $LENGTH($GET(^TMP("LEXSCH",$JOB,"EXM",2)))
SET LEX("EXM")=$GET(^TMP("LEXSCH",$JOB,"EXM",2))
+3 QUIT
EMF ; Set LEX("EXM") pre-selection LIST#^Expression text
+1 KILL LEX("EXM")
+2 IF $LENGTH($GET(^TMP("LEXSCH",$JOB,"EXM",0)))
IF $LENGTH($GET(^TMP("LEXSCH",$JOB,"EXM",1)))
Begin DoDot:1
+3 SET LEX("EXM")=$GET(^TMP("LEXSCH",$JOB,"EXM",0))_"^"_$GET(^TMP("LEXSCH",$JOB,"EXM",1))
End DoDot:1
+4 QUIT
MAT ; Set "matches found" string and top of list flag
+1 ; LEX("MAT") # Matches found
+2 ; ^TMP("LEXSCH",$J,"TOL",0) 1 - Top of list
+3 ; 0 - Not top of list
+4 KILL LEX("MAT")
+5 IF $DATA(LEX("SEL"))!('$DATA(^TMP("LEXSCH",$JOB)))!('$DATA(LEX("LIST")))
QUIT
+6 NEW LEXOL,LEXL
+7 SET LEXOL=$GET(^TMP("LEXSCH",$JOB,"TOL",0))
+8 SET LEXL=$ORDER(LEX("LIST",0))
+9 IF LEXOL'=0
IF LEXL=1
SET ^TMP("LEXSCH",$JOB,"TOL",0)=1
+10 IF LEXOL'=0
IF LEXL'=1
SET ^TMP("LEXSCH",$JOB,"TOL",0)=0
+11 IF LEXOL=1
IF $LENGTH($GET(^TMP("LEXSCH",$JOB,"MAT",0)))
Begin DoDot:1
+12 SET LEX("MAT")=$GET(^TMP("LEXSCH",$JOB,"MAT",0))
End DoDot:1
+13 QUIT
