LEXA4 ;ISL/KER - Look-up (Loud) Unresolved Narrative ;04/21/2014
;;2.0;LEXICON UTILITY;**3,6,15,80**;Sep 23, 1996;Build 1
;
; Global Variables
; ^DISV( ICR 510
; ^TMP("LEXSCH" SACC 2.3.2.5.1
;
; External References
; YN^DICN ICR 10009
;
EN ; User input was not found
; PCH 6 first two lines deleted (Narrative/Exact Match)
S LEX("UNR")=+($G(^TMP("LEXSCH",$J,"UNR",0)))
; PCH 3 - Save number of matches found
S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0)))
; PCH 3 - "not found" flag
N LEXNF S LEXNF=$S(LEX=0:1,1:0)
; Comment out next 2 lines to allow for unresolved narratives
; after the user enters an up-arrow ("^")
; S LEX("RES")=$G(^TMP("LEXSCH",$J,"RES",0))
; I LEX("RES")["^" K LEX("RES"),LEX("NAR"),LEX("UNR") Q
S LEX("RES")=$G(^TMP("LEXSCH",$J,"RES",0))
I LEX("RES")["^" K LEX("RES"),LEX("NAR"),LEX("UNR") Q
; Quit if:
; User Narrative is NULL LEX("NAR")="" or
; Unresolved not allowed ^TMP("LEXSCH",$J,"UNR",0)=0
I $G(LEX("NAR"))=""!($G(LEX("UNR"))=0) D EN^LEXAR("QUIT") Q
N LEXN
S:'LEXNF LEXN=$$NNS(LEX("NAR")) ; PCH 3 - Prompt for user when matches were found
S:LEXNF LEXN=$$NNF(LEX("NAR")) ; PCH 3 - Prompt for user when no matches were found
I LEXN["^" D EN^LEXAR(LEXN) Q
I +LEXN=1,LEX("UNR")=1 D Q
. ; Unresolved pointer when "not found" ; PCH 3 - added
. I LEXNF,$L($G(LEX("NAR"))),$L($G(DIC)),$L($G(DUZ)) D Q
. . S:+LEXN>0&($G(DIC(0))["F") ^DISV(DUZ,DIC)=LEXN_"^"_LEX("NAR")
. . S:DIC(0)["Z" Y(0)=$G(^LEX(757.01,1,0)),Y(0,0)=$P($G(^LEX(757.01,1,0)),"^",1)
. . K:'$L($G(Y(0,0))) Y(0,0)
. . D SET^LEXAR4(1)
. ; Unresolved pointer when not an exact match
. I $L($G(LEX("NAR"))),'$L($G(LEX("EXM"))),$L($G(DIC)),$L($G(DUZ)) D
. . S:+LEXN>0&($G(DIC(0))["F") ^DISV(DUZ,DIC)=LEXN_"^"_LEX("NAR")
. . S:DIC(0)["Z" Y(0)=$G(^LEX(757.01,1,0)),Y(0,0)=$P($G(^LEX(757.01,1,0)),"^",1)
. . K:'$L($G(Y(0,0))) Y(0,0)
. . D EN^LEXAR(LEX("NAR")),SET^LEXAR4(1)
. ; Resolved the pointer if an exact match is found
. I $L($G(LEX("NAR"))),$L($G(LEX("EXM"))),$L($G(DIC)),$L($G(DUZ)) D
. . S:+($G(LEX("EXM")))>2&($G(DIC(0))["F") ^DISV(DUZ,DIC)=+($G(LEX("EXM")))
. . S:DIC(0)["Z" Y(0)=$G(^LEX(757.01,+(LEX("EXM")),0)),Y(0,0)=$P($G(^LEX(757.01,+(LEX("EXM")),0)),"^",1)
. . K:'$L($G(Y(0,0))) Y(0,0)
. . D EN^LEXAR(+($G(LEX("EXM")))),SET^LEXAR4(+($G(LEX("EXM"))))
Q
NNS(X) ; Narrative not selected (LEX>0)
W ! N LEXNARR,LEXANY,LEXPMT1,LEXPMT2,%,%Y S LEXANY="",LEXNARR=X
D NNSA Q X
NNSA ; Use Narrative (anyway)
I +($G(LEX("EXM")))=0 D
. S LEXPMT1=">>> You have not selected a term from the Lexicon"
. S LEXPMT2=$S($L(LEXANY):">>> ",1:" ")_"Use "_LEXNARR_LEXANY
I +($G(LEX("EXM")))>0 D
. S LEXPMT1=">>> Exact match found"
. S LEXPMT2=$S($L(LEXANY):">>> ",1:" ")_"Use "_LEXNARR
W:$L(LEXPMT1)&('$L(LEXANY)) !,LEXPMT1 W:$L(LEXANY) !
W:$L(LEXPMT2) !,LEXPMT2
S %=$S(+($G(LEX("EXM")))>2:1,1:2)
D YN^DICN S:%Y["^" X="^" S:%Y["^^" X="^^" Q:X["^" I %=-1 S X=0 Q
I '%,+($G(LEX("EXM")))>0 D G NNSA
. W !!,"An exact match was found in the Lexicon. By answering"
. W !,"""Yes"" you will be selecting the exact match found in"
. W !,"Lexicon.",!
I '%,+($G(LEX("EXM")))'>0 D G NNSA
. W !!,"A suitable term was not found in the Lexicon. By answering"
. W !,"""Yes"" you will be keeping your exact text as typed rather than"
. W !,"a term from the Lexicon"
. S LEXANY=" anyway"
I %=1 S X=% Q
S X=0 Q
NNF(X) ; Narrative was not found ; PCH 3 - added
W ! N LEXNARR,LEXANY,LEXPMT1,LEXPMT2,LEXPMT3,LEXPMT4,LEXPMT5,%,%Y
S LEXANY="",LEXNARR=X
D NNFA Q X
NNFA ; Use Narrative (anyway) ; PCH 3 - added
N LEXC,LEXF,LEXV S LEXC=1,LEXF=$G(^TMP("LEXSCH",$J,"FIL",0)),LEXV=$G(^TMP("LEXSCH",$J,"VOC",0))
S LEXPMT1=">>> A suitable term was not found based on user input"
S:LEXF="I 1" LEXF="" S:$L(LEXF)!(LEXV'="WRD") LEXPMT1=LEXPMT1_" and current defaults"
S LEXPMT1=LEXPMT1_"."
S LEXPMT2="NOTE : "_$S($L($G(LEXNARR)):"'"_LEXNARR_"' m",1:"You m")
S LEXPMT2=LEXPMT2_"ay have found too many matches."
S LEXPMT3=" You can refine your search by entering more descriptive text"
S LEXPMT4=" (Eg. 'DISEASE' instead of 'DIS') ..."
S LEXPMT5=$S($L(LEXANY):">>> ",1:" ")_"Use "_LEXNARR_LEXANY
W:$L(LEXPMT1)&('$L(LEXANY)) !,LEXPMT1
; W:$L(LEXANY) !
W !!,LEXPMT2,!,LEXPMT3,!,LEXPMT4
W:$L(LEXPMT5) !!!,LEXPMT5
S %=$S(+($G(LEX("EXM")))>2:1,1:2)
D YN^DICN S:%Y["^" X="^" S:%Y["^^" X="^^" Q:X["^" I %=-1 S X=0 Q
I '% D G NNFA
. W !!,"A suitable term was not found in the Lexicon. By answering"
. W !,"""Yes"" you will be keeping the exact text as typed rather than"
. W !,"a term from the Lexicon.",!
. S LEXANY=" anyway"
I %=1 S X=% Q
S X=0 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXA4 4818 printed Nov 22, 2024@17:16:58 Page 2
LEXA4 ;ISL/KER - Look-up (Loud) Unresolved Narrative ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**3,6,15,80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^DISV( ICR 510
+5 ; ^TMP("LEXSCH" SACC 2.3.2.5.1
+6 ;
+7 ; External References
+8 ; YN^DICN ICR 10009
+9 ;
EN ; User input was not found
+1 ; PCH 6 first two lines deleted (Narrative/Exact Match)
+2 SET LEX("UNR")=+($GET(^TMP("LEXSCH",$JOB,"UNR",0)))
+3 ; PCH 3 - Save number of matches found
+4 SET LEX=+($GET(^TMP("LEXSCH",$JOB,"NUM",0)))
+5 ; PCH 3 - "not found" flag
+6 NEW LEXNF
SET LEXNF=$SELECT(LEX=0:1,1:0)
+7 ; Comment out next 2 lines to allow for unresolved narratives
+8 ; after the user enters an up-arrow ("^")
+9 ; S LEX("RES")=$G(^TMP("LEXSCH",$J,"RES",0))
+10 ; I LEX("RES")["^" K LEX("RES"),LEX("NAR"),LEX("UNR") Q
+11 SET LEX("RES")=$GET(^TMP("LEXSCH",$JOB,"RES",0))
+12 IF LEX("RES")["^"
KILL LEX("RES"),LEX("NAR"),LEX("UNR")
QUIT
+13 ; Quit if:
+14 ; User Narrative is NULL LEX("NAR")="" or
+15 ; Unresolved not allowed ^TMP("LEXSCH",$J,"UNR",0)=0
+16 IF $GET(LEX("NAR"))=""!($GET(LEX("UNR"))=0)
DO EN^LEXAR("QUIT")
QUIT
+17 NEW LEXN
+18 ; PCH 3 - Prompt for user when matches were found
if 'LEXNF
SET LEXN=$$NNS(LEX("NAR"))
+19 ; PCH 3 - Prompt for user when no matches were found
if LEXNF
SET LEXN=$$NNF(LEX("NAR"))
+20 IF LEXN["^"
DO EN^LEXAR(LEXN)
QUIT
+21 IF +LEXN=1
IF LEX("UNR")=1
Begin DoDot:1
+22 ; Unresolved pointer when "not found" ; PCH 3 - added
+23 IF LEXNF
IF $LENGTH($GET(LEX("NAR")))
IF $LENGTH($GET(DIC))
IF $LENGTH($GET(DUZ))
Begin DoDot:2
+24 if +LEXN>0&($GET(DIC(0))["F")
SET ^DISV(DUZ,DIC)=LEXN_"^"_LEX("NAR")
+25 if DIC(0)["Z"
SET Y(0)=$GET(^LEX(757.01,1,0))
SET Y(0,0)=$PIECE($GET(^LEX(757.01,1,0)),"^",1)
+26 if '$LENGTH($GET(Y(0,0)))
KILL Y(0,0)
+27 DO SET^LEXAR4(1)
End DoDot:2
QUIT
+28 ; Unresolved pointer when not an exact match
+29 IF $LENGTH($GET(LEX("NAR")))
IF '$LENGTH($GET(LEX("EXM")))
IF $LENGTH($GET(DIC))
IF $LENGTH($GET(DUZ))
Begin DoDot:2
+30 if +LEXN>0&($GET(DIC(0))["F")
SET ^DISV(DUZ,DIC)=LEXN_"^"_LEX("NAR")
+31 if DIC(0)["Z"
SET Y(0)=$GET(^LEX(757.01,1,0))
SET Y(0,0)=$PIECE($GET(^LEX(757.01,1,0)),"^",1)
+32 if '$LENGTH($GET(Y(0,0)))
KILL Y(0,0)
+33 DO EN^LEXAR(LEX("NAR"))
DO SET^LEXAR4(1)
End DoDot:2
+34 ; Resolved the pointer if an exact match is found
+35 IF $LENGTH($GET(LEX("NAR")))
IF $LENGTH($GET(LEX("EXM")))
IF $LENGTH($GET(DIC))
IF $LENGTH($GET(DUZ))
Begin DoDot:2
+36 if +($GET(LEX("EXM")))>2&($GET(DIC(0))["F")
SET ^DISV(DUZ,DIC)=+($GET(LEX("EXM")))
+37 if DIC(0)["Z"
SET Y(0)=$GET(^LEX(757.01,+(LEX("EXM")),0))
SET Y(0,0)=$PIECE($GET(^LEX(757.01,+(LEX("EXM")),0)),"^",1)
+38 if '$LENGTH($GET(Y(0,0)))
KILL Y(0,0)
+39 DO EN^LEXAR(+($GET(LEX("EXM"))))
DO SET^LEXAR4(+($GET(LEX("EXM"))))
End DoDot:2
End DoDot:1
QUIT
+40 QUIT
NNS(X) ; Narrative not selected (LEX>0)
+1 WRITE !
NEW LEXNARR,LEXANY,LEXPMT1,LEXPMT2,%,%Y
SET LEXANY=""
SET LEXNARR=X
+2 DO NNSA
QUIT X
NNSA ; Use Narrative (anyway)
+1 IF +($GET(LEX("EXM")))=0
Begin DoDot:1
+2 SET LEXPMT1=">>> You have not selected a term from the Lexicon"
+3 SET LEXPMT2=$SELECT($LENGTH(LEXANY):">>> ",1:" ")_"Use "_LEXNARR_LEXANY
End DoDot:1
+4 IF +($GET(LEX("EXM")))>0
Begin DoDot:1
+5 SET LEXPMT1=">>> Exact match found"
+6 SET LEXPMT2=$SELECT($LENGTH(LEXANY):">>> ",1:" ")_"Use "_LEXNARR
End DoDot:1
+7 if $LENGTH(LEXPMT1)&('$LENGTH(LEXANY))
WRITE !,LEXPMT1
if $LENGTH(LEXANY)
WRITE !
+8 if $LENGTH(LEXPMT2)
WRITE !,LEXPMT2
+9 SET %=$SELECT(+($GET(LEX("EXM")))>2:1,1:2)
+10 DO YN^DICN
if %Y["^"
SET X="^"
if %Y["^^"
SET X="^^"
if X["^"
QUIT
IF %=-1
SET X=0
QUIT
+11 IF '%
IF +($GET(LEX("EXM")))>0
Begin DoDot:1
+12 WRITE !!,"An exact match was found in the Lexicon. By answering"
+13 WRITE !,"""Yes"" you will be selecting the exact match found in"
+14 WRITE !,"Lexicon.",!
End DoDot:1
GOTO NNSA
+15 IF '%
IF +($GET(LEX("EXM")))'>0
Begin DoDot:1
+16 WRITE !!,"A suitable term was not found in the Lexicon. By answering"
+17 WRITE !,"""Yes"" you will be keeping your exact text as typed rather than"
+18 WRITE !,"a term from the Lexicon"
+19 SET LEXANY=" anyway"
End DoDot:1
GOTO NNSA
+20 IF %=1
SET X=%
QUIT
+21 SET X=0
QUIT
NNF(X) ; Narrative was not found ; PCH 3 - added
+1 WRITE !
NEW LEXNARR,LEXANY,LEXPMT1,LEXPMT2,LEXPMT3,LEXPMT4,LEXPMT5,%,%Y
+2 SET LEXANY=""
SET LEXNARR=X
+3 DO NNFA
QUIT X
NNFA ; Use Narrative (anyway) ; PCH 3 - added
+1 NEW LEXC,LEXF,LEXV
SET LEXC=1
SET LEXF=$GET(^TMP("LEXSCH",$JOB,"FIL",0))
SET LEXV=$GET(^TMP("LEXSCH",$JOB,"VOC",0))
+2 SET LEXPMT1=">>> A suitable term was not found based on user input"
+3 if LEXF="I 1"
SET LEXF=""
if $LENGTH(LEXF)!(LEXV'="WRD")
SET LEXPMT1=LEXPMT1_" and current defaults"
+4 SET LEXPMT1=LEXPMT1_"."
+5 SET LEXPMT2="NOTE : "_$SELECT($LENGTH($GET(LEXNARR)):"'"_LEXNARR_"' m",1:"You m")
+6 SET LEXPMT2=LEXPMT2_"ay have found too many matches."
+7 SET LEXPMT3=" You can refine your search by entering more descriptive text"
+8 SET LEXPMT4=" (Eg. 'DISEASE' instead of 'DIS') ..."
+9 SET LEXPMT5=$SELECT($LENGTH(LEXANY):">>> ",1:" ")_"Use "_LEXNARR_LEXANY
+10 if $LENGTH(LEXPMT1)&('$LENGTH(LEXANY))
WRITE !,LEXPMT1
+11 ; W:$L(LEXANY) !
+12 WRITE !!,LEXPMT2,!,LEXPMT3,!,LEXPMT4
+13 if $LENGTH(LEXPMT5)
WRITE !!!,LEXPMT5
+14 SET %=$SELECT(+($GET(LEX("EXM")))>2:1,1:2)
+15 DO YN^DICN
if %Y["^"
SET X="^"
if %Y["^^"
SET X="^^"
if X["^"
QUIT
IF %=-1
SET X=0
QUIT
+16 IF '%
Begin DoDot:1
+17 WRITE !!,"A suitable term was not found in the Lexicon. By answering"
+18 WRITE !,"""Yes"" you will be keeping the exact text as typed rather than"
+19 WRITE !,"a term from the Lexicon.",!
+20 SET LEXANY=" anyway"
End DoDot:1
GOTO NNFA
+21 IF %=1
SET X=%
QUIT
+22 SET X=0
QUIT
