| 1 | LEXA1 ; ISA/CJE-Lexicon Look-up (Loud) ; 02/02/2006
|
|---|
| 2 | ;;2.0;LEXICON UTILITY;**3,4,6,11,15,38**;Sep 23, 1996;Build 1
|
|---|
| 3 | ; CJE; Force quit when user enters '^' at search prompt.
|
|---|
| 4 | ; JPK; Display code attached to a selected term
|
|---|
| 5 | ;
|
|---|
| 6 | EN ; Initialize
|
|---|
| 7 | D:$D(XRTL) T0^%ZOSV K LEX S LEXQ=0
|
|---|
| 8 | I $D(LEXVDT) I $L($G(^TMP("LEXSCH",$J,"VDT",0))) S LEXVDT=^TMP("LEXSCH",$J,"VDT",0)
|
|---|
| 9 | I '$D(LEXVDT) I $L($G(^TMP("LEXSCH",$J,"VDT",0))) N LEXVDT S LEXVDT=^TMP("LEXSCH",$J,"VDT",0)
|
|---|
| 10 | ;-------------------------------------------------------------
|
|---|
| 11 | ;
|
|---|
| 12 | ;
|
|---|
| 13 | ; LEXSUB Special variable from version 1.0 specifying the
|
|---|
| 14 | ; vocabulary subset to use during the search. It is
|
|---|
| 15 | ; a three character mnemonic taken from the Subset
|
|---|
| 16 | ; Definition file #757.2. The default is "WRD"
|
|---|
| 17 | ;
|
|---|
| 18 | S:'$L($G(LEXSUB)) LEXSUB="WRD"
|
|---|
| 19 | ;
|
|---|
| 20 | ; LEXAP Special variable from version 1.0 specifying the
|
|---|
| 21 | ; application using the Lexicon. It is a pointer
|
|---|
| 22 | ; value to the Subset Definition file #757.2.
|
|---|
| 23 | ; The default is 1 (Lexicon)
|
|---|
| 24 | ;
|
|---|
| 25 | S:'$L($G(LEXAP))&($L($G(^TMP("LEXSCH",$J,"APP",0)))) LEXAP=^TMP("LEXSCH",$J,"APP",0)
|
|---|
| 26 | S:'$L($G(LEXAP)) LEXAP=1
|
|---|
| 27 | ;
|
|---|
| 28 | ; LEXLL Special variable (new) specifying the length of the
|
|---|
| 29 | ; displayable list the user is to select from. Default
|
|---|
| 30 | ; is 5 (display 5 at a time until the entire list has
|
|---|
| 31 | ; been reviewed)
|
|---|
| 32 | ;
|
|---|
| 33 | S:'$L($G(LEXLL)) LEXLL=5
|
|---|
| 34 | ;
|
|---|
| 35 | ; Check the DIC variables new LEXUR "user response"
|
|---|
| 36 | N LEXDICA,LEXDICB D CHK N LEXUR
|
|---|
| 37 | ;
|
|---|
| 38 | ; Save the value of X if "Ask" is not specified in DIC(0)
|
|---|
| 39 | ;
|
|---|
| 40 | I DIC(0)'["A",$L($G(X)) S LEXSAVE=X K X
|
|---|
| 41 | ;
|
|---|
| 42 | ; Save the prompt
|
|---|
| 43 | ;
|
|---|
| 44 | I $L($G(DIC("A"))) S LEXDICA=DIC("A")
|
|---|
| 45 | ;
|
|---|
| 46 | ; Continue to lookup until the dialog with the application
|
|---|
| 47 | ; ends. If there is nothing to lookup (X="") or an uparrow
|
|---|
| 48 | ; is detected, the Lexicon shuts down killing LEX.
|
|---|
| 49 | ;
|
|---|
| 50 | F D LK Q:'$D(LEX)!($D(LEX("SEL")))
|
|---|
| 51 | ;
|
|---|
| 52 | G EXIT
|
|---|
| 53 | ;-------------------------------------------------------------
|
|---|
| 54 | LK ; Start Look-up
|
|---|
| 55 | ; X not provided
|
|---|
| 56 | D:'$D(LEXSAVE) ASK
|
|---|
| 57 | ; X provided
|
|---|
| 58 | S:$D(LEXSAVE) X=LEXSAVE K LEXSAVE
|
|---|
| 59 | ; X was null with a default provided
|
|---|
| 60 | S:$D(DIC("B"))&($G(X)="") X=DIC("B")
|
|---|
| 61 | ; Lookup X
|
|---|
| 62 | ;W:$L(X)&(X'["^")&($E(X,1)'=" ") !,"Searching for ",X ; PCH 4 - Do not display X
|
|---|
| 63 | D LOOK^LEXA(X,LEXAP,LEXLL) K DIC("B")
|
|---|
| 64 | ;
|
|---|
| 65 | ;--------------------------------------------------------------------
|
|---|
| 66 | NOTFND ; PCH 3
|
|---|
| 67 | ;
|
|---|
| 68 | ; If X was not found
|
|---|
| 69 | ;
|
|---|
| 70 | ; Write "??"
|
|---|
| 71 | ;
|
|---|
| 72 | ; If the calling application uses Unresolved Narratives
|
|---|
| 73 | ; Prompt to "accept or reject" the narrative
|
|---|
| 74 | ; If no selection is made continue the search
|
|---|
| 75 | ;
|
|---|
| 76 | ; If the calling application does not use Unresolved Narratives
|
|---|
| 77 | ; Display help
|
|---|
| 78 | ; Re-prompt
|
|---|
| 79 | ; Continue search
|
|---|
| 80 | ;
|
|---|
| 81 | I '$D(LEX("LIST")),+($G(LEX))=0,$L(X),X'["^",$E(X,1)'=" " D I '$D(LEX("SEL")) K LEX S LEX=0 Q
|
|---|
| 82 | . K DIC("B"),LEX("SEL")
|
|---|
| 83 | . I +($G(^TMP("LEXSCH",$J,"UNR",0)))=0 W " ??" D:$D(LEX("HLP")) DH^LEXA3 W ! Q
|
|---|
| 84 | . I +($G(^TMP("LEXSCH",$J,"UNR",0)))=1 W " ??" D EN^LEXA4 W !
|
|---|
| 85 | ;
|
|---|
| 86 | ;--------------------------------------------------------------------
|
|---|
| 87 | FOUND ; PCH 3
|
|---|
| 88 | ;
|
|---|
| 89 | ; If X was found
|
|---|
| 90 | ;
|
|---|
| 91 | ; Begin user selection
|
|---|
| 92 | ;
|
|---|
| 93 | ; Continue to display the list until the dialog with the
|
|---|
| 94 | ; user is terminated. The dialog with the user is
|
|---|
| 95 | ; considered to be terminated if:
|
|---|
| 96 | ;
|
|---|
| 97 | ; the selection list does not exist '$D(LEX("LIST"))
|
|---|
| 98 | ;
|
|---|
| 99 | ; or the user has made a selection $D(LEX("SEL")
|
|---|
| 100 | ;
|
|---|
| 101 | I $D(LEX("LIST")) F Q:+($G(LEX))=0 D SELECT^LEXA2
|
|---|
| 102 | Q:$D(LEX("SEL"))
|
|---|
| 103 | I '$L($G(LEX)) K LEX Q ;PCH 6 quit if LEX=""
|
|---|
| 104 | I $L($G(LEX)),'$D(LEX("SEL")),$D(^TMP("LEXSCH",$J)) D
|
|---|
| 105 | . D EN^LEXA4 S:'$D(LEX("SEL")) LEX=0 ; PCH 6 rebuild list if no SEL
|
|---|
| 106 | ;
|
|---|
| 107 | Q
|
|---|
| 108 | EXIT ; Kill variables
|
|---|
| 109 | S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV
|
|---|
| 110 | S:$L($G(LEXDICA)) DIC("A")=LEXDICA S:$L($G(LEXDICB)) DIC("B")=LEXDICB
|
|---|
| 111 | ; Set Y, Y(0,0) Y(1) from LEX("SEL")
|
|---|
| 112 | S:'$D(LEX("SEL","EXP",1)) Y=-1 K Y(1)
|
|---|
| 113 | I $D(LEX("SEL","EXP",1)) S Y=LEX("SEL","EXP",1) D Y1,SSBR S:DIC(0)["Z" Y(0)=^LEX(757.01,+(LEX("SEL","EXP",1)),0),Y(0,0)=$P(^LEX(757.01,+(LEX("SEL","EXP",1)),0),"^",1)
|
|---|
| 114 | K LEX,LEXSUB,LEXAP,LEXLL
|
|---|
| 115 | K ^TMP("LEXSCH",$J),^TMP("LEXFND",$J),^TMP("LEXHIT",$J)
|
|---|
| 116 | Q
|
|---|
| 117 | Y1 ; ICD in Y(1) and CPT in Y(81)
|
|---|
| 118 | N LEXVAS S LEXVAS=0,Y(1)=""
|
|---|
| 119 | F S LEXVAS=$O(LEX("SEL","VAS","B",80,LEXVAS)) Q:+LEXVAS=0!(Y(1)'="") D
|
|---|
| 120 | . S Y(1)=$P($G(LEX("SEL","VAS",LEXVAS)),"^",3)
|
|---|
| 121 | S LEXVAS=0,Y(81)="" F S LEXVAS=$O(LEX("SEL","VAS","B",81,LEXVAS)) Q:+LEXVAS=0!(Y(81)'="") D
|
|---|
| 122 | . S Y(81)=$P($G(LEX("SEL","VAS",LEXVAS)),"^",3)
|
|---|
| 123 | K:Y(1)="" Y(1) K:Y(81)="" Y(81)
|
|---|
| 124 | I $D(Y(1)) D
|
|---|
| 125 | .W !!,">>> Code : "
|
|---|
| 126 | .I $D(IOINHI)&($D(IOINORM)) W IOINHI,Y(1),IOINORM,! Q
|
|---|
| 127 | .W Y(1),!
|
|---|
| 128 | Q
|
|---|
| 129 | ASK ; Get user input
|
|---|
| 130 | N DIR,DIRUT,DIROUT S:$L($G(LEXDICA)) DIC("A")=LEXDICA
|
|---|
| 131 | S DIR("A")=DIC("A") W:'$L($G(X))&('$L($G(LEXDICB))) !
|
|---|
| 132 | I '$L($G(X)),$L($G(LEXDICB)) S DIR("B")=LEXDICB
|
|---|
| 133 | S DIR("?")=" "_$$SQ^LEXHLP ; PCH 11
|
|---|
| 134 | S DIR("??")="^D INPHLP^LEXA1" N Y S DIR(0)="FAO^0:245" K X
|
|---|
| 135 | D ^DIR
|
|---|
| 136 | K DIC("B") D:$E(X,1)=" " RSBR
|
|---|
| 137 | W:$E(X,1)'=" " ! ; PCH 4
|
|---|
| 138 | F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
|---|
| 139 | W:$D(DTOUT) !,"Try later.",!
|
|---|
| 140 | ; If '^' typed or read timed out, set X="" to force quit.
|
|---|
| 141 | I $D(DTOUT)!(X="^") S X=""
|
|---|
| 142 | S:X[U DUOUT=1 K DIRUT,DIROUT Q
|
|---|
| 143 | INPHLP ; Look-up help PCH 11
|
|---|
| 144 | N X S X="" S:$L($G(DIR("?"))) X=$G(DIR("?")) S:'$L(X) X=" "_$$SQ^LEXHLP
|
|---|
| 145 | W:$L(X) !!,X,!
|
|---|
| 146 | W !," Best results occur using one to three full or partial words without"
|
|---|
| 147 | W !," a suffix (i.e., ""DIABETES"",""DIAB MELL"",""DIAB MELL INSUL"") or"
|
|---|
| 148 | W !," a classification code (ICD, CPT, HCPCS, etc)"
|
|---|
| 149 | Q
|
|---|
| 150 | CLR K ^TMP("LEXSCH",$J),^TMP("LEXHIT",$J),^TMP("LEXFND",$J) Q
|
|---|
| 151 | CHK ; Check Fileman look-up variables
|
|---|
| 152 | K DIC("DR"),DIC("P"),DIC("V"),DLAYGO,DINUM
|
|---|
| 153 | S:$L($G(X)) LEXSAVE=X S:$L($G(DIC("B"))) LEXDICB=DIC("B") K DIC("B")
|
|---|
| 154 | I $L($G(DIC(0))) D
|
|---|
| 155 | . F Q:DIC(0)'["L" S DIC(0)=$P(DIC(0),"L",1)_$P(DIC(0),"L",2)
|
|---|
| 156 | . F Q:DIC(0)'["I" S DIC(0)=$P(DIC(0),"I",1)_$P(DIC(0),"I",2)
|
|---|
| 157 | S:'$L($G(DIC(0))) DIC(0)="QEAMF" S:'$L($G(DIC)) DIC="^LEX(757.01,"
|
|---|
| 158 | S:DIC(0)'["F" DIC(0)=DIC(0)_"F" S:'$L($G(DIC("A"))) DIC("A")="Enter Term/Concept: "
|
|---|
| 159 | S LEXDICA=DIC("A")
|
|---|
| 160 | Q
|
|---|
| 161 | SSBR ; Store data for Space Bar Return
|
|---|
| 162 | ; PCH 3 discontinue saving unresolved narrative
|
|---|
| 163 | Q:'$L($G(DUZ)) Q:+($G(DUZ))=0 Q:'$L($G(DIC)) Q:$G(DIC)'["757.01,"
|
|---|
| 164 | Q:$G(DIC(0))'["F" Q:+($G(Y))'>2 Q:$E($G(X),1)=" " S ^DISV(DUZ,DIC)=+($G(Y))
|
|---|
| 165 | Q
|
|---|
| 166 | RSBR ; Retrieve onSpace Bar Return
|
|---|
| 167 | ; PCH 3 discontinue retrieving unresolved narrative
|
|---|
| 168 | Q:'$L($G(DUZ)) Q:$G(DIC)'="^LEX(757.01," Q:$G(DIC(0))'["F"
|
|---|
| 169 | Q:$E($G(X),1)'=" " S:+($G(^DISV(DUZ,DIC)))>2 X=@(DIC_+($G(^DISV(DUZ,DIC)))_",0)")
|
|---|
| 170 | Q
|
|---|
