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

LEXQHL1.m

Go to the documentation of this file.
  1. LEXQHL1 ;ISL/KER - Query History - ICD-9/10 Diagnosis Extract ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**62,80,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^ICM( ICR 4488
  1. ; ^TMP("LEXQHL") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; $$CODEC^ICDEX ICR 5747
  1. ; $$ICDDX^ICDEX ICR 5747
  1. ; $$ROOT^ICDEX ICR 5747
  1. ; $$CODEABA^ICDEX ICR 5747
  1. ; $$UP^XLFSTR ICR 10104
  1. ;
  1. Q
  1. EN(X,Y) ; ICD-9 Diagnosis File
  1. N LEXIEN,LEXTIEN,LEXDISP,LEXIA,LEXEF,LEXCT,LEXC,LEXSYS,LEXTMP S LEXIEN=$G(X),LEXDISP=$G(Y),LEXIA="" Q:+LEXIEN'>0
  1. S LEXC=$$CODEC^ICDEX(80,+LEXIEN) Q:'$L(LEXC) S LEXSYS=0 S LEXTIEN=$$CODEABA^ICDEX(LEXC,80,1) I LEXTIEN>0 S LEXSYS=1 Q:LEXTIEN'=LEXIEN
  1. I LEXSYS'>0 S LEXTIEN=$$CODEABA^ICDEX(LEXC,80,30) I LEXTIEN>0 S LEXSYS=30 Q:LEXTIEN'=LEXIEN
  1. Q:+($G(LEXSYS))'>0 K ^TMP("LEXQHL",$J) S ^TMP("LEXQHL",$J,"IEN")=LEXIEN,^TMP("LEXQHL",$J,"CODE")=LEXC
  1. S LEXTMP=$$ICDDX^ICDEX(LEXIEN,,LEXSYS,"I"),^TMP("LEXQHL",$J,"NAME")=$P(LEXTMP,U,4)
  1. S:'$L(LEXDISP) LEXDISP="SB" D ST,DX,DS,ID^LEXQHL5(LEXC),DG,MC,CC D:$L($G(LEXDISP)) DP K ^TMP("LEXQHL",$J)
  1. Q
  1. ST ; 1 Status
  1. N LEXCT,LEXD,LEXE,LEXEF,LEXH,LEXMS,LEXN,LEXRT,LEXS,LEXT,LEXARY S LEXRT=$$ROOT^ICDEX(80)
  1. M LEXARY=@(LEXRT_+LEXIEN_",66)") S LEXCT=0,LEXEF="" F S LEXEF=$O(LEXARY("B",LEXEF)) Q:'$L(LEXEF) D
  1. . N LEXH S LEXH=0 F S LEXH=$O(LEXARY("B",LEXEF,LEXH)) Q:+LEXH'>0 D
  1. . . N LEXN,LEXS,LEXE,LEXT,LEXD,LEXMS S LEXN=$G(LEXARY(+LEXH,0)),LEXE=$P(LEXN,U,1),LEXS=$P(LEXN,U,2)
  1. . . Q:+LEXS'>0&(LEXCT'>0) S LEXCT=LEXCT+1,LEXMS=$$MS^LEXQHLM(LEXE,0),LEXT=$S(+LEXS>0:"Activation",1:"Inactivation")
  1. . . S:+LEXS>0&(LEXCT=1) LEXT="Initial Activation"_LEXMS,LEXIA=LEXE
  1. . . S:$O(LEXARY("B",LEXEF))=""&(LEXCT>1) LEXT=LEXT_" (final status change)"
  1. . . S LEXD=$$SD^LEXQHLM(LEXE) S ^TMP("LEXQHL",$J,LEXEF,1,1)=LEXD_U_LEXT
  1. Q
  1. DX ; 2 Diagnosis
  1. N LEX,LEXC,LEXCT,LEXD,LEXE,LEXEF,LEXH,LEXI,LEXN,LEXRT,LEXS,LEXT,LEXARY S LEXRT=$$ROOT^ICDEX(80)
  1. M LEXARY=@(LEXRT_+LEXIEN_",67)") S LEXCT=0,LEXEF="" F S LEXEF=$O(LEXARY("B",LEXEF)) Q:'$L(LEXEF) D
  1. . N LEXH S LEXH=0 F S LEXH=$O(LEXARY("B",LEXEF,LEXH)) Q:+LEXH'>0 D
  1. . . N LEXN,LEXS,LEXE,LEXT,LEXD,LEX,LEXI S LEXN=$G(LEXARY(+LEXH,0)),LEXE=$P(LEXN,U,1),LEXT=$$UP^XLFSTR($P(LEXN,U,2))
  1. . . S LEXCT=LEXCT+1,LEX(1)=LEXT D PR^LEXU(.LEX,63)
  1. . . S LEXS=$S(+LEXCT=1:"Initial Diagnosis",+LEXCT>1:"Updated Diagnosis",1:"Diagnosis")
  1. . . S:$O(LEXARY("B",LEXEF))=""&(LEXCT>1) LEXT=LEXT_" (final diagnosis change)"
  1. . . S LEXD=$$SD^LEXQHLM(LEXE) S ^TMP("LEXQHL",$J,LEXEF,2,1)=LEXD_U_LEXS
  1. . . S LEXI=0 F S LEXI=$O(LEX(LEXI)) Q:+LEXI'>0 D
  1. . . . N LEXC S LEXT=$G(LEX(LEXI)) Q:'$L(LEXT) S LEXC=$O(^TMP("LEXQHL",$J,LEXEF,2," "),-1)+1
  1. . . . S ^TMP("LEXQHL",$J,LEXEF,2,LEXC)=U_LEXT
  1. Q
  1. DS ; 3 Description
  1. N LEX,LEXC,LEXCT,LEXD,LEXE,LEXEF,LEXH,LEXI,LEXN,LEXRT,LEXS,LEXT,LEXARY S LEXRT=$$ROOT^ICDEX(80)
  1. M LEXARY=@(LEXRT_+LEXIEN_",68)") S LEXCT=0,LEXEF="" F S LEXEF=$O(LEXARY("B",LEXEF)) Q:'$L(LEXEF) D
  1. . N LEXH S LEXH=0 F S LEXH=$O(LEXARY("B",LEXEF,LEXH)) Q:+LEXH'>0 D
  1. . . N LEXN,LEXS,LEXE,LEXT,LEXD,LEX,LEXI S LEXN=$G(LEXARY(+LEXH,0))
  1. . . S LEXE=$P(LEXN,U,1),LEXT=$$UP^XLFSTR($G(LEXARY(+LEXH,1)))
  1. . . S LEXCT=LEXCT+1,LEX(1)=LEXT D PR^LEXU(.LEX,63)
  1. . . S LEXS=$S(+LEXCT=1:"Initial Description",+LEXCT>1:"Updated Description",1:"Description")
  1. . . S:$O(LEXARY("B",LEXEF))=""&(LEXCT>1) LEXT=LEXT_" (final description change)"
  1. . . S LEXD=$$SD^LEXQHLM(LEXE) S ^TMP("LEXQHL",$J,LEXEF,3,1)=LEXD_U_LEXS
  1. . . S LEXI=0 F S LEXI=$O(LEX(LEXI)) Q:+LEXI'>0 D
  1. . . . N LEXC S LEXT=$G(LEX(LEXI)) Q:'$L(LEXT) S LEXC=$O(^TMP("LEXQHL",$J,LEXEF,3," "),-1)+1
  1. . . . S ^TMP("LEXQHL",$J,LEXEF,3,LEXC)=U_LEXT
  1. Q
  1. DG ; 5 DRG Groups
  1. N LEX,LEXCT,LEXD,LEXDI,LEXDR,LEXDRG,LEXE,LEXEF,LEXH,LEXI,LEXN,LEXRT,LEXS,LEXT,LEXUN,LEXUND,LEXARY
  1. S LEXRT=$$ROOT^ICDEX(80) M LEXARY=@(LEXRT_+LEXIEN_",3)")
  1. S LEXCT=0,LEXEF="" F S LEXEF=$O(LEXARY("B",LEXEF)) Q:'$L(LEXEF) D
  1. . N LEXH S LEXH=0 F S LEXH=$O(LEXARY("B",LEXEF,LEXH)) Q:+LEXH'>0 D
  1. . . N LEXN,LEXS,LEXE,LEXT,LEXD,LEX,LEXI S LEXN=$G(LEXARY(+LEXH,0))
  1. . . S LEXE=$P(LEXN,U,1),LEXT=$$UP^XLFSTR($G(LEXARY(+LEXH,1)))
  1. . . S LEXCT=LEXCT+1,LEX(1)=LEXT D PR^LEXU(.LEX,63) S:LEXE=$G(LEXIA) LEXUN=0
  1. . . S LEXS=$S(+LEXCT=1&(LEXE'=$G(LEXIA)):"Initial Versioned DRG Groups",+LEXCT=1&(LEXE=$G(LEXIA)):"Initial DRG Groups",+LEXCT>1:"Updated DRG Groups",1:"DRG Groups")
  1. . . S:$O(LEXARY("B",LEXEF))=""&(LEXCT>1) LEXT=LEXT_" (final DRG change)"
  1. . . N LEXDRG,LEXDR,LEXDI
  1. . . S LEXDRG="",LEXDR="" F S LEXDR=$O(LEXARY(+LEXH,1,"B",LEXDR)) Q:'$L(LEXDR) D
  1. . . . S LEXDI=0 F S LEXDI=$O(LEXARY(+LEXH,1,"B",LEXDR,LEXDI)) Q:+LEXDI'>0 D
  1. . . . . N LEXN,LEXD S LEXN=+($G(LEXARY(+LEXH,1,+LEXDI,0)))
  1. . . . . S LEXDRG=LEXDRG_", "_LEXN S:$E(LEXDRG,1,2)=", " LEXDRG=$E(LEXDRG,3,$L(LEXDRG))
  1. . . S LEXDRG=$$CS^LEXQHLM(LEXDRG),LEXDRG=$$AND^LEXQHLM(LEXDRG) S:$L(LEXDRG) LEXDRG="DRG "_LEXDRG Q:'$L(LEXDRG)
  1. . . K LEX S LEX(1)=LEXDRG D PR^LEXU(.LEX,63)
  1. . . S LEXD=$$SD^LEXQHLM(LEXE) S ^TMP("LEXQHL",$J,LEXEF,5,1)=LEXD_U_LEXS
  1. . . S LEXI=0 F S LEXI=$O(LEX(LEXI)) Q:+LEXI'>0 D
  1. . . . N LEXC S LEXT=$G(LEX(LEXI)) Q:'$L(LEXT) S LEXC=$O(^TMP("LEXQHL",$J,LEXEF,5," "),-1)+1
  1. . . . S ^TMP("LEXQHL",$J,LEXEF,5,LEXC)=U_LEXT
  1. I +($G(LEXUN))>0,$L($G(LEXUND)),+($G(LEXIA))?7N D
  1. . N LEXI,LEXD,LEXS,LEX S LEXD=$$SD^LEXQHLM(+($G(LEXIA))),LEXS="Initial Unversioned DRG Groups"
  1. . K LEX S LEX(1)=LEXUND D PR^LEXU(.LEX,63) S ^TMP("LEXQHL",$J,LEXIA,5,1)=LEXD_U_LEXS
  1. . S LEXI=0 F S LEXI=$O(LEX(LEXI)) Q:+LEXI'>0 D
  1. . . N LEXC S LEXT=$G(LEX(LEXI)) Q:'$L(LEXT) S LEXC=$O(^TMP("LEXQHL",$J,LEXIA,5," "),-1)+1
  1. . . S ^TMP("LEXQHL",$J,LEXIA,5,LEXC)=U_LEXT
  1. Q
  1. MC ; 6 Major Diagnostic Category
  1. N LEX,LEXB,LEXC,LEXCT,LEXD,LEXE,LEXEF,LEXH,LEXI,LEXM,LEXN,LEXRT,LEXS,LEXT,LEXUN,LEXUND,LEXARY
  1. S LEXRT=$$ROOT^ICDEX(80) M LEXARY=@(LEXRT_+LEXIEN_",4)")
  1. S LEXCT=0,LEXEF="" F S LEXEF=$O(LEXARY("B",LEXEF)) Q:'$L(LEXEF) D
  1. . N LEXH S LEXH=0 F S LEXH=$O(LEXARY("B",LEXEF,LEXH)) Q:+LEXH'>0 D
  1. . . N LEXB,LEXN,LEXS,LEXE,LEXT,LEXD,LEXM S LEXN=$G(LEXARY(+LEXH,0)),LEXE=$P(LEXN,U,1),LEXS=$P(LEXN,U,2)
  1. . . S LEXM=$$UP^XLFSTR($P($G(^ICM(+LEXS,0)),U,1)) Q:'$L(LEXM) Q:+LEXS'>0&(LEXCT'>0) S LEXCT=LEXCT+1
  1. . . S:LEXE=$G(LEXIA) LEXUN=0 S LEXT=""
  1. . . S:+LEXCT=1&(LEXE'=$G(LEXIA)) LEXT="Initial Versioned Major Diagnostic Category"
  1. . . S:'$L(LEXT)&(+LEXCT=1)&(LEXE=$G(LEXIA)) LEXT="Initial Major Diagnostic Category"
  1. . . S:'$L(LEXT)&(+LEXCT>1) LEXT="Updated Major Diagnostic Category"
  1. . . S:'$L(LEXT) LEXT="Major Diagnostic Category"
  1. . . S:$O(LEXARY("B",LEXEF))=""&(LEXCT>1) LEXT=LEXT_" (final category change)"
  1. . . S LEXD=$$SD^LEXQHLM(LEXE) S ^TMP("LEXQHL",$J,LEXEF,6,1)=LEXD_U_LEXT
  1. . . S ^TMP("LEXQHL",$J,LEXEF,6,2)=U_LEXM
  1. I +($G(LEXUN))>0,$L($G(LEXUND)),+($G(LEXIA))?7N D
  1. . N LEXI,LEXD,LEXS,LEX S LEXD=$$SD^LEXQHLM(+($G(LEXIA))),LEXS="Initial Unversioned Major Diagnostic Category"
  1. . K LEX S LEX(1)=LEXUND D PR^LEXU(.LEX,63) S ^TMP("LEXQHL",$J,LEXIA,6,1)=LEXD_U_LEXS
  1. . S LEXI=0 F S LEXI=$O(LEX(LEXI)) Q:+LEXI'>0 D
  1. . . N LEXC S LEXT=$G(LEX(LEXI)) Q:'$L(LEXT) S LEXC=$O(^TMP("LEXQHL",$J,LEXIA,6," "),-1)+1
  1. . . S ^TMP("LEXQHL",$J,LEXIA,6,LEXC)=U_LEXT
  1. Q
  1. CC ; 7 Complication/Comorbidity
  1. N LEX,LEXB,LEXC,LEXCT,LEXD,LEXE,LEXEF,LEXH,LEXI,LEXM,LEXN,LEXRT,LEXS,LEXT,LEXUN,LEXUND,LEXARY
  1. S LEXRT=$$ROOT^ICDEX(80) M LEXARY=@(LEXRT_+LEXIEN_",69)")
  1. S LEXCT=0,LEXEF="" F S LEXEF=$O(LEXARY("B",LEXEF)) Q:'$L(LEXEF) D
  1. . N LEXH S LEXH=0 F S LEXH=$O(LEXARY("B",LEXEF,LEXH)) Q:+LEXH'>0 D
  1. . . N LEXB,LEXN,LEXS,LEXE,LEXT,LEXD,LEXM S LEXN=$G(LEXARY(+LEXH,0)),LEXE=$P(LEXN,U,1),LEXS=$P(LEXN,U,2)
  1. . . S LEXM=$S(LEXS=1:"COMPLICATION/COMORBIDITY",LEXS=2:"MAJOR COMPLICATION/COMORBIDITY",LEXS="0":"NON-COMPLICATION/COMORBIDITY",1:"") Q:'$L(LEXM)
  1. . . Q:'$L(LEXS)&(LEXCT'>0) S LEXCT=LEXCT+1
  1. . . S:LEXE=$G(LEXIA) LEXUN=0
  1. . . S LEXT=$S(+LEXCT=1&(LEXE'=$G(LEXIA)):"Initial Versioned Complication/Comorbidity",+LEXCT=1&(LEXE=$G(LEXIA)):"Initial Complication/Comorbidity",+LEXCT>1:"Updated Complication/Comorbidity",1:"Complication/Comorbidity")
  1. . . S:$O(LEXARY("B",LEXEF))=""&(LEXCT>1) LEXT=LEXT_" (final CC change)"
  1. . . S LEXD=$$SD^LEXQHLM(LEXE) S ^TMP("LEXQHL",$J,LEXEF,7,1)=LEXD_U_LEXT
  1. . . S ^TMP("LEXQHL",$J,LEXEF,7,2)=U_LEXM
  1. I +($G(LEXUN))>0,$L($G(LEXUND)),+($G(LEXIA))?7N D
  1. . N LEXI,LEXD,LEXS,LEX S LEXD=$$SD^LEXQHLM(+($G(LEXIA))),LEXS="Initial Unversioned Complication/Comorbidity"
  1. . K LEX S LEX(1)=LEXUND D PR^LEXU(.LEX,63) S ^TMP("LEXQHL",$J,LEXIA,7,1)=LEXD_U_LEXS
  1. . S LEXI=0 F S LEXI=$O(LEX(LEXI)) Q:+LEXI'>0 D
  1. . . N LEXC S LEXT=$G(LEX(LEXI)) Q:'$L(LEXT) S LEXC=$O(^TMP("LEXQHL",$J,LEXIA,7," "),-1)+1
  1. . . S ^TMP("LEXQHL",$J,LEXIA,7,LEXC)=U_LEXT
  1. Q
  1. ;
  1. DP ; Display
  1. S LEXDISP=$G(LEXDISP) Q:$L(LEXDISP)>8 Q:$L(LEXDISP)<2 Q:LEXDISP["^" N LEXL S LEXL=$T(@LEXDISP+0) Q:'$L(LEXL) D @LEXDISP
  1. Q
  1. SB ; Subjective
  1. D ATTR^LEXQM N LEX1,LEX2,LEX3,LEXC,LEXCT,LEXE,LEXHDR,LEXI,LEXID,LEXN,LEXP,LEXS,LEXT
  1. S LEXC=$G(^TMP("LEXQHL",$J,"CODE")),LEXI=$G(^TMP("LEXQHL",$J,"IEN")),LEXN=$G(^TMP("LEXQHL",$J,"NAME"))
  1. S LEXT="Code: "_LEXC,LEXT=LEXT_$J(" ",(16-$L(LEXT)))_LEXN D TL^LEXQHLM(($G(BOLD)_LEXT_$G(NORM)))
  1. S LEXT="",LEXT=LEXT_$J(" ",(16-$L(LEXT)))_"IEN: "_LEXI D TL^LEXQHLM(($G(BOLD)_LEXT_$G(NORM)))
  1. F LEXID=1:1:4 D
  1. . N LEXHDR,LEXCT S LEXCT=0,LEXHDR=$$HD(LEXID) Q:'$L(LEXHDR) S LEXP="",LEX1=0 F S LEX1=$O(^TMP("LEXQHL",$J,LEX1)) Q:+LEX1'>0 D
  1. . . I LEXID=1 D Q
  1. . . . S LEXN=$G(^TMP("LEXQHL",$J,LEX1,LEXID,1)) Q:'$L(LEXN) S LEXE=$P(LEXN,U,1),LEXS=$P(LEXN,U,2) Q:'$L(LEXE) Q:'$L(LEXS) S LEXCT=LEXCT+1
  1. . . . D:LEXCT=1 BL^LEXQHLM,TL^LEXQHLM(($G(BOLD)_" "_LEXHDR_$G(NORM))) S:$L(LEXE) LEXE=$G(BOLD)_LEXE_$G(NORM)
  1. . . . S LEXT=LEXE,LEXT=LEXT_$J(" ",(11-$L(LEXT)))_" "_LEXS,LEXT=" "_LEXT D TL^LEXQHLM(LEXT)
  1. . . N LEX2 S LEX2=0,LEXE="" F S LEX2=$O(^TMP("LEXQHL",$J,LEX1,LEXID,LEX2)) Q:+LEX2'>0 D
  1. . . . S LEXN=$G(^TMP("LEXQHL",$J,LEX1,LEXID,LEX2)) S:LEX2=1 LEXE=$P(LEXN,U,1) Q:LEX2=1 Q:'$L(LEXE)
  1. . . . S:$L(LEXE) LEXE=$G(BOLD)_LEXE_$G(NORM)
  1. . . . I LEX2=2 D Q
  1. . . . . S LEXCT=LEXCT+1,LEXT=$G(LEXE),LEXS=$P(LEXN,U,2),LEXT=LEXT_$J(" ",(11-$L(LEXT)))_" "_LEXS,LEXT=" "_LEXT
  1. . . . . D:LEXCT=1 BL^LEXQHLM,TL^LEXQHLM(($G(BOLD)_" "_LEXHDR_$G(NORM))) D TL^LEXQHLM(LEXT)
  1. . . . I LEX2>2 D Q
  1. . . . . S LEXCT=LEXCT+1,LEXT="",LEXS=$P(LEXN,U,2),LEXT=LEXT_$J(" ",(11-$L(LEXT)))_" "_LEXS,LEXT=" "_LEXT
  1. . . . . D:LEXCT=1 BL^LEXQHLM,TL^LEXQHLM(($G(BOLD)_" "_LEXHDR_$G(NORM))) D TL^LEXQHLM(LEXT)
  1. D KATTR^LEXQM
  1. Q
  1. CH ; Chronological
  1. D ATTR^LEXQM N LEX1,LEX2,LEX3,LEXC,LEXD,LEXI,LEXN,LEXP,LEXS,LEXT
  1. S LEXC=$G(^TMP("LEXQHL",$J,"CODE")),LEXI=$G(^TMP("LEXQHL",$J,"IEN")),LEXN=$G(^TMP("LEXQHL",$J,"NAME"))
  1. S LEXT="Code: "_LEXC,LEXT=LEXT_$J(" ",(16-$L(LEXT)))_LEXN D TL^LEXQHLM(($G(BOLD)_LEXT_$G(NORM)))
  1. S LEXT="",LEXT=LEXT_$J(" ",(16-$L(LEXT)))_"IEN: "_LEXI D TL^LEXQHLM(($G(BOLD)_LEXT_$G(NORM)))
  1. S LEXP="",LEX1=0 F S LEX1=$O(^TMP("LEXQHL",$J,LEX1)) Q:+LEX1'>0 D
  1. . D BL^LEXQHLM N LEX2 S LEX2=0 F S LEX2=$O(^TMP("LEXQHL",$J,LEX1,LEX2)) Q:+LEX2'>0 D
  1. . . Q:LEX2>4 N LEX3 S LEX3=0 F S LEX3=$O(^TMP("LEXQHL",$J,LEX1,LEX2,LEX3)) Q:+LEX3'>0 D
  1. . . . N LEXN,LEXD,LEXS,LEXSPC S LEXN=$G(^TMP("LEXQHL",$J,LEX1,LEX2,LEX3)),LEXD=$P(LEXN,U,1),LEXS=$P(LEXN,U,2),LEXSPC=" "
  1. . . . I $L($$TM^LEXQM(LEXD)) S LEXD=$G(BOLD)_LEXD_$G(NORM),LEXSPC=$G(BOLD)_"- "_$G(NORM),LEXS=$G(BOLD)_LEXS_$G(NORM)
  1. . . . S LEXT=$S(LEXD'=LEXP:LEXD,1:""),LEXT=LEXT_$J(" ",(11-$L(LEXT)))_LEXSPC_LEXS
  1. . . . S LEXT=" "_LEXT D TL^LEXQHLM(LEXT) S:LEXD'="" LEXP=LEXD
  1. D KATTR^LEXQM
  1. Q
  1. ;
  1. ; Miscellaneous
  1. HD(X) ; Header
  1. Q:+($G(X))=1 "Status" Q:+($G(X))=2 "Diagnosis" Q:+($G(X))=3 "Description" Q:+($G(X))=4 "Lexicon Expression" Q:+($G(X))=5 "DRG Groups"
  1. Q:+($G(X))=6 "Major Diagnostic Category" Q:+($G(X))=7 "Complication/Comorbidity"
  1. Q ""