Routine: BIEXPRT6

BIEXPRT6 ;IHS/CMI/MWR - EXPORT IMMUNIZATION RECORDS; OCT 15, 2010

 ;;8.5;IMMUNIZATION;**13**;AUG 01,2016

 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 ;;  EXPORT IMMUNIZATION RECORDS: BUILD PATIENT HISTORY EXPORT FOR FORECASTING.

 ;;  CALLED BY BIEXPRT3.

 ;;  PATCH 8: New routine to accommodate new TCH Forecaster   TCHHIST+0

 ;;  PATCH 13: Pass Flu Season Start & End Dates to TCH.  TCHHIST+128

 ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR

 ;---> New Entry Point called from HISTORY+99^BIEXPRT3.

 ;----------

TCHHIST(BIFDT,BIDUZ2,BINF) ;EP

 ;---> Called by BIEXPRT3.

 ;---> Construct ^BITMP($J,2 nodes for Forecast exports from the

 ;---> ^BITMP($J,1 nodes (gathered in ^BIEXPRT2).

 ;---> This prepares the string of Patient Data to be sent to

 ;---> TCH for forecasting.

 ;---> Parameters:

 ;     1 - BIFDT  (opt) Forecast Date (date used to calc Imms due).

 ;     2 - BIDUZ2 (opt) User's DUZ(2) for BISITE parameters,

 ;                      which affect forecasting rules.

 ;     3 - BINF   (opt) Array of Vaccine IEN's that should not be forecast.

 ;---> If no Forecast Date passed, set it equal to today.

 S:'$G(BIFDT) BIFDT=DT

 ;---> If no BIDUZ2, try DUZ(2); otherwise, defaults will be used.

 S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))

 N BIDFN S BIDFN=0

 F  S BIDFN=$O(^BITMP($J,1,BIDFN)) Q:'BIDFN  D

 .N BIAGE,BIDOSES,BITMP1 S BIDOSES=0

 .;---> Set Patient Age in Years for this Forecast Date.

 .S BIAGE=$$AGE^BIUTL1(BIDFN,1,BIFDT)

.;

 .;---> Date used for Forecast (Field 1).

 .S BITMP1=$$FMTCHDT^BIUTL5(BIFDT)

.;

 .;---> Forecasting Mode: Minimum vs. Recommended Age (Field 2).

 .S BITMP1=BITMP1_U_$$MINAGE^BIUTL2(BIDUZ2)

.;

 .;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR

 .;---> Transmit Grace Period option instead of version.

 .;---> Version (Field 3).

 .;S BITMP1=BITMP1_U_$$RULES^BIUTL2(BIDUZ2)

 .;---> Grace Period (Field 3).

 .S BITMP1=BITMP1_U_$P($G(^BISITE(BIDUZ2,0)),U,21)

.;

 .;---> Reserved for future use (Field 4).

 .S BITMP1=BITMP1_U_0

.;

 .;---> Reserved for future use (Field 5).

 .S BITMP1=BITMP1_U_0

.;

 .;---> Personal ID: Patient Name and Chart# (Field 6)

 .S BITMP1=BITMP1_U_$$NAME^BIUTL1(BIDFN)

 .S BITMP1=BITMP1_"  Chart#: "_$$HRCN^BIUTL1(BIDFN)

.;

 .;---> User Note: DFN  (Field 7)

 .S BITMP1=BITMP1_U_BIDFN

.;

 .;---> Date of Birth (Field 8).

 .S BITMP1=BITMP1_U_$$FMTCHDT^BIUTL5($$DOB^BIUTL1(BIDFN))

.;

 .;---> Gender (Field 9).

 .S BITMP1=BITMP1_U_$$SEXW^BIUTL1(BIDFN)

.;

 .;---> Mother HBsAg Status: P,N,U,A  (Field 10).

 .S BITMP1=BITMP1_U_$$MOTHER^BIUTL11(BIDFN)

.;

 .;---> Build array of contraindicated HL7 Codes for this Patient.

 .N BICT D CONTRA^BIUTL11(BIDFN,.BICT)

.;

 .;---> Pertussis Indication (Field 11).

