| 1 | LEXAL2 ; ISL Look-up List (Array)                 ; 09-23-96
 | 
|---|
| 2 |  ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;  LEXL        Last on List
 | 
|---|
| 5 |  ;  LEXT/LEXF  List To/From
 | 
|---|
| 6 |  ;  LEXA        List position asked for
 | 
|---|
| 7 |  ;  "HOME"       Position at the begining of List
 | 
|---|
| 8 |  ;  "END"        Position at the end of List
 | 
|---|
| 9 |  ;  "PGDN"       Position down the list by #LEXLL
 | 
|---|
| 10 |  ;  "PGUP"       Position up the list by #LEXLL
 | 
|---|
| 11 |  ;
 | 
|---|
| 12 | LIST(LEXA) ; Continue to build list
 | 
|---|
| 13 |  N LEXC,LEXDSP,LEXF,LEXI,LEXIEN,LEXL,LEXLL,LEXO
 | 
|---|
| 14 |  N LEXT
 | 
|---|
| 15 |  I '$D(^TMP("LEXSCH",$J))!('$D(^TMP("LEXFND",$J)))!('$D(^TMP("LEXHIT",$J))) D EDA^LEXAR Q
 | 
|---|
| 16 |  ; Positional
 | 
|---|
| 17 |  S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0))) S:LEXA="END" LEXA=+($G(^TMP("LEXSCH",$J,"NUM",0)))
 | 
|---|
| 18 |  S:LEXA="HOME" LEXA=1 I LEXA="PGDN" S LEXA=+($P($G(LEX("LIST",0)),"^",1))+(+($G(^TMP("LEXSCH",$J,"LEN",0)))) S:LEXA>LEX LEXA=LEX
 | 
|---|
| 19 |  I LEXA="PGUP" S LEXA=+($P($G(LEX("LIST",0)),"^",1))-(+($G(^TMP("LEXSCH",$J,"LEN",0)))) S:LEXA=0 LEXA=1
 | 
|---|
| 20 |  ; End listing
 | 
|---|
| 21 |  I +($G(LEXA))=0 D EDA^LEXAR Q
 | 
|---|
| 22 |  ; Make List
 | 
|---|
| 23 |  N LEXL,LEXC,LEXLL,LEXT,LEXF S LEXL=+($G(^TMP("LEXSCH",$J,"LST",0)))
 | 
|---|
| 24 |  S LEXLL=+($G(^TMP("LEXSCH",$J,"LEN",0))) S:LEXLL=0 LEXLL=5
 | 
|---|
| 25 |  Q:LEXA>LEX  D HILO Q:+($G(LEXF))>+($G(LEX))  Q:+($G(LEXA))>+($G(LEX))
 | 
|---|
| 26 |  D:LEXA>LEXL FWD D:LEXA'>LEXL BKW
 | 
|---|
| 27 |  I $D(LEX("LIST")) D LST^LEXAR
 | 
|---|
| 28 |  Q
 | 
|---|
| 29 | HILO ; List From LEXF - To LEXT
 | 
|---|
| 30 |  I +($G(LEXA))=0 S LEXF=1,LEXT=LEXLL Q
 | 
|---|
| 31 |  S (LEXA,LEXT)=+($G(LEXA)) Q:LEXT'>0!(LEXT>+($G(LEX)))
 | 
|---|
| 32 |  S LEXF=LEXT#LEXLL S:LEXF=0 LEXF=LEXLL S LEXF=LEXF-1,LEXF=LEXT-LEXF,LEXT=LEXF+(LEXLL-1)
 | 
|---|
| 33 |  Q
 | 
|---|
| 34 | FWD ; Build list Forward (User Response was Null or Jump Forward)
 | 
|---|
| 35 |  K LEX N LEXI,LEXIEN,LEXDSP S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0)))
 | 
|---|
| 36 |  Q:LEXT'>0!(LEXF>+($G(LEX)))  D:'$D(^TMP("LEXHIT",$J,LEXT)) ADD D:$D(^TMP("LEXHIT",$J,LEXF)) BLD
 | 
|---|
| 37 |  Q
 | 
|---|
| 38 | ADD ; Add to Hit list
 | 
