LEXAR2.m

LEXAR2 ;ISL/KER - Look-up Response (up arrow/jump/null) ;04/21/2014

 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10

 ;               

 ; 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,299)

 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

LEXAR2    ;ISL/KER - Look-up Response (up arrow/jump/null) ;04/21/2014

 +1       ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10

 +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,299)

 +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