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

BIDX.m

Go to the documentation of this file. 
  1. BIDX ;IHS/CMI/MWR - RISK FOR FLU & PNEUMO, CHECK FOR DIAGNOSES.; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**15**;SEP 30,2017
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  CHECK FOR DIAGNOSES IN A TAXONOMY RANGE, WITHIN A GIVE DATE RANGE.
  1.  ;;  FROM LORI BUTCHER, 9-18-05
  1.  ;;  PATCH 5: New code to check for Smoking Health Factors.   HFSMKR+23
  1.  ;;  PATCH 9: Changes to include Hep B Risk.  RISK+9, RISK+41
  1.  ;;  PATCH 13: Changes to check for Flu High Risk.   RISK+25, HASDX+38
  1.  ;;  PATCH 15: Changes to check for Flu High Risk (removed in p14).   RISKAB+19
  1.  ;
  1.  ;
  1.  ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
  1.  ;----------
  1. RISKP(BIDFN,BIFDT,BIAGE,BISMKR,BIRISKF) ;EP Return Pneumo High Risk.
  1.  ;---> Determine if this patient is in the Pneumo Risk Taxonomy.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient IEN.
  1.  ;     2 - BIFDT   (opt) Forecast Date (date used for forecast).
  1.  ;     3 - BIAGE   (req) Patient Age in years for this Forecast Date.
  1.  ;     4 - BISMKR  (opt) 1=Include Smoking Factors.
  1.  ;     5 - BIRISKF (ret) 1=Patient has Risk of Pneumo; otherwise 0.
  1.  ;
  1.  S BIRISKF=0
  1.  Q:'$G(BIDFN)
  1.  ;---> Quit if this Pt Age <5 yrs or >65 yrs, regardless of risk.
  1.  Q:((BIAGE<5)!(BIAGE>64))
  1.  S:'$G(BIFDT) BIFDT=$G(DT)
  1.  N BIBEGDT,Y S BIBEGDT=$$FMADD^XLFDT(BIFDT,-(3*365))
  1.  ;
  1.  ;---> Check Pneumo Risk (2 Pneumo Dx's over 3-year range).
  1.  S Y=+$$HASDX(BIDFN,"BI HIGH RISK PNEUMO",2,BIBEGDT,BIFDT)
  1.  ;S BIRISKF=1 Q  ;Uncomment to test. MWRZZZ
  1.  I Y S BIRISKF=1 Q
  1.  ;
  1.  ;---> Quit if site parameter says don't include Smoking.
  1.  Q:'$G(BISMKR)
  1.  S Y=+$$HASDX(BIDFN,"BI HIGH RISK PNEUMO W/SMOKING",2,BIBEGDT,BIFDT)
  1.  I Y S BIRISKF=1 Q
  1.  ;
  1.  ;---> Check for Smoking Health Factor in the last 2 years.
  1.  S BIRISKF=$$HFSMKR(BIDFN,BIFDT)
  1.  I Y=1 S BIRISKF=1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. RISKB(BIDFN,BIFDT,BIAGE,BIRISKF) ;EP Return Hep B High Risk.
  1.  ;---> Determine if this patient is in the Hep B due to Diabetes Risk Taxonomy.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient IEN.
  1.  ;     2 - BIFDT   (opt) Forecast Date (date used for forecast).
  1.  ;     3 - BIAGE   (req) Patient Age in years for this Forecast Date.
  1.  ;     4 - BIRISKF (ret) 1=Patient has Risk of Hep B due to Diabetes; otherwise 0.
  1.  ;
  1.  S BIRISKF=0
  1.  Q:'$G(BIDFN)
  1.  S:'$G(BIFDT) BIFDT=$G(DT)
  1.  N Y
  1.  ;
  1.  ;---> Check Hep B Risk (2 Diabetes Dx's from DOB to Forecast Date).
  1.  Q:(BIAGE>59)
  1.  N Y S Y=+$$V2DM(BIDFN,,BIFDT)
  1.  ;S BIRISKF=1 Q  ;Uncomment to test. MWRZZZ
  1.  I Y=1 S BIRISKF=1
  1.  Q
  1.  ;----------
  1. RISKAB(BIDFN,BIFDT,BIRISKF) ;EP Return Hep A & Hep B High Risk.
  1.  ;---> Determine if this patient is in the CLD/HepC Risk Taxonomy.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient IEN.
  1.  ;     2 - BIFDT   (opt) Forecast Date (date used for forecast).
  1.  ;     3 - BIRISKF (ret) 1=Patient has Risk of HepA&B; otherwise 0.
  1.  ;
  1.  S BIRISKF=0
  1.  Q:'$G(BIDFN)
  1.  S:'$G(BIFDT) BIFDT=$G(DT)
  1.  N BIBEGDT,Y S BIBEGDT=$$FMADD^XLFDT(BIFDT,-(3*365))
  1.  ;
  1.  ;---> Check CLD/HepC Risk (1 CLD/HepC Dx's over 3-year range).
  1.  S Y=+$$HASDX(BIDFN,"BI HIGH RISK HEPA/B, CLD/HEPC",1,BIBEGDT,BIFDT)
  1.  ;S BIRISKF=1 Q  ;Uncomment to test. MWRZZZ
  1.  I Y=1 S BIRISKF=1
  1.  Q
  1.  ;
  1.  ;
  1.  ;********** PATCH 15, v8.5, SEP 30,2017, IHS/CMI/MWR
  1.  ;---> Return Flu High Risk Value.
  1.  ;----------
  1. RISKF(BIDFN,BIFDT,BIRISKF) ;EP Return Flu High Risk.
  1.  ;---> Determine if this patient is in the Flu High Risk Taxonomy.
  1.  ;---> Generally patients passed are >18 yrs and <50 yrs.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient IEN.
  1.  ;     2 - BIFDT   (opt) Forecast Date (date used for forecast).
  1.  ;     3 - BIRISKF (ret) 1=Patient has Risk of Influenza; otherwise 0.
  1.  ;
  1.  ;---> Check Flu Risk Taxonomy(2 Dx's within 3 yrs prior to the date passed).
  1.  S BIRISKF=0
  1.  Q:'$G(BIDFN)
  1.  S:'$G(BIFDT) BIFDT=$G(DT)
  1.  N BIBEGDT,Y S BIBEGDT=$$FMADD^XLFDT(BIFDT,-(3*365))
  1.  S Y=+$$HASDX(BIDFN,"BI HIGH RISK FLU",2,BIBEGDT,BIFDT)
  1.  S:(Y>0) BIRISKI=1
  1.  Q
  1.  ;**********
  1.  ;
  1.  ;
  1.  ;----------
  1. HASDX(BIDFN,BITAX,BINUM,BIBD,BIED) ;EP
  1.  ;---> This call is made to determine if a patient (BIDFN) has had
  1.  ;---> BINUM number of diagnoses within taxonomy BITAX during the
  1.  ;---> time period BIBD to BIED.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient DFN.
  1.  ;     2 - BITAX  (req) Name of the Taxonomy e.g. "BI HIGH RISK FLU"
  1.  ;     3 - BINUM  (req) The number of diagnoses the patient has to have had.
  1.  ;     4 - BIBD   (opt) Beginning date (earliest) date to search for diagnoses.
  1.  ;                      If null, use patient's DOB.
  1.  ;     5 - BIED   (opt) Date (latest) date to search for diagnoses.
  1.  ;                      If null, use DT.
  1.  ;
  1.  ;  Return values:  1 if patient has had the diagnoses
  1.  ;                  0 if patient has NOT had the diagnoses
  1.  ;                 -1^error message   if error occurred
  1.  ;
  1.  ;  Example:  to find if patient has had at least 2 diagnoses in past 3 years
  1.  ;           S X=$$HASDX^BIDX(40503,"BI HIGH RISK FLU",2,$$FMADD^XLFDT(DT,-(3*365)),DT)
  1.  ;           I X=1 Then yes they had the diagnoses, I X=0 then no they didn't
  1.  ;           to find if patient has ever had a diagnoses in the SURVEILLANCE DIABETES
  1.  ;           taxonomy:  S X=$$HASDX^BIDX(dfn,"SURVEILLANCE DIABETES",1)
  1.  ;
  1.  ;
  1.  I '$G(BIDFN) Q "-1^Patient DFN invalid"
  1.  ;
  1.  I $G(BIBD)="" S BIBD=$$DOB^AUPNPAT(BIDFN)
  1.  I $G(BIED)="" S BIED=DT
  1.  NEW BITAXI,BIIBD,BIIED,BISD,X,Y,I,P,R,C,BIREF
  1.  S BITAXI=$O(^ATXAX("B",BITAX,0))
  1.  I 'BITAXI Q "-1^Invalid Taxonomy name"
  1.  S R=0  ;return value
  1.  S BIIBD=9999999-BIBD  ;inverse of beginning date
  1.  S BIIED=9999999-BIED  ;inverse of ending date
  1.  S BISD=BIIED-1  ;start one day later for $O
  1.  ;ihs/cmi/lab - added lines below for ICD10
  1.  ;
  1.  ;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR
  1.  ;---> Code to prevent error out if atx_0510.11k missing.
  1.  ;I $D(^ICDS(0)) D
  1.  I $D(^ICDS(0)),$T(^ATXAPI)]"" D
  1.  .;**********
  1.  .K ^TMP($J,"BITAX")
  1.  .S BIREF=$NA(^TMP($J,"BITAX"))
  1.  .D BLDTAX^ATXAPI(BITAX,BIREF,BITAXI)
  1.  S C=0  ;counter for diagnoses
  1.  S X=0 F  S X=$O(^AUPNVPOV("AA",BIDFN,X)) Q:X=""!(X>BIIBD)!(C=BINUM)  D
  1.  .S Y=0 F  S Y=$O(^AUPNVPOV("AA",BIDFN,X,Y)) Q:Y'=+Y!(C=BINUM)  D
  1.  ..Q:'$D(^AUPNVPOV(Y,0))  ;bad xref
  1.  ..S P=$P($G(^AUPNVPOV(Y,0)),"^")
  1.  ..Q:P=""  ;bad entry
  1.  ..;added lines below for ICD10
  1.  ..I $D(^TMP($J,"BITAX")) Q:'$D(^TMP($J,"BITAX",P))
  1.  ..I '$D(^TMP($J,"BITAX")) Q:'$$ICD^ATXCHK(P,BITAXI,9)  ;this diagnosis not in taxonomy
  1.  ..S C=C+1  ;update counter as diagnosis found
  1.  ..Q
  1.  .Q
  1.  K ^TMP($J,"BITAX")
  1.  I C<BINUM Q 0  ;patient did not meet the required # of diagnoses
  1.  Q 1
  1.  ;
  1.  ;
  1.  ;----------
  1. HFSMKR(BIDFN,BIFDT) ;EP
  1.  ;---> Return 1 if Patient has Last Health Factor in the TOBACCO category
  1.  ;---> with a date of <2 years.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient's IEN (DFN).
  1.  ;     2 - BIFDT   (req) Forecast Date (date used for forecast).
  1.  ;
  1.  ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1.  ;---> New code to check for Smoking Health Factors.
  1.  ;
  1.  ;---> Return 0 if routine APCLAPIU is not in the namespace.
  1.  ;---> APCLAPIU is from ;;2.0;IHS PCC SUITE;**2,6**;MAY 14, 2009.
  1.  Q:('$L($T(^APCLAPIU))) 0
  1.  Q:'$G(BIDFN) 0
  1.  S:'$G(BIFDT) BIFDT=$G(DT)
  1.  ;
  1.  N Y S Y=$$LASTHF^APCLAPIU(BIDFN,"TOBACCO (SMOKING)",$$FMADD^XLFDT(BIFDT,-730),BIFDT)
  1.  ;---> If there's a hit it looks like this:
  1.  ;--->     3110815^HF: CURRENT SMOKER, SOME DAY^^2580^9000010.23^2, otherwise null.
  1.  ;---> So, if there's a leading date, then patient has an HF "TOBACCO (SMOKING)" Category.
  1.  ;---> Looking for these Health Factors:
  1.  ;
  1.  Q:(Y["CURRENT SMOKER, STATUS UNKNOWN") 1
  1.  Q:(Y["CURRENT SMOKER, EVERY DAY") 1
  1.  Q:(Y["CURRENT SMOKER, SOME DAY") 1
  1.  Q:(Y["CESSATION-SMOKER") 1
  1.  Q:(Y["HEAVY TOBACCO SMOKER") 1
  1.  Q:(Y["LIGHT TOBACCO SMOKER") 1
  1.  ;
  1.  ;---> Patient does NOT have a SMOKER Health Factor 2 years prior to the Forecast Date.
  1.  Q 0
  1.  ;**********
  1.  ;
  1.  ;
  1.  ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
  1.  ;---> New code from Lori Butcher to check for Diabetes (rtn: CIMZDMCK).
  1. V2DM(P,BDATE,EDATE) ;EP - are there 2 visits with DM?
  1.  ;P is Patient DFN
  1.  ;BDATE  - beginning date to look default is DOB
  1.  ;EDATE - end date to look default is DT
  1.  I '$G(P) Q ""
  1.  I '$D(^AUPNVSIT("AC",P)) Q ""  ;patient has no visits
  1.  I '$G(BDATE) S BDATE=$$DOB^AUPNPAT(P)
  1.  I '$G(EDATE) S EDATE=DT
  1.  NEW T,BIREF,PDA,PIEN,CDX,VST,VDT,IBDATE,IEDATE,V,G  ;IHS/CMI/LAB/maw - modified and added lines to speed up the process
  1.  ;K ^TMP($J,"A")
  1.  ;S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  ;I '$D(^TMP($J,"A",1)) Q ""  ;no visits returned
  1.  S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
  1.  I 'T Q ""
  1.  ;IHS/CMI/LAB - added lines below for icd10
  1.  ;MWRZZZ  COMMENT OUT NEXT LINE, ADD ONE AFTER.
  1.  ;I $D(^ICDS(0)) D
  1.  I $D(^ICDS(0)),$T(^ATXAPI)]"" D
  1.  .K ^TMP($J,"BITAX")  ;IHS/CMI/LAB - clean out old nodes just in case
  1.  .S BIREF=$NA(^TMP($J,"BITAX"))  ;IHS/CMI/LAB
  1.  .D BLDTAX^ATXAPI("SURVEILLANCE DIABETES",BIREF,T)
  1.  ;S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>1)  S V=$P(^TMP($J,"A",X),U,5) D
  1.  ;.Q:'$D(^AUPNVSIT(V,0))
  1.  ;.Q:'$P(^AUPNVSIT(V,0),U,9)  ;0 DEPENDENT ENTRIES
  1.  ;.Q:$P(^AUPNVSIT(V,0),U,11)  ;DELETED VISIT
  1.  ;.Q:"SAHOR"'[$P(^AUPNVSIT(V,0),U,7)  ;ELIMINATE TELEPHONE CALLS, CHART REVIEWS, ETC
  1.  ;.S (D,Y)=0 F  S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D)  I $D(^AUPNVPOV(Y,0)) D
  1.  ;..S %=$P(^AUPNVPOV(Y,0),U)
  1.  ;S (PDA,G)=0 F  S PDA=$O(^AUPNVPOV("AC",P,PDA)) Q:'PDA!(G>1)  D
  1.  ;. S CDX=$P($G(^AUPNVPOV(PDA,0)),U)
  1.  S IBDATE=9999999-BDATE
  1.  S IEDATE=9999999-EDATE
  1.  S G=0
  1.  K V
  1.  S PDA=IEDATE-1 F  S PDA=$O(^AUPNVPOV("AA",P,PDA)) Q:'PDA!(PDA>IBDATE)!(G>1)  D
  1.  . S PIEN=0 F  S PIEN=$O(^AUPNVPOV("AA",P,PDA,PIEN)) Q:'PIEN  D
  1.  .. S CDX=$P($G(^AUPNVPOV(PIEN,0)),U)
  1.  .. Q:'CDX
  1.  .. I $D(^TMP($J,"BITAX")) Q:'$D(^TMP($J,"BITAX",CDX))
  1.  .. I '$D(^TMP($J,"BITAX")) Q:'$$ICD^ATXCHK(CDX,T,9)
  1.  .. S VST=$P($G(^AUPNVPOV(PIEN,0)),U,3)
  1.  .. Q:'VST  ;HAPPENS
  1.  .. Q:'$D(^AUPNVSIT(VST,0))
  1.  .. Q:"SAHOR"'[$P(^AUPNVSIT(VST,0),U,7)  ;ELIMINATE TELEPHONE CALLS, CHART REVIEWS, ETC
  1.  .. I '$D(V(VST)) S V(VST)="",G=G+1
  1.  K ^TMP($J,"BITAX")
  1.  ;Q 1  ;for testing a positive hit on Diabetes.
  1.  Q $S(G<2:"",1:1)
  1.  ;**********
  1.  ;
  1.  ;----------
  1. TEST ;
  1.  ;D ^%T
  1.  ;S P=0 F  S P=$O(^AUPNPAT(P)) Q:P'=+P  S X=$$HASDX(P,"BI HIGH RISK PNEUMO",2,3020101,DT) W ".",X
  1.  ;S P=0 F  S P=$O(^AUPNPAT(P)) Q:P'=+P  S X=$$V2DM(P,,) I X S ^LORIHAS(P)="" W ".",P
  1.  ;D ^%T
  1.  ;Q