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
+208 ;
+209 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+210 ;---> Allow Hx of Chickenpox to count for Varicella.
+211 ;Q:'$D(BIHX(7,1,A))
+212 IF (('$DATA(BIHX(7,1,A)))&('$DATA(BIHXX(132,1,A))))
QUIT
+213 DO COMBO("1|4^2|3^6|1^3|3^4|3^7|1",A)
End DoDot:1
+214 ;
+215 ;
+216 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR, 3-PNE
+217 FOR K=1:1
SET A=$PIECE(BIAGRPS,",",K)
IF 'A
QUIT
Begin DoDot:1
+218 IF '$DATA(BIHX(1,4,A))
QUIT
+219 IF '$DATA(BIHX(2,3,A))
QUIT
+220 IF '$DATA(BIHX(6,1,A))
QUIT
+221 IF BIHIB2<2
IF '$DATA(BIHX(3,4,A))
QUIT
+222 IF '$DATA(BIHX(3,3,A))
QUIT
+223 IF '$DATA(BIHX(4,3,A))
QUIT
+224 ;---> Allow Hx of Chickenpox to count for Varicella.
+225 ;Q:'$D(BIHX(7,1,A))
+226 IF (('$DATA(BIHX(7,1,A)))&('$DATA(BIHXX(132,1,A))))
QUIT
+227 IF '$DATA(BIHX(11,3,A))
QUIT
+228 DO COMBO("1|4^2|3^6|1^3|3^4|3^7|1^11|3",A)
End DoDot:1
+229 ;
+230 ;
+231 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR, 4-PNE vvv83
+232 FOR K=1:1
SET A=$PIECE(BIAGRPS,",",K)
IF 'A
QUIT
Begin DoDot:1
+233 IF '$DATA(BIHX(1,4,A))
QUIT
+234 IF '$DATA(BIHX(2,3,A))
QUIT
+235 IF '$DATA(BIHX(6,1,A))
QUIT
+236 IF BIHIB2<2
IF '$DATA(BIHX(3,4,A))
QUIT
+237 IF '$DATA(BIHX(3,3,A))
QUIT
+238 IF '$DATA(BIHX(4,3,A))
QUIT
+239 ;---> Allow Hx of Chickenpox to count for Varicella.
+240 ;Q:'$D(BIHX(7,1,A))
+241 IF (('$DATA(BIHX(7,1,A)))&('$DATA(BIHXX(132,1,A))))
QUIT
+242 IF '$DATA(BIHX(11,4,A))
QUIT
+243 DO COMBO("1|4^2|3^6|1^3|3^4|3^7|1^11|4",A)
+244 ;---> Store for Patient Report Roster (complete 4313314).
+245 SET BIVAL=2
End DoDot:1
+246 ;
+247 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR, 4-PNE, 1-HEPA
+248 FOR K=1:1
SET A=$PIECE(BIAGRPS,",",K)
IF 'A
QUIT
Begin DoDot:1
+249 IF '$DATA(BIHX(1,4,A))
QUIT
+250 IF '$DATA(BIHX(2,3,A))
QUIT
+251 IF '$DATA(BIHX(6,1,A))
QUIT
+252 IF BIHIB2<2
IF '$DATA(BIHX(3,4,A))
QUIT
+253 IF '$DATA(BIHX(3,3,A))
QUIT
+254 IF '$DATA(BIHX(4,3,A))
QUIT
+255 ;---> Allow Hx of Chickenpox to count for Varicella.
+256 ;Q:'$D(BIHX(7,1,A))
+257 IF (('$DATA(BIHX(7,1,A)))&('$DATA(BIHXX(132,1,A))))
QUIT
+258 IF '$DATA(BIHX(11,4,A))
QUIT
+259 IF '$DATA(BIHX(9,1,A))
QUIT
+260 DO COMBO("1|4^2|3^6|1^3|3^4|3^7|1^11|4^9|1",A)
End DoDot:1
+261 ;
+262 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR, 4-PNE, 2-HEPA, 3-ROTA vvv83
+263 FOR K=1:1
SET A=$PIECE(BIAGRPS,",",K)
IF 'A
QUIT
Begin DoDot:1
+264 IF '$DATA(BIHX(1,4,A))
QUIT
+265 IF '$DATA(BIHX(2,3,A))
QUIT
+266 IF '$DATA(BIHX(6,1,A))
QUIT
+267 IF BIHIB2<2
IF '$DATA(BIHX(3,4,A))
QUIT
+268 IF '$DATA(BIHX(3,3,A))
QUIT
+269 IF '$DATA(BIHX(4,3,A))
QUIT
+270 ;---> Allow Hx of Chickenpox to count for Varicella.
+271 ;Q:'$D(BIHX(7,1,A))
+272 IF (('$DATA(BIHX(7,1,A)))&('$DATA(BIHXX(132,1,A))))
QUIT
+273 IF '$DATA(BIHX(11,4,A))
QUIT
+274 IF '$DATA(BIHX(9,2,A))
QUIT
+275 ;Q:'$D(BIHX(15,3,A))
+276 ;---> If you don't have 2 Rota 119's, then quit if you don't have 3 Rotas.
+277 IF BIROT<2
IF '$DATA(BIHX(15,3,A))
QUIT
+278 DO COMBO("1|4^2|3^6|1^3|3^4|3^7|1^11|4^9|2^15|3",A)
End DoDot:1
+279 ;
+280 ;---> 4-DTP, 3-OPV, 1-MMR, 3-HIB, 3-HEPB, 1-VAR, 4-PNE, 2-HEPA, 3-ROTA, 2-FLU vvv83
+281 FOR K=1:1
SET A=$PIECE(BIAGRPS,",",K)
IF 'A
QUIT
Begin DoDot:1
+282 IF '$DATA(BIHX(1,4,A))
QUIT
+283 IF '$DATA(BIHX(2,3,A))
QUIT
+284 IF '$DATA(BIHX(6,1,A))
QUIT
+285 IF BIHIB2<2
IF '$DATA(BIHX(3,4,A))
QUIT
+286 IF '$DATA(BIHX(3,3,A))
QUIT
+287 IF '$DATA(BIHX(4,3,A))
QUIT
+288 ;---> Allow Hx of Chickenpox to count for Varicella.
+289 ;Q:'$D(BIHX(7,1,A))
+290 IF (('$DATA(BIHX(7,1,A)))&('$DATA(BIHXX(132,1,A))))
QUIT
+291 ;**********
+292 IF '$DATA(BIHX(11,4,A))
QUIT
+293 IF '$DATA(BIHX(9,2,A))
QUIT
+294 ;Q:'$D(BIHX(15,3,A))
+295 IF BIROT<2
IF '$DATA(BIHX(15,3,A))
QUIT
+296 IF '$DATA(BIHX(10,2,A))
QUIT
+297 DO COMBO("1|4^2|3^6|1^3|3^4|3^7|1^11|4^9|2^15|3^10|2",A)
End DoDot:1
+298 ;
+299 ;---> Re-evaluate Current vs. Non-current based on Hib and Rota regimens.
+300 ;---> If BIVAL=1,
+301 IF BIVAL=1
QUIT
+302 ;
+303 QUIT
+304 ;
+305 ;
+306 ;----------
COMBO(BICOMB,BIAGRP) ;EP
+1 ;---> Store Patient vaccine combination for Age Group.
+2 ;---> Parameters:
+3 ; 1 - BICOMB (req) Combination number.
+4 ; 1 - BIAGRP (req) Node/number for this Age Group.
+5 ;
+6 ;---> Store Patient in Age Group.
+7 NEW Z
SET Z=$GET(BITMP("STATS",BICOMB,BIAGRP))
+8 SET BITMP("STATS",BICOMB,BIAGRP)=Z+1
+9 QUIT
