LEXAR4 ;ISL/KER - Look-up Response (Select Entry) ;04/21/2014
;;2.0;LEXICON UTILITY;**4,5,6,25,55,80**;Sep 23, 1996;Build 10
;
; 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"
; Set concept level, if modifiers are allowed build list
S LEXLVL=+($G(LEX("LVL"))) I LEXLVL'>1,+LEXEXP>2,$D(^LEX(757.01,+LEXEXP,0)),+($G(^TMP("LEXSCH",$J,"MOD",0)))>0 D EN^LEXAMD(LEXEXP,$G(LEXVDT))
; Quit if modifiers found at next level
G:+($G(LEX("LVL")))>LEXLVL SELQ
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
LEXAR4 ;ISL/KER - Look-up Response (Select Entry) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**4,5,6,25,55,80**;Sep 23, 1996;Build 10
+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 concept level, if modifiers are allowed build list
+15 SET LEXLVL=+($GET(LEX("LVL")))
IF LEXLVL'>1
IF +LEXEXP>2
IF $DATA(^LEX(757.01,+LEXEXP,0))
IF +($GET(^TMP("LEXSCH",$JOB,"MOD",0)))>0
DO EN^LEXAMD(LEXEXP,$GET(LEXVDT))
+16 ; Quit if modifiers found at next level
+17 IF +($GET(LEX("LVL")))>LEXLVL
GOTO SELQ
+18 DO SET(LEXEXP,$GET(LEXVDT))
DO EDU^LEXAR
+19 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