.D

 ..;---> If patient has contra to DTP or DTaP, pass contra to pertussis.

 ..N I,J S J=0 F I=1,11,20 I $D(BICT(I)) S J=1 Q

 ..S BITMP1=BITMP1_U_J

.;

 .;---> Diphtheria Indication (Field 12).

.D

 ..;---> If pt has contra to DT-PEDS or TD-Adult, pass contra to Diph.

 ..N I,J S J=0 F I=28,9 I $D(BICT(I)) S J=1 Q

 ..S BITMP1=BITMP1_U_J

.;

 .;---> Tetanus Indication (Field 13).

.D

 ..;---> If pt has contra to TET TOX,

 ..;---> pass contra to Tetanus.

 ..N I,J S J=0 F I=28,9,35 I $D(BICT(I)) S J=1 Q

 ..S BITMP1=BITMP1_U_J

.;

 .;---> Hib Indication (Field 14).

.D

 ..;---> If pt has contra to any HIB, pass contra to HIB.

 ..N I,J S J=0 F I=17,46,47,48,49 I $D(BICT(I)) S J=1 Q

 ..S BITMP1=BITMP1_U_J

.;

 .;---> HBIG Indication (Field 15).

 .S BITMP1=BITMP1_U_$S($D(BICT(30)):1,1:0)

.;

 .;---> HepB Indication (Field 16).

 .S BITMP1=BITMP1_U_$S($D(BICT(45)):1,1:0)

.;

 .;---> OPV Indication (Field 17).

 .;---> 2003: ImmServe no longer forecasts OPV.

 .;S BITMP1=BITMP1_U_$S($D(BICT(2)):1,$D(BINF(2)):1,1:0)

 .S BITMP1=BITMP1_U_0

.;

 .;---> IPV Indication (Field 18).

 .S BITMP1=BITMP1_U_$S($D(BICT(10)):1,1:0)

.;

 .;---> Measles Indication (Field 19).

 .S BITMP1=BITMP1_U_$S($D(BICT(5)):1,1:0)

.;

 .;---> Mumps Indication (Field 20).

 .S BITMP1=BITMP1_U_$S($D(BICT(7)):1,1:0)

.;

 .;---> Rubella Indication (Field 21).

 .S BITMP1=BITMP1_U_$S($D(BICT(6)):1,1:0)

.;

 .;---> Varicella Indication (Field 22).

 .S BITMP1=BITMP1_U_$S($D(BICT(21)):1,1:0)

.;

 .;---> HepA Indication (Field 23).

 .S BITMP1=BITMP1_U_$S($D(BICT(85)):1,1:0)

.;

 .;---> Rotavirus Indication (Field 24).

 .S BITMP1=BITMP1_U_$S($D(BICT(74)):1,1:0)

.;

 .;---> Pneumococcal Indication (Field 25).

 .;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR

 .;---> Add ALL Pneumos.

.D

 ..;---> If pt has contra to any Pneumo, pass contra to Pneumo.

 ..N I,J S J=0 F I=33,100,109,133 I $D(BICT(I)) S J=1 Q

 ..S BITMP1=BITMP1_U_J

.;

 .;---> Influenza Indication (Field 26).

 .;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR

 .;---> Pass Flu Season Start & End Dates to TCH.

 .;S BITMP1=BITMP1_U_$S($D(BICT(88)):1,1:0)

.D

 ..;---> If Flu contraindicated, concat 1 and quit.

 ..I $D(BICT(88)) S BITMP1=BITMP1_U_1 Q

 ..;---> Pass Site's Flu season dates.

 ..S BITMP1=BITMP1_U_$$FLUDATS^BIUTL8(BIDUZ2)

 .;**********

.;

 .;---> Meningococcal Indication (Field 27).

 .S BITMP1=BITMP1_U_$S($D(BICT(32)):1,1:0)

.;

 .;---> HPV Indication (Field 28).

 .S BITMP1=BITMP1_U_$S($D(BICT(62)):1,1:0)

.;

 .;---> H1N1 Indication (Field 29).

.D

 ..;---> If pt has contra to any H1N1, pass contra to H1N1.

 ..N I,J S J=0 F I=125,126,127,128 I $D(BICT(I)) S J=1 Q

 ..S BITMP1=BITMP1_U_J

