BIREPD4 ;IHS/CMI/MWR - REPORT, ADOLESCENT RATES; AUG 10,2010
;;8.5;IMMUNIZATION;**3**;SEP 10,2012
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW ADOLESCENT IMMUNIZATION RATES REPORT, WRITE HEADERS, ETC.
;; PATCH 1: Fix to count only one Flu dose per season; do not affect
;; other Vaccine Groups. CHECKSET+158
;; PATCH 3: Include new "1-Td 1-Men 3-HPV" lines. CHKSET+215
;
;
;----------
GETPATS(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIQDT,BIAGRPS,BISITE,BIUP,BITMP) ;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 ("1112,1313,1317").
; 9 - BISITE (req) Site IEN.
; 10 - BIUP (req) User Population/Group (All, Imm, User, Active).
; 11 - BITMP (ret) Stores Patient Totals by Age Group and Sex.
;
;---> Set begin and end dates for search through PATIENT File.
;
Q:'$G(BIBEGDT) Q:'$G(BIENDDT) Q:'$G(BIQDT) Q:'$G(BIAGRPS)
;
;---> 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,.BITMP)
..;---> 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,BITMP) ;EP
;---> Check if this patient fits criteria; if so, set DFN
;---> in ^TMP("BIREPD1".
;---> 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=1321 complete.
; 9 - BIAGRPS (req) String of Age Groups ("1112,1313,1317").
; 10 - BIUP (req) User Population/Group (All, Imm, User, Active).
; 11 - BITMP (ret) Stores Patient Totals by Age Group and Sex.
;
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)
Q:$G(BIUP)=""
;
;---> 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)
;
;---> Get patient gender.
N BISEX S BISEX=$$SEX^BIUTL1(BIDFN)
Q:((BISEX'="F")&(BISEX'="M"))
;
;---> Get patient age in years on report date.
N BIAGE S BIAGE=$$AGE^BIUTL1(BIDFN,1,BIQDT)
Q:'BIAGE Q:(BIAGE<11) Q:(BIAGE>18)
;
;---> Set patient's Age Group for this report; either 1112 or 1317.
N BIAGRP S BIAGRP=$S(BIAGE<13:1112,1:1317)
;
;---> Store Patient in appropriate totals.
;---> Total patients.
N Z S Z=$G(BITMP("STATS","TOTLPTS")) S BITMP("STATS","TOTLPTS")=Z+1
;---> Total patients in Age Group.
S Z=$G(BITMP("STATS","TOTLPTS",BIAGRP)) S BITMP("STATS","TOTLPTS",BIAGRP)=Z+1
;----> * NOTE! Here's an example where I build column for 13-yr-olds!
;---> Duplicate tracking of 13-yr-olds.
D:BIAGE=13
.S Z=$G(BITMP("STATS","TOTLPTS",1313)) S BITMP("STATS","TOTLPTS",1313)=Z+1
;
;
;---> Set node for female or male denominators.
N BISXNOD S BISXNOD=$S(BISEX="F":"TOTLFPTS",1:"TOTLMPTS")
;---> Total Female patients.
S Z=$G(BITMP("STATS",BISXNOD)) S BITMP("STATS",BISXNOD)=Z+1
;---> Total female patients in Age Group.
S Z=$G(BITMP("STATS",BISXNOD,BIAGRP)) S BITMP("STATS",BISXNOD,BIAGRP)=Z+1
;---> Duplicate tracking of 13-yr-olds.
D:BIAGE=13
.S Z=$G(BITMP("STATS",BISXNOD,1313)) S BITMP("STATS",BISXNOD,1313)=Z+1
;
;
;---> Store for Patient Report Roster (not yet determined if complete 1321).
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).
F I=30,55,56 S BIDE(I)=""
;
;---> Fourth parameter=0: Do not return Skin Tests.
;---> Fifth parameter=0: Means the components of a combination vaccine will
;---> be split out.
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)="" K Z
;
;
;---> Check for Hx of Chicken Pox (as a reason for contra to Var & MMRV.
;---> If HX of Chicken Pox to add to Varicella Stats Line and to 1:3:2:1 line.
N BIHXX,Z
D CONTRA^BIUTL11(BIDFN,.Z,2) I ($G(Z(21))=12)!($G(Z(94))=12) D
.S Z=$G(BITMP("STATS",132,1,BIAGRP)) S BITMP("STATS",132,1,BIAGRP)=Z+1
.;---> Duplicate tracking of 13-yr-olds.
.I BIAGE=13 S Z=$G(BITMP("STATS",132,1,1313)) S BITMP("STATS",132,1,1313)=Z+1
.;---> Also set for 1:3:2:1 line.
.S BIHXX(132,1,BIAGRP)=""
;
;---> Set BIHX=to a valid Immunization History.
N BIHX S BIHX=$P(BIRETVAL,BI31,1)
;
;---> Add this Patient's History to stats.
N I,Y
;---> Loop through "^"-pieces of Imm History, getting data.
F I=1:1 S Y=$P(BIHX,U,I) Q:Y="" D
.;---> Age (A), Dose# (D), Visit Date (J), sratch variable (Q),
.;---> Vaccine Group IEN (V), Vaccine IEN (W).
.N A,D,J,Q,V,W
.S W=$P(Y,"|",2),V=$P(Y,"|",3),J=$P(Y,"|",4)
.;
.;---> Select for Vaccine Group IEN's:
.;---> 4-HEPB, 6-MMR, 7-VAR, 8-Td_B, 9-HEPA, 10-FLU, 16-MEN, 17-HPV
.Q:'$G(V)
.N Q F Q=1,2,3,5,11:1:15 Q:V=Q
.Q:V=Q
.;
.;---> Exclude immunization visits after the Quarter Ending Date, BIQDT.
.Q:(J>BIQDT)
.;
.;********** v8.5, MAY 15,2011, IHS/CMI/MWR
.;---> This code moved up from below. BIHX(10,D) was getting set for a prior
.;---> year's dose, then quitting (because >1year), but also blocking this
.;---> year's dose--since BIHX(10 already existed.
.;---> Quit if V=FLU and Date of Visit is more than 1 year before Report Date.
.Q:((V=10)&($$FMDIFF^XLFDT(BIQDT,J,1)>365))
.;**********
.;
.;---> Quit if one Flu dose has already been recorded (only want one Flu
.;---> dose per patient per season).
.Q:((V=10)&($D(BIHX(10))))
.;
.;---> Build local array for setting combinations stats below.
.;
.;---> Set Dose# (increment by 1's to assign highest/latest dose#)
.S D=1,Q=0
.F Q:Q D
..I $D(BIHX(V,D)) S D=D+1 Q
..S BIHX(V,D)="",Q=1
.;
.;---> For Flu count every dose as a "dose #1". Might want to go to dose #2. MWRZZZ
.I V=10 S D=1
.;
.;---> Set each immunization in the STATS array by Vaccine Group (V),
.;---> Dose (D), and Age Group (BIAGRP).
.;
.;---> If this is HPV, separate female and male by appending sex to age group.
.I V=17 D Q
..N Z S Z=$G(BITMP("STATS",V,D,BIAGRP_BISEX)) S BITMP("STATS",V,D,BIAGRP_BISEX)=Z+1
..S BIHX(V,D,BIAGRP)=""
..;---> Duplicate tracking of 13-yr-olds.
..D:BIAGE=13
...S Z=$G(BITMP("STATS",V,D,1313_BISEX)) S BITMP("STATS",V,D,1313_BISEX)=Z+1
.;
.;---> Okay, not HPV (don't append sex).
.N Z S Z=$G(BITMP("STATS",V,D,BIAGRP)) S BITMP("STATS",V,D,BIAGRP)=Z+1
.S BIHX(V,D,BIAGRP)=""
.;---> Duplicate tracking of 13-yr-olds.
.D:BIAGE=13
..S Z=$G(BITMP("STATS",V,D,1313)) S BITMP("STATS",V,D,1313)=Z+1
.;
.;
.;---> If this is Td and the vaccine was Tdap, add a Tdap line.
.;---> Substitute Vaccine IEN 221 for Vaccine Group.
.Q:(W'=221) Q:$D(BIHX(221))
.S Z=$G(BITMP("STATS",221,1,BIAGRP)) S BITMP("STATS",221,1,BIAGRP)=Z+1
.;---> Duplicate tracking of 13-yr-olds.
.D:BIAGE=13
..S Z=$G(BITMP("STATS",221,1,1313)) S BITMP("STATS",221,1,1313)=Z+1
.;---> Flag to ensure only 1 dose is counted per patient.
.S BIHX(221)=""
;
;---> Now calculate vaccine combination stats.
;---> NOTE: DO NOT GENERALIZE CODE BELOW (highly iterative).
;---> Relies on the following Vaccine Group IEN's in ^BISERT:
;---> 4-HEPB, 6-MMR, 7-VAR, 8-Td_B, 9-HEPA, 16-MEN, 17-HPV
;
N K
;
;---> 1-Td_B, 3-HEPB, 2-MMR, 1-VAR
F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A D
.Q:'$D(BIHX(8,1,A))
.Q:'$D(BIHX(4,3,A))
.Q:'$D(BIHX(6,2,A))
.;---> Either 1-VAR or Hx of Chicken Pox will count as "1:3:2:1 Current."
.Q:(('$D(BIHX(7,1,A)))&('$D(BIHXX(132,1,A))))
.D COMBO("8|1^4|3^6|2^7|1",A,.BITMP,BIAGE)
.;---> Store for Patient Report Roster (complete 1321).
.;S BIVAL=2
;
;---> 1-Td_B, 3-HEPB, 2-MMR, 1-MEN, 2-VAR
F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A D
.Q:'$D(BIHX(8,1,A))
.Q:'$D(BIHX(4,3,A))
.Q:'$D(BIHX(6,2,A))
.Q:'$D(BIHX(16,1,A))
.Q:'$D(BIHX(7,2,A))
.D COMBO("8|1^4|3^6|2^16|1^7|2",A,.BITMP,BIAGE)
.;---> Store for Patient Report Roster (complete 13212).
.;S BIVAL=2
;
;---> 1-Td_B, 1-MEN
F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A D
.Q:'$D(BIHX(8,1,A))
.Q:'$D(BIHX(16,1,A))
.D COMBO("8|1^16|1",A,.BITMP,BIAGE)
.;---> Store for Patient Report Roster (complete 11).
.;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
.;---> 11 no longer complete. Now 113, see immediately below.
.;S BIVAL=2
;
;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
;---> Include new "1-Td 1-Men 3-HPV" lines, combined as well as sex specific.
;---> 1-Td_B, 1-MEN, 3-HPV (because HPV include BISEX).
F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A D
.Q:'$D(BIHX(8,1,A))
.Q:'$D(BIHX(16,1,A))
.Q:'$D(BIHX(17,3,A))
.;---> Store both combined and sex specific lines.
.D COMBO("8|1^16|1^17|3",A,.BITMP,BIAGE)
.D COMBO("8|1^16|1^17|3",A_BISEX,.BITMP,BIAGE,BISEX)
.;---> Store for Patient Report Roster (complete 113).
.S BIVAL=2
;**********
;
;
;---> 1-Td_B, 3-HEPB, 2-MMR, 1-MEN, 2-VAR, 3-HPV (because HPV include BISEX).
F K=1:1 S A=$P(BIAGRPS,",",K) Q:'A D
.Q:'$D(BIHX(8,1,A))
.Q:'$D(BIHX(4,3,A))
.Q:'$D(BIHX(6,2,A))
.Q:'$D(BIHX(16,1,A))
.Q:'$D(BIHX(7,2,A))
.Q:'$D(BIHX(17,3,A))
.D COMBO("8|1^4|3^6|2^16|1^7|2^17|3",A_BISEX,.BITMP,BIAGE,BISEX)
;
Q
;
;
;----------
COMBO(BICOMB,BIAGRP,BITMP,BIAGE,BISEX) ;EP
;---> Store Patient vaccine combination for Age Group.
;---> Parameters:
; 1 - BICOMB (req) Combination number.
; 2 - BIAGRP (req) Node/number for this Age Group.
; 3 - BITMP (ret) Stores Patient Totals by Age Group and Sex.
; 4 - BIAGE (opt) Age of patient (if 13, duplicate stats).
; 5 - BISEX (opt) F or M for HPV.
;
;---> Store Patient in Age Group.
N Z S Z=$G(BITMP("STATS",BICOMB,BIAGRP))
S BITMP("STATS",BICOMB,BIAGRP)=Z+1
;---> Duplicate tracking of 13-yr-olds.
D:BIAGE=13
.;---> If this is the HPV combo, include BISEX.
.I ((BIAGRP["F")!(BIAGRP["M")) D Q
..S Z=$G(BITMP("STATS",BICOMB,1313_BISEX)) S BITMP("STATS",BICOMB,1313_BISEX)=Z+1
.;
.S Z=$G(BITMP("STATS",BICOMB,1313)) S BITMP("STATS",BICOMB,1313)=Z+1
;
Q
BIREPD4 ;IHS/CMI/MWR - REPORT, ADOLESCENT RATES; AUG 10,2010
+1 ;;8.5;IMMUNIZATION;**3**;SEP 10,2012
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW ADOLESCENT IMMUNIZATION RATES REPORT, WRITE HEADERS, ETC.
+4 ;; PATCH 1: Fix to count only one Flu dose per season; do not affect
+5 ;; other Vaccine Groups. CHECKSET+158
+6 ;; PATCH 3: Include new "1-Td 1-Men 3-HPV" lines. CHKSET+215
+7 ;
+8 ;
+9 ;----------
GETPATS(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIQDT,BIAGRPS,BISITE,BIUP,BITMP) ;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 ("1112,1313,1317").
+11 ; 9 - BISITE (req) Site IEN.
+12 ; 10 - BIUP (req) User Population/Group (All, Imm, User, Active).
+13 ; 11 - BITMP (ret) Stores Patient Totals by Age Group and Sex.
+14 ;
+15 ;---> Set begin and end dates for search through PATIENT File.
+16 ;
+17 IF '$GET(BIBEGDT)
QUIT
IF '$GET(BIENDDT)
QUIT
IF '$GET(BIQDT)
QUIT
IF '$GET(BIAGRPS)
QUIT
+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,.BITMP)
+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,BITMP) ;EP
+1 ;---> Check if this patient fits criteria; if so, set DFN
+2 ;---> in ^TMP("BIREPD1".
+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=1321 complete.
+12 ; 9 - BIAGRPS (req) String of Age Groups ("1112,1313,1317").
+13 ; 10 - BIUP (req) User Population/Group (All, Imm, User, Active).
+14 ; 11 - BITMP (ret) Stores Patient Totals by Age Group and Sex.
+15 ;
+16 IF '$GET(BIDFN)
QUIT
+17 IF '$DATA(BICC)
QUIT
+18 IF '$DATA(BIHCF)
QUIT
+19 IF '$DATA(BICM)
QUIT
+20 IF '$DATA(BIBEN)
QUIT
+21 IF '$GET(BIDOB)
SET BIDOB=$$DOB^BIUTL1(BIDFN)
+22 IF '$GET(BIQDT)
QUIT
+23 IF '$GET(BIAGRPS)
QUIT
+24 IF $GET(BIUP)=""
QUIT
+25 ;
+26 ;---> Don't include this patient in Roster unless set below.
+27 SET BIVAL=0
+28 ;
+29 ;---> Filter for standard Patient Population parameter.
+30 IF '$$PPFILTR^BIREP(BIDFN,.BIHCF,BIQDT,BIUP)
QUIT
+31 ;
+32 ;---> Quit if Current Community doesn't match.
+33 IF $$CURCOM^BIEXPRT2(BIDFN,.BICC)
QUIT
+34 ;
+35 ;---> Quit if Case Manager doesn't match.
+36 IF $$CMGR^BIDUR(BIDFN,.BICM)
QUIT
+37 ;
+38 ;---> Quit if Beneficiary Type doesn't match.
+39 IF $$BENT^BIDUR1(BIDFN,.BIBEN)
QUIT
+40 ;
+41 ;---> Get patient gender.
+42 NEW BISEX
SET BISEX=$$SEX^BIUTL1(BIDFN)
+43 IF ((BISEX'="F")&(BISEX'="M"))
QUIT
+44 ;
+45 ;---> Get patient age in years on report date.
+46 NEW BIAGE
SET BIAGE=$$AGE^BIUTL1(BIDFN,1,BIQDT)
+47 IF 'BIAGE
QUIT
IF (BIAGE<11)
QUIT
IF (BIAGE>18)
QUIT
+48 ;
+49 ;---> Set patient's Age Group for this report; either 1112 or 1317.
+50 NEW BIAGRP
SET BIAGRP=$SELECT(BIAGE<13:1112,1:1317)
+51 ;
+52 ;---> Store Patient in appropriate totals.
+53 ;---> Total patients.
+54 NEW Z
SET Z=$GET(BITMP("STATS","TOTLPTS"))
SET BITMP("STATS","TOTLPTS")=Z+1
+55 ;---> Total patients in Age Group.
+56 SET Z=$GET(BITMP("STATS","TOTLPTS",BIAGRP))
SET BITMP("STATS","TOTLPTS",BIAGRP)=Z+1
+57 ;----> * NOTE! Here's an example where I build column for 13-yr-olds!
+58 ;---> Duplicate tracking of 13-yr-olds.
+59 IF BIAGE=13
Begin DoDot:1
+60 SET Z=$GET(BITMP("STATS","TOTLPTS",1313))
SET BITMP("STATS","TOTLPTS",1313)=Z+1
End DoDot:1
+61 ;
+62 ;
+63 ;---> Set node for female or male denominators.
+64 NEW BISXNOD
SET BISXNOD=$SELECT(BISEX="F":"TOTLFPTS",1:"TOTLMPTS")
+65 ;---> Total Female patients.
+66 SET Z=$GET(BITMP("STATS",BISXNOD))
SET BITMP("STATS",BISXNOD)=Z+1
+67 ;---> Total female patients in Age Group.
+68 SET Z=$GET(BITMP("STATS",BISXNOD,BIAGRP))
SET BITMP("STATS",BISXNOD,BIAGRP)=Z+1
+69 ;---> Duplicate tracking of 13-yr-olds.
+70 IF BIAGE=13
Begin DoDot:1
+71 SET Z=$GET(BITMP("STATS",BISXNOD,1313))
SET BITMP("STATS",BISXNOD,1313)=Z+1
End DoDot:1
+72 ;
+73 ;
+74 ;---> Store for Patient Report Roster (not yet determined if complete 1321).
+75 SET BIVAL=1
+76 ;
+77 ;---> RPC to gather Immunization History.
+78 NEW BI31,BIDE,BIRETVAL,BIRETERR,I
SET BI31=$CHAR(31)_$CHAR(31)
SET BIRETVAL=""
+79 ;---> 30=Vaccine IEN, 55=Vaccine Group IEN, 56=Date of Visit(Fileman).
+80 FOR I=30,55,56
SET BIDE(I)=""
+81 ;
+82 ;---> Fourth parameter=0: Do not return Skin Tests.
+83 ;---> Fifth parameter=0: Means the components of a combination vaccine will
+84 ;---> be split out.
+85 DO IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,0,0)
+86 ;
+87 ;---> If BIRETERR has a value, store it and quit.
+88 SET BIRETERR=$PIECE(BIRETVAL,BI31,2)
+89 IF BIRETERR]""
QUIT
+90 ;
+91 ;---> Add refusals, if any.
+92 NEW Z
DO CONTRA^BIUTL11(BIDFN,.Z,1)
IF $ORDER(Z(0))
SET BITMP("REFUSALS",BIDFN)=""
KILL Z
+93 ;
+94 ;
+95 ;---> Check for Hx of Chicken Pox (as a reason for contra to Var & MMRV.
+96 ;---> If HX of Chicken Pox to add to Varicella Stats Line and to 1:3:2:1 line.
+97 NEW BIHXX,Z
+98 DO CONTRA^BIUTL11(BIDFN,.Z,2)
IF ($GET(Z(21))=12)!($GET(Z(94))=12)
Begin DoDot:1
+99 SET Z=$GET(BITMP("STATS",132,1,BIAGRP))
SET BITMP("STATS",132,1,BIAGRP)=Z+1
+100 ;---> Duplicate tracking of 13-yr-olds.
+101 IF BIAGE=13
SET Z=$GET(BITMP("STATS",132,1,1313))
SET BITMP("STATS",132,1,1313)=Z+1
+102 ;---> Also set for 1:3:2:1 line.
+103 SET BIHXX(132,1,BIAGRP)=""
End DoDot:1
+104 ;
+105 ;---> Set BIHX=to a valid Immunization History.
+106 NEW BIHX
SET BIHX=$PIECE(BIRETVAL,BI31,1)
+107 ;
+108 ;---> Add this Patient's History to stats.
+109 NEW I,Y
+110 ;---> Loop through "^"-pieces of Imm History, getting data.
+111 FOR I=1:1
SET Y=$PIECE(BIHX,U,I)
IF Y=""
QUIT
Begin DoDot:1
+112 ;---> Age (A), Dose# (D), Visit Date (J), sratch variable (Q),
+113 ;---> Vaccine Group IEN (V), Vaccine IEN (W).
+114 NEW A,D,J,Q,V,W
+115 SET W=$PIECE(Y,"|",2)
SET V=$PIECE(Y,"|",3)
SET J=$PIECE(Y,"|",4)
+116 ;
+117 ;---> Select for Vaccine Group IEN's:
+118 ;---> 4-HEPB, 6-MMR, 7-VAR, 8-Td_B, 9-HEPA, 10-FLU, 16-MEN, 17-HPV
+119 IF '$GET(V)
QUIT
+120 NEW Q
FOR Q=1,2,3,5,11:1:15
IF V=Q
QUIT
+121 IF V=Q
QUIT
+122 ;
+123 ;---> Exclude immunization visits after the Quarter Ending Date, BIQDT.
+124 IF (J>BIQDT)
QUIT
+125 ;
+126 ;********** v8.5, MAY 15,2011, IHS/CMI/MWR
+127 ;---> This code moved up from below. BIHX(10,D) was getting set for a prior
+128 ;---> year's dose, then quitting (because >1year), but also blocking this
+129 ;---> year's dose--since BIHX(10 already existed.
+130 ;---> Quit if V=FLU and Date of Visit is more than 1 year before Report Date.
+131 IF ((V=10)&($$FMDIFF^XLFDT(BIQDT,J,1)>365))
QUIT
+132 ;**********
+133 ;
+134 ;---> Quit if one Flu dose has already been recorded (only want one Flu
+135 ;---> dose per patient per season).
+136 IF ((V=10)&($DATA(BIHX(10))))
QUIT
+137 ;
+138 ;---> Build local array for setting combinations stats below.
+139 ;
+140 ;---> Set Dose# (increment by 1's to assign highest/latest dose#)
+141 SET D=1
SET Q=0
+142 FOR
IF Q
QUIT
Begin DoDot:2
+143 IF $DATA(BIHX(V,D))
SET D=D+1
QUIT
+144 SET BIHX(V,D)=""
SET Q=1
End DoDot:2
+145 ;
+146 ;---> For Flu count every dose as a "dose #1". Might want to go to dose #2. MWRZZZ
+147 IF V=10
SET D=1
+148 ;
+149 ;---> Set each immunization in the STATS array by Vaccine Group (V),
+150 ;---> Dose (D), and Age Group (BIAGRP).
+151 ;
+152 ;---> If this is HPV, separate female and male by appending sex to age group.
+153 IF V=17
Begin DoDot:2
+154 NEW Z
SET Z=$GET(BITMP("STATS",V,D,BIAGRP_BISEX))
SET BITMP("STATS",V,D,BIAGRP_BISEX)=Z+1
+155 SET BIHX(V,D,BIAGRP)=""
+156 ;---> Duplicate tracking of 13-yr-olds.
+157 IF BIAGE=13
Begin DoDot:3
+158 SET Z=$GET(BITMP("STATS",V,D,1313_BISEX))
SET BITMP("STATS",V,D,1313_BISEX)=Z+1
End DoDot:3
End DoDot:2
QUIT
+159 ;
+160 ;---> Okay, not HPV (don't append sex).
+161 NEW Z
SET Z=$GET(BITMP("STATS",V,D,BIAGRP))
SET BITMP("STATS",V,D,BIAGRP)=Z+1
+162 SET BIHX(V,D,BIAGRP)=""
+163 ;---> Duplicate tracking of 13-yr-olds.
+164 IF BIAGE=13
Begin DoDot:2
+165 SET Z=$GET(BITMP("STATS",V,D,1313))
SET BITMP("STATS",V,D,1313)=Z+1
End DoDot:2
+166 ;
+167 ;
+168 ;---> If this is Td and the vaccine was Tdap, add a Tdap line.
+169 ;---> Substitute Vaccine IEN 221 for Vaccine Group.
+170 IF (W'=221)
QUIT
IF $DATA(BIHX(221))
QUIT
+171 SET Z=$GET(BITMP("STATS",221,1,BIAGRP))
SET BITMP("STATS",221,1,BIAGRP)=Z+1
+172 ;---> Duplicate tracking of 13-yr-olds.
+173 IF BIAGE=13
Begin DoDot:2
+174 SET Z=$GET(BITMP("STATS",221,1,1313))
SET BITMP("STATS",221,1,1313)=Z+1
End DoDot:2
+175 ;---> Flag to ensure only 1 dose is counted per patient.
+176 SET BIHX(221)=""
End DoDot:1
+177 ;
+178 ;---> Now calculate vaccine combination stats.
+179 ;---> NOTE: DO NOT GENERALIZE CODE BELOW (highly iterative).
+180 ;---> Relies on the following Vaccine Group IEN's in ^BISERT:
+181 ;---> 4-HEPB, 6-MMR, 7-VAR, 8-Td_B, 9-HEPA, 16-MEN, 17-HPV
+182 ;
+183 NEW K
+184 ;
+185 ;---> 1-Td_B, 3-HEPB, 2-MMR, 1-VAR
+186 FOR K=1:1
SET A=$PIECE(BIAGRPS,",",K)
IF 'A
QUIT
Begin DoDot:1
+187 IF '$DATA(BIHX(8,1,A))
QUIT
+188 IF '$DATA(BIHX(4,3,A))
QUIT
+189 IF '$DATA(BIHX(6,2,A))
QUIT
+190 ;---> Either 1-VAR or Hx of Chicken Pox will count as "1:3:2:1 Current."
+191 IF (('$DATA(BIHX(7,1,A)))&('$DATA(BIHXX(132,1,A))))
QUIT
+192 DO COMBO("8|1^4|3^6|2^7|1",A,.BITMP,BIAGE)
+193 ;---> Store for Patient Report Roster (complete 1321).
+194 ;S BIVAL=2
End DoDot:1
+195 ;
+196 ;---> 1-Td_B, 3-HEPB, 2-MMR, 1-MEN, 2-VAR
+197 FOR K=1:1
SET A=$PIECE(BIAGRPS,",",K)
IF 'A
QUIT
Begin DoDot:1
+198 IF '$DATA(BIHX(8,1,A))
QUIT
+199 IF '$DATA(BIHX(4,3,A))
QUIT
+200 IF '$DATA(BIHX(6,2,A))
QUIT
+201 IF '$DATA(BIHX(16,1,A))
QUIT
+202 IF '$DATA(BIHX(7,2,A))
QUIT
+203 DO COMBO("8|1^4|3^6|2^16|1^7|2",A,.BITMP,BIAGE)
+204 ;---> Store for Patient Report Roster (complete 13212).
+205 ;S BIVAL=2
End DoDot:1
+206 ;
+207 ;---> 1-Td_B, 1-MEN
+208 FOR K=1:1
SET A=$PIECE(BIAGRPS,",",K)
IF 'A
QUIT
Begin DoDot:1
+209 IF '$DATA(BIHX(8,1,A))
QUIT
+210 IF '$DATA(BIHX(16,1,A))
QUIT
+211 DO COMBO("8|1^16|1",A,.BITMP,BIAGE)
+212 ;---> Store for Patient Report Roster (complete 11).
+213 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+214 ;---> 11 no longer complete. Now 113, see immediately below.
+215 ;S BIVAL=2
End DoDot:1
+216 ;
+217 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+218 ;---> Include new "1-Td 1-Men 3-HPV" lines, combined as well as sex specific.
+219 ;---> 1-Td_B, 1-MEN, 3-HPV (because HPV include BISEX).
+220 FOR K=1:1
SET A=$PIECE(BIAGRPS,",",K)
IF 'A
QUIT
Begin DoDot:1
+221 IF '$DATA(BIHX(8,1,A))
QUIT
+222 IF '$DATA(BIHX(16,1,A))
QUIT
+223 IF '$DATA(BIHX(17,3,A))
QUIT
+224 ;---> Store both combined and sex specific lines.
+225 DO COMBO("8|1^16|1^17|3",A,.BITMP,BIAGE)
+226 DO COMBO("8|1^16|1^17|3",A_BISEX,.BITMP,BIAGE,BISEX)
+227 ;---> Store for Patient Report Roster (complete 113).
+228 SET BIVAL=2
End DoDot:1
+229 ;**********
+230 ;
+231 ;
+232 ;---> 1-Td_B, 3-HEPB, 2-MMR, 1-MEN, 2-VAR, 3-HPV (because HPV include BISEX).
+233 FOR K=1:1
SET A=$PIECE(BIAGRPS,",",K)
IF 'A
QUIT
Begin DoDot:1
+234 IF '$DATA(BIHX(8,1,A))
QUIT
+235 IF '$DATA(BIHX(4,3,A))
QUIT
+236 IF '$DATA(BIHX(6,2,A))
QUIT
+237 IF '$DATA(BIHX(16,1,A))
QUIT
+238 IF '$DATA(BIHX(7,2,A))
QUIT
+239 IF '$DATA(BIHX(17,3,A))
QUIT
+240 DO COMBO("8|1^4|3^6|2^16|1^7|2^17|3",A_BISEX,.BITMP,BIAGE,BISEX)
End DoDot:1
+241 ;
+242 QUIT
+243 ;
+244 ;
+245 ;----------
COMBO(BICOMB,BIAGRP,BITMP,BIAGE,BISEX) ;EP
+1 ;---> Store Patient vaccine combination for Age Group.
+2 ;---> Parameters:
+3 ; 1 - BICOMB (req) Combination number.
+4 ; 2 - BIAGRP (req) Node/number for this Age Group.
+5 ; 3 - BITMP (ret) Stores Patient Totals by Age Group and Sex.
+6 ; 4 - BIAGE (opt) Age of patient (if 13, duplicate stats).
+7 ; 5 - BISEX (opt) F or M for HPV.
+8 ;
+9 ;---> Store Patient in Age Group.
+10 NEW Z
SET Z=$GET(BITMP("STATS",BICOMB,BIAGRP))
+11 SET BITMP("STATS",BICOMB,BIAGRP)=Z+1
+12 ;---> Duplicate tracking of 13-yr-olds.
+13 IF BIAGE=13
Begin DoDot:1
+14 ;---> If this is the HPV combo, include BISEX.
+15 IF ((BIAGRP["F")!(BIAGRP["M"))
Begin DoDot:2
+16 SET Z=$GET(BITMP("STATS",BICOMB,1313_BISEX))
SET BITMP("STATS",BICOMB,1313_BISEX)=Z+1
End DoDot:2
QUIT
+17 ;
+18 SET Z=$GET(BITMP("STATS",BICOMB,1313))
SET BITMP("STATS",BICOMB,1313)=Z+1
End DoDot:1
+19 ;
+20 QUIT
