- LEXAR4 ;ISL/KER - Look-up Response (Select Entry) ;05/23/2017
- ;;2.0;LEXICON UTILITY;**4,5,6,25,55,80,103**;Sep 23, 1996;Build 2
- ;
- ; Global Variables
- ; ^LEX(757.001) N/A
- ; ^TMP("LEXHIT") SACC 2.3.2.5.1
- ; ^TMP("LEXSCH") SACC 2.3.2.5.1
- ;
- ; External References
- ; HOME^%ZIS ICR 10086
- ; ^%ZTLOAD ICR 10063
- ; ^DIE ICR 10018
- ;
- SEL(LEXUR,LEXVDT) ; Select # on list
- K LEX("SEL") D VDT^LEXU N LEXLVL,LEXMAX,LEXLF S LEXLF=1,LEXMAX=+($G(^TMP("LEXSCH",$J,"LST",0)))
- S LEX=+($G(LEX)),LEXUR=+($G(LEXUR))
- I LEXMAX=0!(LEX=0) D EDA^LEXAR G SELQ
- K LEX("ERR"),LEX("SEL") I LEXUR'>0!(LEXUR>LEXMAX) D G SELQ
- . S LEX("ERR",0)=+($G(LEX("ERR",0)))+1
- . S LEX("ERR",LEX("ERR",0))="User response out of range"
- I '$D(^TMP("LEXHIT",$J,LEXUR)) D G SELQ
- . S LEX("ERR",0)=+($G(LEX("ERR",0)))+1
- . S LEX("ERR",LEX("ERR",0))="Selection is either out of range or invalid"
- N LEXEXP S LEXEXP=+($P(^TMP("LEXHIT",$J,LEXUR),"^",1))
- I '$D(^LEX(757.01,LEXEXP,0)) D G SELQ
- . S LEX("ERR",0)=+($G(LEX("ERR",0)))+1
- . S LEX("ERR",LEX("ERR",0))="Selection not found in the Lexicon"
- S LEXLVL=+($G(LEX("LVL")))
- D SET(LEXEXP,$G(LEXVDT)),EDU^LEXAR
- G SELQ
- SET(LEXEXP,LEXVDT) ; Set LEX("SEL") Nodes
- K LEX("SEL") D VDT^LEXU D SETEXP^LEXAR5(LEXEXP)
- N LEXMC S LEXMC=+($P(^LEX(757.01,LEXEXP,1),"^",1))
- ; If selected from the list increment frequency
- ; Temporarily deactivated until after Oct 1, 2013
- ; D:+($G(^TMP("LEXSCH",$J,"LST",0)))>0&(+($G(^TMP("LEXSCH",$J,"APP",0)))>1) INC(LEXMC)
- N LEXMCE S LEXMCE=+(^LEX(757,LEXMC,0))
- D SETSRC^LEXAR5(LEXEXP,$G(LEXVDT))
- D:'$D(LEX("SEL","SRC","D",LEXMCE))&(LEXMCE'=LEXEXP) SETSRC^LEXAR5(LEXMCE,$G(LEXVDT))
- D SETDEF^LEXAR5(LEXMCE)
- D SETSTY^LEXAR5(LEXMC)
- N LEXE S LEXE=0 F S LEXE=$O(^LEX(757.01,"AMC",LEXMC,LEXE)) Q:+LEXE=0 D
- . Q:LEXE=LEXEXP D SETEXP^LEXAR5(LEXE),SETSRC^LEXAR5(LEXE,$G(LEXVDT))
- G:+($G(LEXLF))=0 SELQ
- Q
- INC(LEXMC) ; Increment frequency counter in ^LEX(757)
- N LEXF,LEXFQ S LEXMC=+($G(LEXMC)) Q:LEXMC=0 Q:'$D(^LEX(757,LEXMC))
- S ZTSAVE("LEXMC")="",ZTRTN="FQ^LEXAR4",ZTDESC="Updating Lexicon Frequencies",ZTIO="",ZTDTH=$H
- D ^%ZTLOAD,HOME^%ZIS K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
- Q
- FQ ; Edit Concept Frequency
- N LEXA,LEXM,LEXQ,LEXS,DA,DIC,DIE S:$D(ZTQUEUED) ZTREQ="@"
- S LEXM=+($G(LEXMC)) Q:LEXM=0 Q:'$D(^LEX(757,LEXM,0))
- I '$D(^LEX(757.001,LEXM,0)) D AFQ G FQQ
- S LEXQ=+($P($G(^LEX(757.001,LEXM,0)),"^",3)),LEXQ=LEXQ+1
- S DA=+($G(LEXM)) Q:+DA=0 Q:'$D(^LEX(757.001,DA,0))
- S LEXM=+($G(LEXMC)) Q:'$D(^LEX(757,LEXMC,0)) S LEXA=0
- S (DIC,DIE)="^LEX(757.001,",DR="2////^S X=LEXQ"
- EFQ ; Lock record and edit frequency record
- L +^LEX(757.001,+DA):1 I '$T S LEXA=LEXA+1 H 2 G:LEXA<4 EFQ
- D:LEXA<4 ^DIE L -^LEX(757.001,+DA)
- G FQQ
- Q
- AFQ ; Add frequency record
- N DIC,DA S ^LEX(757.001,LEXM,0)=LEXM_"^0^0" S DIC="^LEX(757.001,",DA=LEXM D SET^LEXNDX2 Q
- Q
- FQQ ; Quit Frequency
- Q
- SELQ ; Quit Selection
- D:$D(LEX("SEL")) SEL^LEXAR
- D:$D(LEX("LIST")) LST^LEXAR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXAR4 3087 printed Feb 18, 2025@23:33:07 Page 2
- LEXAR4 ;ISL/KER - Look-up Response (Select Entry) ;05/23/2017
- +1 ;;2.0;LEXICON UTILITY;**4,5,6,25,55,80,103**;Sep 23, 1996;Build 2
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX(757.001) N/A
- +5 ; ^TMP("LEXHIT") SACC 2.3.2.5.1
- +6 ; ^TMP("LEXSCH") SACC 2.3.2.5.1
- +7 ;
- +8 ; External References
- +9 ; HOME^%ZIS ICR 10086
- +10 ; ^%ZTLOAD ICR 10063
- +11 ; ^DIE ICR 10018
- +12 ;
- SEL(LEXUR,LEXVDT) ; Select # on list
- +1 KILL LEX("SEL")
- DO VDT^LEXU
- NEW LEXLVL,LEXMAX,LEXLF
- SET LEXLF=1
- SET LEXMAX=+($GET(^TMP("LEXSCH",$JOB,"LST",0)))
- +2 SET LEX=+($GET(LEX))
- SET LEXUR=+($GET(LEXUR))
- +3 IF LEXMAX=0!(LEX=0)
- DO EDA^LEXAR
- GOTO SELQ
- +4 KILL LEX("ERR"),LEX("SEL")
- IF LEXUR'>0!(LEXUR>LEXMAX)
- Begin DoDot:1
- +5 SET LEX("ERR",0)=+($GET(LEX("ERR",0)))+1
- +6 SET LEX("ERR",LEX("ERR",0))="User response out of range"
- End DoDot:1
- GOTO SELQ
- +7 IF '$DATA(^TMP("LEXHIT",$JOB,LEXUR))
- Begin DoDot:1
- +8 SET LEX("ERR",0)=+($GET(LEX("ERR",0)))+1
- +9 SET LEX("ERR",LEX("ERR",0))="Selection is either out of range or invalid"
- End DoDot:1
- GOTO SELQ
- +10 NEW LEXEXP
- SET LEXEXP=+($PIECE(^TMP("LEXHIT",$JOB,LEXUR),"^",1))
- +11 IF '$DATA(^LEX(757.01,LEXEXP,0))
- Begin DoDot:1
- +12 SET LEX("ERR",0)=+($GET(LEX("ERR",0)))+1
- +13 SET LEX("ERR",LEX("ERR",0))="Selection not found in the Lexicon"
- End DoDot:1
- GOTO SELQ
- +14 SET LEXLVL=+($GET(LEX("LVL")))
- +15 DO SET(LEXEXP,$GET(LEXVDT))
- DO EDU^LEXAR
- +16 GOTO SELQ
- SET(LEXEXP,LEXVDT) ; Set LEX("SEL") Nodes
- +1 KILL LEX("SEL")
- DO VDT^LEXU
- DO SETEXP^LEXAR5(LEXEXP)
- +2 NEW LEXMC
- SET LEXMC=+($PIECE(^LEX(757.01,LEXEXP,1),"^",1))
- +3 ; If selected from the list increment frequency
- +4 ; Temporarily deactivated until after Oct 1, 2013
- +5 ; D:+($G(^TMP("LEXSCH",$J,"LST",0)))>0&(+($G(^TMP("LEXSCH",$J,"APP",0)))>1) INC(LEXMC)
- +6 NEW LEXMCE
- SET LEXMCE=+(^LEX(757,LEXMC,0))
- +7 DO SETSRC^LEXAR5(LEXEXP,$GET(LEXVDT))
- +8 if '$DATA(LEX("SEL","SRC","D",LEXMCE))&(LEXMCE'=LEXEXP)
- DO SETSRC^LEXAR5(LEXMCE,$GET(LEXVDT))
- +9 DO SETDEF^LEXAR5(LEXMCE)
- +10 DO SETSTY^LEXAR5(LEXMC)
- +11 NEW LEXE
- SET LEXE=0
- FOR
- SET LEXE=$ORDER(^LEX(757.01,"AMC",LEXMC,LEXE))
- if +LEXE=0
- QUIT
- Begin DoDot:1
- +12 if LEXE=LEXEXP
- QUIT
- DO SETEXP^LEXAR5(LEXE)
- DO SETSRC^LEXAR5(LEXE,$GET(LEXVDT))
- End DoDot:1
- +13 if +($GET(LEXLF))=0
- GOTO SELQ
- +14 QUIT
- INC(LEXMC) ; Increment frequency counter in ^LEX(757)
- +1 NEW LEXF,LEXFQ
- SET LEXMC=+($GET(LEXMC))
- if LEXMC=0
- QUIT
- if '$DATA(^LEX(757,LEXMC))
- QUIT
- +2 SET ZTSAVE("LEXMC")=""
- SET ZTRTN="FQ^LEXAR4"
- SET ZTDESC="Updating Lexicon Frequencies"
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- +3 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
- +4 QUIT
- FQ ; Edit Concept Frequency
- +1 NEW LEXA,LEXM,LEXQ,LEXS,DA,DIC,DIE
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 SET LEXM=+($GET(LEXMC))
- if LEXM=0
- QUIT
- if '$DATA(^LEX(757,LEXM,0))
- QUIT
- +3 IF '$DATA(^LEX(757.001,LEXM,0))
- DO AFQ
- GOTO FQQ
- +4 SET LEXQ=+($PIECE($GET(^LEX(757.001,LEXM,0)),"^",3))
- SET LEXQ=LEXQ+1
- +5 SET DA=+($GET(LEXM))
- if +DA=0
- QUIT
- if '$DATA(^LEX(757.001,DA,0))
- QUIT
- +6 SET LEXM=+($GET(LEXMC))
- if '$DATA(^LEX(757,LEXMC,0))
- QUIT
- SET LEXA=0
- +7 SET (DIC,DIE)="^LEX(757.001,"
- SET DR="2////^S X=LEXQ"
- EFQ ; Lock record and edit frequency record
- +1 LOCK +^LEX(757.001,+DA):1
- IF '$TEST
- SET LEXA=LEXA+1
- HANG 2
- if LEXA<4
- GOTO EFQ
- +2 if LEXA<4
- DO ^DIE
- LOCK -^LEX(757.001,+DA)
- +3 GOTO FQQ
- +4 QUIT
- AFQ ; Add frequency record
- +1 NEW DIC,DA
- SET ^LEX(757.001,LEXM,0)=LEXM_"^0^0"
- SET DIC="^LEX(757.001,"
- SET DA=LEXM
- DO SET^LEXNDX2
- QUIT
- +2 QUIT
- FQQ ; Quit Frequency
- +1 QUIT
- SELQ ; Quit Selection
- +1 if $DATA(LEX("SEL"))
- DO SEL^LEXAR
- +2 if $DATA(LEX("LIST"))
- DO LST^LEXAR
- +3 QUIT