.;

 .;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR

 .;---> Add Zoster Contraindication field.

 .;---> Zoster Indication (Field 30).

 .S BITMP1=BITMP1_U_$S($D(BICT(121)):1,1:0)

.;

 .;---> Delimiter between Patient Case Data and Imm History Doses.

 .S BITMP1=BITMP1_U_"~~~"

 .;**********

.;

.;

 .N BIMM,BITMP S BIMM=0,BITMP=""

 .F  S BIMM=$O(^BITMP($J,1,BIDFN,BIMM)) Q:'BIMM  D

 ..N BIDATE,Y S BIDATE=0

 ..F  S BIDATE=$O(^BITMP($J,1,BIDFN,BIMM,BIDATE)) Q:'BIDATE  D

 ...N BIVIMM,Y S BIVIMM=0

 ...F  S BIVIMM=$O(^BITMP($J,1,BIDFN,BIMM,BIDATE,BIVIMM)) Q:'BIVIMM  D

 ....;---> Tack on V Imm IEN for matching ImmServe History.

 ....N BIDOSE S Y=^BITMP($J,1,BIDFN,BIMM,BIDATE,BIVIMM)_"^"_BIVIMM

 ....D DOSES(Y,BIAGE,.BIDOSE,.BIDOSES)

 ....S BITMP=BITMP_BIDOSE

.;

 .;---> Allow for Maximum Global Length to be as small as 255.

 .;---> This gets picked up in +63^BIEXPRT4.

 .S BITMP=BITMP1_BITMP

 .S ^BITMP($J,2,BIDFN,1,1,1)=$E(BITMP,1,250)

 .S:$L(BITMP)>250 ^BITMP($J,2,BIDFN,1,1,1,1)=$E(BITMP,251,500)

 .S:$L(BITMP)>500 ^BITMP($J,2,BIDFN,1,1,1,2)=$E(BITMP,501,750)

 .S:$L(BITMP)>750 ^BITMP($J,2,BIDFN,1,1,1,3)=$E(BITMP,751,1000)

 .S:$L(BITMP)>1000 ^BITMP($J,2,BIDFN,1,1,1,4)=$E(BITMP,1001,1250)

 .S:$L(BITMP)>1250 ^BITMP($J,2,BIDFN,1,1,1,5)=$E(BITMP,1251,1500)

 .S:$L(BITMP)>1500 ^BITMP($J,2,BIDFN,1,1,1,6)=$E(BITMP,1501,1750)

 .S:$L(BITMP)>1750 ^BITMP($J,2,BIDFN,1,1,1,7)=$E(BITMP,1751,2000)

 ;----------

