BIREPT4.m

BIREPT4 ;IHS/CMI/MWR - REPORT, TWO-YR-OLD RATES; MAY 10, 2010

 ;;8.5;IMMUNIZATION;**3**;SEP 10,2012

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

 ;;  VIEW TWO-YR-OLD IMMUNIZATION RATES REPORT, WRITE HEADERS, ETC.

 ;;  PATCH 1: Exclude patients whose Inactive Date=Not in Register.  CHKSET+35

 ;;  PATCH 3: Extensive edits to allow Hx of Chickenpox to count for Varicella.

 ;;           CHKSET+60, CHKSET+209

 ;

 ;----------

GETPATS(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIQDT,BIAGRPS,BISITE,BIUP) ;EP

 ;---> Get patients from VA PATIENT File, ^DPT(.

 ;---> Parameters:

 ;     1 - BIBEGDT (req) Begin DOB for this group.

 ;     2 - BIENDDT (req) End DOB for this group.

 ;     3 - BICC    (req) Current Community array.

 ;     4 - BIHCF   (req) Health Care Facility array.

 ;     5 - BICM    (req) Case Manager array.

 ;     6 - BIBEN   (req) Beneficiary Type array.

 ;     7 - BIQDT   (req) Quarter Ending Date.

 ;     8 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36)

 ;     9 - BISITE  (req) Site IEN.

 ;     9 - BIUP    (req) User Population/Group (Registered, Imm, User, Active).

 ;

 ;---> Set begin and end dates for search through PATIENT File.

 ;

 Q:'$G(BIBEGDT)  Q:'$G(BIENDDT)  Q:'$G(BIQDT)  Q:'$G(BIAGRPS)

 S:$G(BIUP)="" BIUP="u"

 ;

 ;---> Start 1 day prior to Begin Date and $O into the desired DOB's.

 N BIDOB S BIDOB=BIBEGDT-1

 F  S BIDOB=$O(^DPT("ADOB",BIDOB)) Q:(BIDOB>BIENDDT!('BIDOB))  D

 .S BIDFN=0

 .F  S BIDFN=$O(^DPT("ADOB",BIDOB,BIDFN)) Q:'BIDFN  D

 ..D CHKSET(BIDFN,.BICC,.BIHCF,.BICM,.BIBEN,BIDOB,BIQDT,.BIVAL,BIAGRPS,BIUP)

 ..;---> Set ^TMP("BIDUL",$J,CURCOM,1,HRCN,BIDFN)=$G(BIVAL) for Patient Roster.

 ..D:$G(BIVAL) STORE^BIDUR1(BIDFN,DT,9,,BIVAL,BISITE)

 Q

 ;

 ;

 ;----------

CHKSET(BIDFN,BICC,BIHCF,BICM,BIBEN,BIDOB,BIQDT,BIVAL,BIAGRPS,BIUP) ;EP

 ;---> Check if this patient fits criteria; if so, set DFN

 ;---> in ^TMP("BIREPT1".

 ;---> Parameters:

 ;     1 - BIDFN  (req) Patient IEN.

 ;     2 - BICC   (req) Current Community array.

 ;     3 - BIHCF  (req) Health Care Facility array.

 ;     4 - BICM   (req) Case Manager array.

 ;     5 - BIBEN  (req) Beneficiary Type array.

 ;     6 - BIDOB  (req) Patient's Date of Birth.

 ;     7 - BIQDT  (req) Quarter Ending Date.

 ;     8 - BIVAL  (ret) 1=Not appropriate/complete, 2=43133 complete.

 ;     9 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36)

 ;     9 - BIUP    (req) User Population/Group (Registered, Imm, User, Active).

 ;

 Q:'$G(BIDFN)

 Q:'$D(BICC)

 Q:'$D(BIHCF)

 Q:'$D(BICM)

 Q:'$D(BIBEN)

 I '$G(BIDOB) S BIDOB=$$DOB^BIUTL1(BIDFN)

 Q:'$G(BIQDT)

 Q:'$G(BIAGRPS)

 S:$G(BIUP)="" BIUP="u"

 ;

 ;---> Don't include this patient in Roster unless set below.

 S BIVAL=0

 ;

 ;---> Filter for standard Patient Population parameter.

 Q:'$$PPFILTR^BIREP(BIDFN,.BIHCF,BIQDT,BIUP)

 ;

 ;---> Quit if Current Community doesn't match.

 Q:$$CURCOM^BIEXPRT2(BIDFN,.BICC)

 ;

 ;---> Quit if Case Manager doesn't match.

 Q:$$CMGR^BIDUR(BIDFN,.BICM)

 ;

 ;---> Quit if Beneficiary Type doesn't match.

 Q:$$BENT^BIDUR1(BIDFN,.BIBEN)

 ;

 ;---> Store Patient in Age Group.

 N Z S Z=$G(BITMP("STATS","TOTLPTS")) S BITMP("STATS","TOTLPTS")=Z+1

 ;---> Store for Patient Report Roster (not yet determined if complete 43133).

 S BIVAL=1

 ;

 ;---> RPC to gather Immunization History.

 N BI31,BIDE,BIRETVAL,BIRETERR,I S BI31=$C(31)_$C(31),BIRETVAL=""

 ;---> 30=Vaccine IEN, 55=Vaccine Group IEN, 56=Date of Visit(Fileman),

 ;---> 65=Invalid Dose (1-4).

 F I=30,55,56,65 S BIDE(I)=""

 ;---> Fourth parameter=0: Do not return Skin Tests.

 D IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,0,0)

 ;

 ;---> If BIRETERR has a value, store it and quit.

 S BIRETERR=$P(BIRETVAL,BI31,2)

 Q:BIRETERR]""

 ;

 ;---> Add refusals, if any.

 N Z D CONTRA^BIUTL11(BIDFN,.Z,1) I $O(Z(0)) S BITMP("REFUSALS",BIDFN)=""

 ;

 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR

 ;---> Check for Hx of Chicken Pox (as a reason for contra to Var & MMRV.)

 ;---> If HX of Chicken Pox to add to Hx of Chickenpox line and count as

 ;---> Varicella Combo Stats Lines.

 N BICHXDT,BIHXX,Z

 D CONTRA^BIUTL11(BIDFN,.Z,2,1) I (+$G(Z(21))=12)!(+$G(Z(94))=12) D

 .N BICHXDT D

 ..;---> Get the date of Chickenpox contraindication.

 ..I $D(Z(21)) S BICHXDT=$P(Z(21),U,2) Q

 ..I $D(Z(21)) S BICHXDT=$P(Z(94),U,2)

 .Q:'BICHXDT

 .;

 .N BIAGE,J,K S J=1

 .F K=1:1 S BIAGE=$P(BIAGRPS,",",K) Q:'BIAGE  D

 ..D:J PASTMTH^BIAGE(BICHXDT,BIAGE,.BIDATE)

 ..Q:BIDATE>BIDOB

 ..;---> Patient received imm by BIAGE months, set in stats array.

 ..N Z S Z=$G(BITMP("STATS",132,1,BIAGE)) S BITMP("STATS",132,1,BIAGE)=Z+1

 ..S J=0

 ..;---> Also set for combo lines.

 ..S BIHXX(132,1,BIAGE)=""

 ;**********

 ;

 ;---> Set BIHX=to a valid Immunization History.

 N BIHX S BIHX=$P(BIRETVAL,BI31,1)

 ;

 ;---> *** Okay, add this Patient's History to stats.

 ;

 ;---> BIHIB local array by date gets built; if the first two were CVX 49's (IEN=127)

 ;---> then patient will only need 3 Hibs to be UTD.

 N BIHIB,BIROT,I,Y

 ;

 ;---> BIROT gets set=1 if there were 2 CVX 119's (IEN=225)--patient is UTD for Rota.

 S BIROT=0

 ;

 ;---> Loop through "^"-pieces of Imm History, getting data.

 F I=1:1 S Y=$P(BIHX,U,I) Q:Y=""  D

 .;

 .;---> BIIEN=Vaccine IEN, BIVGRP=Vaccine Group, BIVDAT=Visit Date, BINVLD=Invalid Code.

 .N BIAGE,BIDOSE,BIIEN,BINVLD,BIVDAT,BIVGRP,Q

 .S BIIEN=$P(Y,"|",2),BIVGRP=$P(Y,"|",3),BIVDAT=$P(Y,"|",4),BINVLD=$P(Y,"|",5)

 .;

 .;---> Quit if not Vaccine Group or Visit Date.

 .Q:'$G(BIVGRP)  Q:'$G(BIVDAT)

 .;

 .;---> Quit if this dose has been overrided as Invalid (1-4).

 .Q:(1234[+BINVLD)

 .;

 .;---> Quit if this imm was given after the Quarter Ending Date.

 .;---> NOTE: This will cause some patients to appear in the "NOT Current"

 .;---> group, even if they got caught up to date later.

 .Q:(BIVDAT>BIQDT)

 .;

 .;---> Quit if this Vaccine Group should not be included.

 .Q:'($$VGROUP^BIUTL2(BIVGRP,8))

 .;

 .;---> Set BIDOSE=Dose# (increment by 1's to assign highest/latest dose#)

 .S BIDOSE=1,Q=0

 .F  Q:Q  D

 ..I $D(BIHX(BIVGRP,BIDOSE)) S BIDOSE=BIDOSE+1 Q

 ..S BIHX(BIVGRP,BIDOSE)="",Q=1

 .;

 .;

 .;---> If this was a Hib, store it in local array for UTD eval.

 .I BIVGRP=3 S BIHIB(BIVDAT,BIIEN)=""

 .;

 .;---> If this was a Rotarix, increment its counter.

 .S:BIIEN=225 BIROT=BIROT+1

 .;

 .;---> Set this immunization in the STATS array for each Age (A)

 .;---> by which the patient had already received it (cumulative).

 .N J,K S J=1

 .F K=1:1 S BIAGE=$P(BIAGRPS,",",K) Q:'BIAGE  D

 ..;---> If patient received imm by BIAGE months on the previous iteration

 ..;---> of this loop (and J was set=0), then bypass call to PASTMTH

 ..;---> and simply set it for the higher BIAGE values, cumulatively.

 ..;---> (i.e., if patient received it by 3 months, then he also

 ..;--->  necessarily received it by 5 months, 7 months, etc.)

 ..D:J PASTMTH^BIAGE(BIVDAT,BIAGE,.BIDATE)

 ..;

 ..;---> Quit if BIAGE months prior to Visit Date is AFTER the DOB

 ..;---> (means patient was OLDER than BIAGE months when he received

 ..;---> the imm--did NOT receive the imm by BIAGE months).

 ..Q:BIDATE>BIDOB

 ..;

 ..;---> Patient received imm by BIAGE months, set in stats array.

 ..N Z S Z=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGE)) S BITMP("STATS",BIVGRP,BIDOSE,BIAGE)=Z+1

 ..S J=0

 ..S BIHX(BIVGRP,BIDOSE,BIAGE)=""

 ;

 ;

 ;---> Now calculate whether this patient needs 3 Hibs or 4 Hibs to be UTD.

 ;---> If first 2 Hibs=127 (CVX 49), then BIHIB2=2 and patient only needs 3 Hibs to be UTD.

 N BIHIB2,I,N S BIHIB2=0,N=0

 F I=1:1:2 S N=$O(BIHIB(N)) Q:'N  D

 .I $O(BIHIB(N,0))=127 S BIHIB2=BIHIB2+1

 ;

 ;---> Now calculate vaccine combination stats.

 ;---> NOTE: DO NOT GENERALIZE CODE BELOW (highly iterative).

 ;---> Relies on the following Vaccine Group IEN's in ^BISERT:

 ;---> DTP=1, OPV=2, HIB=3, HEPB=4, MMR=6, VAR=7, HEPA=9, FLU=10, PNE=11, ROT=15

 ;

 ;---> 1-DTP, 1-OPV, 1-HIB, 1-HEPB

 N K

 F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A  D

 .;---> Matrix=Vaccine Group, Dose#, Age Group.

 .Q:'$D(BIHX(1,1,A))

 .Q:'$D(BIHX(2,1,A))

 .Q:'$D(BIHX(3,1,A))

 .Q:'$D(BIHX(4,1,A))

 .D COMBO("1|1^2|1^3|1^4|1",A)

 ;

 ;---> 4-DTP, 3-OPV, 1-MMR

 F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A  D

 .Q:'$D(BIHX(1,4,A))

 .Q:'$D(BIHX(2,3,A))

 .Q:'$D(BIHX(6,1,A))

 .D COMBO("1|4^2|3^6|1",A)

 ;

 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB

 F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A  D

 .Q:'$D(BIHX(1,4,A))

 .Q:'$D(BIHX(2,3,A))

 .Q:'$D(BIHX(6,1,A))

 .;---> If you don't have 2 Hib 49's, then quit if you don't have 4 Hibs.

 .I BIHIB2<2 Q:'$D(BIHX(3,4,A))

 .;---> Okay, first 2 Hibs are 49's, quit if you don't have 3 Hibs.

 .Q:'$D(BIHX(3,3,A))

 .D COMBO("1|4^2|3^6|1^3|3",A)

 ;

 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB

 F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A  D

 .Q:'$D(BIHX(1,4,A))

 .Q:'$D(BIHX(2,3,A))

 .Q:'$D(BIHX(6,1,A))

 .I BIHIB2<2 Q:'$D(BIHX(3,4,A))

 .Q:'$D(BIHX(3,3,A))

 .Q:'$D(BIHX(4,3,A))

 .D COMBO("1|4^2|3^6|1^3|3^4|3",A)

 ;

 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR

 F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A  D

 .Q:'$D(BIHX(1,4,A))

 .Q:'$D(BIHX(2,3,A))

 .Q:'$D(BIHX(6,1,A))

 .I BIHIB2<2 Q:'$D(BIHX(3,4,A))

 .Q:'$D(BIHX(3,3,A))

 .Q:'$D(BIHX(4,3,A))

 .;

 .;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR

 .;---> Allow Hx of Chickenpox to count for Varicella.

 .;Q:'$D(BIHX(7,1,A))

 .Q:(('$D(BIHX(7,1,A)))&('$D(BIHXX(132,1,A))))

 .D COMBO("1|4^2|3^6|1^3|3^4|3^7|1",A)

 ;

 ;

 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR, 3-PNE

 F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A  D

 .Q:'$D(BIHX(1,4,A))

 .Q:'$D(BIHX(2,3,A))

 .Q:'$D(BIHX(6,1,A))

 .I BIHIB2<2 Q:'$D(BIHX(3,4,A))

 .Q:'$D(BIHX(3,3,A))

 .Q:'$D(BIHX(4,3,A))

 .;---> Allow Hx of Chickenpox to count for Varicella.

 .;Q:'$D(BIHX(7,1,A))

 .Q:(('$D(BIHX(7,1,A)))&('$D(BIHXX(132,1,A))))

 .Q:'$D(BIHX(11,3,A))

 .D COMBO("1|4^2|3^6|1^3|3^4|3^7|1^11|3",A)

 ;

 ;

 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR, 4-PNE  vvv83

 F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A  D

 .Q:'$D(BIHX(1,4,A))

 .Q:'$D(BIHX(2,3,A))

 .Q:'$D(BIHX(6,1,A))

 .I BIHIB2<2 Q:'$D(BIHX(3,4,A))

 .Q:'$D(BIHX(3,3,A))

 .Q:'$D(BIHX(4,3,A))

 .;---> Allow Hx of Chickenpox to count for Varicella.

 .;Q:'$D(BIHX(7,1,A))

 .Q:(('$D(BIHX(7,1,A)))&('$D(BIHXX(132,1,A))))

 .Q:'$D(BIHX(11,4,A))

 .D COMBO("1|4^2|3^6|1^3|3^4|3^7|1^11|4",A)

 .;---> Store for Patient Report Roster (complete 4313314).

 .S BIVAL=2

 ;

 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR, 4-PNE, 1-HEPA

 F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A  D

 .Q:'$D(BIHX(1,4,A))

 .Q:'$D(BIHX(2,3,A))

 .Q:'$D(BIHX(6,1,A))

 .I BIHIB2<2 Q:'$D(BIHX(3,4,A))

 .Q:'$D(BIHX(3,3,A))

 .Q:'$D(BIHX(4,3,A))

 .;---> Allow Hx of Chickenpox to count for Varicella.

 .;Q:'$D(BIHX(7,1,A))

 .Q:(('$D(BIHX(7,1,A)))&('$D(BIHXX(132,1,A))))

 .Q:'$D(BIHX(11,4,A))

 .Q:'$D(BIHX(9,1,A))

 .D COMBO("1|4^2|3^6|1^3|3^4|3^7|1^11|4^9|1",A)

 ;

 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR, 4-PNE, 2-HEPA, 3-ROTA  vvv83

 F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A  D

 .Q:'$D(BIHX(1,4,A))

 .Q:'$D(BIHX(2,3,A))

 .Q:'$D(BIHX(6,1,A))

 .I BIHIB2<2 Q:'$D(BIHX(3,4,A))

 .Q:'$D(BIHX(3,3,A))

 .Q:'$D(BIHX(4,3,A))

 .;---> Allow Hx of Chickenpox to count for Varicella.

 .;Q:'$D(BIHX(7,1,A))

 .Q:(('$D(BIHX(7,1,A)))&('$D(BIHXX(132,1,A))))

 .Q:'$D(BIHX(11,4,A))

 .Q:'$D(BIHX(9,2,A))

 .;Q:'$D(BIHX(15,3,A))

 .;---> If you don't have 2 Rota 119's, then quit if you don't have 3 Rotas.

 .I BIROT<2 Q:'$D(BIHX(15,3,A))

 .D COMBO("1|4^2|3^6|1^3|3^4|3^7|1^11|4^9|2^15|3",A)

 ;

 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR, 4-PNE, 2-HEPA, 3-ROTA, 2-FLU  vvv83

 F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A  D

 .Q:'$D(BIHX(1,4,A))

 .Q:'$D(BIHX(2,3,A))

 .Q:'$D(BIHX(6,1,A))

 .I BIHIB2<2 Q:'$D(BIHX(3,4,A))

 .Q:'$D(BIHX(3,3,A))

 .Q:'$D(BIHX(4,3,A))

 .;---> Allow Hx of Chickenpox to count for Varicella.

 .;Q:'$D(BIHX(7,1,A))

 .Q:(('$D(BIHX(7,1,A)))&('$D(BIHXX(132,1,A))))

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

 .Q:'$D(BIHX(11,4,A))

 .Q:'$D(BIHX(9,2,A))

 .;Q:'$D(BIHX(15,3,A))

 .I BIROT<2 Q:'$D(BIHX(15,3,A))

 .Q:'$D(BIHX(10,2,A))

 .D COMBO("1|4^2|3^6|1^3|3^4|3^7|1^11|4^9|2^15|3^10|2",A)

 ;

 ;---> Re-evaluate Current vs. Non-current based on Hib and Rota regimens.

 ;---> If BIVAL=1,

 Q:BIVAL=1

 ;

 Q

 ;

 ;

 ;----------

