LEXAR2 ;ISL/KER - Look-up Response (up arrow/jump/null) ;05/23/2017
;;2.0;LEXICON UTILITY;**80,103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^TMP("LEXSCH") SACC 2.3.2.5.1
;
; External References
; None
;
UPA(LEXUR) ; Up-Arrow Detected
I LEXUR="^^" S X=LEXUR D EDA^LEXAR Q
N LEXR S LEXR=$P(LEXUR,"^",2,4000)
I +LEXR>0,+LEXR'>LEX D JMP Q
S LEXUR=$E(LEXUR,1) I LEXUR="^",+LEXR=0 S X=LEXUR D EDU^LEXAR Q
Q
NULL ; Null response
N LEXEOA,LEXN S LEXEOA=+($P($G(LEX("LIST",0)),"^",1))
I LEXEOA=0 D EDA^LEXAR Q
S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0))) I LEX=0 D EDA^LEXAR Q
I LEXEOA=LEX!(LEXEOA>LEX) D EDU^LEXAR Q
I LEXEOA'=LEX,LEXEOA<LEX D LIST^LEXAL2("PGDN")
Q
JMP ; Jump to # on list
S LEXR=+($G(LEXR)) Q:LEXR'>0!(LEXR>LEX)
D LIST^LEXAL2(LEXR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXAR2 846 printed Oct 16, 2024@18:07:43 Page 2
LEXAR2 ;ISL/KER - Look-up Response (up arrow/jump/null) ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**80,103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXSCH") SACC 2.3.2.5.1
+5 ;
+6 ; External References
+7 ; None
+8 ;
UPA(LEXUR) ; Up-Arrow Detected
+1 IF LEXUR="^^"
SET X=LEXUR
DO EDA^LEXAR
QUIT
+2 NEW LEXR
SET LEXR=$PIECE(LEXUR,"^",2,4000)
+3 IF +LEXR>0
IF +LEXR'>LEX
DO JMP
QUIT
+4 SET LEXUR=$EXTRACT(LEXUR,1)
IF LEXUR="^"
IF +LEXR=0
SET X=LEXUR
DO EDU^LEXAR
QUIT
+5 QUIT
NULL ; Null response
+1 NEW LEXEOA,LEXN
SET LEXEOA=+($PIECE($GET(LEX("LIST",0)),"^",1))
+2 IF LEXEOA=0
DO EDA^LEXAR
QUIT
+3 SET LEX=+($GET(^TMP("LEXSCH",$JOB,"NUM",0)))
IF LEX=0
DO EDA^LEXAR
QUIT
+4 IF LEXEOA=LEX!(LEXEOA>LEX)
DO EDU^LEXAR
QUIT
+5 IF LEXEOA'=LEX
IF LEXEOA<LEX
DO LIST^LEXAL2("PGDN")
+6 QUIT
JMP ; Jump to # on list
+1 SET LEXR=+($GET(LEXR))
if LEXR'>0!(LEXR>LEX)
QUIT
+2 DO LIST^LEXAL2(LEXR)
+3 QUIT
