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

BIPATUP3.m

Go to the documentation of this file. 
  1. BIPATUP3 ;IHS/CMI/MWR - UPDATE PATIENT DATA 2; DEC 15, 2011
  1.  ;;8.5;IMMUNIZATION;**14**;AUG 01,2017
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  IHS FORECAST. UPDATE PATIENT DATA, IMM FORECAST IN ^BIPDUE(.
  1.  ;;  HOLDING RTN IN CASE H1N1 (OR SIMILAR) FORECASTING IS NEEDED IN THE FUTURE.
  1.  ;;  PATCH 1: Clarify Report explanation.  IHSZOS+19
  1.  ;;  PATCH 4, v8.5: Use newer Related Contraindications call to determine
  1.  ;;                 contraindicaton.  IHSZOS+29
  1.  ;;  PATCH 14: Move IHSPNEU & IHSHEPB call here from BIPATUP1 IHSPNEU+00
  1.  ;
  1.  ;
  1.  ;
  1.  ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
  1.  ;---> Move IHSPNEU & IHSHEPB calls from rtn BIPATUP1 and add BIADDND to pass
  1.  ;---> back IHS Addendum text.
  1.  ;----------
  1. IHSPNEU(BIDFN,BIFLU,BIFFLU,BINF,BIFDT,BIAGE,BIDUZ2,BIRISKF,BIADDND) ;EP
  1.  ;---> IHS Pneumo Forecast.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient IEN.
  1.  ;     2 - BIFLU   (req) Pneumo History array: BIFLU(CVX,INVDATE).
  1.  ;     3 - BIFFLU  (req) If =2, for force Pneumo regardless of age.
  1.  ;     4 - BINF    (opt) Array of Vaccine Grp IEN'S that should not be forecast.
  1.  ;     5 - BIFDT   (req) Forecast Date (date used for forecast).
  1.  ;     6 - BIAGE   (req) Patient Age in years for this Forecast Date.
  1.  ;     7 - BIDUZ2  (req) User's DUZ(2) indicating Immserve Forc Rules.
  1.  ;     5 - BIRISKF (req) 1=Patient has High Risk of Pneumo; otherwise 0.
  1.  ;     8 - BIADDND (ret) IHS forecasting addendum (to be added to TCH Report).
  1.  ;
  1.  ;---> NOTE: This call does NOT even get made if TCH has already forecast Pneumo
  1.  ;--->       (LDFORC+72^BIPATUP1).
  1.  ;
  1.  ;---> Quit if Forecasting turned off for Pneumo.
  1.  Q:$D(BINF(11))
  1.  ;
  1.  ;---> Quit if this patient has a contraindication to Pneumo.
  1.  ;********** PATCH 4, v8.5, DEC 01,2012, IHS/CMI/MWR
  1.  N BICT D CONTRA^BIUTL11(BIDFN,.BICT)
  1.  Q:$D(BICT(33))
  1.  ;**********
  1.  ;
  1.  ;---> Quit if this Pt Age <5 yrs or >65 yrs, regardless of risk.
  1.  Q:((BIAGE<5)!(BIAGE>64))
  1.  ;
  1.  ;---> Flag to indicate Pneumo already set.
  1.  N BIFLAG S BIFLAG=0
  1.  ;
  1.  ;---> EARLY PNEUMO * * *
  1.  ;---> Forecast Early Pneumo per Site Parameter.
  1.  D
  1.  .;---> Quit if patient has had ANY Pneumo (NOT just 33 for High Risk).
  1.  .N A,Z S Z=0 F A=33,100,109,133,152 D
  1.  ..I $D(BIFLU(A)) S Z=1
  1.  .Q:Z
  1.  .;---> BIPNAGE=Site Parameter Age to forecast Pneumo ("Pneumo Age") in years.
  1.  .N BIPNAGE S BIPNAGE=$P($$PNMAGE^BIPATUP2(BIDUZ2),U)
  1.  .;---> Quit if patient is less than site parameter age.
  1.  .Q:(BIAGE<BIPNAGE)
  1.  .;---> Set patient due for Pneumo.
  1.  .D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(33)_U_U_BIFDT)
  1.  .S BIADDND=$G(BIADDND)_"|||   Pneumo added per Site Parameter #11 (early Pneumo: "
  1.  .S BIADDND=BIADDND_BIPNAGE_" yrs)."
  1.  .S BIFLAG=1
  1.  ;
  1.  Q:BIFLAG
  1.  ;
  1.  ;---> HIGH RISK * * *
  1.  ;---> Forecast Pneumo if patient has high risk medical conditions and no previous 33.
  1.  ;
  1.  ;---> NOTE: BIFFLU=4 "Disregard Risk Factors" checked at IHSPOST+??^BIPATUP1.
  1.  ;---> If High Risk Pneumo or Forecast for this patient regardless of Age.
  1.  I BIRISKF!(BIFFLU=2) D
  1.  .D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(33)_U_U_BIFDT)
  1.  .I BIRISKF S BIADDND=$G(BIADDND)_"|||   Pneumo added for High Risk Medical Conditions." Q
  1.  .S BIADDND=$G(BIADDND)_"|||   Pneumo added due to manual edit of High Risk for this patient."
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> TCH will forecast routine Pneumo after age 65.
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. IHSHEPB(BIDFN,BINF,BIFDT,BIADDNT,BIADDND) ;EP
  1.  ;---> HS Forecast Hep B.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient IEN.
  1.  ;     2 - BINF    (opt) Array of Vaccine Grp IEN'S that should not be forecast.
  1.  ;     3 - BIFDT   (req) Forecast Date (date used for forecast).
  1.  ;     4 - BIADDNT (opt) Addendum Note parameter: 1=Diabetes, 2=CLD/HepC.
  1.  ;     5 - BIADDND (ret) IHS forecasting addendum (to be added to TCH Report).
  1.  ;
  1.  ;---> Quit if Forecasting turned off for Hep B.
  1.  Q:$D(BINF(4))
  1.  ;
  1.  ;---> Quit if this patient has a contraindication to Hep B.
  1.  N BICT D CONTRA^BIUTL11(BIDFN,.BICT)
  1.  Q:$D(BICT(45))
  1.  ;
  1.  D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(45)_U_U_BIFDT)
  1.  S BIADDND=$G(BIADDND)_"|||   Hep B added for High Risk"
  1.  I $G(BIADDNT)=1 S BIADDND=BIADDND_" due to Diabetes."
  1.  I $G(BIADDNT)=2 S BIADDND=BIADDND_" due to CLD/Hep C."
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. IHSHEPA(BIDFN,BINF,BIFDT,BIADDNT,BIADDND) ;EP
  1.  ;---> IHS Forecast Hep A.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient IEN.
  1.  ;     2 - BINF    (opt) Array of Vaccine Grp IEN'S that should not be forecast.
  1.  ;     3 - BIFDT   (req) Forecast Date (date used for forecast).
  1.  ;     4 - BIADDNT (opt) Addendum Note parameter: not used for Hep A at this time.
  1.  ;     5 - BIADDND (ret) IHS forecasting addendum (to be added to TCH Report).
  1.  ;
  1.  ;---> Quit if Forecasting turned off for Hep B.
  1.  Q:$D(BINF(4))
  1.  ;
  1.  ;---> Quit if this patient has a contraindication to Hep B.
  1.  N BICT D CONTRA^BIUTL11(BIDFN,.BICT)
  1.  Q:$D(BICT(85))
  1.  ;
  1.  D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(85)_U_U_BIFDT)
  1.  S BIADDND=$G(BIADDND)_"|||   Hep A added for High Risk due to CLD/Hep C."
  1.  Q
  1.  ;
  1.  ;
  1.  ; * * * CODE BELOW NO LONGER USED. * * *
  1.  ;
  1.  ;----------
  1. IHSZOS(BIDFN,BIFLU,BIFFLU,BIRISKP,BINF,BIFDT,BIAGE,BIDUZ2) ;EP
  1.  ;---> IHS Zoster Forecast.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient IEN.
  1.  ;     2 - BIFLU   (req) Influ and Pneumo History array: BIFLU(CVX,INVDATE).
  1.  ;     3 - BIFFLU  (req) Value (0-4) for force Flu/Pneumo regardless of age.
  1.  ;     4 - BIRISKP (req) 1=Patient has Risk of Pneumo; otherwise 0.
  1.  ;     5 - BINF    (opt) Array of Vaccine Grp IEN'S that should not be forecast.
  1.  ;     6 - BIFDT   (req) Forecast Date (date used for forecast).
  1.  ;     7 - BIAGE   (req) Patient Age in months for this Forecast Date.
  1.  ;     8 - BIDUZ2  (req) User's DUZ(2) indicating Immserve Forc Rules.
  1.  ;
  1.  ;
  1.  ;---> Quit if this Pt Age <60 months (5yrs), regardless of risk.
  1.  Q:BIAGE<720
  1.  ;
  1.  ;---> Quit if Site Parameter 11 says NO to Zoster forecast.
  1.  ;---> (According to Amy, shutting down Varicella Group should not disable Zoster.)
  1.  ;
  1.  ;********** PATCH 1, v8.5, JAN 03,2012, IHS/CMI/MWR
  1.  ;---> Use passed parameter BIDUZ2 to avoid <UNDEF> of BISITE.
  1.  ;Q:('$$ZOSTER^BIPATUP2(BISITE))
  1.  ;---> Next line commented out because SAC Checker doesn't like $$, but doesn't
  1.  ;---> matter since this call isn't in use (TCH does Zoster).
  1.  ;Q:('$$ZOSTER^BIPATUP2(BIDUZ2))
  1.  ;**********
  1.  ;
  1.  ;---> Quit if patient has a previous Zoster.
  1.  Q:$D(BIFLU(121))
  1.  ;
  1.  ;---> Quit if this patient has a contraindication to Zoster.
  1.  ;********** PATCH 4, v8.5, DEC 01,2012, IHS/CMI/MWR
  1.  ;---> Use newer Related Contraindications call to determine contraindication.
  1.  ;Q:$$CONTR^BIUTL11(BIDFN,227)
  1.  N BICT D CONTRA^BIUTL11(BIDFN,.BICT)
  1.  Q:$D(BICT(121))
  1.  ;**********
  1.  ;
  1.  ;---> Forecast Zoster.
  1.  D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(121)_U_U_BIFDT)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. IHSH1N1(BIDFN,BIFLU,BIFFLU,BIRISKI,BINF,BIFDT,BIAGE,BIIMMH1,BILIVE) ;EP
  1.  ;---> IHS H1N1 Forecast.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient IEN.
  1.  ;     2 - BIFLU   (req) Influ, Pneumo, and H1N1 History array: BIFLU(CVX,INVDATE).
  1.  ;     3 - BIFFLU  (req) * NOT USED FOR NOW! *
  1.  ;                       Value (0-4) for force Flu/Pneumo regardless of age.
  1.  ;     4 - BIRISKI (req) 1=Patient has Risk of Influenza; otherwise 0.
  1.  ;     5 - BINF    (opt) Array of Vaccine Grp IEN'S that should not be forecast.
  1.  ;     6 - BIFDT   (req) Forecast Date (date used for forecast).
  1.  ;     7 - BIAGE   (req) Patient Age in months for this Forecast Date.
  1.  ;     8 - BIIMMH1 (opt) BIIMMFL=1 means Immserve already forecast H1N1.
  1.  ;     9 - BILIVE  (opt) 1-Patient received a LIVE vaccine <28 days before
  1.  ;                       the forecast date.
  1.  ;
  1.  ;---> Quit if Forecasting turned off for H1N1.
  1.  Q:$D(BINF(18))
  1.  ;
  1.  ;---> Quit if Immserve already forecast H1N1.
  1.  Q:$G(BIIMMH1)
  1.  ;
  1.  ;***********************************************************
  1.  ;********** PATCH 4, v8.3, DEC 30,2009, IHS/CMI/MWR
  1.  ;---> PATCH: No longer consider live vaccine factor in H1N1 forecasting.
  1.  ;---> Quit if patient received a LIVE vaccine <28 days before forecast date.
  1.  ;---> Also quit if patient received Flu-nasal CVX 111 on the Forecast Date.
  1.  ;Q:$G(BILIVE)
  1.  ;***********************************************************
  1.  ;
  1.  ;---> Set numeric Year, Month, and MonthDay.
  1.  N BIYEAR,BIMTH,BIMDAY
  1.  S BIYEAR=$E(BIFDT,1,3),BIMTH=$E(BIFDT,4,5),BIMDAY=+$E(BIFDT,4,7)
  1.  ;
  1.  ;---> Quit if the Forecast Date is not between Oct 1 and April 30.
  1.  Q:((BIMDAY<1001)&(BIMDAY>430))
  1.  ;
  1.  ;---> Quit if this patient has a contraindication to H1N1.
  1.  N BICONTR D CONTRA^BIUTL11(BIDFN,.BICONTR)
  1.  Q:$D(BICONTR(125))
  1.  ;
  1.  ;---> Change: Quit if patient is <6 months.
  1.  Q:BIAGE<6
  1.  ;
  1.  ;---> Get value for forced Influenza regardless of age.
  1.  ;S:(31'[BIFFLU) BIFFLU=0
  1.  ;
  1.  ;---> Quit if over 65 yrs old and no previous H1N1 dose (regardless of risk).
  1.  Q:((BIAGE>779)&('$D(BIFLU(125))))
  1.  ;
  1.  ;---> Forecast H1N1 up to 25 yrs old, and over 50 yrs.
  1.  ;---> Quit if not age appropriate and no risk and not forced and no previous H1N1 dose.
  1.  Q:((BIAGE>299)&('BIRISKI)&('BIFFLU)&('$D(BIFLU(125))))
  1.  ;
  1.  ;***********************************************************
  1.  ;********** PATCH 4, v8.3, DEC 30,2009, IHS/CMI/MWR
  1.  ;
  1.  ;---> Quit if patient is 10yrs or older and has a one H1N1 already.
  1.  ;Q:((BIAGE>120)&($D(BIFLU(125))))
  1.  Q:((BIAGE'<120)&($D(BIFLU(125))))
  1.  ;
  1.  ;---> PATCH: Quit if the patient has had 2 doses.
  1.  N M,N S M=0,N=0
  1.  F  S M=$O(BIFLU(125,M)) Q:'M  S N=N+1
  1.  Q:(N>1)
  1.  ;***********************************************************
  1.  ;
  1.  N X,X1,X2
  1.  S X1=BIFDT,X2=9999999-$O(BIFLU(125,0)) S:X2=9999999 X2=0
  1.  D ^%DTC
  1.  ;---> Quit if patient received a H1N1 shot today.
  1.  Q:X=0
  1.  ;---> Quit if patient had a H1N1 vac <28 days prior to Forecast date.
  1.  Q:((X>0)&(X<28))
  1.  ;
  1.  ;---> X must be either null (never had flu shot) or negative (had
  1.  ;---> a shot recently, but AFTER the Forecast Date).
  1.  ;
  1.  ;---> If not Jan, Feb, or March, then due date=Apr 30 of the new year.
  1.  S:BIMDAY>430 BIYEAR=BIYEAR+1
  1.  ;---> Due by April 30.
  1.  N BIDUEDT S BIDUEDT=BIYEAR_0430
  1.  ;---> Set CVX 127 due by April 30.
  1.  D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(127)_U_U_BIYEAR_"0430")
  1.  Q