COMBO(BICOMB,BIAGRP) ;EP

 ;---> Store Patient vaccine combination for Age Group.

 ;---> Parameters:

 ;     1 - BICOMB (req) Combination number.

 ;     1 - BIAGRP (req) Node/number for this Age Group.

 ;

 ;---> Store Patient in Age Group.

 N Z S Z=$G(BITMP("STATS",BICOMB,BIAGRP))

 S BITMP("STATS",BICOMB,BIAGRP)=Z+1

 Q

BIREPT4   ;IHS/CMI/MWR - REPORT, TWO-YR-OLD RATES; MAY 10, 2010

 +1       ;;8.5;IMMUNIZATION;**3**;SEP 10,2012

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

 +3       ;;  VIEW TWO-YR-OLD IMMUNIZATION RATES REPORT, WRITE HEADERS, ETC.

 +4       ;;  PATCH 1: Exclude patients whose Inactive Date=Not in Register.  CHKSET+35

 +5       ;;  PATCH 3: Extensive edits to allow Hx of Chickenpox to count for Varicella.

 +6       ;;           CHKSET+60, CHKSET+209

 +7       ;

 +8       ;----------

GETPATS(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIQDT,BIAGRPS,BISITE,BIUP) ;EP

 +1       ;---> Get patients from VA PATIENT File, ^DPT(.

 +2       ;---> Parameters:

 +3       ;     1 - BIBEGDT (req) Begin DOB for this group.

 +4       ;     2 - BIENDDT (req) End DOB for this group.

 +5       ;     3 - BICC    (req) Current Community array.

 +6       ;     4 - BIHCF   (req) Health Care Facility array.

 +7       ;     5 - BICM    (req) Case Manager array.

 +8       ;     6 - BIBEN   (req) Beneficiary Type array.

 +9       ;     7 - BIQDT   (req) Quarter Ending Date.

 +10      ;     8 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36)

 +11      ;     9 - BISITE  (req) Site IEN.

 +12      ;     9 - BIUP    (req) User Population/Group (Registered, Imm, User, Active).

 +13      ;

 +14      ;---> Set begin and end dates for search through PATIENT File.

 +15      ;

 +16       IF '$GET(BIBEGDT)

               QUIT 

           IF '$GET(BIENDDT)

               QUIT 

           IF '$GET(BIQDT)

               QUIT 

           IF '$GET(BIAGRPS)

               QUIT 

 +17       IF $GET(BIUP)=""

               SET BIUP="u"

 +18      ;

 +19      ;---> Start 1 day prior to Begin Date and $O into the desired DOB's.

 +20       NEW BIDOB

           SET BIDOB=BIBEGDT-1

 +21       FOR 

               SET BIDOB=$ORDER(^DPT("ADOB",BIDOB))

               IF (BIDOB>BIENDDT!('BIDOB))

                   QUIT 

               Begin DoDot:1

 +22               SET BIDFN=0

 +23               FOR 

                       SET BIDFN=$ORDER(^DPT("ADOB",BIDOB,BIDFN))

                       IF 'BIDFN

                           QUIT 

                       Begin DoDot:2

 +24                       DO CHKSET(BIDFN,.BICC,.BIHCF,.BICM,.BIBEN,BIDOB,BIQDT,.BIVAL,BIAGRPS,BIUP)

 +25      ;---> Set ^TMP("BIDUL",$J,CURCOM,1,HRCN,BIDFN)=$G(BIVAL) for Patient Roster.

 +26                       IF $GET(BIVAL)

                               DO STORE^BIDUR1(BIDFN,DT,9,,BIVAL,BISITE)

                       End DoDot:2

               End DoDot:1

 +27       QUIT 

 +28      ;

 +29      ;

 +30      ;----------

CHKSET(BIDFN,BICC,BIHCF,BICM,BIBEN,BIDOB,BIQDT,BIVAL,BIAGRPS,BIUP) ;EP

 +1       ;---> Check if this patient fits criteria; if so, set DFN

 +2       ;---> in ^TMP("BIREPT1".

 +3       ;---> Parameters:

 +4       ;     1 - BIDFN  (req) Patient IEN.

 +5       ;     2 - BICC   (req) Current Community array.

 +6       ;     3 - BIHCF  (req) Health Care Facility array.

 +7       ;     4 - BICM   (req) Case Manager array.

 +8       ;     5 - BIBEN  (req) Beneficiary Type array.

 +9       ;     6 - BIDOB  (req) Patient's Date of Birth.

 +10      ;     7 - BIQDT  (req) Quarter Ending Date.

 +11      ;     8 - BIVAL  (ret) 1=Not appropriate/complete, 2=43133 complete.

 +12      ;     9 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36)

 +13      ;     9 - BIUP    (req) User Population/Group (Registered, Imm, User, Active).

 +14      ;

 +15       IF '$GET(BIDFN)

               QUIT 

 +16       IF '$DATA(BICC)

               QUIT 

 +17       IF '$DATA(BIHCF)

               QUIT 

 +18       IF '$DATA(BICM)

               QUIT 

 +19       IF '$DATA(BIBEN)

               QUIT 

 +20       IF '$GET(BIDOB)

               SET BIDOB=$$DOB^BIUTL1(BIDFN)

 +21       IF '$GET(BIQDT)

               QUIT 

 +22       IF '$GET(BIAGRPS)

               QUIT 

 +23       IF $GET(BIUP)=""

               SET BIUP="u"

 +24      ;

 +25      ;---> Don't include this patient in Roster unless set below.

 +26       SET BIVAL=0

 +27      ;

 +28      ;---> Filter for standard Patient Population parameter.

 +29       IF '$$PPFILTR^BIREP(BIDFN,.BIHCF,BIQDT,BIUP)

               QUIT 

 +30      ;

 +31      ;---> Quit if Current Community doesn't match.

 +32       IF $$CURCOM^BIEXPRT2(BIDFN,.BICC)

               QUIT 

 +33      ;

 +34      ;---> Quit if Case Manager doesn't match.

 +35       IF $$CMGR^BIDUR(BIDFN,.BICM)

               QUIT 

 +36      ;

 +37      ;---> Quit if Beneficiary Type doesn't match.

 +38       IF $$BENT^BIDUR1(BIDFN,.BIBEN)

               QUIT 

 +39      ;

 +40      ;---> Store Patient in Age Group.

 +41       NEW Z

           SET Z=$GET(BITMP("STATS","TOTLPTS"))

           SET BITMP("STATS","TOTLPTS")=Z+1

 +42      ;---> Store for Patient Report Roster (not yet determined if complete 43133).

 +43       SET BIVAL=1

 +44      ;

 +45      ;---> RPC to gather Immunization History.

 +46       NEW BI31,BIDE,BIRETVAL,BIRETERR,I

           SET BI31=$CHAR(31)_$CHAR(31)

           SET BIRETVAL=""

 +47      ;---> 30=Vaccine IEN, 55=Vaccine Group IEN, 56=Date of Visit(Fileman),

 +48      ;---> 65=Invalid Dose (1-4).

 +49       FOR I=30,55,56,65

               SET BIDE(I)=""

 +50      ;---> Fourth parameter=0: Do not return Skin Tests.

 +51       DO IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,0,0)

 +52      ;

 +53      ;---> If BIRETERR has a value, store it and quit.

 +54       SET BIRETERR=$PIECE(BIRETVAL,BI31,2)

 +55       IF BIRETERR]""

               QUIT 

 +56      ;

 +57      ;---> Add refusals, if any.

 +58       NEW Z

           DO CONTRA^BIUTL11(BIDFN,.Z,1)

           IF $ORDER(Z(0))

               SET BITMP("REFUSALS",BIDFN)=""

 +59      ;

 +60      ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR

 +61      ;---> Check for Hx of Chicken Pox (as a reason for contra to Var & MMRV.)

 +62      ;---> If HX of Chicken Pox to add to Hx of Chickenpox line and count as

 +63      ;---> Varicella Combo Stats Lines.

 +64       NEW BICHXDT,BIHXX,Z

 +65       DO CONTRA^BIUTL11(BIDFN,.Z,2,1)

           IF (+$GET(Z(21))=12)!(+$GET(Z(94))=12)

               Begin DoDot:1

 +66               NEW BICHXDT

                   Begin DoDot:2

 +67      ;---> Get the date of Chickenpox contraindication.

 +68                   IF $DATA(Z(21))

                           SET BICHXDT=$PIECE(Z(21),U,2)

                           QUIT 

 +69                   IF $DATA(Z(21))

                           SET BICHXDT=$PIECE(Z(94),U,2)

                   End DoDot:2

 +70               IF 'BICHXDT

                       QUIT 

 +71      ;

 +72               NEW BIAGE,J,K

                   SET J=1

 +73               FOR K=1:1

                       SET BIAGE=$PIECE(BIAGRPS,",",K)

                       IF 'BIAGE

                           QUIT 

                       Begin DoDot:2

 +74                       IF J

                               DO PASTMTH^BIAGE(BICHXDT,BIAGE,.BIDATE)

 +75                       IF BIDATE>BIDOB

                               QUIT 

 +76      ;---> Patient received imm by BIAGE months, set in stats array.

 +77                       NEW Z

                           SET Z=$GET(BITMP("STATS",132,1,BIAGE))

                           SET BITMP("STATS",132,1,BIAGE)=Z+1

 +78                       SET J=0

 +79      ;---> Also set for combo lines.

 +80                       SET BIHXX(132,1,BIAGE)=""

                       End DoDot:2

               End DoDot:1

 +81      ;**********

 +82      ;

 +83      ;---> Set BIHX=to a valid Immunization History.

 +84       NEW BIHX

           SET BIHX=$PIECE(BIRETVAL,BI31,1)

 +85      ;

 +86      ;---> *** Okay, add this Patient's History to stats.

 +87      ;

 +88      ;---> BIHIB local array by date gets built; if the first two were CVX 49's (IEN=127)

 +89      ;---> then patient will only need 3 Hibs to be UTD.

 +90       NEW BIHIB,BIROT,I,Y

 +91      ;

 +92      ;---> BIROT gets set=1 if there were 2 CVX 119's (IEN=225)--patient is UTD for Rota.

 +93       SET BIROT=0

 +94      ;

 +95      ;---> Loop through "^"-pieces of Imm History, getting data.

 +96       FOR I=1:1

               SET Y=$PIECE(BIHX,U,I)

               IF Y=""

                   QUIT 

               Begin DoDot:1

 +97      ;

 +98      ;---> BIIEN=Vaccine IEN, BIVGRP=Vaccine Group, BIVDAT=Visit Date, BINVLD=Invalid Code.

 +99               NEW BIAGE,BIDOSE,BIIEN,BINVLD,BIVDAT,BIVGRP,Q

 +100              SET BIIEN=$PIECE(Y,"|",2)

                   SET BIVGRP=$PIECE(Y,"|",3)

                   SET BIVDAT=$PIECE(Y,"|",4)

                   SET BINVLD=$PIECE(Y,"|",5)

 +101     ;

 +102     ;---> Quit if not Vaccine Group or Visit Date.

 +103              IF '$GET(BIVGRP)

                       QUIT 

                   IF '$GET(BIVDAT)

                       QUIT 

 +104     ;

 +105     ;---> Quit if this dose has been overrided as Invalid (1-4).

 +106              IF (1234[+BINVLD)

                       QUIT 

 +107     ;

 +108     ;---> Quit if this imm was given after the Quarter Ending Date.

 +109     ;---> NOTE: This will cause some patients to appear in the "NOT Current"

 +110     ;---> group, even if they got caught up to date later.

 +111              IF (BIVDAT>BIQDT)

                       QUIT 

 +112     ;

 +113     ;---> Quit if this Vaccine Group should not be included.

 +114              IF '($$VGROUP^BIUTL2(BIVGRP,8))

                       QUIT 

 +115     ;

 +116     ;---> Set BIDOSE=Dose# (increment by 1's to assign highest/latest dose#)

 +117              SET BIDOSE=1

                   SET Q=0

 +118              FOR 

                       IF Q

                           QUIT 

                       Begin DoDot:2

 +119                      IF $DATA(BIHX(BIVGRP,BIDOSE))

                               SET BIDOSE=BIDOSE+1

                               QUIT 

 +120                      SET BIHX(BIVGRP,BIDOSE)=""

                           SET Q=1

                       End DoDot:2

 +121     ;

 +122     ;

 +123     ;---> If this was a Hib, store it in local array for UTD eval.

 +124              IF BIVGRP=3

                       SET BIHIB(BIVDAT,BIIEN)=""

 +125     ;

 +126     ;---> If this was a Rotarix, increment its counter.

 +127              IF BIIEN=225

                       SET BIROT=BIROT+1

 +128     ;

 +129     ;---> Set this immunization in the STATS array for each Age (A)

 +130     ;---> by which the patient had already received it (cumulative).

 +131              NEW J,K

                   SET J=1

 +132              FOR K=1:1

                       SET BIAGE=$PIECE(BIAGRPS,",",K)

                       IF 'BIAGE

                           QUIT 

                       Begin DoDot:2

 +133     ;---> If patient received imm by BIAGE months on the previous iteration

 +134     ;---> of this loop (and J was set=0), then bypass call to PASTMTH

 +135     ;---> and simply set it for the higher BIAGE values, cumulatively.

 +136     ;---> (i.e., if patient received it by 3 months, then he also

 +137     ;--->  necessarily received it by 5 months, 7 months, etc.)

 +138                      IF J

                               DO PASTMTH^BIAGE(BIVDAT,BIAGE,.BIDATE)

 +139     ;

 +140     ;---> Quit if BIAGE months prior to Visit Date is AFTER the DOB

 +141     ;---> (means patient was OLDER than BIAGE months when he received

 +142     ;---> the imm--did NOT receive the imm by BIAGE months).

 +143                      IF BIDATE>BIDOB

                               QUIT 

 +144     ;

 +145     ;---> Patient received imm by BIAGE months, set in stats array.

 +146                      NEW Z

                           SET Z=$GET(BITMP("STATS",BIVGRP,BIDOSE,BIAGE))

                           SET BITMP("STATS",BIVGRP,BIDOSE,BIAGE)=Z+1

 +147                      SET J=0

 +148                      SET BIHX(BIVGRP,BIDOSE,BIAGE)=""

                       End DoDot:2

               End DoDot:1

 +149     ;

 +150     ;

 +151     ;---> Now calculate whether this patient needs 3 Hibs or 4 Hibs to be UTD.

 +152     ;---> If first 2 Hibs=127 (CVX 49), then BIHIB2=2 and patient only needs 3 Hibs to be UTD.

 +153      NEW BIHIB2,I,N

           SET BIHIB2=0

           SET N=0

 +154      FOR I=1:1:2

               SET N=$ORDER(BIHIB(N))

               IF 'N

                   QUIT 

               Begin DoDot:1

 +155              IF $ORDER(BIHIB(N,0))=127

                       SET BIHIB2=BIHIB2+1

               End DoDot:1

 +156     ;

 +157     ;---> Now calculate vaccine combination stats.

 +158     ;---> NOTE: DO NOT GENERALIZE CODE BELOW (highly iterative).

 +159     ;---> Relies on the following Vaccine Group IEN's in ^BISERT:

 +160     ;---> DTP=1, OPV=2, HIB=3, HEPB=4, MMR=6, VAR=7, HEPA=9, FLU=10, PNE=11, ROT=15

 +161     ;

 +162     ;---> 1-DTP, 1-OPV, 1-HIB, 1-HEPB

 +163      NEW K

 +164      FOR K=1:1

               SET A=$PIECE(BIAGRPS,",",K)

               IF 'A

                   QUIT 

               Begin DoDot:1

 +165     ;---> Matrix=Vaccine Group, Dose#, Age Group.

 +166              IF '$DATA(BIHX(1,1,A))

                       QUIT 

 +167              IF '$DATA(BIHX(2,1,A))

                       QUIT 

 +168              IF '$DATA(BIHX(3,1,A))

                       QUIT 

 +169              IF '$DATA(BIHX(4,1,A))

                       QUIT 

 +170              DO COMBO("1|1^2|1^3|1^4|1",A)

               End DoDot:1

 +171     ;

 +172     ;---> 4-DTP, 3-OPV, 1-MMR

 +173      FOR K=1:1

               SET A=$PIECE(BIAGRPS,",",K)

               IF 'A

                   QUIT 

               Begin DoDot:1

 +174              IF '$DATA(BIHX(1,4,A))

                       QUIT 

 +175              IF '$DATA(BIHX(2,3,A))

                       QUIT 

 +176              IF '$DATA(BIHX(6,1,A))

                       QUIT 

 +177              DO COMBO("1|4^2|3^6|1",A)

               End DoDot:1

 +178     ;

 +179     ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB

 +180      FOR K=1:1

               SET A=$PIECE(BIAGRPS,",",K)

               IF 'A

                   QUIT 

               Begin DoDot:1

 +181              IF '$DATA(BIHX(1,4,A))

                       QUIT 

 +182              IF '$DATA(BIHX(2,3,A))

                       QUIT 

 +183              IF '$DATA(BIHX(6,1,A))

                       QUIT 

 +184     ;---> If you don't have 2 Hib 49's, then quit if you don't have 4 Hibs.

 +185              IF BIHIB2<2

                       IF '$DATA(BIHX(3,4,A))

                           QUIT 

 +186     ;---> Okay, first 2 Hibs are 49's, quit if you don't have 3 Hibs.

 +187              IF '$DATA(BIHX(3,3,A))

                       QUIT 

 +188              DO COMBO("1|4^2|3^6|1^3|3",A)

               End DoDot:1

 +189     ;

 +190     ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB

 +191      FOR K=1:1

               SET A=$PIECE(BIAGRPS,",",K)

               IF 'A

                   QUIT 

               Begin DoDot:1

 +192              IF '$DATA(BIHX(1,4,A))

                       QUIT 

 +193              IF '$DATA(BIHX(2,3,A))

                       QUIT 

 +194              IF '$DATA(BIHX(6,1,A))

                       QUIT 

 +195              IF BIHIB2<2

                       IF '$DATA(BIHX(3,4,A))

                           QUIT 

 +196              IF '$DATA(BIHX(3,3,A))

                       QUIT 

 +197              IF '$DATA(BIHX(4,3,A))

                       QUIT 

 +198              DO COMBO("1|4^2|3^6|1^3|3^4|3",A)

               End DoDot:1

 +199     ;

 +200     ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR

 +201      FOR K=1:1

               SET A=$PIECE(BIAGRPS,",",K)

               IF 'A

                   QUIT 

               Begin DoDot:1

 +202              IF '$DATA(BIHX(1,4,A))

                       QUIT 

 +203              IF '$DATA(BIHX(2,3,A))

                       QUIT 

 +204              IF '$DATA(BIHX(6,1,A))

                       QUIT 

 +205              IF BIHIB2<2

                       IF '$DATA(BIHX(3,4,A))

                           QUIT 

 +206              IF '$DATA(BIHX(3,3,A))

                       QUIT 

 +207              IF '$DATA(BIHX(4,3,A))

                       QUIT