|---|
| 39 |  N LEXC,LEXI,LEXIEN S LEXC=LEXL,LEXI=-9999999999
 | 
|---|
| 40 |  F  S LEXI=$O(^TMP("LEXFND",$J,LEXI)) Q:+LEXI=0!(LEXC>LEXT)!(LEXC>LEX)  D  Q:LEXC>LEXT!(LEXC>LEX)  D
 | 
|---|
| 41 |  . S LEXIEN=0 F  S LEXIEN=$O(^TMP("LEXFND",$J,LEXI,LEXIEN)) Q:+LEXIEN=0!(LEXC>LEXT)!(LEXC>LEX)  D  Q:LEXC>LEXT!(LEXC>LEX)
 | 
|---|
| 42 |  . . S LEXC=LEXC+1 I LEXC'>LEXT D
 | 
|---|
| 43 |  . . . S LEXDSP=^TMP("LEXFND",$J,LEXI,LEXIEN),^TMP("LEXHIT",$J,0)=LEXC
 | 
|---|
| 44 |  . . . S ^TMP("LEXHIT",$J,LEXC)=LEXIEN_"^"_LEXDSP
 | 
|---|
| 45 |  . . . S:+($G(^TMP("LEXSCH",$J,"EXM",0)))=+LEXIEN ^TMP("LEXSCH",$J,"EXM",2)=LEXC_"^"_$G(^LEX(757.01,+LEXIEN,0))
 | 
|---|
| 46 |  . . . S:+($G(^TMP("LEXSCH",$J,"EXC",0)))=+LEXIEN ^TMP("LEXSCH",$J,"EXC",2)=LEXC_"^"_$G(^LEX(757.01,+LEXIEN,0))
 | 
|---|
| 47 |  . . . K ^TMP("LEXFND",$J,LEXI,LEXIEN) S ^TMP("LEXSCH",$J,"LST",0)=$G(^TMP("LEXSCH",$J,"LST",0))+1
 | 
|---|
| 48 |  Q
 | 
|---|
| 49 | BLD ; Build LEX("LIST")
 | 
|---|
| 50 |  S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0))) S:'$D(^TMP("LEXHIT",$J)) LEX=0
 | 
|---|
| 51 |  N LEXC,LEXCTR S LEXCTR=0,LEXC=LEXF-1
 | 
|---|
| 52 |  F  S LEXC=$O(^TMP("LEXHIT",$J,LEXC)) Q:+LEXC=0!(+LEXC>LEXT)  D  Q:+LEXC>LEXT
 | 
|---|
| 53 |  . S LEXCTR=LEXCTR+1,LEX("LIST",LEXC)=^TMP("LEXHIT",$J,LEXC),LEX("LIST",0)=LEXC_"^"_LEXCTR
 | 
|---|
| 54 |  . S LEX("MIN")=1,LEX("MAX")=LEXC,(LEXL,^TMP("LEXSCH",$J,"LST",0))=LEXC
 | 
|---|
| 55 |  Q
 | 
|---|
| 56 | BKW ; Build list Backwards (User Response was Jump Backwards)
 | 
|---|
| 57 |  S LEXLL=+($G(LEXLL)),LEXF=+($G(LEXF)),LEXT=+($G(LEXT)) Q:LEXF=0  Q:LEXT=0  Q:LEXLL=0
 | 
|---|
| 58 |  Q:'$D(^TMP("LEXHIT",$J,LEXF))  N LEXCTR,LEXO,LEXC S LEXCTR=0,LEXO=LEXF-1,LEXC=0
 | 
|---|
| 59 |  K LEX("LIST") F  S LEXO=$O(^TMP("LEXHIT",$J,LEXO)) Q:+LEXO=0!(LEXC>LEXLL)  D  Q:LEXC>LEXLL
 | 
|---|
| 60 |  . S LEXCTR=LEXCTR+1,LEXC=LEXC+1
 | 
|---|
| 61 |  . I LEXC'>LEXLL S LEX("LIST",LEXO)=^TMP("LEXHIT",$J,LEXO),LEX("LIST",0)=LEXO_"^"_LEXCTR
 | 
|---|
| 62 |  Q
 | 
|---|