- 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 Feb 18, 2025@23:33:06 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
