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