DOSES(Y,BIAGE,BIDOSE,BIDOSES) ;EP

 ;---> Add data (4 TCH fields) for one dose to BITMP.

 ;---> Parameters:

 ;     1 - Y       (req) Data for one visit, stored in ^BITMP($J,1,BIDFN...

 ;                       CVX Code^Dose Override^TCH Date^V Imm IEN.

 ;     2 - BIAGE   (req) Patient Age in years (for translating Td).

 ;     3 - BIDOSE  (ret) Data returned for one "Input Dose":

 ;                       Dose Note(V Imm IEN)^CVX Code^Date of Dose

 ;                       ^Dose Override^Reserved^Reserved

 ;     4 - BIDOSES (ret) Total number of doses collected (not used for now).

 Q:$G(Y)=""

 S:$G(BIDOSE)="" BIDOSE=""

 S:$G(BIDOSES)="" BIDOSES=0

 ;---> Quit if no Dose CVX Code or if NULL.

 Q:"NULL"[$P(Y,U,1)

 ;---> Dose Note - ^V Imm IEN (Field 1).

 S BIDOSE=$P(Y,U,4)

 ;---> Dose HL7/CVX Code (Field 2)  * * * ALL OUTGOING TRANSLATIONS HERE * * *

 ;***** TRANSLATIONS NECESSARY??? ****

 .;---> If this is an Adult Td Booster and patient age>7, send -10 to ImmServe.

 .;I $P(Y,U,1)=9!($P(Y,U,1)=113) I BIAGE>6 S BIDOSE=BIDOSE_U_-10 Q

.;

 .;---> If this is Tdap, send -13 to ImmServe.

.;

 .;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR

 .;---> Include CVX 20 (DTaP) in translation to -13, so that DTaP satisfies Tdap.

 .;---> During Beta Test decision was made to abandon this for now, due to

 .;---> complications.  However, Tdap CVX 115 translated to -13 on 7yrs and older.

 .;I $P(Y,U,1)=115 I BIAGE>6 S BIDOSE=BIDOSE_U_-13 Q

 .;I $P(Y,U,2)=115!($P(Y,U,2)=20) I BIAGE>6 S BIDOSE=BIDOSE_U_-13 Q

 .;**********

.;

 .;********** PATCH 2, v8.4.2, Oct 15,2010, IHS/CMI/MWR

 .;---> Translate new Flu CVX Codes 140 & 141 to 15 until Immserve can accommodate.

 .;---> If this is a new Flu, send 15.

.;

 .;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR

 .;---> Recognize new Flu Codes.

 .;I ($P(Y,U,2)=140)!($P(Y,U,2)=141)  S BIDOSE=BIDOSE_U_15 Q

 .;N Z S Z=($P(Y,U,1))

 .;I (Z=149)!(Z=150)!(Z=151)!(Z=153)!(Z=155)!(Z=158)  S BIDOSE=BIDOSE_U_15 Q

 .;**********

.;

 .;---> No translation of this dose.

 .S BIDOSE=BIDOSE_U_$P(Y,U,1)

 ;---> Date of Dose Administration--Visit Date (Field 3).

 S BIDOSE=BIDOSE_U_$P(Y,U,3)

 ;---> Dose Override: (Field 4).

 ;---> 0=Exclude if violates screening rules

 ;---> 1=Include even if violates screening rules

 ;---> 2=Exclude per user input (invalidated by user, e.g., expired vaccine).

 .;---> Interpret Dose Override for ImmServe.

 .N X S X=(+$P(Y,U,2))

 .D:X

 ..I X=9 S X=1 Q

 ..S X=2

 .S BIDOSE=BIDOSE_U_X

 ;---> Reserved for future use (Field 5).

 S BIDOSE=BIDOSE_"^0"

 ;---> Reserved for future use (Field 6).

 S BIDOSE=BIDOSE_"^0"

 ;---> End of Dose Delimiter.

 S BIDOSE=BIDOSE_"|||"

 ;---> Keep count of doses.

 S BIDOSES=BIDOSES+1

BIEXPRT6  ;IHS/CMI/MWR - EXPORT IMMUNIZATION RECORDS; OCT 15, 2010

 +1       ;;8.5;IMMUNIZATION;**13**;AUG 01,2016

 +2       ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 +3       ;;  EXPORT IMMUNIZATION RECORDS: BUILD PATIENT HISTORY EXPORT FOR FORECASTING.

 +4       ;;  CALLED BY BIEXPRT3.

 +5       ;;  PATCH 8: New routine to accommodate new TCH Forecaster   TCHHIST+0

 +6       ;;  PATCH 13: Pass Flu Season Start & End Dates to TCH.  TCHHIST+128

 +7       ;

 +8       ;

 +9       ;

 +10      ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR

 +11      ;---> New Entry Point called from HISTORY+99^BIEXPRT3.

 +12      ;----------

TCHHIST(BIFDT,BIDUZ2,BINF) ;EP

 +1       ;---> Called by BIEXPRT3.

 +2       ;---> Construct ^BITMP($J,2 nodes for Forecast exports from the

 +3       ;---> ^BITMP($J,1 nodes (gathered in ^BIEXPRT2).

 +4       ;---> This prepares the string of Patient Data to be sent to

 +5       ;---> TCH for forecasting.

 +6       ;---> Parameters:

 +7       ;     1 - BIFDT  (opt) Forecast Date (date used to calc Imms due).

 +8       ;     2 - BIDUZ2 (opt) User's DUZ(2) for BISITE parameters,

 +9       ;                      which affect forecasting rules.

 +10      ;     3 - BINF   (opt) Array of Vaccine IEN's that should not be forecast.

 +11      ;

 +12      ;---> If no Forecast Date passed, set it equal to today.

 +13       IF '$GET(BIFDT)

               SET BIFDT=DT

 +14      ;

 +15      ;---> If no BIDUZ2, try DUZ(2); otherwise, defaults will be used.

 +16       IF '$GET(BIDUZ2)

               SET BIDUZ2=$GET(DUZ(2))

 +17      ;

 +18       NEW BIDFN

           SET BIDFN=0

 +19       FOR

               SET BIDFN=$ORDER(^BITMP($JOB,1,BIDFN))

               IF 'BIDFN

                   QUIT

               Begin DoDot:1

 +20               NEW BIAGE,BIDOSES,BITMP1

                   SET BIDOSES=0

 +21      ;---> Set Patient Age in Years for this Forecast Date.

 +22               SET BIAGE=$$AGE^BIUTL1(BIDFN,1,BIFDT)

 +23      ;

 +24      ;---> Date used for Forecast (Field 1).

 +25               SET BITMP1=$$FMTCHDT^BIUTL5(BIFDT)

 +26      ;

 +27      ;---> Forecasting Mode: Minimum vs. Recommended Age (Field 2).

 +28               SET BITMP1=BITMP1_U_$$MINAGE^BIUTL2(BIDUZ2)

 +29      ;

 +30      ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR

 +31      ;---> Transmit Grace Period option instead of version.

 +32      ;---> Version (Field 3).

 +33      ;S BITMP1=BITMP1_U_$$RULES^BIUTL2(BIDUZ2)

 +34      ;---> Grace Period (Field 3).

 +35               SET BITMP1=BITMP1_U_$PIECE($GET(^BISITE(BIDUZ2,0)),U,21)

 +36      ;

 +37      ;---> Reserved for future use (Field 4).

 +38               SET BITMP1=BITMP1_U_0

 +39      ;

 +40      ;---> Reserved for future use (Field 5).

 +41               SET BITMP1=BITMP1_U_0

 +42      ;

 +43      ;---> Personal ID: Patient Name and Chart# (Field 6)

 +44               SET BITMP1=BITMP1_U_$$NAME^BIUTL1(BIDFN)

 +45               SET BITMP1=BITMP1_"  Chart#: "_$$HRCN^BIUTL1(BIDFN)

 +46      ;

 +47      ;---> User Note: DFN  (Field 7)

 +48               SET BITMP1=BITMP1_U_BIDFN

 +49      ;

 +50      ;---> Date of Birth (Field 8).

 +51               SET BITMP1=BITMP1_U_$$FMTCHDT^BIUTL5($$DOB^BIUTL1(BIDFN))

 +52      ;

 +53      ;---> Gender (Field 9).

 +54               SET BITMP1=BITMP1_U_$$SEXW^BIUTL1(BIDFN)

 +55      ;

 +56      ;---> Mother HBsAg Status: P,N,U,A  (Field 10).

 +57               SET BITMP1=BITMP1_U_$$MOTHER^BIUTL11(BIDFN)

 +58      ;

 +59      ;---> Build array of contraindicated HL7 Codes for this Patient.

 +60               NEW BICT

                   DO CONTRA^BIUTL11(BIDFN,.BICT)

 +61      ;

 +62      ;---> Pertussis Indication (Field 11).

 +63               Begin DoDot:2

 +64      ;---> If patient has contra to DTP or DTaP, pass contra to pertussis.

 +65                   NEW I,J

                       SET J=0

                       FOR I=1,11,20

                           IF $DATA(BICT(I))

                               SET J=1

                               QUIT

 +66                   SET BITMP1=BITMP1_U_J

                   End DoDot:2

 +67      ;

 +68      ;---> Diphtheria Indication (Field 12).

 +69               Begin DoDot:2

 +70      ;---> If pt has contra to DT-PEDS or TD-Adult, pass contra to Diph.

 +71                   NEW I,J

                       SET J=0

                       FOR I=28,9

                           IF $DATA(BICT(I))

                               SET J=1

                               QUIT

 +72                   SET BITMP1=BITMP1_U_J

                   End DoDot:2

 +73      ;

 +74      ;---> Tetanus Indication (Field 13).

 +75               Begin DoDot:2

 +76      ;---> If pt has contra to TET TOX,

 +77      ;---> pass contra to Tetanus.

 +78                   NEW I,J

                       SET J=0

                       FOR I=28,9,35

                           IF $DATA(BICT(I))

                               SET J=1

                               QUIT

 +79                   SET BITMP1=BITMP1_U_J

                   End DoDot:2

 +80      ;

 +81      ;---> Hib Indication (Field 14).

 +82               Begin DoDot:2

 +83      ;---> If pt has contra to any HIB, pass contra to HIB.

 +84                   NEW I,J

                       SET J=0

                       FOR I=17,46,47,48,49

                           IF $DATA(BICT(I))

                               SET J=1

                               QUIT

 +85                   SET BITMP1=BITMP1_U_J

                   End DoDot:2

 +86      ;

 +87      ;---> HBIG Indication (Field 15).

 +88               SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(30)):1,1:0)

 +89      ;

 +90      ;---> HepB Indication (Field 16).

 +91               SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(45)):1,1:0)

 +92      ;

 +93      ;---> OPV Indication (Field 17).

 +94      ;---> 2003: ImmServe no longer forecasts OPV.

 +95      ;S BITMP1=BITMP1_U_$S($D(BICT(2)):1,$D(BINF(2)):1,1:0)

 +96               SET BITMP1=BITMP1_U_0

 +97      ;

 +98      ;---> IPV Indication (Field 18).

 +99               SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(10)):1,1:0)

 +100     ;

 +101     ;---> Measles Indication (Field 19).

 +102              SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(5)):1,1:0)

 +103     ;

 +104     ;---> Mumps Indication (Field 20).

 +105              SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(7)):1,1:0)

 +106     ;

 +107     ;---> Rubella Indication (Field 21).

 +108              SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(6)):1,1:0)

 +109     ;

 +110     ;---> Varicella Indication (Field 22).

 +111              SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(21)):1,1:0)

 +112     ;

 +113     ;---> HepA Indication (Field 23).

 +114              SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(85)):1,1:0)

 +115     ;

 +116     ;---> Rotavirus Indication (Field 24).

 +117              SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(74)):1,1:0)

 +118     ;

 +119     ;---> Pneumococcal Indication (Field 25).

 +120     ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR

 +121     ;---> Add ALL Pneumos.

 +122              Begin DoDot:2

 +123     ;---> If pt has contra to any Pneumo, pass contra to Pneumo.

 +124                  NEW I,J

                       SET J=0

                       FOR I=33,100,109,133

                           IF $DATA(BICT(I))

                               SET J=1

                               QUIT

 +125                  SET BITMP1=BITMP1_U_J

                   End DoDot:2

 +126     ;

 +127     ;---> Influenza Indication (Field 26).

 +128     ;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR

 +129     ;---> Pass Flu Season Start & End Dates to TCH.

 +130     ;S BITMP1=BITMP1_U_$S($D(BICT(88)):1,1:0)

 +131              Begin DoDot:2

 +132     ;---> If Flu contraindicated, concat 1 and quit.

 +133                  IF $DATA(BICT(88))

                           SET BITMP1=BITMP1_U_1

                           QUIT

 +134     ;---> Pass Site's Flu season dates.

 +135                  SET BITMP1=BITMP1_U_$$FLUDATS^BIUTL8(BIDUZ2)

                   End DoDot:2

 +136     ;**********

 +137     ;

 +138     ;---> Meningococcal Indication (Field 27).

 +139              SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(32)):1,1:0)

 +140     ;

 +141     ;---> HPV Indication (Field 28).

 +142              SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(62)):1,1:0)

 +143     ;

 +144     ;---> H1N1 Indication (Field 29).

 +145              Begin DoDot:2

 +146     ;---> If pt has contra to any H1N1, pass contra to H1N1.

 +147                  NEW I,J

                       SET J=0

                       FOR I=125,126,127,128

                           IF $DATA(BICT(I))

                               SET J=1

                               QUIT

 +148                  SET BITMP1=BITMP1_U_J

                   End DoDot:2

 +149     ;

 +150     ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR

 +151     ;---> Add Zoster Contraindication field.

 +152     ;---> Zoster Indication (Field 30).

 +153              SET BITMP1=BITMP1_U_$SELECT($DATA(BICT(121)):1,1:0)

 +154     ;

 +155     ;---> Delimiter between Patient Case Data and Imm History Doses.

 +156              SET BITMP1=BITMP1_U_"~~~"

 +157     ;**********

 +158     ;

 +159     ;

 +160              NEW BIMM,BITMP

                   SET BIMM=0

                   SET BITMP=""

 +161              FOR

                       SET BIMM=$ORDER(^BITMP($JOB,1,BIDFN,BIMM))

                       IF 'BIMM

                           QUIT

                       Begin DoDot:2

 +162                      NEW BIDATE,Y

                           SET BIDATE=0

 +163                      FOR

                               SET BIDATE=$ORDER(^BITMP($JOB,1,BIDFN,BIMM,BIDATE))

                               IF 'BIDATE

                                   QUIT

                               Begin DoDot:3

 +164                              NEW BIVIMM,Y

                                   SET BIVIMM=0

 +165                              FOR

                                       SET BIVIMM=$ORDER(^BITMP($JOB,1,BIDFN,BIMM,BIDATE,BIVIMM))

                                       IF 'BIVIMM

                                           QUIT

                                       Begin DoDot:4

 +166     ;---> Tack on V Imm IEN for matching ImmServe History.

 +167                                      NEW BIDOSE

                                           SET Y=^BITMP($JOB,1,BIDFN,BIMM,BIDATE,BIVIMM)_"^"_BIVIMM

 +168                                      DO DOSES(Y,BIAGE,.BIDOSE,.BIDOSES)

 +169                                      SET BITMP=BITMP_BIDOSE

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +170     ;

 +171     ;---> Allow for Maximum Global Length to be as small as 255.

 +172     ;---> This gets picked up in +63^BIEXPRT4.

 +173              SET BITMP=BITMP1_BITMP

 +174              SET ^BITMP($JOB,2,BIDFN,1,1,1)=$EXTRACT(BITMP,1,250)

 +175              IF $LENGTH(BITMP)>250

                       SET ^BITMP($JOB,2,BIDFN,1,1,1,1)=$EXTRACT(BITMP,251,500)

 +176              IF $LENGTH(BITMP)>500

                       SET ^BITMP($JOB,2,BIDFN,1,1,1,2)=$EXTRACT(BITMP,501,750)

 +177              IF $LENGTH(BITMP)>750

                       SET ^BITMP($JOB,2,BIDFN,1,1,1,3)=$EXTRACT(BITMP,751,1000)

 +178              IF $LENGTH(BITMP)>1000

                       SET ^BITMP($JOB,2,BIDFN,1,1,1,4)=$EXTRACT(BITMP,1001,1250)

 +179              IF $LENGTH(BITMP)>1250

                       SET ^BITMP($JOB,2,BIDFN,1,1,1,5)=$EXTRACT(BITMP,1251,1500)

 +180              IF $LENGTH(BITMP)>1500

                       SET ^BITMP($JOB,2,BIDFN,1,1,1,6)=$EXTRACT(BITMP,1501,1750)

 +181              IF $LENGTH(BITMP)>1750

                       SET ^BITMP($JOB,2,BIDFN,1,1,1,7)=$EXTRACT(BITMP,1751,2000)

               End DoDot:1

 +182      QUIT

 +183     ;

 +184     ;----------

