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

BIPATUP1.m

Go to the documentation of this file. 
  1. BIPATUP1 ;IHS/CMI/MWR - UPDATE PATIENT DATA; DEC 15, 2011
  1.  ;;8.5;IMMUNIZATION;**14**;AUG 01,2017
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  UPDATE PATIENT DATA, IMM FORECAST IN ^BIPDUE(.
  1.  ;;  PATCH 8: Extensive changes to accommodate new TCH Forecaster   LDFORC+0
  1.  ;;  PATCH 9: Numerous changes to accomodate new Heb B High Risk  IHSPOST+0
  1.  ;;  PATCH 10: Recognize both TCH incoming 33 PNEUMO-PS or 133 PCV-13. DDUE2+56
  1.  ;;  PATCH 12: If Dose Override is Invalid (1-4) forecast Pneumo.  IHSPOST+30
  1.  ;;  PATCH 13: Do not forecast Flu before local Flu Season Start Date.  DDUE2+46
  1.  ;;  PATCH 14: Mods to add IHS Forecast Addendum to TCH Report.  LDFORC+0, IHSPOST+0
  1.  ;;            Only CVX 33 should satisfy Pneumo High Risk. IHSPOST+39
  1.  ;
  1.  ;
  1.  ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
  1.  ;---> IHS Forecast Addendum to TCH Report.
  1.  ;----------
  1. LDFORC(BIDFN,BIFORC,BIHX,BIFDT,BIDUZ2,BINF,BIPDSS,BIADDND) ;EP
  1.  ;---> Load Immserve Data (Immunizations Due) into ^BIPDUE(.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient IEN.
  1.  ;     2 - BIFORC (req) String containing Patient's Imms Due.
  1.  ;     3 - BIHX   (req) String containing Patient's Imm History.
  1.  ;     4 - BIFDT  (opt) Forecast Date (date used for forecast).
  1.  ;     5 - BIDUZ2 (opt) User's DUZ(2) indicating site parameters.
  1.  ;     6 - BINF   (opt) Array of Vaccine Grp IEN'S that should not be forecast.
  1.  ;     7 - BIPDSS (ret) Returned string of V IMM IEN's that are
  1.  ;                      Problem Doses, according to ImmServe.
  1.  ;     8 - BIADDND(ret) IHS forecasting addendum (to be added to TCH Report).
  1.  ;
  1.  Q:'$G(BIDFN)  Q:$G(BIFORC)=""  Q:$G(BIHX)=""
  1.  ;---> If no Forecast Date passed, set it equal to today.
  1.  S:'$G(BIFDT) BIFDT=DT S:'$D(BINF) BINF=""
  1.  ;
  1.  ;---> First clear out any previously set Immunizations Due and
  1.  ;---> any Forecasting Errors for this patient.
  1.  D KILLDUE^BIPATUP2(BIDFN)
  1.  ;
  1.  ;---> If no BIDUZ2, try DUZ(2); otherwise, defaults will be used.
  1.  S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Check for any input doses that TCH identified as problems.
  1.  ;---> Build and return a string of "V IMM IEN_%_CVX" problem doses,
  1.  ;---> as identified in the TCH Input Doses segment.
  1.  D DPROBS^BIPATUP2(BIFORC,.BIPDSS)
  1.  ;**********
  1.  ;
  1.  ;---> Seed BITCHAF to collect
  1.  N BITCHAF S BITCHAF=""
  1.  ;
  1.  ;---> Parse Doses Due from Forecaster string (BIFORC), perform any
  1.  ;---> necessary translations, and set as due in patient global ^BIPDUE(.
  1.  D DDUE(BIFORC,BIHX,.BINF,BIDUZ2,BIFDT,.BITCHAF)
  1.  ;
  1.  ;---> After loading (SETDUE) TCH forecast, perform any follow-up forecasting
  1.  ;---> needed for High Risk, "Post-forecast".
  1.  D IHSPOST(BIDFN,BIHX,BIFDT,BIDUZ2,.BINF,BITCHAF,.BIADDND)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DDUE(BIFORC,BIHX,BINF,BIDUZ2,BIFDT,BITCHAF) ;EP
  1.  ;---> Parse Doses Due from Immserve string (BIFORC), perform any
  1.  ;---> necessary translations, and set as due in patient global ^BIPDUE.
  1.  ;---> Parameters:
  1.  ;     1 - BIFORC  (req) Forecast string coming back from TCH.
  1.  ;     2 - BIHX    (req) String containing Patient's Imm History.
  1.  ;     3 - BINF    (opt) Array of Vaccine Grp IEN'S that should not be forecast.
  1.  ;     4 - BIDUZ2  (opt) User's DUZ(2) indicating site parameters.
  1.  ;     5 - BIFDT   (opt) Forecast Date (date used for forecast).
  1.  ;     6 - BITCHAF (ret) [1=TCH Already Forecast Pneumo (33), [2=HepB(45), [3=HepA(85).
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Changes to accommodate new TCH Forecaster parsing.
  1.  N BIFORC1,BIDOSE,N
  1.  S BIFORC1=$P(BIFORC,"~~~",3)
  1.  ;
  1.  F N=1:1 S BIDOSE=$P(BIFORC1,"|||",N) Q:(BIDOSE="")  D
  1.  .D DDUE2(BIDOSE,BIHX,.BINF,.BIPC,BIDUZ2,BIFDT,.BITCHAF)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DDUE2(BIDOSE,BIHX,BINF,BIPC,BIDUZ2,BIFDT,BITCHAF) ;EP
  1.  ;---> Parse Doses Due (see linelabel DDUE above).
  1.  ;---> Parameters: See DDUE immediately above!
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Many changes below to accommodate new TCH Forecaster.
  1.  ;
  1.  ;---> Uncomment next line to see raw Doses Due:
  1.  ;W !!!,BIDOSE R ZZZ
  1.  ;
  1.  N A,BI,D,X S X=BIDOSE
  1.  ;---> A=CVX Code
  1.  S A=$P(X,U,1)
  1.  ;
  1.  ;---> "PAST"=Past Due Indicator
  1.  S BI("PAST")=$P(X,U,3)
  1.  ;
  1.  ;---> Get Fileman formats of due dates.
  1.  ;---> "MIN"=Minimum Date Due
  1.  S BI("MIN")=$$TCHFMDT^BIUTL5($P(X,U,4)) S:('BI("MIN")) BI("MIN")=""
  1.  ;
  1.  ;---> "REC"=Recommended Date Due
  1.  S BI("REC")=$$TCHFMDT^BIUTL5($P(X,U,5)) S:('BI("REC")) BI("REC")=""
  1.  ;
  1.  ;---> "EXC"=Exceeds Date Due
  1.  S BI("EXC")=$$TCHFMDT^BIUTL5($P(X,U,6)) S:('BI("EXC")) BI("EXC")=""
  1.  ;
  1.  ;---> Determine whether to set Recommended Age or Minimum Accepted Age
  1.  ;---> based on Site Parameter.
  1.  S BI("DUE")=BI("REC")
  1.  I $$MINAGE^BIUTL2($G(BIDUZ2))=1 S BI("DUE")=BI("MIN")
  1.  ;
  1.  ;---> If this dose is past due (BI("PAST")=1), D(2) will stuff DATE PAST DUE;
  1.  ;---> Otherwise, D(1) will stuff RECOMMENDED DATE DUE.
  1.  S (D(1),D(2))="" D
  1.  .I BI("PAST") S D(2)=BI("EXC") Q
  1.  .S D(1)=BI("DUE")
  1.  ;
  1.  ;---> *** TRANSLATIONS OF INCOMING IMMSERVE VACCINES:
  1.  ;--->     -------------------------------------------
  1.  Q:A=""
  1.  ;
  1.  ;---> Check to see if Site specified do not forecast this Vaccine Group.
  1.  Q:$D(BINF($$HL7TX^BIUTL2(A,1)))
  1.  ;
  1.  ;
  1.  ;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR
  1.  ;---> Do not forecast Flu (CVX 88) before local Flu Season Start Date, regardless of
  1.  ;---> Min vs. Rec site parameter #8.
  1.  I A=88,$E($G(BIFDT),4,5)>6 Q:(BIFDT<($E(BIFDT,1,3)_$TR($P($$FLUDATS^BIUTL8(BIDUZ2),"%"),"/")))
  1.  ;**********
  1.  ;
  1.  ;---> Add this Immunization Due.
  1.  D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(A)_U_U_D(1)_U_D(2))
  1.  ;
  1.  ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
  1.  ;---> Use BITCHAF to track TCH forecasting of Pneumo, Hep A and Hep B.
  1.  ;
  1.  ;---> Pneumo 33 OR 133 was forecast by TCH.
  1.  I (A=33)!(A=133) S BITCHAF=BITCHAF_1
  1.  ;---> Hep B was forecast by TCH.
  1.  I A=45 S BITCHAF=BITCHAF_2
  1.  ;---> Hep A was forecast by TCH.
  1.  I A=85 S BITCHAF=BITCHAF_3
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
  1.  ;---> Extensive changes.
  1.  ;----------
  1. IHSPOST(BIDFN,BIHX,BIFDT,BIDUZ2,BINF,BITCHAF,BIADDND) ;EP
  1.  ;---> Post forecast; after loading  TCH forecast, perform any follow-up forecasting
  1.  ;---> needed for High Risk.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient IEN.
  1.  ;     2 - BIHX    (req) String containing Patient's Imm History.
  1.  ;     3 - BIFDT   (req) Forecast Date (date used for forecast).
  1.  ;     4 - BIDUZ2  (req) User's DUZ(2) for High Risk Site Parameter.
  1.  ;     5 - BINF    (opt) Array of Vaccine Grp IEN'S that should not be forecast.
  1.  ;     6 - BIADDND (ret) IHS forecasting addendum (to be added to TCH Report).
  1.  ;
  1.  ;---> Loop through History string, gathering previous Influenzas and Pneumos.
  1.  ;
  1.  N BIDOSE,BIFLU,BIHX1,I,X,Y
  1.  S BIHX1=$P(BIHX,"~~~",2)
  1.  ;
  1.  ;---> Loop through RPMS Input String History, collecting for prior Pneumo.
  1.  ;---> Store in BIFLU by HL7 Code, inverse date.
  1.  ;F I=1:1:Y D
  1.  F I=1:1  S BIDOSE=$P(BIHX1,"|||",I) Q:BIDOSE=""  D
  1.  .;
  1.  .;---> For this Immunization, set A=CVX Code, D=Date.
  1.  .N A,D S A=$P(BIDOSE,U,2),D=$P(BIDOSE,U,3)
  1.  .;
  1.  .;---> Quit if Dose Override is Invalid (1-4).
  1.  .I $P(BIDOSE,U,4),$P(BIDOSE,U,4)<9 Q
  1.  .;
  1.  .;---> If this is Hep B or Hep A,
  1.  .;---> translate and store it in local array BIFLU(CVX,Inverse Fm date).
  1.  .;---> (Pneumo (33,100,109,133,152) not translated.)
  1.  .;
  1.  .;---> Collect Hep B CVX's.
  1.  .S:((A=8)!(A=42)!(A=44)!(A=43)!(A=43)!(A=51)!(A=102)) A=45
  1.  .S:((A=104)!(A=110)!(A=132)!(A=146)) A=45
  1.  .;
  1.  .;---> Collect Hep A CVX's.
  1.  .S:((A=31)!(A=52)!(A=83)!(A=84)!(A=104)!(A=169)) A=85
  1.  .;
  1.  .;---> Save any Pneumo, Hep B, or Hep A.
  1.  .D:((A=33)!(A=100)!(A=109)!(A=133)!(A=152)!(A=45)!(A=85))
  1.  ..S BIFLU(A,9999999-$$TCHFMDT^BIUTL5(D))=""
  1.  ;
  1.  ;
  1.  ;---> Check for THIS PATIENT: forced Pneumo or Disregard all Risk Factors.
  1.  ;---> BIFFLU: 0=Normal, 1=not used, 2=Force Pneumo, 3=not used, 4=Disregard Risk Factors.
  1.  S BIFFLU=$$INFL^BIUTL11(BIDFN)
  1.  ;---> Quit (don't check Risk Factors) if BIFFLU=4, Disregard Risk Factors for this patient.
  1.  Q:BIFFLU=4
  1.  ;
  1.  ;---> Quit if SITE PARAMETER says NOT to include any Risk Factors in forecast (returns 0).
  1.  N BIRISK S BIRISK=$$RISKP^BIUTL2(BIDUZ2)
  1.  Q:'BIRISK
  1.  ;
  1.  S:'$G(BIFDT) BIFDT=$G(DT)
  1.  ;
  1.  ;---> Set Patient Age in years for this Forecast Date.
  1.  N BIAGE S BIAGE=$$AGE^BIUTL1(BIDFN,1,BIFDT)
  1.  ;
  1.  ;---> No High Risk computation under 19 years.
  1.  Q:(BIAGE<19)
  1.  ;
  1.  ;
  1.  ;---> * * * Forecast Pneumo for High Risk if needed. * * *
  1.  D
  1.  .;---> Quit if CVX 33 is in the history (satisfies both Early Pneumo and High Risk.)
  1.  .Q:($D(BIFLU(33)))
  1.  .;
  1.  .;---> Quit if TCH already forecast Pneumo (33).
  1.  .Q:(BITCHAF[1)
  1.  .;---> Quit if Site Parameter does not include Pneumo.
  1.  .Q:(BIRISK'[1)
  1.  .;---> Check if Site Parameter includes Smoking (includes 9).
  1.  .N BIRISKF,BISMKR S BISMKR=$S(BIRISK[9:1,1:0)
  1.  .;---> Check for High Risk.
  1.  .D RISKP^BIDX(BIDFN,BIFDT,BIAGE,BISMKR,.BIRISKF)
  1.  .;
  1.  .;---> Set Early Forecast or High Risk if needed.
  1.  .D IHSPNEU^BIPATUP3(BIDFN,.BIFLU,BIFFLU,.BINF,BIFDT,BIAGE,BIDUZ2,BIRISKF,.BIADDND)
  1.  ;
  1.  ;
  1.  ;---> * * * Forecast Hep B for Diabetes if needed. * * *
  1.  D
  1.  .;---> Quit if Hep B (45) is in the history, ever received a Hep B.
  1.  .Q:($D(BIFLU(45)))
  1.  .;---> Quit if TCH already forecast Hep B (45).
  1.  .Q:(BITCHAF[2)
  1.  .;---> Quit if Site Parameter does not include Hep B for Diabetes.
  1.  .Q:(BIRISK'[2)
  1.  .;---> Quit if this Pt Age is older than 60 yrs, regardless of risk.
  1.  .Q:(BIAGE>59)
  1.  .;---> Check for High Risk.
  1.  .N BIRISKF
  1.  .D RISKB^BIDX(BIDFN,BIFDT,BIAGE,.BIRISKF)
  1.  .Q:'BIRISKF
  1.  .;---> Set Early Forecast or High Risk if needed.
  1.  .D IHSHEPB^BIPATUP3(BIDFN,.BINF,BIFDT,1,.BIADDND)
  1.  .S BITCHAF=BITCHAF_2
  1.  ;
  1.  ;
  1.  ;--->  * * * Forecast Hep A & B for CLD/HepC if needed. * * *
  1.  D
  1.  .;---> Quit if Hep A (85) and Hep B (45) are BOTH in the history.
  1.  .Q:($D(BIFLU(85))&$D(BIFLU(45)))
  1.  .;---> Quit if Site Parameter does not include Hep A&B for CLD/HepC.
  1.  .Q:(BIRISK'[3)
  1.  .;
  1.  .;---> Check for High Risk.
  1.  .N BIRISKF
  1.  .D RISKAB^BIDX(BIDFN,BIFDT,.BIRISKF)
  1.  .Q:'BIRISKF
  1.  .;
  1.  .;---> If TCH did NOT already forecast Hep B (45), forecast Hep B for CLD/HepC.
  1.  .I ('$D(BIFLU(45)))&(BITCHAF'[2) D IHSHEPB^BIPATUP3(BIDFN,.BINF,BIFDT,2,.BIADDND)
  1.  .;
  1.  .;---> If TCH did NOT already forecast Hep A (85), forecast Hep A for CLD/HepC.
  1.  .I ('$D(BIFLU(85)))&(BITCHAF'[3) D IHSHEPA^BIPATUP3(BIDFN,.BINF,BIFDT,,.BIADDND)
  1.  ;
  1.  Q