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

BGOASLK.m

Go to the documentation of this file. 
  1. BGOASLK ; IHS/MSC/MGH - ASTHMA FILE ;12-Apr-2016 04:34;MGH
  1.  ;;1.1;BGO COMPONENTS;**6,10,12,13,19,20**;Mar 20, 2007;Build 2
  1.  ;---------------------------------------------------------------
  1. CHKASM(RET,CODE,SNOMED) ;RPC to see if its a SNOMED code
  1.  N X
  1.  S CODE=$G(CODE),SNOMED=$G(SNOMED)
  1.  S X=$$CHECK(CODE,SNOMED)
  1.  S RET=X
  1.  Q
  1. CHECK(CODE,SNOMED) ;EP see if the icd code entered is an asthma code
  1.  N X,X1,TAX,LOW,HIGH,ICD,NODE,IN,OUT
  1.  S CODE=$G(CODE),SNOMED=$G(SNOMED)
  1.  S X=0,X1=0
  1.  I DUZ("AG")'="I" Q X
  1.  I SNOMED'="" D
  1.  .S OUT="ARR"
  1.  .S IN=SNOMED_"^EHR IPL ASTHMA DXS^^1"
  1.  .S X=$$VALSBTRM^BSTSAPI(.OUT,.IN)
  1.  .I +X S X1=$G(@OUT) ; ISC/DKA
  1.  I +X1=0 D
  1.  .;IHS/MSC/MGH Patch 12
  1.  .S X=0
  1.  .Q:CODE=""
  1.  .;Patch 20 changed lookup to use standard for taxonomies
  1.  .S TAX="" S TAX=$O(^ATXAX("B","BGP ASTHMA DXS",TAX))
  1.  .Q:TAX=""
  1.  .S CODE=$P($$ICDDX^ICDEX(CODE,$$NOW^XLFDT,"","E"),U,1)
  1.  .S X1=$$ICD^ATXAPI(CODE,TAX,9)
  1.  .;S ICD=0 F  S ICD=$O(^ATXAX(TAX,21,ICD)) Q:ICD=""!(ICD?1.2A)  D
  1.  .;.S NODE=$G(^ATXAX(TAX,21,ICD,0))
  1.  .;.S LOW=$P(NODE,U,1),HIGH=$P(NODE,U,2)
  1.  .;.;EHR patch 18 changed to accomodate non-numeric codes
  1.  .;.I +CODE=0 D
  1.  .;..I (CODE=LOW)!(CODE=HIGH) S X1=1
  1.  .;.E  I (CODE'<LOW)&(CODE'>HIGH) S X1=1
  1.  Q X1
  1.  ;Set the classification for an asthma diagnosis
  1.  ;INP=  IEN of problem [1] ^ Classification[2]
  1. CLASS(RET,INP) ;EP to set the classification of an asthma dx
  1.  N PIEN,CLASS,FNUM,IENS,FDA
  1.  S PIEN=$P(INP,U,1)
  1.  Q:PIEN=""
  1.  S CLASS=$P(INP,U,2)
  1.  S FNUM=$$FNUM,RET=""
  1.  S IENS=PIEN_","
  1.  S FDA=$NA(FDA(FNUM,IENS))
  1.  S @FDA@(.15)=CLASS
  1.  S RET=$$UPDATE^BGOUTL(.FDA,,.IEN)
  1.  Q:RET
  1.  S:'RET RET=PIEN
  1.  Q
  1.  ;Get the classification for an asthma diagnosis
  1.  ;INP=DX [1] ^ SNOMED [2] ^Classification [2]
  1. DICLASS(RET,INP) ;EP Get the classifications for an asthma DX
  1.  N CNT,VAL,TYPE,CLASS,CTYPE,ICD,ASTHMA,SNO
  1.  S ICD=$P(INP,U,1)
  1.  S SNO=$P(INP,U,2)
  1.  S ASTHMA=$$CHECK^BGOASLK(ICD,SNO)
  1.  K RET
  1.  I ASTHMA=0 S RET="" Q
  1.  S CNT=0
  1.  S TYPE=$O(^APCDPLCL("B",$P(INP,U,3),"")) Q:TYPE=""  D
  1.  .S CLASS=0 F  S CLASS=$O(^APCDPLCL(TYPE,11,CLASS)) Q:CLASS=""!(CLASS="B")  D
  1.  ..S CTYPE=$G(^APCDPLCL(TYPE,11,CLASS,0))
  1.  ..I CTYPE'="" S VAL=$P(CTYPE,U,1)_"^"_$P(CTYPE,U,2)
  1.  ..S CNT=CNT+1,RET(CNT)=VAL
  1.  Q
  1. ACONTROL(DFN,VST) ;Find last entry of patient's asthma control
  1.  ;IHS/MSC/MGH Patch 10 modified to loop through IENs on visit
  1.  N LEVEL,DT,IEN
  1.  S LEVEL=""
  1.  I DUZ("AG")'="I" Q LEVEL
  1.  S IEN="" F  S IEN=$O(^AUPNVAST("AD",VST,IEN),-1) Q:IEN=""!(LEVEL'="")  D
  1.  .S LEVEL=$P($G(^AUPNVAST(IEN,0)),U,14)
  1.  .I LEVEL'="" D
  1.  ..S LEVEL=$S(LEVEL="W":"WELL CONTROLLED",LEVEL="N":"NOT WELL CONTROLLED",LEVEL="V":"VERY POORLY CONTROLLED",1:"")
  1.  ..S LEVEL=LEVEL_U_IEN
  1.  Q LEVEL
  1. TMPGBL(X) ;EP
  1.  K ^TMP("BGO"_$G(X),$J) Q $NA(^($J))
  1. FNUM() Q 9000011