LEXQID4 ;ISL/KER - Query - ICD Diagnosis - Save ;04/21/2014
;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^TMP("LEXQID") SACC 2.3.2.5.1
; ^TMP("LEXQIDO") SACC 2.3.2.5.1
;
; External References
; $$UPDX^ICDEX ICR 5747
; $$VAGEH^ICDEXD ICR 5747
; $$VAGEL^ICDEXD ICR 5747
; $$VSEX^ICDEXD ICR 5747
; $$UP^XLFSTR ICR 10104
;
; Local Variables NEWed or KILLed in LEXQID
; LEXIEN ICD Internal Entry Number
; LEXCDT Code Set Date
; LEXLEN Offset Length
; LEXST ICD Status and Effective Dates
; LEXSD Versioned Short Description
; LEXLD Versioned Long Description
; LEXLX Versioned Lexicon Term
; LEXWN Warning
; LEXCC Code CC Status
; LEXMC Major Diagnostic Category
; LEXELDT External Last Date
;
EN ; Main Entry Point
K ^TMP("LEXQIDO",$J) Q:'$L($G(LEXELDT)) I +($G(LEXST))<0 D FUT D:$D(^TMP("LEXQIDO",$J)) DSP^LEXQO("LEXQIDO") Q
D FUL D:$D(^TMP("LEXQIDO",$J)) DSP^LEXQO("LEXQIDO")
Q
FUT ; Future Activation
N LEX1,LEX2,LEX3,LEXEFF,LEXI,LEXL,LEXSTA S LEXI=+($G(LEXIEN)) Q:+LEXI'>0
S LEXL=+($G(LEXLEN)) Q:+LEXL'>0 S:LEXL>62 LEXL=62
Q:'$L($G(LEXSO)) Q:'$L($G(LEXNAM)) S LEXSTA=$G(LEXST)
S LEXEFF=$P(LEXSTA,"^",5),LEXSTA=$P(LEXSTA,"^",4)
Q:'$L(LEXSTA) Q:'$L(LEXEFF) S (LEX1,LEX2,LEX3)=""
D BOD(LEXELDT),COD(LEXSO,LEXNAM,+($G(LEXL))),STA(.LEXST,+($G(LEXL)))
Q
BOD(X) ; Based on Date
N LEXBOD S LEXBOD=$G(X),X="Display based on date: "_LEXBOD D BL,TL(X)
Q
COD(X,Y,LEXLEN) ; Code Line
N LEXC,LEXN,LEXT S LEXC=$G(X),LEXN=$G(Y),LEXT="Code: "_LEXC
S LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D BL,TL(LEXT)
Q
STA(X,LEXLEN) ; Status Line
N LEX,LEXC,LEXX,LEXE,LEXI,LEXN,LEXS,LEXT,LEXW,LEXEFF,LEXSTA
S LEXX=$G(X),LEXSTA=$P(LEXX,"^",4),LEXEFF=$P(LEXX,"^",5)
S LEXEFF=$TR(LEXEFF,"()",""),LEXW=$P(LEXX,"^",6)
S LEXT=" Status: ",LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXSTA
S LEXT=LEXT_$J(" ",(35-$L(LEXT)))
S:LEXEFF'["future" LEXT=LEXT_"Effective: "
S LEXT=LEXT_$$UP^XLFSTR($E(LEXEFF,1))_$E(LEXEFF,2,$L(LEXEFF)) D BL,TL(LEXT)
I $L(LEXW) D
. N LEX,LEXT,LEXC,LEXI,LEXN S LEX(1)=LEXW D PR^LEXQM(.LEX,(LEXLEN-7))
. Q:+($O(LEX(" "),-1))'>0 S LEXT=$J(" ",((79-+($G(LEXLEN)))))
. S (LEXC,LEXI)=0 F S LEXI=$O(LEX(LEXI)) Q:+LEXI'>0 D
. . N LEXN S LEXN=$$TM^LEXQM($G(LEX(LEXI))) S:$L(LEXN) LEXC=LEXC+1
. . D:LEXC=1 BL D TL((LEXT_LEXN))
Q
FUL ; Full Display
N LEXFUL,LEX,LEXL S LEXL=+($G(LEXLEN)) S:LEXL>62 LEXL=62
S LEXFUL="" D FUT
D LIM(+($G(LEXIEN)),+($G(LEXL)))
D SD(.LEXSD,+($G(LEXL)))
D LD(.LEXLD,+($G(LEXL)))
D LX(.LEXLX,+($G(LEXL)))
D WN(.LEXWN,+($G(LEXL)))
D:$L($G(LEXCC(1)))!($L($G(LEXMC(1)))) BL
D CC(.LEXCC,+($G(LEXL)))
D MC(.LEXMC,+($G(LEXL)))
D DRG(+($G(LEXL)))
D NOT(+($G(LEXL)))
D REQ(+($G(LEXL)))
D NCC(+($G(LEXL)))
Q
LIM(X,LEXLEN) ; Limitations - Age Low, Age High and Sex
N LEXC,LEXI,LEXH,LEXL,LEXS,LEXT,LEXU,LEXP S LEXC=0,LEXI=+($G(X))
S LEXL=$$VAGEL^ICDEX(+($G(LEXIEN)),$G(LEXCDT)) S:'$L(LEXL) LEXL="N/A"
S LEXH=$$VAGEH^ICDEX(+($G(LEXIEN)),$G(LEXCDT)) S:'$L(LEXH) LEXH="N/A"
S LEXS=$$VSEX^ICDEX(80,+($G(LEXIEN)),$G(LEXCDT))
S LEXS=$S(LEXS="M":"Male",LEXS="F":"Female",1:"") S:'$L(LEXS) LEXS="N/A"
S LEXU=$$UPDX^ICDEX(+($G(LEXIEN))) S:'$L(LEXU)!(LEXU=0) LEXU="N/A"
I (LEXH_LEXL_LEXS+LEXU)'="N/AN/AN/AN/A" D
. N LEXLDR S LEXLDR=" Limitations: ",LEXC=0
. I LEXL'="N/A" D
. . S LEXT="" S LEXT=LEXLDR_$J(" ",((79-+($G(LEXLEN)))-$L(LEXLDR)))_"Minimum Age: "_LEXL
. . S LEXLDR=" " I $L(LEXT) D BL,TL(LEXT) S LEXC=1
. I LEXH'="N/A" D
. . S LEXT="" S LEXT=LEXLDR_$J(" ",((79-+($G(LEXLEN)))-$L(LEXLDR)))_"Maximum Age: "_LEXH
. . S LEXLDR=" " I $L(LEXT) D:'LEXC BL D TL(LEXT) S LEXC=1
. I LEXS'="N/A" D
. . S LEXT="" S LEXT=LEXLDR_$J(" ",((79-+($G(LEXLEN)))-$L(LEXLDR)))_"Applies to: "_LEXS_" patients"
. . S LEXLDR=" " I $L(LEXT) D:'LEXC BL D TL(LEXT) S LEXC=1
. I LEXU'="N/A" D
. . S LEXT="" S LEXT=LEXLDR_$J(" ",((79-+($G(LEXLEN)))-$L(LEXLDR)))_"Principle DX: "_"Code is unacceptable as a principal DX"
. . S LEXLDR=" " I $L(LEXT) D:'LEXC BL D TL(LEXT) S LEXC=1
Q
SD(X,LEXLEN) ; Short Description
N LEXI,LEXH,LEXE,LEXN,LEXT Q:'$D(X(1)) S LEXN=$G(X(1)),LEXT=" Short Name: ",LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D BL,TL(LEXT)
S LEXE=$G(X(0)),LEXT=" "_LEXE,LEXN=$G(X(2)),LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D TL(LEXT)
Q
LD(X,LEXLEN) ; Long Description
N LEXI,LEXH,LEXE,LEXN,LEXT Q:'$D(X(1)) S LEXN=$G(X(1)),LEXT=" Description: ",LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D BL,TL(LEXT)
S LEXE=$G(X(0)),LEXT=" "_LEXE,LEXN=$G(X(2)),LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D TL(LEXT)
S LEXT=$J(" ",((79-+($G(LEXLEN))))) S LEXI=2 F S LEXI=$O(X(LEXI)) Q:+LEXI'>0 S LEXN=LEXT_$G(X(LEXI)) D TL(LEXN)
Q
LX(X,LEXLEN) ; Lexicon Expression
N LEXI,LEXH,LEXE,LEXN,LEXT Q:'$D(X(1)) S LEXN=$G(X(1)),LEXT=" Lexicon Term:",LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D BL,TL(LEXT)
S LEXE=$G(X(0)),LEXT=" "_LEXE,LEXN=$G(X(2)),LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D TL(LEXT)
S LEXT=$J(" ",((79-+($G(LEXLEN))))),LEXI=2 F S LEXI=$O(X(LEXI)) Q:+LEXI'>0 S LEXN=LEXT_$G(X(LEXI)) D TL(LEXN)
Q
WN(X,LEXLEN) ; Warning
N LEXI,LEXH,LEXE,LEXN,LEXT,LEXC Q:'$D(X(1)) S LEXC=0,LEXN=$G(X(1)),LEXT="",LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D BL,TL(LEXT)
S LEXT=$J(" ",((79-+($G(LEXLEN))))),LEXI=1 F S LEXI=$O(X(LEXI)) Q:+LEXI'>0 S LEXN=LEXT_$G(X(LEXI)) D TL(LEXN)
Q
CC(X,LEXLEN) ; Complication/Comorbidity
N LEXI,LEXH,LEXE,LEXN,LEXT Q:'$D(X(1)) S LEXN=$G(X(1)),LEXE=$G(X(0)),LEXT=" CC:",LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN
S LEXT=LEXT_$J(" ",(66-$L(LEXT)))_LEXE D TL(LEXT)
Q
MC(X,LEXLEN) ; Major Diagnostic Category
N LEXI,LEXH,LEXE,LEXN,LEXT Q:'$D(X(1)) S LEXN=$G(X(1)),LEXE=$G(X(0)),LEXT=" MDC:",LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN
S LEXT=LEXT_$J(" ",(66-$L(LEXT)))_LEXE D TL(LEXT)
Q
DRG(LEXLEN) ; Diagnosis Related Groups
Q:$O(^TMP("LEXQID",$J,"DRG",3,0))'>0 Q:'$D(^TMP("LEXQID",$J,"DRG",3,1)) Q:'$D(^TMP("LEXQID",$J,"DRG",1,1))
Q:'$D(^TMP("LEXQID",$J,"DRG",1,2)) Q:'$D(^TMP("LEXQID",$J,"DRG",2,1)) N LEXI,LEXH,LEXE,LEXN,LEXT
S LEXT=" "_$G(^TMP("LEXQID",$J,"DRG",1,1))_":",LEXN=$G(^TMP("LEXQID",$J,"DRG",2,1)) S LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D BL,TL(LEXT)
S LEXE=$G(^TMP("LEXQID",$J,"DRG",1,2)),LEXT=" "_LEXE,LEXN=$G(^TMP("LEXQID",$J,"DRG",3,1)) S LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D TL(LEXT)
S LEXT=$J(" ",((79-+($G(LEXLEN))))),LEXI=1 F S LEXI=$O(^TMP("LEXQID",$J,"DRG",3,LEXI)) Q:+LEXI'>0 D
. S LEXN=LEXT_$G(^TMP("LEXQID",$J,"DRG",3,LEXI)) D TL(LEXN)
K ^TMP("LEXQID",$J,"DRG")
Q
NOT(LEXLEN) ; ICD codes not used with
Q:'$L($O(^TMP("LEXQID",$J,"NOT",3,""))) Q:'$D(^TMP("LEXQID",$J,"NOT",1,1)) Q:'$D(^TMP("LEXQID",$J,"NOT",2,1))
N LEXI,LEXH,LEXE,LEXN,LEXT S LEXT=" "_$G(^TMP("LEXQID",$J,"NOT",1,1))_":",LEXN=$G(^TMP("LEXQID",$J,"NOT",2,1))
S LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D BL,TL(LEXT)
S LEXT=$J(" ",((79-+($G(LEXLEN))))),LEXN=$$TM^LEXQM($G(^TMP("LEXQID",$J,"NOT",2,2))) I $L(LEXN) D TL((LEXT_LEXN))
S LEXI=" " F S LEXI=$O(^TMP("LEXQID",$J,"NOT",3,LEXI)) Q:'$L(LEXI) D
. S LEXN=$G(^TMP("LEXQID",$J,"NOT",3,LEXI)) D TL((LEXT_LEXN))
K ^TMP("LEXQID",$J,"NOT")
Q
REQ(LEXLEN) ; ICD codes requried with
Q:'$L($O(^TMP("LEXQID",$J,"REQ",3,""))) Q:'$D(^TMP("LEXQID",$J,"REQ",1,1)) Q:'$D(^TMP("LEXQID",$J,"REQ",2,1))
N LEXI,LEXH,LEXE,LEXN,LEXT S LEXT=" "_$G(^TMP("LEXQID",$J,"REQ",1,1))_":",LEXN=$G(^TMP("LEXQID",$J,"REQ",2,1))
S LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D BL,TL(LEXT)
S LEXT=$J(" ",((79-+($G(LEXLEN))))),LEXN=$$TM^LEXQM($G(^TMP("LEXQID",$J,"REQ",2,2))) I $L(LEXN) D TL((LEXT_LEXN))
S LEXI=" " F S LEXI=$O(^TMP("LEXQID",$J,"REQ",3,LEXI)) Q:'$L(LEXI) D
. S LEXN=$G(^TMP("LEXQID",$J,"REQ",3,LEXI)) D TL((LEXT_LEXN))
K ^TMP("LEXQID",$J,"REQ")
Q
NCC(LEXLEN) ; Not CC with
Q:'$L($O(^TMP("LEXQID",$J,"NCC",3,""))) Q:'$D(^TMP("LEXQID",$J,"NCC",1,1)) Q:'$D(^TMP("LEXQID",$J,"NCC",2,1))
N LEXI,LEXH,LEXE,LEXN,LEXT S LEXT=" "_$G(^TMP("LEXQID",$J,"NCC",1,1))_":",LEXN=$G(^TMP("LEXQID",$J,"NCC",2,1))
S LEXT=LEXT_$J(" ",((79-+($G(LEXLEN)))-$L(LEXT)))_LEXN D BL,TL(LEXT)
S LEXT=$J(" ",((79-+($G(LEXLEN))))),LEXN=$$TM^LEXQM($G(^TMP("LEXQID",$J,"NCC",2,2))) I $L(LEXN) D TL((LEXT_LEXN))
S LEXI=" " F S LEXI=$O(^TMP("LEXQID",$J,"NCC",3,LEXI)) Q:'$L(LEXI) D
. S LEXN=$G(^TMP("LEXQID",$J,"NCC",3,LEXI)) D TL((LEXT_LEXN))
K ^TMP("LEXQID",$J,"NCC")
Q
;
; Miscellaneous
BL ; Blank Line
D TL(" ") Q
TL(X) ; Text Line
I $D(LEXTEST) W !,$G(X) Q
N LEXI,LEXTEST S LEXI=+($O(^TMP("LEXQIDO",$J," "),-1))+1 S ^TMP("LEXQIDO",$J,LEXI)=$G(X),^TMP("LEXQIDO",$J,0)=LEXI
Q
LEXQID4 ;ISL/KER - Query - ICD Diagnosis - Save ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXQID") SACC 2.3.2.5.1
+5 ; ^TMP("LEXQIDO") SACC 2.3.2.5.1
+6 ;
+7 ; External References
+8 ; $$UPDX^ICDEX ICR 5747
+9 ; $$VAGEH^ICDEXD ICR 5747
+10 ; $$VAGEL^ICDEXD ICR 5747
+11 ; $$VSEX^ICDEXD ICR 5747
+12 ; $$UP^XLFSTR ICR 10104
+13 ;
+14 ; Local Variables NEWed or KILLed in LEXQID
+15 ; LEXIEN ICD Internal Entry Number
+16 ; LEXCDT Code Set Date
+17 ; LEXLEN Offset Length
+18 ; LEXST ICD Status and Effective Dates
+19 ; LEXSD Versioned Short Description
+20 ; LEXLD Versioned Long Description
+21 ; LEXLX Versioned Lexicon Term
+22 ; LEXWN Warning
+23 ; LEXCC Code CC Status
+24 ; LEXMC Major Diagnostic Category
+25 ; LEXELDT External Last Date
+26 ;
EN ; Main Entry Point
+1 KILL ^TMP("LEXQIDO",$JOB)
IF '$LENGTH($GET(LEXELDT))
QUIT
IF +($GET(LEXST))<0
DO FUT
IF $DATA(^TMP("LEXQIDO",$JOB))
DO DSP^LEXQO("LEXQIDO")
QUIT
+2 DO FUL
IF $DATA(^TMP("LEXQIDO",$JOB))
DO DSP^LEXQO("LEXQIDO")
+3 QUIT
FUT ; Future Activation
+1 NEW LEX1,LEX2,LEX3,LEXEFF,LEXI,LEXL,LEXSTA
SET LEXI=+($GET(LEXIEN))
IF +LEXI'>0
QUIT
+2 SET LEXL=+($GET(LEXLEN))
IF +LEXL'>0
QUIT
IF LEXL>62
SET LEXL=62
+3 IF '$LENGTH($GET(LEXSO))
QUIT
IF '$LENGTH($GET(LEXNAM))
QUIT
SET LEXSTA=$GET(LEXST)
+4 SET LEXEFF=$PIECE(LEXSTA,"^",5)
SET LEXSTA=$PIECE(LEXSTA,"^",4)
+5 IF '$LENGTH(LEXSTA)
QUIT
IF '$LENGTH(LEXEFF)
QUIT
SET (LEX1,LEX2,LEX3)=""
+6 DO BOD(LEXELDT)
DO COD(LEXSO,LEXNAM,+($GET(LEXL)))
DO STA(.LEXST,+($GET(LEXL)))
+7 QUIT
BOD(X) ; Based on Date
+1 NEW LEXBOD
SET LEXBOD=$GET(X)
SET X="Display based on date: "_LEXBOD
DO BL
DO TL(X)
+2 QUIT
COD(X,Y,LEXLEN) ; Code Line
+1 NEW LEXC,LEXN,LEXT
SET LEXC=$GET(X)
SET LEXN=$GET(Y)
SET LEXT="Code: "_LEXC
+2 SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO BL
DO TL(LEXT)
+3 QUIT
STA(X,LEXLEN) ; Status Line
+1 NEW LEX,LEXC,LEXX,LEXE,LEXI,LEXN,LEXS,LEXT,LEXW,LEXEFF,LEXSTA
+2 SET LEXX=$GET(X)
SET LEXSTA=$PIECE(LEXX,"^",4)
SET LEXEFF=$PIECE(LEXX,"^",5)
+3 SET LEXEFF=$TRANSLATE(LEXEFF,"()","")
SET LEXW=$PIECE(LEXX,"^",6)
+4 SET LEXT=" Status: "
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXSTA
+5 SET LEXT=LEXT_$JUSTIFY(" ",(35-$LENGTH(LEXT)))
+6 IF LEXEFF'["future"
SET LEXT=LEXT_"Effective: "
+7 SET LEXT=LEXT_$$UP^XLFSTR($EXTRACT(LEXEFF,1))_$EXTRACT(LEXEFF,2,$LENGTH(LEXEFF))
DO BL
DO TL(LEXT)
+8 IF $LENGTH(LEXW)
Begin DoDot:1
+9 NEW LEX,LEXT,LEXC,LEXI,LEXN
SET LEX(1)=LEXW
DO PR^LEXQM(.LEX,(LEXLEN-7))
+10 IF +($ORDER(LEX(" "),-1))'>0
QUIT
SET LEXT=$JUSTIFY(" ",((79-+($GET(LEXLEN)))))
+11 SET (LEXC,LEXI)=0
FOR
SET LEXI=$ORDER(LEX(LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:2
+12 NEW LEXN
SET LEXN=$$TM^LEXQM($GET(LEX(LEXI)))
IF $LENGTH(LEXN)
SET LEXC=LEXC+1
+13 IF LEXC=1
DO BL
DO TL((LEXT_LEXN))
End DoDot:2
End DoDot:1
+14 QUIT
FUL ; Full Display
+1 NEW LEXFUL,LEX,LEXL
SET LEXL=+($GET(LEXLEN))
IF LEXL>62
SET LEXL=62
+2 SET LEXFUL=""
DO FUT
+3 DO LIM(+($GET(LEXIEN)),+($GET(LEXL)))
+4 DO SD(.LEXSD,+($GET(LEXL)))
+5 DO LD(.LEXLD,+($GET(LEXL)))
+6 DO LX(.LEXLX,+($GET(LEXL)))
+7 DO WN(.LEXWN,+($GET(LEXL)))
+8 IF $LENGTH($GET(LEXCC(1)))!($LENGTH($GET(LEXMC(1))))
DO BL
+9 DO CC(.LEXCC,+($GET(LEXL)))
+10 DO MC(.LEXMC,+($GET(LEXL)))
+11 DO DRG(+($GET(LEXL)))
+12 DO NOT(+($GET(LEXL)))
+13 DO REQ(+($GET(LEXL)))
+14 DO NCC(+($GET(LEXL)))
+15 QUIT
LIM(X,LEXLEN) ; Limitations - Age Low, Age High and Sex
+1 NEW LEXC,LEXI,LEXH,LEXL,LEXS,LEXT,LEXU,LEXP
SET LEXC=0
SET LEXI=+($GET(X))
+2 SET LEXL=$$VAGEL^ICDEX(+($GET(LEXIEN)),$GET(LEXCDT))
IF '$LENGTH(LEXL)
SET LEXL="N/A"
+3 SET LEXH=$$VAGEH^ICDEX(+($GET(LEXIEN)),$GET(LEXCDT))
IF '$LENGTH(LEXH)
SET LEXH="N/A"
+4 SET LEXS=$$VSEX^ICDEX(80,+($GET(LEXIEN)),$GET(LEXCDT))
+5 SET LEXS=$SELECT(LEXS="M":"Male",LEXS="F":"Female",1:"")
IF '$LENGTH(LEXS)
SET LEXS="N/A"
+6 SET LEXU=$$UPDX^ICDEX(+($GET(LEXIEN)))
IF '$LENGTH(LEXU)!(LEXU=0)
SET LEXU="N/A"
+7 IF (LEXH_LEXL_LEXS+LEXU)'="N/AN/AN/AN/A"
Begin DoDot:1
+8 NEW LEXLDR
SET LEXLDR=" Limitations: "
SET LEXC=0
+9 IF LEXL'="N/A"
Begin DoDot:2
+10 SET LEXT=""
SET LEXT=LEXLDR_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXLDR)))_"Minimum Age: "_LEXL
+11 SET LEXLDR=" "
IF $LENGTH(LEXT)
DO BL
DO TL(LEXT)
SET LEXC=1
End DoDot:2
+12 IF LEXH'="N/A"
Begin DoDot:2
+13 SET LEXT=""
SET LEXT=LEXLDR_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXLDR)))_"Maximum Age: "_LEXH
+14 SET LEXLDR=" "
IF $LENGTH(LEXT)
IF 'LEXC
DO BL
DO TL(LEXT)
SET LEXC=1
End DoDot:2
+15 IF LEXS'="N/A"
Begin DoDot:2
+16 SET LEXT=""
SET LEXT=LEXLDR_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXLDR)))_"Applies to: "_LEXS_" patients"
+17 SET LEXLDR=" "
IF $LENGTH(LEXT)
IF 'LEXC
DO BL
DO TL(LEXT)
SET LEXC=1
End DoDot:2
+18 IF LEXU'="N/A"
Begin DoDot:2
+19 SET LEXT=""
SET LEXT=LEXLDR_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXLDR)))_"Principle DX: "_"Code is unacceptable as a principal DX"
+20 SET LEXLDR=" "
IF $LENGTH(LEXT)
IF 'LEXC
DO BL
DO TL(LEXT)
SET LEXC=1
End DoDot:2
End DoDot:1
+21 QUIT
SD(X,LEXLEN) ; Short Description
+1 NEW LEXI,LEXH,LEXE,LEXN,LEXT
IF '$DATA(X(1))
QUIT
SET LEXN=$GET(X(1))
SET LEXT=" Short Name: "
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO BL
DO TL(LEXT)
+2 SET LEXE=$GET(X(0))
SET LEXT=" "_LEXE
SET LEXN=$GET(X(2))
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO TL(LEXT)
+3 QUIT
LD(X,LEXLEN) ; Long Description
+1 NEW LEXI,LEXH,LEXE,LEXN,LEXT
IF '$DATA(X(1))
QUIT
SET LEXN=$GET(X(1))
SET LEXT=" Description: "
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO BL
DO TL(LEXT)
+2 SET LEXE=$GET(X(0))
SET LEXT=" "_LEXE
SET LEXN=$GET(X(2))
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO TL(LEXT)
+3 SET LEXT=$JUSTIFY(" ",((79-+($GET(LEXLEN)))))
SET LEXI=2
FOR
SET LEXI=$ORDER(X(LEXI))
IF +LEXI'>0
QUIT
SET LEXN=LEXT_$GET(X(LEXI))
DO TL(LEXN)
+4 QUIT
LX(X,LEXLEN) ; Lexicon Expression
+1 NEW LEXI,LEXH,LEXE,LEXN,LEXT
IF '$DATA(X(1))
QUIT
SET LEXN=$GET(X(1))
SET LEXT=" Lexicon Term:"
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO BL
DO TL(LEXT)
+2 SET LEXE=$GET(X(0))
SET LEXT=" "_LEXE
SET LEXN=$GET(X(2))
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO TL(LEXT)
+3 SET LEXT=$JUSTIFY(" ",((79-+($GET(LEXLEN)))))
SET LEXI=2
FOR
SET LEXI=$ORDER(X(LEXI))
IF +LEXI'>0
QUIT
SET LEXN=LEXT_$GET(X(LEXI))
DO TL(LEXN)
+4 QUIT
WN(X,LEXLEN) ; Warning
+1 NEW LEXI,LEXH,LEXE,LEXN,LEXT,LEXC
IF '$DATA(X(1))
QUIT
SET LEXC=0
SET LEXN=$GET(X(1))
SET LEXT=""
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO BL
DO TL(LEXT)
+2 SET LEXT=$JUSTIFY(" ",((79-+($GET(LEXLEN)))))
SET LEXI=1
FOR
SET LEXI=$ORDER(X(LEXI))
IF +LEXI'>0
QUIT
SET LEXN=LEXT_$GET(X(LEXI))
DO TL(LEXN)
+3 QUIT
CC(X,LEXLEN) ; Complication/Comorbidity
+1 NEW LEXI,LEXH,LEXE,LEXN,LEXT
IF '$DATA(X(1))
QUIT
SET LEXN=$GET(X(1))
SET LEXE=$GET(X(0))
SET LEXT=" CC:"
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
+2 SET LEXT=LEXT_$JUSTIFY(" ",(66-$LENGTH(LEXT)))_LEXE
DO TL(LEXT)
+3 QUIT
MC(X,LEXLEN) ; Major Diagnostic Category
+1 NEW LEXI,LEXH,LEXE,LEXN,LEXT
IF '$DATA(X(1))
QUIT
SET LEXN=$GET(X(1))
SET LEXE=$GET(X(0))
SET LEXT=" MDC:"
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
+2 SET LEXT=LEXT_$JUSTIFY(" ",(66-$LENGTH(LEXT)))_LEXE
DO TL(LEXT)
+3 QUIT
DRG(LEXLEN) ; Diagnosis Related Groups
+1 IF $ORDER(^TMP("LEXQID",$JOB,"DRG",3,0))'>0
QUIT
IF '$DATA(^TMP("LEXQID",$JOB,"DRG",3,1))
QUIT
IF '$DATA(^TMP("LEXQID",$JOB,"DRG",1,1))
QUIT
+2 IF '$DATA(^TMP("LEXQID",$JOB,"DRG",1,2))
QUIT
IF '$DATA(^TMP("LEXQID",$JOB,"DRG",2,1))
QUIT
NEW LEXI,LEXH,LEXE,LEXN,LEXT
+3 SET LEXT=" "_$GET(^TMP("LEXQID",$JOB,"DRG",1,1))_":"
SET LEXN=$GET(^TMP("LEXQID",$JOB,"DRG",2,1))
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO BL
DO TL(LEXT)
+4 SET LEXE=$GET(^TMP("LEXQID",$JOB,"DRG",1,2))
SET LEXT=" "_LEXE
SET LEXN=$GET(^TMP("LEXQID",$JOB,"DRG",3,1))
SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO TL(LEXT)
+5 SET LEXT=$JUSTIFY(" ",((79-+($GET(LEXLEN)))))
SET LEXI=1
FOR
SET LEXI=$ORDER(^TMP("LEXQID",$JOB,"DRG",3,LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:1
+6 SET LEXN=LEXT_$GET(^TMP("LEXQID",$JOB,"DRG",3,LEXI))
DO TL(LEXN)
End DoDot:1
+7 KILL ^TMP("LEXQID",$JOB,"DRG")
+8 QUIT
NOT(LEXLEN) ; ICD codes not used with
+1 IF '$LENGTH($ORDER(^TMP("LEXQID",$JOB,"NOT",3,"")))
QUIT
IF '$DATA(^TMP("LEXQID",$JOB,"NOT",1,1))
QUIT
IF '$DATA(^TMP("LEXQID",$JOB,"NOT",2,1))
QUIT
+2 NEW LEXI,LEXH,LEXE,LEXN,LEXT
SET LEXT=" "_$GET(^TMP("LEXQID",$JOB,"NOT",1,1))_":"
SET LEXN=$GET(^TMP("LEXQID",$JOB,"NOT",2,1))
+3 SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO BL
DO TL(LEXT)
+4 SET LEXT=$JUSTIFY(" ",((79-+($GET(LEXLEN)))))
SET LEXN=$$TM^LEXQM($GET(^TMP("LEXQID",$JOB,"NOT",2,2)))
IF $LENGTH(LEXN)
DO TL((LEXT_LEXN))
+5 SET LEXI=" "
FOR
SET LEXI=$ORDER(^TMP("LEXQID",$JOB,"NOT",3,LEXI))
IF '$LENGTH(LEXI)
QUIT
Begin DoDot:1
+6 SET LEXN=$GET(^TMP("LEXQID",$JOB,"NOT",3,LEXI))
DO TL((LEXT_LEXN))
End DoDot:1
+7 KILL ^TMP("LEXQID",$JOB,"NOT")
+8 QUIT
REQ(LEXLEN) ; ICD codes requried with
+1 IF '$LENGTH($ORDER(^TMP("LEXQID",$JOB,"REQ",3,"")))
QUIT
IF '$DATA(^TMP("LEXQID",$JOB,"REQ",1,1))
QUIT
IF '$DATA(^TMP("LEXQID",$JOB,"REQ",2,1))
QUIT
+2 NEW LEXI,LEXH,LEXE,LEXN,LEXT
SET LEXT=" "_$GET(^TMP("LEXQID",$JOB,"REQ",1,1))_":"
SET LEXN=$GET(^TMP("LEXQID",$JOB,"REQ",2,1))
+3 SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO BL
DO TL(LEXT)
+4 SET LEXT=$JUSTIFY(" ",((79-+($GET(LEXLEN)))))
SET LEXN=$$TM^LEXQM($GET(^TMP("LEXQID",$JOB,"REQ",2,2)))
IF $LENGTH(LEXN)
DO TL((LEXT_LEXN))
+5 SET LEXI=" "
FOR
SET LEXI=$ORDER(^TMP("LEXQID",$JOB,"REQ",3,LEXI))
IF '$LENGTH(LEXI)
QUIT
Begin DoDot:1
+6 SET LEXN=$GET(^TMP("LEXQID",$JOB,"REQ",3,LEXI))
DO TL((LEXT_LEXN))
End DoDot:1
+7 KILL ^TMP("LEXQID",$JOB,"REQ")
+8 QUIT
NCC(LEXLEN) ; Not CC with
+1 IF '$LENGTH($ORDER(^TMP("LEXQID",$JOB,"NCC",3,"")))
QUIT
IF '$DATA(^TMP("LEXQID",$JOB,"NCC",1,1))
QUIT
IF '$DATA(^TMP("LEXQID",$JOB,"NCC",2,1))
QUIT
+2 NEW LEXI,LEXH,LEXE,LEXN,LEXT
SET LEXT=" "_$GET(^TMP("LEXQID",$JOB,"NCC",1,1))_":"
SET LEXN=$GET(^TMP("LEXQID",$JOB,"NCC",2,1))
+3 SET LEXT=LEXT_$JUSTIFY(" ",((79-+($GET(LEXLEN)))-$LENGTH(LEXT)))_LEXN
DO BL
DO TL(LEXT)
+4 SET LEXT=$JUSTIFY(" ",((79-+($GET(LEXLEN)))))
SET LEXN=$$TM^LEXQM($GET(^TMP("LEXQID",$JOB,"NCC",2,2)))
IF $LENGTH(LEXN)
DO TL((LEXT_LEXN))
+5 SET LEXI=" "
FOR
SET LEXI=$ORDER(^TMP("LEXQID",$JOB,"NCC",3,LEXI))
IF '$LENGTH(LEXI)
QUIT
Begin DoDot:1
+6 SET LEXN=$GET(^TMP("LEXQID",$JOB,"NCC",3,LEXI))
DO TL((LEXT_LEXN))
End DoDot:1
+7 KILL ^TMP("LEXQID",$JOB,"NCC")
+8 QUIT
+9 ;
+10 ; Miscellaneous
BL ; Blank Line
+1 DO TL(" ")
QUIT
TL(X) ; Text Line
+1 IF $DATA(LEXTEST)
WRITE !,$GET(X)
QUIT
+2 NEW LEXI,LEXTEST
SET LEXI=+($ORDER(^TMP("LEXQIDO",$JOB," "),-1))+1
SET ^TMP("LEXQIDO",$JOB,LEXI)=$GET(X)
SET ^TMP("LEXQIDO",$JOB,0)=LEXI
+3 QUIT
