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