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