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