LEXAL2 ;ISL/KER - Look-up List (Array) ;04/21/2014
;;2.0;LEXICON UTILITY;**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
;
; LEXL Last on List
; LEXT/LEXF List To/From
; LEXA List position asked for
; "HOME" Position at the begining of List
; "END" Position at the end of List
; "PGDN" Position down the list by #LEXLL
; "PGUP" Position up the list by #LEXLL
;
LIST(LEXA) ; Continue to build list
N LEXC,LEXDSP,LEXF,LEXI,LEXIEN,LEXL,LEXLL,LEXO
N LEXT
I '$D(^TMP("LEXSCH",$J))!('$D(^TMP("LEXFND",$J)))!('$D(^TMP("LEXHIT",$J))) D EDA^LEXAR Q
; Positional
S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0))) S:LEXA="END" LEXA=+($G(^TMP("LEXSCH",$J,"NUM",0)))
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
I LEXA="PGUP" S LEXA=+($P($G(LEX("LIST",0)),"^",1))-(+($G(^TMP("LEXSCH",$J,"LEN",0)))) S:LEXA=0 LEXA=1
; End listing
I +($G(LEXA))=0 D EDA^LEXAR Q
; Make List
N LEXL,LEXC,LEXLL,LEXT,LEXF S LEXL=+($G(^TMP("LEXSCH",$J,"LST",0)))
S LEXLL=+($G(^TMP("LEXSCH",$J,"LEN",0))) S:LEXLL=0 LEXLL=5
Q:LEXA>LEX D HILO Q:+($G(LEXF))>+($G(LEX)) Q:+($G(LEXA))>+($G(LEX))
D:LEXA>LEXL FWD D:LEXA'>LEXL BKW
I $D(LEX("LIST")) D LST^LEXAR
Q
HILO ; List From LEXF - To LEXT
I +($G(LEXA))=0 S LEXF=1,LEXT=LEXLL Q
S (LEXA,LEXT)=+($G(LEXA)) Q:LEXT'>0!(LEXT>+($G(LEX)))
S LEXF=LEXT#LEXLL S:LEXF=0 LEXF=LEXLL S LEXF=LEXF-1,LEXF=LEXT-LEXF,LEXT=LEXF+(LEXLL-1)
Q
FWD ; Build list Forward (User Response was Null or Jump Forward)
K LEX N LEXI,LEXIEN,LEXDSP S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0)))
Q:LEXT'>0!(LEXF>+($G(LEX))) D:'$D(^TMP("LEXHIT",$J,LEXT)) ADD D:$D(^TMP("LEXHIT",$J,LEXF)) BLD
Q
ADD ; Add to Hit list
N LEXC,LEXI,LEXIEN S LEXC=LEXL,LEXI=-9999999999
F S LEXI=$O(^TMP("LEXFND",$J,LEXI)) Q:+LEXI=0!(LEXC>LEXT)!(LEXC>LEX) D Q:LEXC>LEXT!(LEXC>LEX) D
. 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)
. . S LEXC=LEXC+1 I LEXC'>LEXT D
. . . S LEXDSP=^TMP("LEXFND",$J,LEXI,LEXIEN),^TMP("LEXHIT",$J,0)=LEXC
. . . S ^TMP("LEXHIT",$J,LEXC)=LEXIEN_"^"_LEXDSP
. . . S:+($G(^TMP("LEXSCH",$J,"EXM",0)))=+LEXIEN ^TMP("LEXSCH",$J,"EXM",2)=LEXC_"^"_$G(^LEX(757.01,+LEXIEN,0))
. . . S:+($G(^TMP("LEXSCH",$J,"EXC",0)))=+LEXIEN ^TMP("LEXSCH",$J,"EXC",2)=LEXC_"^"_$G(^LEX(757.01,+LEXIEN,0))
. . . K ^TMP("LEXFND",$J,LEXI,LEXIEN) S ^TMP("LEXSCH",$J,"LST",0)=$G(^TMP("LEXSCH",$J,"LST",0))+1
Q
BLD ; Build LEX("LIST")
S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0))) S:'$D(^TMP("LEXHIT",$J)) LEX=0
N LEXC,LEXCTR S LEXCTR=0,LEXC=LEXF-1
F S LEXC=$O(^TMP("LEXHIT",$J,LEXC)) Q:+LEXC=0!(+LEXC>LEXT) D Q:+LEXC>LEXT
. S LEXCTR=LEXCTR+1,LEX("LIST",LEXC)=^TMP("LEXHIT",$J,LEXC),LEX("LIST",0)=LEXC_"^"_LEXCTR
. S LEX("MIN")=1,LEX("MAX")=LEXC,(LEXL,^TMP("LEXSCH",$J,"LST",0))=LEXC
Q
BKW ; Build list Backwards (User Response was Jump Backwards)
S LEXLL=+($G(LEXLL)),LEXF=+($G(LEXF)),LEXT=+($G(LEXT)) Q:LEXF=0 Q:LEXT=0 Q:LEXLL=0
Q:'$D(^TMP("LEXHIT",$J,LEXF)) N LEXCTR,LEXO,LEXC S LEXCTR=0,LEXO=LEXF-1,LEXC=0
K LEX("LIST") F S LEXO=$O(^TMP("LEXHIT",$J,LEXO)) Q:+LEXO=0!(LEXC>LEXLL) D Q:LEXC>LEXLL
. S LEXCTR=LEXCTR+1,LEXC=LEXC+1
. I LEXC'>LEXLL S LEX("LIST",LEXO)=^TMP("LEXHIT",$J,LEXO),LEX("LIST",0)=LEXO_"^"_LEXCTR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXAL2 3606 printed Dec 13, 2024@02:06:57 Page 2
LEXAL2 ;ISL/KER - Look-up List (Array) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**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 ; LEXL Last on List
+12 ; LEXT/LEXF List To/From
+13 ; LEXA List position asked for
+14 ; "HOME" Position at the begining of List
+15 ; "END" Position at the end of List
+16 ; "PGDN" Position down the list by #LEXLL
+17 ; "PGUP" Position up the list by #LEXLL
+18 ;
LIST(LEXA) ; Continue to build list
+1 NEW LEXC,LEXDSP,LEXF,LEXI,LEXIEN,LEXL,LEXLL,LEXO
+2 NEW LEXT
+3 IF '$DATA(^TMP("LEXSCH",$JOB))!('$DATA(^TMP("LEXFND",$JOB)))!('$DATA(^TMP("LEXHIT",$JOB)))
DO EDA^LEXAR
QUIT
+4 ; Positional
+5 SET LEX=+($GET(^TMP("LEXSCH",$JOB,"NUM",0)))
if LEXA="END"
SET LEXA=+($GET(^TMP("LEXSCH",$JOB,"NUM",0)))
+6 if LEXA="HOME"
SET LEXA=1
IF LEXA="PGDN"
SET LEXA=+($PIECE($GET(LEX("LIST",0)),"^",1))+(+($GET(^TMP("LEXSCH",$JOB,"LEN",0))))
if LEXA>LEX
SET LEXA=LEX
+7 IF LEXA="PGUP"
SET LEXA=+($PIECE($GET(LEX("LIST",0)),"^",1))-(+($GET(^TMP("LEXSCH",$JOB,"LEN",0))))
if LEXA=0
SET LEXA=1
+8 ; End listing
+9 IF +($GET(LEXA))=0
DO EDA^LEXAR
QUIT
+10 ; Make List
+11 NEW LEXL,LEXC,LEXLL,LEXT,LEXF
SET LEXL=+($GET(^TMP("LEXSCH",$JOB,"LST",0)))
+12 SET LEXLL=+($GET(^TMP("LEXSCH",$JOB,"LEN",0)))
if LEXLL=0
SET LEXLL=5
+13 if LEXA>LEX
QUIT
DO HILO
if +($GET(LEXF))>+($GET(LEX))
QUIT
if +($GET(LEXA))>+($GET(LEX))
QUIT
+14 if LEXA>LEXL
DO FWD
if LEXA'>LEXL
DO BKW
+15 IF $DATA(LEX("LIST"))
DO LST^LEXAR
+16 QUIT
HILO ; List From LEXF - To LEXT
+1 IF +($GET(LEXA))=0
SET LEXF=1
SET LEXT=LEXLL
QUIT
+2 SET (LEXA,LEXT)=+($GET(LEXA))
if LEXT'>0!(LEXT>+($GET(LEX)))
QUIT
+3 SET LEXF=LEXT#LEXLL
if LEXF=0
SET LEXF=LEXLL
SET LEXF=LEXF-1
SET LEXF=LEXT-LEXF
SET LEXT=LEXF+(LEXLL-1)
+4 QUIT
FWD ; Build list Forward (User Response was Null or Jump Forward)
+1 KILL LEX
NEW LEXI,LEXIEN,LEXDSP
SET LEX=+($GET(^TMP("LEXSCH",$JOB,"NUM",0)))
+2 if LEXT'>0!(LEXF>+($GET(LEX)))
QUIT
if '$DATA(^TMP("LEXHIT",$JOB,LEXT))
DO ADD
if $DATA(^TMP("LEXHIT",$JOB,LEXF))
DO BLD
+3 QUIT
ADD ; Add to Hit list
+1 NEW LEXC,LEXI,LEXIEN
SET LEXC=LEXL
SET LEXI=-9999999999
+2 FOR
SET LEXI=$ORDER(^TMP("LEXFND",$JOB,LEXI))
if +LEXI=0!(LEXC>LEXT)!(LEXC>LEX)
QUIT
Begin DoDot:1
+3 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^TMP("LEXFND",$JOB,LEXI,LEXIEN))
if +LEXIEN=0!(LEXC>LEXT)!(LEXC>LEX)
QUIT
Begin DoDot:2
+4 SET LEXC=LEXC+1
IF LEXC'>LEXT
Begin DoDot:3
+5 SET LEXDSP=^TMP("LEXFND",$JOB,LEXI,LEXIEN)
SET ^TMP("LEXHIT",$JOB,0)=LEXC
+6 SET ^TMP("LEXHIT",$JOB,LEXC)=LEXIEN_"^"_LEXDSP
+7 if +($GET(^TMP("LEXSCH",$JOB,"EXM",0)))=+LEXIEN
SET ^TMP("LEXSCH",$JOB,"EXM",2)=LEXC_"^"_$GET(^LEX(757.01,+LEXIEN,0))
+8 if +($GET(^TMP("LEXSCH",$JOB,"EXC",0)))=+LEXIEN
SET ^TMP("LEXSCH",$JOB,"EXC",2)=LEXC_"^"_$GET(^LEX(757.01,+LEXIEN,0))
+9 KILL ^TMP("LEXFND",$JOB,LEXI,LEXIEN)
SET ^TMP("LEXSCH",$JOB,"LST",0)=$GET(^TMP("LEXSCH",$JOB,"LST",0))+1
End DoDot:3
End DoDot:2
if LEXC>LEXT!(LEXC>LEX)
QUIT
End DoDot:1
if LEXC>LEXT!(LEXC>LEX)
QUIT
Begin DoDot:1
End DoDot:1
+10 QUIT
BLD ; Build LEX("LIST")
+1 SET LEX=+($GET(^TMP("LEXSCH",$JOB,"NUM",0)))
if '$DATA(^TMP("LEXHIT",$JOB))
SET LEX=0
+2 NEW LEXC,LEXCTR
SET LEXCTR=0
SET LEXC=LEXF-1
+3 FOR
SET LEXC=$ORDER(^TMP("LEXHIT",$JOB,LEXC))
if +LEXC=0!(+LEXC>LEXT)
QUIT
Begin DoDot:1
+4 SET LEXCTR=LEXCTR+1
SET LEX("LIST",LEXC)=^TMP("LEXHIT",$JOB,LEXC)
SET LEX("LIST",0)=LEXC_"^"_LEXCTR
+5 SET LEX("MIN")=1
SET LEX("MAX")=LEXC
SET (LEXL,^TMP("LEXSCH",$JOB,"LST",0))=LEXC
End DoDot:1
if +LEXC>LEXT
QUIT
+6 QUIT
BKW ; Build list Backwards (User Response was Jump Backwards)
+1 SET LEXLL=+($GET(LEXLL))
SET LEXF=+($GET(LEXF))
SET LEXT=+($GET(LEXT))
if LEXF=0
QUIT
if LEXT=0
QUIT
if LEXLL=0
QUIT
+2 if '$DATA(^TMP("LEXHIT",$JOB,LEXF))
QUIT
NEW LEXCTR,LEXO,LEXC
SET LEXCTR=0
SET LEXO=LEXF-1
SET LEXC=0
+3 KILL LEX("LIST")
FOR
SET LEXO=$ORDER(^TMP("LEXHIT",$JOB,LEXO))
if +LEXO=0!(LEXC>LEXLL)
QUIT
Begin DoDot:1
+4 SET LEXCTR=LEXCTR+1
SET LEXC=LEXC+1
+5 IF LEXC'>LEXLL
SET LEX("LIST",LEXO)=^TMP("LEXHIT",$JOB,LEXO)
SET LEX("LIST",0)=LEXO_"^"_LEXCTR
End DoDot:1
if LEXC>LEXLL
QUIT
+6 QUIT
