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

LEXQID2.m

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