LEXQID2 ;ISL/KER - Query - ICD Diagnosis - Extract (cont) ;04/21/2014
;;2.0;LEXICON UTILITY;**62,73,80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^ICM( ICR 4488
;
; External References
; $$CODEC^ICDEX ICR 5747
; $$CSI^ICDEX ICR 5747
; $$DTBR^ICDEX ICR 5747
; $$HIST^ICDEX ICR 5747
; $$LA^ICDEX ICR 5747
; $$LD^ICDEX ICR 5747
; $$VMDC^ICDEX ICR 5747
; $$DT^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
;
; Local Variables NEWed or KILLed in LEXQID
; LEXLX Local Array containing Lexicon term
;
Q
LDS(X,LEXVDT,LEX,LEXLEN,LEXSTA) ; Long Description
;
; LEX=# of Lines
; LEX(0)=External Date of Description
; LEX(#)=Description
;
N LEXBRD,LEXBRW,LEXC,LEXD,LEXDDT,LEXE,LEXEE,LEXEFF,LEXFA
N LEXHIS,LEXI,LEXIA,LEXIEN,LEXL,LEXLA,LEXLAST,LEXLEF
N LEXLHI,LEXLSD,LEXM,LEXOD,LEXODD,LEXR,LEXS,LEXLD,LEXLDD
N LEXSDT,LEXSO,LEXSY,LEXT S LEXIEN=$G(X) Q:+LEXIEN'>0
S LEXVDT=+($G(LEXVDT)) S:LEXVDT'?7N LEXVDT=$$DT^XLFDT
S LEXSTA=+($G(LEXSTA)) S LEXSO=$$CODEC^ICDEX(80,+LEXIEN)
S LEXSY=$$CSI^ICDEX(80,+LEXIEN)
S LEXLA=$$LA^ICDEX(80,+LEXIEN,9999999),LEXFA=$$FA(+LEXIEN)
S LEXLSD=$$LD^ICDEX(80,+LEXIEN,LEXLA)
S LEXBRD=$$DTBR^ICDEX(LEXVDT,0,LEXSY),LEXBRW=""
S LEXLD=$$LD^ICDEX(80,+LEXIEN,LEXVDT,.LEXS,245)
S LEXLD=$G(LEXS(1)),LEXLDD=$P($G(LEXS(0)),"^",2)
S:'$L(LEXLD) LEXLDD="--/--/----" S LEXM=""
I $P(LEXLD,"^",1)="-1"!('$L(LEXLD)) D
. S LEXM="Diagnosis Description is not available."
. I (LEXVDT'?7N!(LEXFA'?7N)),LEXVDT<LEXFA D
. . S LEXM=LEXM_" The date provided precedes the initial activation of the code"
. I LEXVDT?7N&(LEXFA?7N),LEXVDT<LEXFA D
. . S LEXM=LEXM_" The date provided ("_$$ED^LEXQM(LEXVDT)_") precedes the initial activation ("_$$ED^LEXQM(LEXFA)_") of the code"
. S:$L(LEXM) LEXM="NOTE: "_LEXM S LEXOD=LEXLSD,LEXODD="--/--/----"
I $L(LEXLD)&($P(LEXLD,"^",1)'="-1") D
. S LEXM="" S LEXOD=LEXLD,LEXODD=$S(LEXLDD?7N:$$ED^LEXQM(LEXLDD),1:"--/--/----")
S:'$L(LEXOD) LEXOD="Diagnosis Description not found"
S:'$L(LEXODD) LEXODD="--/--/----"
K LEX,LEXT S LEXT(1)=LEXOD D PR^LEXQM(.LEXT,(LEXLEN-7))
S LEXI=0 F S LEXI=$O(LEXT(LEXI)) Q:+LEXI'>0 S LEXT=$G(LEXT(LEXI)) S LEX(LEXI)=LEXT
I $L($G(LEXM)) D
. K LEX,LEXT N LEXC S LEXT(1)=LEXM D PR^LEXQM(.LEXT,(LEXLEN-7))
. S LEXI=0 F S LEXI=$O(LEXT(LEXI)) Q:+LEXI'>0 S LEXT=$G(LEXT(LEXI)) S LEXC=$O(LEX(" "),-1)+1,LEX(LEXC)=LEXT
S:$D(LEX(1)) LEX(0)=LEXODD
Q
LX(X,LEXVDT,LEX,LEXLEN,LEXSTA) ; Lexicon Expression
;
; LEX=# of Lines
; LEX(0)=External Date of Expression
; LEX(#)=Expression
;
N LEXEF,LEXEVDT,LEXLEX,LEXEE,LEXFA,LEXI,LEXIA,LEXIEN,LEXLEF,LEXLHS,LEXLST,LEXM,LEXN0
N LEXPF,LEXSAB,LEXSIEN,LEXSO,LEXT,LEXVTMP S LEXIEN=$G(X) Q:+LEXIEN'>0
S LEXVDT=+($G(LEXVDT)) S:LEXVDT'?7N LEXVDT=$$DT^XLFDT S LEXSTA=+($G(LEXSTA))
S LEXEVDT=$$SD^LEXQM(LEXVDT),LEXLEN=+($G(LEXLEN)) S:+LEXLEN'>0 LEXLEN=62
Q:'$L(LEXEVDT) S LEXSO=$$CODEC^ICDEX(80,+LEXIEN)
Q:'$L(LEXSO) S LEXFA=$$FA(+LEXIEN),LEXM="",LEXIA=$$IA(LEXVDT) S LEXSIEN=0
F S LEXSIEN=$O(^LEX(757.02,"CODE",(LEXSO_" "),LEXSIEN)) Q:+LEXSIEN'>0 D
. N LEXN0 S LEXN0=$G(^LEX(757.02,+LEXSIEN,0)),LEXSAB=$P(LEXN0,"^",3)
. Q:"^1^"'[("^"_LEXSAB_"^") S LEXPF=+($P(LEXN0,"^",5)) S LEXLEF=$O(^LEX(757.02,+LEXSIEN,4,"B",(LEXVDT+.99999)),-1) I LEXLEF?7N D
. . S LEXLHS=$O(^LEX(757.02,+LEXSIEN,4,"B",+LEXLEF," "),-1) I +LEXLHS>0 D
. . . S LEXLST=$G(^LEX(757.02,+LEXSIEN,4,+LEXLHS,0)),LEXLST=$P(LEXLST,"^",2)
. . . S:LEXLST>0 LEXVTMP(+LEXPF,LEXSIEN)=+LEXN0_"^"_LEXLEF
S (LEXLEX,LEXEF)="",LEXSIEN=$O(LEXVTMP(1,0)),LEXLEX=+($G(LEXVTMP(1,+LEXSIEN))),LEXEF=$P($G(LEXVTMP(1,+LEXSIEN)),"^",2)
S:+LEXSIEN'>0!(+LEXLEX'>0) LEXSIEN=$O(LEXVTMP(0,0)),LEXLEX=+($G(LEXVTMP(0,+LEXSIEN))),LEXEF=$P($G(LEXVTMP(0,+LEXSIEN)),"^",2)
K LEX I +LEXLEX>0,$L($G(^LEX(757.01,+LEXLEX,0))),$L(LEXEF),LEXEF?7N D Q
. K LEX N LEXT,LEXM,LEXI S LEXT(1)=$G(^LEX(757.01,+LEXLEX,0)) D PR^LEXQM(.LEXT,(LEXLEN-7))
. S LEXI=0 F S LEXI=$O(LEXT(LEXI)) Q:+LEXI'>0 S:$L($G(LEXT(LEXI))) LEX(+LEXI)=$G(LEXT(LEXI))
. S LEX=+($O(LEX(" "),-1)) S LEXEE=$$SD^LEXQM(LEXEF) S LEX(0)=LEXEE
Q
WN(X,LEX,LEXLEN) ; Warning
;
; LEX=# of Lines
; LEX(0)=External Date
; LEX(#)=Warning
;
N LEXVDT,LEXREF,LEXIA,LEXTMP K LEX S LEXVDT=$G(X) Q:LEXVDT'?7N S LEXIA=$$IA(LEXVDT) Q:+LEXIA'>0 S LEXLEN=+$G(LEXLEN) S:+LEXLEN>62 LEXLEN=62
S LEXREF="Diagnosis (Short Name) and Description" S:$D(LEXLX) LEXREF="Diagnosis (Short Name), Description and Lexicon Term"
S LEXTMP(1)="Warning: The 'Based on Date' provided precedes Code Set Versioning. The "_LEXREF_" may be inaccurate for "_$$SD^LEXQM(LEXVDT)
D PR^LEXQM(.LEXTMP,LEXLEN) K LEX S LEXI=0 F S LEXI=$O(LEXTMP(LEXI)) Q:+LEXI'>0 S LEX(LEXI)=$G(LEXTMP(LEXI))
S LEX=$O(LEX(" "),-1),LEX(0)=$$SD^LEXQM(LEXVDT)
Q
MDC(X,LEXVDT,LEX) ; Major Diagnostic Category
;
; LEX=# of Lines
; LEX(0)=External Date of MDC
; LEX(#)=MDC
;
N LEXEF,LEXMDC,LEXMH,LEXN0,LEXNAM
K LEX S LEX=0,LEXIEN=+($G(X)) Q:+LEXIEN'>0
S LEXVDT=+($G(LEXVDT)) S:LEXVDT'?7N LEXVDT=$$DT^XLFDT
S LEXMDC=$$VMDC^ICDEX(+LEXIEN,+LEXVDT,1)
S LEXEF=$P(LEXMDC,"^",2),LEXMDC=$P(LEXMDC,"^",1)
Q:+LEXMDC'>0 Q:'$D(^ICM(+LEXMDC,0))
S LEXNAM=$P($G(^ICM(+LEXMDC,0)),"^",1) Q:'$L(LEXNAM)
S LEX=1,LEX(0)=$$SD^LEXQM(LEXEF),LEX(1)=$$UP^XLFSTR(LEXNAM)
Q
; Miscellaneous
FA(X) ; First Activation
N LEXFA,LEXH,LEXI,LEXIEN,LEXSO,LEXSY
S LEXIEN=+($G(X)) S X="",LEXSO=$$CODEC^ICDEX(80,+LEXIEN),LEXSY=$$CSI^ICDEX(80,+LEXIEN)
K LEXH S X=$$HIST^ICDEX(LEXSO,.LEXH,LEXSY) S LEXFA="",LEXI=0
F S LEXI=$O(LEXH(LEXI)) Q:+LEXI'>0!($L(LEXFA)) S:+($G(LEXH(LEXI)))>0&(LEXI?7N) LEXFA=LEXI Q:$L(LEXFA)
S X=LEXFA
Q X
IA(X,Y) ; Inaccurate
N LEXBRD,LEXVDT,LEXIEN,LEXSYS S LEXVDT=+($G(X)),LEXIEN=+($G(Y)) Q:+LEXIEN'>0 0
S LEXSYS=$$CSI^ICDEX(80,+LEXIEN) Q:+LEXSYS'>0 0 S:'$L(LEXVDT) LEXVDT=$$DT^XLFDT
S:LEXVDT#10000=0 LEXVDT=LEXVDT+101 S:LEXVDT#100=0 LEXVDT=LEXVDT+1
S LEXBRD=$$DTBR^ICDEX(LEXVDT,0,LEXSYS) S X=$S(LEXVDT<LEXBRD:1,1:0)
Q X
LEXQID2 ;ISL/KER - Query - ICD Diagnosis - Extract (cont) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**62,73,80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^ICM( ICR 4488
+5 ;
+6 ; External References
+7 ; $$CODEC^ICDEX ICR 5747
+8 ; $$CSI^ICDEX ICR 5747
+9 ; $$DTBR^ICDEX ICR 5747
+10 ; $$HIST^ICDEX ICR 5747
+11 ; $$LA^ICDEX ICR 5747
+12 ; $$LD^ICDEX ICR 5747
+13 ; $$VMDC^ICDEX ICR 5747
+14 ; $$DT^XLFDT ICR 10103
+15 ; $$UP^XLFSTR ICR 10104
+16 ;
+17 ; Local Variables NEWed or KILLed in LEXQID
+18 ; LEXLX Local Array containing Lexicon term
+19 ;
+20 QUIT
LDS(X,LEXVDT,LEX,LEXLEN,LEXSTA) ; Long Description
+1 ;
+2 ; LEX=# of Lines
+3 ; LEX(0)=External Date of Description
+4 ; LEX(#)=Description
+5 ;
+6 NEW LEXBRD,LEXBRW,LEXC,LEXD,LEXDDT,LEXE,LEXEE,LEXEFF,LEXFA
+7 NEW LEXHIS,LEXI,LEXIA,LEXIEN,LEXL,LEXLA,LEXLAST,LEXLEF
+8 NEW LEXLHI,LEXLSD,LEXM,LEXOD,LEXODD,LEXR,LEXS,LEXLD,LEXLDD
+9 NEW LEXSDT,LEXSO,LEXSY,LEXT
SET LEXIEN=$GET(X)
IF +LEXIEN'>0
QUIT
+10 SET LEXVDT=+($GET(LEXVDT))
IF LEXVDT'?7N
SET LEXVDT=$$DT^XLFDT
+11 SET LEXSTA=+($GET(LEXSTA))
SET LEXSO=$$CODEC^ICDEX(80,+LEXIEN)
+12 SET LEXSY=$$CSI^ICDEX(80,+LEXIEN)
+13 SET LEXLA=$$LA^ICDEX(80,+LEXIEN,9999999)
SET LEXFA=$$FA(+LEXIEN)
+14 SET LEXLSD=$$LD^ICDEX(80,+LEXIEN,LEXLA)
+15 SET LEXBRD=$$DTBR^ICDEX(LEXVDT,0,LEXSY)
SET LEXBRW=""
+16 SET LEXLD=$$LD^ICDEX(80,+LEXIEN,LEXVDT,.LEXS,245)
+17 SET LEXLD=$GET(LEXS(1))
SET LEXLDD=$PIECE($GET(LEXS(0)),"^",2)
+18 IF '$LENGTH(LEXLD)
SET LEXLDD="--/--/----"
SET LEXM=""
+19 IF $PIECE(LEXLD,"^",1)="-1"!('$LENGTH(LEXLD))
Begin DoDot:1
+20 SET LEXM="Diagnosis Description is not available."
+21 IF (LEXVDT'?7N!(LEXFA'?7N))
IF LEXVDT<LEXFA
Begin DoDot:2
+22 SET LEXM=LEXM_" The date provided precedes the initial activation of the code"
End DoDot:2
+23 IF LEXVDT?7N&(LEXFA?7N)
IF LEXVDT<LEXFA
Begin DoDot:2
+24 SET LEXM=LEXM_" The date provided ("_$$ED^LEXQM(LEXVDT)_") precedes the initial activation ("_$$ED^LEXQM(LEXFA)_") of the code"
End DoDot:2
+25 IF $LENGTH(LEXM)
SET LEXM="NOTE: "_LEXM
SET LEXOD=LEXLSD
SET LEXODD="--/--/----"
End DoDot:1
+26 IF $LENGTH(LEXLD)&($PIECE(LEXLD,"^",1)'="-1")
Begin DoDot:1
+27 SET LEXM=""
SET LEXOD=LEXLD
SET LEXODD=$SELECT(LEXLDD?7N:$$ED^LEXQM(LEXLDD),1:"--/--/----")
End DoDot:1
+28 IF '$LENGTH(LEXOD)
SET LEXOD="Diagnosis Description not found"
+29 IF '$LENGTH(LEXODD)
SET LEXODD="--/--/----"
+30 KILL LEX,LEXT
SET LEXT(1)=LEXOD
DO PR^LEXQM(.LEXT,(LEXLEN-7))
+31 SET LEXI=0
FOR
SET LEXI=$ORDER(LEXT(LEXI))
IF +LEXI'>0
QUIT
SET LEXT=$GET(LEXT(LEXI))
SET LEX(LEXI)=LEXT
+32 IF $LENGTH($GET(LEXM))
Begin DoDot:1
+33 KILL LEX,LEXT
NEW LEXC
SET LEXT(1)=LEXM
DO PR^LEXQM(.LEXT,(LEXLEN-7))
+34 SET LEXI=0
FOR
SET LEXI=$ORDER(LEXT(LEXI))
IF +LEXI'>0
QUIT
SET LEXT=$GET(LEXT(LEXI))
SET LEXC=$ORDER(LEX(" "),-1)+1
SET LEX(LEXC)=LEXT
End DoDot:1
+35 IF $DATA(LEX(1))
SET LEX(0)=LEXODD
+36 QUIT
LX(X,LEXVDT,LEX,LEXLEN,LEXSTA) ; Lexicon Expression
+1 ;
+2 ; LEX=# of Lines
+3 ; LEX(0)=External Date of Expression
+4 ; LEX(#)=Expression
+5 ;
+6 NEW LEXEF,LEXEVDT,LEXLEX,LEXEE,LEXFA,LEXI,LEXIA,LEXIEN,LEXLEF,LEXLHS,LEXLST,LEXM,LEXN0
+7 NEW LEXPF,LEXSAB,LEXSIEN,LEXSO,LEXT,LEXVTMP
SET LEXIEN=$GET(X)
IF +LEXIEN'>0
QUIT
+8 SET LEXVDT=+($GET(LEXVDT))
IF LEXVDT'?7N
SET LEXVDT=$$DT^XLFDT
SET LEXSTA=+($GET(LEXSTA))
+9 SET LEXEVDT=$$SD^LEXQM(LEXVDT)
SET LEXLEN=+($GET(LEXLEN))
IF +LEXLEN'>0
SET LEXLEN=62
+10 IF '$LENGTH(LEXEVDT)
QUIT
SET LEXSO=$$CODEC^ICDEX(80,+LEXIEN)
+11 IF '$LENGTH(LEXSO)
QUIT
SET LEXFA=$$FA(+LEXIEN)
SET LEXM=""
SET LEXIA=$$IA(LEXVDT)
SET LEXSIEN=0
+12 FOR
SET LEXSIEN=$ORDER(^LEX(757.02,"CODE",(LEXSO_" "),LEXSIEN))
IF +LEXSIEN'>0
QUIT
Begin DoDot:1
+13 NEW LEXN0
SET LEXN0=$GET(^LEX(757.02,+LEXSIEN,0))
SET LEXSAB=$PIECE(LEXN0,"^",3)
+14 IF "^1^"'[("^"_LEXSAB_"^")
QUIT
SET LEXPF=+($PIECE(LEXN0,"^",5))
SET LEXLEF=$ORDER(^LEX(757.02,+LEXSIEN,4,"B",(LEXVDT+.99999)),-1)
IF LEXLEF?7N
Begin DoDot:2
+15 SET LEXLHS=$ORDER(^LEX(757.02,+LEXSIEN,4,"B",+LEXLEF," "),-1)
IF +LEXLHS>0
Begin DoDot:3
+16 SET LEXLST=$GET(^LEX(757.02,+LEXSIEN,4,+LEXLHS,0))
SET LEXLST=$PIECE(LEXLST,"^",2)
+17 IF LEXLST>0
SET LEXVTMP(+LEXPF,LEXSIEN)=+LEXN0_"^"_LEXLEF
End DoDot:3
End DoDot:2
End DoDot:1
+18 SET (LEXLEX,LEXEF)=""
SET LEXSIEN=$ORDER(LEXVTMP(1,0))
SET LEXLEX=+($GET(LEXVTMP(1,+LEXSIEN)))
SET LEXEF=$PIECE($GET(LEXVTMP(1,+LEXSIEN)),"^",2)
+19 IF +LEXSIEN'>0!(+LEXLEX'>0)
SET LEXSIEN=$ORDER(LEXVTMP(0,0))
SET LEXLEX=+($GET(LEXVTMP(0,+LEXSIEN)))
SET LEXEF=$PIECE($GET(LEXVTMP(0,+LEXSIEN)),"^",2)
+20 KILL LEX
IF +LEXLEX>0
IF $LENGTH($GET(^LEX(757.01,+LEXLEX,0)))
IF $LENGTH(LEXEF)
IF LEXEF?7N
Begin DoDot:1
+21 KILL LEX
NEW LEXT,LEXM,LEXI
SET LEXT(1)=$GET(^LEX(757.01,+LEXLEX,0))
DO PR^LEXQM(.LEXT,(LEXLEN-7))
+22 SET LEXI=0
FOR
SET LEXI=$ORDER(LEXT(LEXI))
IF +LEXI'>0
QUIT
IF $LENGTH($GET(LEXT(LEXI)))
SET LEX(+LEXI)=$GET(LEXT(LEXI))
+23 SET LEX=+($ORDER(LEX(" "),-1))
SET LEXEE=$$SD^LEXQM(LEXEF)
SET LEX(0)=LEXEE
End DoDot:1
QUIT
+24 QUIT
WN(X,LEX,LEXLEN) ; Warning
+1 ;
+2 ; LEX=# of Lines
+3 ; LEX(0)=External Date
+4 ; LEX(#)=Warning
+5 ;
+6 NEW LEXVDT,LEXREF,LEXIA,LEXTMP
KILL LEX
SET LEXVDT=$GET(X)
IF LEXVDT'?7N
QUIT
SET LEXIA=$$IA(LEXVDT)
IF +LEXIA'>0
QUIT
SET LEXLEN=+$GET(LEXLEN)
IF +LEXLEN>62
SET LEXLEN=62
+7 SET LEXREF="Diagnosis (Short Name) and Description"
IF $DATA(LEXLX)
SET LEXREF="Diagnosis (Short Name), Description and Lexicon Term"
+8 SET LEXTMP(1)="Warning: The 'Based on Date' provided precedes Code Set Versioning. The "_LEXREF_" may be inaccurate for "_$$SD^LEXQM(LEXVDT)
+9 DO PR^LEXQM(.LEXTMP,LEXLEN)
KILL LEX
SET LEXI=0
FOR
SET LEXI=$ORDER(LEXTMP(LEXI))
IF +LEXI'>0
QUIT
SET LEX(LEXI)=$GET(LEXTMP(LEXI))
+10 SET LEX=$ORDER(LEX(" "),-1)
SET LEX(0)=$$SD^LEXQM(LEXVDT)
+11 QUIT
MDC(X,LEXVDT,LEX) ; Major Diagnostic Category
+1 ;
+2 ; LEX=# of Lines
+3 ; LEX(0)=External Date of MDC
+4 ; LEX(#)=MDC
+5 ;
+6 NEW LEXEF,LEXMDC,LEXMH,LEXN0,LEXNAM
+7 KILL LEX
SET LEX=0
SET LEXIEN=+($GET(X))
IF +LEXIEN'>0
QUIT
+8 SET LEXVDT=+($GET(LEXVDT))
IF LEXVDT'?7N
SET LEXVDT=$$DT^XLFDT
+9 SET LEXMDC=$$VMDC^ICDEX(+LEXIEN,+LEXVDT,1)
+10 SET LEXEF=$PIECE(LEXMDC,"^",2)
SET LEXMDC=$PIECE(LEXMDC,"^",1)
+11 IF +LEXMDC'>0
QUIT
IF '$DATA(^ICM(+LEXMDC,0))
QUIT
+12 SET LEXNAM=$PIECE($GET(^ICM(+LEXMDC,0)),"^",1)
IF '$LENGTH(LEXNAM)
QUIT
+13 SET LEX=1
SET LEX(0)=$$SD^LEXQM(LEXEF)
SET LEX(1)=$$UP^XLFSTR(LEXNAM)
+14 QUIT
+15 ; Miscellaneous
FA(X) ; First Activation
+1 NEW LEXFA,LEXH,LEXI,LEXIEN,LEXSO,LEXSY
+2 SET LEXIEN=+($GET(X))
SET X=""
SET LEXSO=$$CODEC^ICDEX(80,+LEXIEN)
SET LEXSY=$$CSI^ICDEX(80,+LEXIEN)
+3 KILL LEXH
SET X=$$HIST^ICDEX(LEXSO,.LEXH,LEXSY)
SET LEXFA=""
SET LEXI=0
+4 FOR
SET LEXI=$ORDER(LEXH(LEXI))
IF +LEXI'>0!($LENGTH(LEXFA))
QUIT
IF +($GET(LEXH(LEXI)))>0&(LEXI?7N)
SET LEXFA=LEXI
IF $LENGTH(LEXFA)
QUIT
+5 SET X=LEXFA
+6 QUIT X
IA(X,Y) ; Inaccurate
+1 NEW LEXBRD,LEXVDT,LEXIEN,LEXSYS
SET LEXVDT=+($GET(X))
SET LEXIEN=+($GET(Y))
IF +LEXIEN'>0
QUIT 0
+2 SET LEXSYS=$$CSI^ICDEX(80,+LEXIEN)
IF +LEXSYS'>0
QUIT 0
IF '$LENGTH(LEXVDT)
SET LEXVDT=$$DT^XLFDT
+3 IF LEXVDT#10000=0
SET LEXVDT=LEXVDT+101
IF LEXVDT#100=0
SET LEXVDT=LEXVDT+1
+4 SET LEXBRD=$$DTBR^ICDEX(LEXVDT,0,LEXSYS)
SET X=$SELECT(LEXVDT<LEXBRD:1,1:0)
+5 QUIT X
