- LEXASC ;ISL/KER - Look-up by Shortcuts ;04/21/2014
- ;;2.0;LEXICON UTILITY;**25,80**;Sep 23, 1996;Build 10
- ;
- ; Global Variables
- ; ^LEX(757.4) N/A
- ; ^LEX(757.41) N/A
- ; ^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
- ;
- ; ^TMP("LEXFND",$J) Entries found
- ; ^TMP("LEXHIT",$J) Entries returned
- ;
- ; LEXSCH User input string to search for
- ; LEXVDT Date is used to screen out inactive codes
- ;
- ; LEXC Pointer to Shortcut Context in file 757.41
- ; LEXS Pointer to Shortcut in file 757.4
- ; LEXE Pointer to expression in 757.01
- ; LEXM Pointer to Major Concept in 757.01
- ;
- ; LEXDSP Source Display string
- ; LEXDES Flag - has (*) or doesn't have () a description
- ; LEXSHOW Display string from Application/User defaults
- ; LEXX Returned variable from functions
- ;
- EN(LEXSCH,LEXC,LEXVDT) ; Check Shortcuts file 757.4 for LEXSCH
- S LEXC=+($G(LEXC))
- Q:'$L(LEXSCH)!(LEXC=0) 0
- Q:'$D(^LEX(757.41,LEXC)) 0
- Q:$L(LEXSCH)<2!($L(LEXSCH)>63) 0
- Q:'$D(^LEX(757.4,"ARA",LEXSCH,LEXC)) 0
- D VDT^LEXU N LEXS S LEXS=0
- F S LEXS=$O(^LEX(757.4,"ARA",LEXSCH,LEXC,LEXS)) Q:+LEXS=0 D
- . N LEXE,LEXDES,LEXDSP,LEXLKT S LEXLKT="ASC"
- . S LEXE=+($G(^LEX(757.4,LEXS,0))) Q:LEXE'>0
- . ; Filter
- . S LEXFILR=$$EN^LEXAFIL($G(LEXFIL),LEXE) Q:LEXFILR=0
- . ; Deactivated Term
- . Q:'$D(LEXIGN)&(+($P($G(^LEX(757.01,LEXE,1)),"^",5))=1)
- . Q:+($$SUB(LEXE))=0
- . S LEXDES=$$DES(LEXE)
- . S LEXDSP="",LEXSHOW=$G(^TMP("LEXSCH",$J,"DIS",0)) S:$L($G(LEXSHOW)) LEXDSP=$$DSP(LEXE,$G(LEXSHOW),$G(LEXVDT))
- . D ADDL^LEXAL(LEXE,LEXDES,LEXDSP)
- I $D(^TMP("LEXFND",$J)) D BEG^LEXAL
- I '$D(^TMP("LEXFND",$J)) D
- . K LEX,^TMP("LEXFND",$J),^TMP("LEXHIT",$J) S LEX=0
- . S:+($G(^TMP("LEXSCH",$J,"UNR",0)))>0&($L($G(^TMP("LEXSCH",$J,"NAR",0)))) LEX("NAR")=$G(^TMP("LEXSCH",$J,"NAR",0))
- Q:$D(^TMP("LEXHIT",$J)) 1
- Q 0
- DES(LEXX) ; Get description flag
- N LEXDES,LEXE,LEXM S LEXDES="",LEXE=+LEXX
- S LEXM=$P($G(^LEX(757.01,+($G(LEXX)),1)),"^",1)
- S LEXM=+($G(^LEX(757,+($G(LEXM)),0)))
- S:$D(^LEX(757.01,LEXM,3)) LEXDES="*"
- S LEXX=$G(LEXDES) Q LEXX
- TERM(LEXX) ; Get expression
- Q $G(^LEX(757.01,LEXX,0))
- DSP(LEXX,LEXDSP,LEXVDT) ; Return displayable text
- S LEXX=$$SO^LEXASO(LEXX,LEXDSP,1,$G(LEXVDT)) Q LEXX
- SUB(LEXX) ;
- Q:$G(^TMP("LEXSCH",$J,"GBL",0))'="^LEX(757.21," 1
- Q:'$L($G(^TMP("LEXSCH",$J,"IDX",0))) 1
- N LEXIDX,LEXSS,LEXSN S LEXIDX=$G(^TMP("LEXSCH",$J,"IDX",0))
- S LEXSS=$E(LEXIDX,2,$L(LEXIDX))
- S LEXSN=$O(^LEXT(757.2,"AA",LEXSS,0))
- Q:+($G(LEXSN))=0 1
- N LEXOK,LEXR S (LEXR,LEXOK)=0
- F S LEXR=$O(^LEX(757.21,"B",LEXX,LEXR)) Q:+LEXR=0 D
- . I $P($G(^LEX(757.21,LEXR,0)),"^",2)=LEXSN S LEXOK=1
- S LEXX=LEXOK Q LEXX
- CLR ; Clear
- N LEXIGN
- Q
- LEXASC ;ISL/KER - Look-up by Shortcuts ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**25,80**;Sep 23, 1996;Build 10
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX(757.4) N/A
- +5 ; ^LEX(757.41) N/A
- +6 ; ^TMP("LEXFND") SACC 2.3.2.5.1
- +7 ; ^TMP("LEXHIT") SACC 2.3.2.5.1
- +8 ; ^TMP("LEXSCH") SACC 2.3.2.5.1
- +9 ;
- +10 ; External References
- +11 ; None
- +12 ;
- +13 ; ^TMP("LEXFND",$J) Entries found
- +14 ; ^TMP("LEXHIT",$J) Entries returned
- +15 ;
- +16 ; LEXSCH User input string to search for
- +17 ; LEXVDT Date is used to screen out inactive codes
- +18 ;
- +19 ; LEXC Pointer to Shortcut Context in file 757.41
- +20 ; LEXS Pointer to Shortcut in file 757.4
- +21 ; LEXE Pointer to expression in 757.01
- +22 ; LEXM Pointer to Major Concept in 757.01
- +23 ;
- +24 ; LEXDSP Source Display string
- +25 ; LEXDES Flag - has (*) or doesn't have () a description
- +26 ; LEXSHOW Display string from Application/User defaults
- +27 ; LEXX Returned variable from functions
- +28 ;
- EN(LEXSCH,LEXC,LEXVDT) ; Check Shortcuts file 757.4 for LEXSCH
- +1 SET LEXC=+($GET(LEXC))
- +2 IF '$LENGTH(LEXSCH)!(LEXC=0)
- QUIT 0
- +3 IF '$DATA(^LEX(757.41,LEXC))
- QUIT 0
- +4 IF $LENGTH(LEXSCH)<2!($LENGTH(LEXSCH)>63)
- QUIT 0
- +5 IF '$DATA(^LEX(757.4,"ARA",LEXSCH,LEXC))
- QUIT 0
- +6 DO VDT^LEXU
- NEW LEXS
- SET LEXS=0
- +7 FOR
- SET LEXS=$ORDER(^LEX(757.4,"ARA",LEXSCH,LEXC,LEXS))
- IF +LEXS=0
- QUIT
- Begin DoDot:1
- +8 NEW LEXE,LEXDES,LEXDSP,LEXLKT
- SET LEXLKT="ASC"
- +9 SET LEXE=+($GET(^LEX(757.4,LEXS,0)))
- IF LEXE'>0
- QUIT
- +10 ; Filter
- +11 SET LEXFILR=$$EN^LEXAFIL($GET(LEXFIL),LEXE)
- IF LEXFILR=0
- QUIT
- +12 ; Deactivated Term
- +13 IF '$DATA(LEXIGN)&(+($PIECE($GET(^LEX(757.01,LEXE,1)),"^",5))=1)
- QUIT
- +14 IF +($$SUB(LEXE))=0
- QUIT
- +15 SET LEXDES=$$DES(LEXE)
- +16 SET LEXDSP=""
- SET LEXSHOW=$GET(^TMP("LEXSCH",$JOB,"DIS",0))
- IF $LENGTH($GET(LEXSHOW))
- SET LEXDSP=$$DSP(LEXE,$GET(LEXSHOW),$GET(LEXVDT))
- +17 DO ADDL^LEXAL(LEXE,LEXDES,LEXDSP)
- End DoDot:1
- +18 IF $DATA(^TMP("LEXFND",$JOB))
- DO BEG^LEXAL
- +19 IF '$DATA(^TMP("LEXFND",$JOB))
- Begin DoDot:1
- +20 KILL LEX,^TMP("LEXFND",$JOB),^TMP("LEXHIT",$JOB)
- SET LEX=0
- +21 IF +($GET(^TMP("LEXSCH",$JOB,"UNR",0)))>0&($LENGTH($GET(^TMP("LEXSCH",$JOB,"NAR",0))))
- SET LEX("NAR")=$GET(^TMP("LEXSCH",$JOB,"NAR",0))
- End DoDot:1
- +22 IF $DATA(^TMP("LEXHIT",$JOB))
- QUIT 1
- +23 QUIT 0
- DES(LEXX) ; Get description flag
- +1 NEW LEXDES,LEXE,LEXM
- SET LEXDES=""
- SET LEXE=+LEXX
- +2 SET LEXM=$PIECE($GET(^LEX(757.01,+($GET(LEXX)),1)),"^",1)
- +3 SET LEXM=+($GET(^LEX(757,+($GET(LEXM)),0)))
- +4 IF $DATA(^LEX(757.01,LEXM,3))
- SET LEXDES="*"
- +5 SET LEXX=$GET(LEXDES)
- QUIT LEXX
- TERM(LEXX) ; Get expression
- +1 QUIT $GET(^LEX(757.01,LEXX,0))
- DSP(LEXX,LEXDSP,LEXVDT) ; Return displayable text
- +1 SET LEXX=$$SO^LEXASO(LEXX,LEXDSP,1,$GET(LEXVDT))
- QUIT LEXX
- SUB(LEXX) ;
- +1 IF $GET(^TMP("LEXSCH",$JOB,"GBL",0))'="^LEX(757.21,"
- QUIT 1
- +2 IF '$LENGTH($GET(^TMP("LEXSCH",$JOB,"IDX",0)))
- QUIT 1
- +3 NEW LEXIDX,LEXSS,LEXSN
- SET LEXIDX=$GET(^TMP("LEXSCH",$JOB,"IDX",0))
- +4 SET LEXSS=$EXTRACT(LEXIDX,2,$LENGTH(LEXIDX))
- +5 SET LEXSN=$ORDER(^LEXT(757.2,"AA",LEXSS,0))
- +6 IF +($GET(LEXSN))=0
- QUIT 1
- +7 NEW LEXOK,LEXR
- SET (LEXR,LEXOK)=0
- +8 FOR
- SET LEXR=$ORDER(^LEX(757.21,"B",LEXX,LEXR))
- IF +LEXR=0
- QUIT
- Begin DoDot:1
- +9 IF $PIECE($GET(^LEX(757.21,LEXR,0)),"^",2)=LEXSN
- SET LEXOK=1
- End DoDot:1
- +10 SET LEXX=LEXOK
- QUIT LEXX
- CLR ; Clear
- +1 NEW LEXIGN
- +2 QUIT