DOSES(Y,BIAGE,BIDOSE,BIDOSES) ;EP

 +1       ;---> Add data (4 TCH fields) for one dose to BITMP.

 +2       ;---> Parameters:

 +3       ;     1 - Y       (req) Data for one visit, stored in ^BITMP($J,1,BIDFN...

 +4       ;                       CVX Code^Dose Override^TCH Date^V Imm IEN.

 +5       ;     2 - BIAGE   (req) Patient Age in years (for translating Td).

 +6       ;     3 - BIDOSE  (ret) Data returned for one "Input Dose":

 +7       ;                       Dose Note(V Imm IEN)^CVX Code^Date of Dose

 +8       ;                       ^Dose Override^Reserved^Reserved

 +9       ;     4 - BIDOSES (ret) Total number of doses collected (not used for now).

 +10      ;

 +11       IF $GET(Y)=""

               QUIT

 +12       IF $GET(BIDOSE)=""

               SET BIDOSE=""

 +13       IF $GET(BIDOSES)=""

               SET BIDOSES=0

 +14      ;

 +15      ;---> Quit if no Dose CVX Code or if NULL.

 +16       IF "NULL"[$PIECE(Y,U,1)

               QUIT

 +17      ;

 +18      ;---> Dose Note - ^V Imm IEN (Field 1).

 +19       SET BIDOSE=$PIECE(Y,U,4)

 +20      ;

 +21      ;---> Dose HL7/CVX Code (Field 2)  * * * ALL OUTGOING TRANSLATIONS HERE * * *

 +22      ;***** TRANSLATIONS NECESSARY??? ****

 +23       Begin DoDot:1

 +24      ;---> If this is an Adult Td Booster and patient age>7, send -10 to ImmServe.

 +25      ;I $P(Y,U,1)=9!($P(Y,U,1)=113) I BIAGE>6 S BIDOSE=BIDOSE_U_-10 Q

 +26      ;

 +27      ;---> If this is Tdap, send -13 to ImmServe.

 +28      ;

 +29      ;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR

 +30      ;---> Include CVX 20 (DTaP) in translation to -13, so that DTaP satisfies Tdap.

 +31      ;---> During Beta Test decision was made to abandon this for now, due to

 +32      ;---> complications.  However, Tdap CVX 115 translated to -13 on 7yrs and older.

 +33      ;I $P(Y,U,1)=115 I BIAGE>6 S BIDOSE=BIDOSE_U_-13 Q

 +34      ;I $P(Y,U,2)=115!($P(Y,U,2)=20) I BIAGE>6 S BIDOSE=BIDOSE_U_-13 Q

 +35      ;**********

 +36      ;

 +37      ;********** PATCH 2, v8.4.2, Oct 15,2010, IHS/CMI/MWR

 +38      ;---> Translate new Flu CVX Codes 140 & 141 to 15 until Immserve can accommodate.

 +39      ;---> If this is a new Flu, send 15.

 +40      ;

 +41      ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR

 +42      ;---> Recognize new Flu Codes.

 +43      ;I ($P(Y,U,2)=140)!($P(Y,U,2)=141)  S BIDOSE=BIDOSE_U_15 Q

 +44      ;N Z S Z=($P(Y,U,1))

 +45      ;I (Z=149)!(Z=150)!(Z=151)!(Z=153)!(Z=155)!(Z=158)  S BIDOSE=BIDOSE_U_15 Q

 +46      ;**********

 +47      ;

 +48      ;---> No translation of this dose.

 +49           SET BIDOSE=BIDOSE_U_$PIECE(Y,U,1)

           End DoDot:1

 +50      ;

 +51      ;

 +52      ;---> Date of Dose Administration--Visit Date (Field 3).

 +53       SET BIDOSE=BIDOSE_U_$PIECE(Y,U,3)

 +54      ;

 +55      ;---> Dose Override: (Field 4).

 +56      ;---> 0=Exclude if violates screening rules

 +57      ;---> 1=Include even if violates screening rules

 +58      ;---> 2=Exclude per user input (invalidated by user, e.g., expired vaccine).

 +59       Begin DoDot:1

 +60      ;---> Interpret Dose Override for ImmServe.

 +61           NEW X

               SET X=(+$PIECE(Y,U,2))

 +62           IF X

                   Begin DoDot:2

 +63                   IF X=9

                           SET X=1

                           QUIT

 +64                   SET X=2

                   End DoDot:2

 +65           SET BIDOSE=BIDOSE_U_X

           End DoDot:1

 +66      ;

 +67      ;---> Reserved for future use (Field 5).

 +68       SET BIDOSE=BIDOSE_"^0"

 +69      ;

 +70      ;---> Reserved for future use (Field 6).

 +71       SET BIDOSE=BIDOSE_"^0"

 +72      ;

 +73      ;---> End of Dose Delimiter.

 +74       SET BIDOSE=BIDOSE_"|||"

 +75      ;

 +76      ;---> Keep count of doses.

 +77       SET BIDOSES=BIDOSES+1

 +78       QUIT

BIEXPRT6.m