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