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

LEXQHL5.m

Go to the documentation of this file.
  1. LEXQHL5 ;ISL/KER - Query History - Lexicon ICD/CPT Extract ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**62,80,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^TMP("LEXQHL") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; None
  1. ;
  1. Q
  1. CP(X) ; 4 Lexicon CPT
  1. N LEX,LEXC,LEXCT,LEXD,LEXE,LEXEIEN,LEXLEX,LEXH,LEXI,LEXN,LEXS,LEXSAB,LEXSIEN,LEXSO,LEXT,LEXX S LEXSO=$G(X),(LEXCT,LEXSIEN)=0
  1. F S LEXSIEN=$O(^LEX(757.02,"CODE",(LEXSO_" "),LEXSIEN)) Q:+LEXSIEN'>0 D
  1. . N LEXN,LEXEIEN,LEXSAB,LEXLEX,LEXH,LEXD,LEXE S LEXN=$G(^LEX(757.02,+LEXSIEN,0)),LEXEIEN=+LEXN,LEXSAB=$P(LEXN,U,3) Q:"^3^4^"'[("^"_+LEXSAB_"^")
  1. . Q:+$P(LEXN,U,5)'>0 S LEXLEX=$P($G(^LEX(757.01,+LEXEIEN,0)),U,1),LEXH=0 F S LEXH=$O(^LEX(757.02,+LEXSIEN,4,LEXH)) Q:+LEXH'>0 D
  1. . . N LEXN S LEXN=$G(^LEX(757.02,+LEXSIEN,4,LEXH,0)) Q:+($P(LEXN,U,2))'>0
  1. . . S LEXE=$P(LEXN,U,1) Q:LEXE'?7N S LEXD=$$SD^LEXQHLM(LEXE),LEXX(LEXE)=LEXD_U_LEXLEX
  1. S LEXCT=0,LEXE="" F S LEXE=$O(LEXX(LEXE)) Q:'$L(LEXE) D
  1. . N LEXN,LEXD,LEXT,LEXS,LEX S LEXN=$G(LEXX(LEXE)),LEXD=$P(LEXN,U,1),LEXT=$P(LEXN,U,2) Q:'$L(LEXD) Q:'$L(LEXT)
  1. . S LEX(1)=LEXT D PR^LEXU(.LEX,63) Q:'$L($G(LEX(1))) S LEXCT=LEXCT+1
  1. . S LEXS=$S(+LEXCT=1:"Initial Lexicon Expression",+LEXCT>1:"Updated Lexicon Expression",1:"Lexicon Expression")
  1. . S:$O(LEXX(LEXE))=""&(LEXCT>1) LEXS=LEXS_" (final change)"
  1. . S ^TMP("LEXQHL",$J,LEXE,4,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,LEXE,4," "),-1)+1 S ^TMP("LEXQHL",$J,LEXE,4,LEXC)=U_LEXT
  1. Q
  1. ID(X) ; 4 Lexicon ICD
  1. N LEX,LEXC,LEXCT,LEXD,LEXE,LEXEIEN,LEXLEX,LEXH,LEXI,LEXN,LEXS,LEXSAB,LEXSIEN,LEXSO,LEXT,LEXX S LEXSO=$G(X),(LEXCT,LEXSIEN)=0
  1. F S LEXSIEN=$O(^LEX(757.02,"CODE",(LEXSO_" "),LEXSIEN)) Q:+LEXSIEN'>0 D
  1. . N LEXN,LEXEIEN,LEXSAB,LEXLEX,LEXH,LEXD,LEXE S LEXN=$G(^LEX(757.02,+LEXSIEN,0)),LEXEIEN=+LEXN,LEXSAB=$P(LEXN,U,3) Q:"^1^"'[("^"_+LEXSAB_"^")
  1. . Q:+$P(LEXN,U,5)'>0 S LEXLEX=$P($G(^LEX(757.01,+LEXEIEN,0)),U,1),LEXH=0 F S LEXH=$O(^LEX(757.02,+LEXSIEN,4,LEXH)) Q:+LEXH'>0 D
  1. . . N LEXN S LEXN=$G(^LEX(757.02,+LEXSIEN,4,LEXH,0)) Q:+($P(LEXN,U,2))'>0
  1. . . S LEXE=$P(LEXN,U,1) Q:LEXE'?7N S LEXD=$$SD^LEXQHLM(LEXE),LEXX(LEXE)=LEXD_U_LEXLEX
  1. S LEXCT=0,LEXE="" F S LEXE=$O(LEXX(LEXE)) Q:'$L(LEXE) D
  1. . N LEXN,LEXD,LEXT,LEXS,LEX S LEXN=$G(LEXX(LEXE)),LEXD=$P(LEXN,U,1),LEXT=$P(LEXN,U,2) Q:'$L(LEXD) Q:'$L(LEXT)
  1. . S LEX(1)=LEXT D PR^LEXU(.LEX,63) Q:'$L($G(LEX(1))) S LEXCT=LEXCT+1
  1. . S LEXS=$S(+LEXCT=1:"Initial Lexicon Expression",+LEXCT>1:"Updated Lexicon Expression",1:"Lexicon Expression")
  1. . S:$O(LEXX(LEXE))=""&(LEXCT>1) LEXS=LEXS_" (final change)"
  1. . S ^TMP("LEXQHL",$J,LEXE,4,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,LEXE,4," "),-1)+1 S ^TMP("LEXQHL",$J,LEXE,4,LEXC)=U_LEXT
  1. Q
  1. IX(X,Y) ; 4 Lexicon ICD 10
  1. N LEX,LEXC,LEXCT,LEXD,LEXE,LEXEIEN,LEXLEX,LEXH,LEXI,LEXN,LEXS,LEXSR,LEXSAB,LEXSIEN,LEXSO,LEXT,LEXX S LEXSO=$G(X),(LEXCT,LEXSIEN)=0
  1. S LEXSR=$G(Y) S:'$L(LEXSR) LEXSR="30^31" S LEXSR="^"_LEXSR_"^" F S LEXSIEN=$O(^LEX(757.02,"CODE",(LEXSO_" "),LEXSIEN)) Q:+LEXSIEN'>0 D
  1. . N LEXN,LEXEIEN,LEXSAB,LEXLEX,LEXH,LEXD,LEXE S LEXN=$G(^LEX(757.02,+LEXSIEN,0)),LEXEIEN=+LEXN,LEXSAB=$P(LEXN,U,3)
  1. . Q:LEXSR'[("^"_+LEXSAB_"^")
  1. . Q:+$P(LEXN,U,5)'>0 S LEXLEX=$P($G(^LEX(757.01,+LEXEIEN,0)),U,1),LEXH=0 F S LEXH=$O(^LEX(757.02,+LEXSIEN,4,LEXH)) Q:+LEXH'>0 D
  1. . . N LEXN S LEXN=$G(^LEX(757.02,+LEXSIEN,4,LEXH,0)) Q:+($P(LEXN,U,2))'>0
  1. . . S LEXE=$P(LEXN,U,1) Q:LEXE'?7N S LEXD=$$SD^LEXQHLM(LEXE),LEXX(LEXE)=LEXD_U_LEXLEX
  1. S LEXCT=0,LEXE="" F S LEXE=$O(LEXX(LEXE)) Q:'$L(LEXE) D
  1. . N LEXN,LEXD,LEXT,LEXS,LEX S LEXN=$G(LEXX(LEXE)),LEXD=$P(LEXN,U,1),LEXT=$P(LEXN,U,2) Q:'$L(LEXD) Q:'$L(LEXT)
  1. . S LEX(1)=LEXT D PR^LEXU(.LEX,63) Q:'$L($G(LEX(1))) S LEXCT=LEXCT+1
  1. . S LEXS=$S(+LEXCT=1:"Initial Lexicon Expression",+LEXCT>1:"Updated Lexicon Expression",1:"Lexicon Expression")
  1. . S:$O(LEXX(LEXE))=""&(LEXCT>1) LEXS=LEXS_" (final change)"
  1. . S ^TMP("LEXQHL",$J,LEXE,4,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,LEXE,4," "),-1)+1 S ^TMP("LEXQHL",$J,LEXE,4,LEXC)=U_LEXT
  1. Q