Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXA4

LEXA4.m

Go to the documentation of this file. 
  1. LEXA4 ;ISL/KER - Look-up (Loud) Unresolved Narrative ;04/21/2014
  1.  ;;2.0;LEXICON UTILITY;**3,6,15,80**;Sep 23, 1996;Build 10
  1.  ;               
  1.  ; Global Variables
  1.  ;    ^DISV(              ICR    510
  1.  ;    ^TMP("LEXSCH"       SACC 2.3.2.5.1
  1.  ;               
  1.  ; External References
  1.  ;    YN^DICN             ICR  10009
  1.  ;               
  1. EN ; User input was not found
  1.  ; PCH 6 first two lines deleted (Narrative/Exact Match)
  1.  S LEX("UNR")=+($G(^TMP("LEXSCH",$J,"UNR",0)))
  1.  ; PCH 3 - Save number of matches found
  1.  S LEX=+($G(^TMP("LEXSCH",$J,"NUM",0)))
  1.  ; PCH 3 - "not found" flag
  1.  N LEXNF S LEXNF=$S(LEX=0:1,1:0)
  1.  ; Comment out next 2 lines to allow for unresolved narratives
  1.  ; after the user enters an up-arrow ("^")
  1.  ; S LEX("RES")=$G(^TMP("LEXSCH",$J,"RES",0))
  1.  ; I LEX("RES")["^" K LEX("RES"),LEX("NAR"),LEX("UNR") Q
  1.  S LEX("RES")=$G(^TMP("LEXSCH",$J,"RES",0))
  1.  I LEX("RES")["^" K LEX("RES"),LEX("NAR"),LEX("UNR") Q
  1.  ; Quit if:
  1.  ;   User Narrative is NULL   LEX("NAR")=""   or
  1.  ;   Unresolved not allowed   ^TMP("LEXSCH",$J,"UNR",0)=0
  1.  I $G(LEX("NAR"))=""!($G(LEX("UNR"))=0) D EN^LEXAR("QUIT") Q
  1.  N LEXN
  1.  S:'LEXNF LEXN=$$NNS(LEX("NAR"))  ; PCH 3 - Prompt for user when matches were found
  1.  S:LEXNF LEXN=$$NNF(LEX("NAR"))  ; PCH 3 - Prompt for user when no matches were found
  1.  I LEXN["^" D EN^LEXAR(LEXN) Q
  1.  I +LEXN=1,LEX("UNR")=1 D  Q
  1.  . ; Unresolved pointer when "not found"  ; PCH 3 - added
  1.  . I LEXNF,$L($G(LEX("NAR"))),$L($G(DIC)),$L($G(DUZ)) D  Q
  1.  . . S:+LEXN>0&($G(DIC(0))["F") ^DISV(DUZ,DIC)=LEXN_"^"_LEX("NAR")
  1.  . . S:DIC(0)["Z" Y(0)=$G(^LEX(757.01,1,0)),Y(0,0)=$P($G(^LEX(757.01,1,0)),"^",1)
  1.  . . K:'$L($G(Y(0,0))) Y(0,0)
  1.  . . D SET^LEXAR4(1)
  1.  . ; Unresolved pointer when not an exact match 
  1.  . I $L($G(LEX("NAR"))),'$L($G(LEX("EXM"))),$L($G(DIC)),$L($G(DUZ)) D
  1.  . . S:+LEXN>0&($G(DIC(0))["F") ^DISV(DUZ,DIC)=LEXN_"^"_LEX("NAR")
  1.  . . S:DIC(0)["Z" Y(0)=$G(^LEX(757.01,1,0)),Y(0,0)=$P($G(^LEX(757.01,1,0)),"^",1)
  1.  . . K:'$L($G(Y(0,0))) Y(0,0)
  1.  . . D EN^LEXAR(LEX("NAR")),SET^LEXAR4(1)
  1.  . ; Resolved the pointer if an exact match is found
  1.  . I $L($G(LEX("NAR"))),$L($G(LEX("EXM"))),$L($G(DIC)),$L($G(DUZ)) D
  1.  . . S:+($G(LEX("EXM")))>2&($G(DIC(0))["F") ^DISV(DUZ,DIC)=+($G(LEX("EXM")))
  1.  . . 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)
  1.  . . K:'$L($G(Y(0,0))) Y(0,0)
  1.  . . D EN^LEXAR(+($G(LEX("EXM")))),SET^LEXAR4(+($G(LEX("EXM"))))
  1.  Q
  1. NNS(X) ; Narrative not selected (LEX>0)
  1.  W ! N LEXNARR,LEXANY,LEXPMT1,LEXPMT2,%,%Y S LEXANY="",LEXNARR=X
  1.  D NNSA Q X
  1. NNSA ; Use Narrative (anyway)
  1.  I +($G(LEX("EXM")))=0 D
  1.  . S LEXPMT1=">>>  You have not selected a term from the Lexicon"
  1.  . S LEXPMT2=$S($L(LEXANY):">>>  ",1:"     ")_"Use "_LEXNARR_LEXANY
  1.  I +($G(LEX("EXM")))>0 D
  1.  . S LEXPMT1=">>>  Exact match found"
  1.  . S LEXPMT2=$S($L(LEXANY):">>>  ",1:"     ")_"Use "_LEXNARR
  1.  W:$L(LEXPMT1)&('$L(LEXANY)) !,LEXPMT1 W:$L(LEXANY) !
  1.  W:$L(LEXPMT2) !,LEXPMT2
  1.  S %=$S(+($G(LEX("EXM")))>2:1,1:2)
  1.  D YN^DICN S:%Y["^" X="^" S:%Y["^^" X="^^" Q:X["^"  I %=-1 S X=0 Q
  1.  I '%,+($G(LEX("EXM")))>0 D  G NNSA
  1.  . W !!,"An exact match was found in the Lexicon.  By answering"
  1.  . W !,"""Yes"" you will be selecting the exact match found in"
  1.  . W !,"Lexicon.",!
  1.  I '%,+($G(LEX("EXM")))'>0 D  G NNSA
  1.  . W !!,"A suitable term was not found in the Lexicon.  By answering"
  1.  . W !,"""Yes"" you will be keeping your exact text as typed rather than"
  1.  . W !,"a term from the Lexicon"
  1.  . S LEXANY=" anyway"
  1.  I %=1 S X=% Q
  1.  S X=0 Q
  1. NNF(X) ; Narrative was not found ; PCH 3 - added
  1.  W ! N LEXNARR,LEXANY,LEXPMT1,LEXPMT2,LEXPMT3,LEXPMT4,LEXPMT5,%,%Y
  1.  S LEXANY="",LEXNARR=X
  1.  D NNFA Q X
  1. NNFA ; Use Narrative (anyway) ; PCH 3 - added
  1.  N LEXC,LEXF,LEXV S LEXC=1,LEXF=$G(^TMP("LEXSCH",$J,"FIL",0)),LEXV=$G(^TMP("LEXSCH",$J,"VOC",0))
  1.  S LEXPMT1=">>>  A suitable term was not found based on user input"
  1.  S:LEXF="I 1" LEXF="" S:$L(LEXF)!(LEXV'="WRD") LEXPMT1=LEXPMT1_" and current defaults"
  1.  S LEXPMT1=LEXPMT1_"."
  1.  S LEXPMT2="NOTE : "_$S($L($G(LEXNARR)):"'"_LEXNARR_"' m",1:"You m")
  1.  S LEXPMT2=LEXPMT2_"ay have found too many matches."
  1.  S LEXPMT3="         You can refine your search by entering more descriptive text"
  1.  S LEXPMT4="         (Eg. 'DISEASE' instead of 'DIS') ..."
  1.  S LEXPMT5=$S($L(LEXANY):">>>  ",1:"     ")_"Use "_LEXNARR_LEXANY
  1.  W:$L(LEXPMT1)&('$L(LEXANY)) !,LEXPMT1
  1.  ; W:$L(LEXANY) !
  1.  W !!,LEXPMT2,!,LEXPMT3,!,LEXPMT4
  1.  W:$L(LEXPMT5) !!!,LEXPMT5
  1.  S %=$S(+($G(LEX("EXM")))>2:1,1:2)
  1.  D YN^DICN S:%Y["^" X="^" S:%Y["^^" X="^^" Q:X["^"  I %=-1 S X=0 Q
  1.  I '% D  G NNFA
  1.  . W !!,"A suitable term was not found in the Lexicon.  By answering"
  1.  . W !,"""Yes"" you will be keeping the exact text as typed rather than"
  1.  . W !,"a term from the Lexicon.",!
  1.  . S LEXANY=" anyway"
  1.  I %=1 S X=% Q
  1.  S X=0 Q