Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BIREPF4

BIREPF4.m

Go to the documentation of this file. 
  1. BIREPF4 ;IHS/CMI/MWR - REPORT, FLU IMM; OCT 15, 2010
  1.  ;;8.5;IMMUNIZATION;**15**;SEP 30,2017
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  INFLUENZA IMM REPORT, GATHER/STORE PATIENTS.
  1.  ;;  PATCH 1: Exclude patients whose Inactive Date=Not in Register.  CHKSET+31
  1.  ;;  PATCH 2: Filter for Active Clinical, all ages, using $$ACTCLIN^BIUTL6 call.
  1.  ;;           CHKSET+39
  1.  ;;  PATCH 5: Begin Flu Report on July 1.  CHKSET+107
  1.  ;;  PATCH 13: Reincorporate Flu High Risk check with a value of "4".  CHKSET+41
  1.  ;;  PATCH 15: Reincorporate Flu High Risk check with a value of "4".  CHKSET+46
  1.  ;;            Update list of CVX's that count as Flu refusal.  CHKSET+87
  1.  ;
  1.  ;
  1.  ;----------
  1. GETPATS(BIBEGDT,BIENDDT,BIAGRP,BICC,BIHCF,BICM,BIBEN,BIQDT,BIFH,BIYEAR,BIUP) ;EP
  1.  ;---> Get patients from VA PATIENT File, ^DPT(.
  1.  ;---> Parameters:
  1.  ;     1 - BIBEGDT (req) Begin DOB for this group.
  1.  ;     2 - BIENDDT (req) End DOB for this group.
  1.  ;     3 - BIAGRP  (req) Node/number for this Age Group.
  1.  ;     4 - BICC    (req) Current Community array.
  1.  ;     5 - BIHCF   (req) Health Care Facility array.
  1.  ;     6 - BICM    (req) Case Manager array.
  1.  ;     7 - BIBEN   (req) Beneficiary Type array.
  1.  ;     8 - BIQDT   (req) Quarter Ending Date.
  1.  ;     9 - BIFH    (req) F=report on Flu Vaccine Group (default), H=H1N1 group.
  1.  ;    10 - BIYEAR  (req) Report Year^m (if 2nd pc="m", then End Date=March 31 of
  1.  ;                       the report year; otherwise End Date=Dec 31 of BIYEAR)
  1.  ;    11 - BIUP    (req) User Population/Group (Registered, Imm, User, Active).
  1.  ;
  1.  ;---> Set begin and end dates for search through PATIENT File.
  1.  ;
  1.  Q:'$G(BIBEGDT)  Q:'$G(BIENDDT)  Q:'$G(BIAGRP)  Q:'$G(BIYEAR)
  1.  ;---> Start 1 day prior to Begin Date and $O into the desired DOB's.
  1.  N N S N=BIBEGDT-1
  1.  F  S N=$O(^DPT("ADOB",N)) Q:(N>BIENDDT!('N))  D
  1.  .S BIDFN=0
  1.  .F  S BIDFN=$O(^DPT("ADOB",N,BIDFN)) Q:'BIDFN  D
  1.  ..D CHKSET(BIDFN,.BICC,.BIHCF,.BICM,.BIBEN,BIAGRP,BIQDT,BIFH,BIYEAR,BIUP)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. CHKSET(BIDFN,BICC,BIHCF,BICM,BIBEN,BIAGRP,BIQDT,BIFH,BIYEAR,BIUP) ;EP
  1.  ;---> Check if this patient fits criteria; if so, set DFN
  1.  ;---> in ^TMP("BIREPF1".
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient IEN.
  1.  ;     2 - BICC   (req) Current Community array.
  1.  ;     3 - BIHCF  (req) Health Care Facility array.
  1.  ;     4 - BICM   (req) Case Manager array.
  1.  ;     5 - BIBEN  (req) Beneficiary Type array.
  1.  ;     6 - BIAGRP (req) Node/number for this Age Group.
  1.  ;     7 - BIQDT  (req) Quarter Ending Date.
  1.  ;     8 - BIFH   (req) F=report on Flu Vaccine Group, H=H1N1 group.
  1.  ;     9 - BIYEAR (req) Report Year^m (if 2nd pc="m", then End Date=March 31 of
  1.  ;                       the report year; otherwise End Date=Dec 31 of BIYEAR)
  1.  ;    10 - BIUP   (req) User Population/Group (Registered, Imm, User, Active).
  1.  ;
  1.  Q:'$G(BIDFN)
  1.  Q:'$D(BICC)
  1.  Q:'$D(BIHCF)
  1.  Q:'$D(BICM)
  1.  Q:'$D(BIBEN)
  1.  Q:'$G(BIAGRP)
  1.  Q:'$G(BIQDT)
  1.  S:($G(BIFH)="") BIFH="F"
  1.  Q:'$G(BIYEAR)
  1.  Q:$G(BIUP)=""
  1.  ;
  1.  ;---> Quit if patient is not in the Register.
  1.  Q:'$D(^BIP(BIDFN,0))
  1.  ;
  1.  ;---> Filter for standard Patient Population parameter.
  1.  Q:'$$PPFILTR^BIREP(BIDFN,.BIHCF,BIQDT,BIUP)
  1.  ;
  1.  ;---> For first Age Group, 10-23m, filter by Active in Imm Register.
  1.  ;---> Quit if patient became Inactive before the Quarter Ending Date.
  1.  ;I BIAGRP=1 N X S X=$$INACT^BIUTL1(BIDFN) I X]"" Q:X<BIQDT
  1.  ;
  1.  ;---> For 18-49y Age Group, if this patient is High Risk for Flu set BIRISKI=1.
  1.  N BIRISKI S BIRISKI=0
  1.  ;
  1.  ;
  1.  ;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR
  1.  ;---> Reincorporate Flu High Risk check with new parameter value of "4".
  1.  ;---> Note: Third parameter=1 (retrieve Flu risk only).
  1.  ;D:BIAGRP=4 RISK^BIDX(BIDFN,$E(BIQDT,1,3)_"0901",1,.BIRISKI)
  1.  ;
  1.  ;
  1.  ;********** PATCH 15, v8.5, SEP 30,2017, IHS/CMI/MWR
  1.  ;---> Return Flu High Risk Value for ages >18 yrs and <50 yrs.
  1.  ;D:BIAGRP=4 RISK^BIDX(BIDFN,$E(BIQDT,1,3)_"0901",4,.BIRISKI)
  1.  D:BIAGRP=4 RISKF^BIDX(BIDFN,$E(BIQDT,1,3)_"0901",.BIRISKI)
  1.  ;**********
  1.  ;
  1.  ;
  1.  ;---> Uncomment next line to test High Risk.
  1.  ;S:(BIDFN=30) BIRISKI=1  ;MWRZZZ
  1.  ;---> If this patient is (18-49y) High Risk, change Age Group to 5.
  1.  I BIRISKI S BIAGRP=5
  1.  ;
  1.  ;---> Quit if Current Community doesn't match.
  1.  Q:$$CURCOM^BIEXPRT2(BIDFN,.BICC)
  1.  ;
  1.  ;---> Quit if Case Manager doesn't match.
  1.  Q:$$CMGR^BIDUR(BIDFN,.BICM)
  1.  ;
  1.  ;---> Quit if Beneficiary Type doesn't match.
  1.  Q:$$BENT^BIDUR1(BIDFN,.BIBEN)
  1.  ;
  1.  ;---> Store Patient in Age Group.
  1.  S ^TMP("BIREPF1",$J,"PATS",BIAGRP,BIDFN)=""
  1.  ;
  1.  ;---> RPC to gather Immunization History.
  1.  N BI31,BIDE,BIRETVAL,BIRETERR,I S BI31=$C(31)_$C(31),BIRETVAL=""
  1.  ;---> 55=Vaccine Group IEN, 56=Date of Visit (Fileman), 65=Dose Override.
  1.  F I=55,56,65 S BIDE(I)=""
  1.  ;---> Fourth parameter=0: Do not return Skin Tests.
  1.  ;---> Fifth parameter=0: Split out combinations as if given individually.
  1.  D IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,0,0)
  1.  ;
  1.  ;---> If BIRETERR has a value, store it and quit.
  1.  S BIRETERR=$P(BIRETVAL,BI31,2)
  1.  Q:BIRETERR]""
  1.  ;
  1.  ;---> Add refusals, if any.
  1.  N Z D CONTRA^BIUTL11(BIDFN,.Z,1) I $O(Z(0)) D
  1.  .;---> If this refusal is for an Influenza vaccine, count it.
  1.  .;
  1.  .;********** PATCH 15, v8.5, SEP 30,2017, IHS/CMI/MWR
  1.  .;---> Update list of CVX's that count as Flu refusal.
  1.  .;N I F I=15,16,88,111,123,135 I $D(Z(I)) S BITMP("REFUSALS",BIDFN)=""
  1.  .N I F I=15,16,88,111,123,125,126,127,128,135,140,141 I $D(Z(I)) S BITMP("REFUSALS",BIDFN)=""
  1.  .F I=144,149,150,151,153,155,158,161,166,168,171,185,186 I $D(Z(I)) S BITMP("REFUSALS",BIDFN)=""
  1.  .;**********
  1.  ;
  1.  ;---> Set BIHX=to a valid Immunization History.
  1.  N BIHX S BIHX=$P(BIRETVAL,BI31,1)
  1.  ;
  1.  ;---> Add this Patient's History to stats.
  1.  N I,Y
  1.  ;---> Loop through "^"-pieces of Imm History, getting data.
  1.  F I=1:1 S Y=$P(BIHX,U,I) Q:Y=""  D
  1.  .;
  1.  .;---> Set this immunization in the STATS array by:
  1.  .;---> Vaccine Group (V), Dose# (D), and Age (A), and Current Season (C).
  1.  .N A,C,D,Q,V
  1.  .S A=BIAGRP,V=$P(Y,"|",2)
  1.  .;
  1.  .;---> Quit if this is not a Flu vaccine or H1N1.
  1.  .I BIFH="H" Q:(V'=18)
  1.  .;---> Default="F" (Flu).
  1.  .I BIFH'="H" Q:(V'=10)
  1.  .;I $G(BIFH)'="H" Q:(V'=18)
  1.  .;
  1.  .;---> Quit if this dose is marked INVALID.
  1.  .I $P(Y,"|",4),$P(Y,"|",4)<9 Q
  1.  .;
  1.  .;---> Quit (don't count) if Visit was AFTER the Report Year End Date.
  1.  .N BIDT S BIDT=$P(Y,"|",3)
  1.  .;---> If the Report End Date is not March 31, then quit if visit is after
  1.  .;---> the Quarter Ending Date (12/31 of the Report Year).
  1.  .I $P(BIYEAR,U,2)'="m" Q:(BIDT>BIQDT)
  1.  .;---> Quit if visit is after March Report End Date (following the Report Year).
  1.  .Q:(BIDT>(($E(BIQDT,1,3)+1)_"0331"))
  1.  .;
  1.  .;---> If this was in the current season, C=1; otherwise C=0 (before this season).
  1.  .D
  1.  ..;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1.  ..;---> Begin Flu Report on July 1.
  1.  ..;I BIDT<($E(BIQDT,1,3)_"0901") S C=0 Q
  1.  ..I BIDT<($E(BIQDT,1,3)_"0701") S C=0 Q
  1.  ..;**********
  1.  ..S C=1
  1.  .;
  1.  .;---> Set Dose# (increment by 1's to assign highest/latest dose#).
  1.  .S D=1,Q=0
  1.  .F  Q:Q  D
  1.  ..;---> Set: BIHX(Vaccine Grp, Current Season, Dose)
  1.  ..I $D(BIHX(V,C,D)) S D=D+1 Q
  1.  ..S BIHX(V,C,D)="",Q=1
  1.  .;
  1.  .;---> Set: BITMP(Vaccine Grp, Season, Dose, Age Grp)
  1.  .N Z S Z=$G(BITMP("STATS",V,C,D,A)) S BITMP("STATS",V,C,D,A)=Z+1
  1.  .;---> If Age Group 18-19y and pt is High Risk, set stat for Age Group 5.
  1.  .;Q:((A'=4)!('BIRISKI))
  1.  .;S Z=$G(BITMP("STATS",V,C,D,5)) S BITMP("STATS",V,C,D,5)=Z+1
  1.  ;
  1.  ;
  1.  ;---> Next Section:
  1.  ;---> If this patient has the minimum required immunizations for
  1.  ;---> his/her Age Group, then increment by 1 the "Appro for Age"
  1.  ;---> tally for that Age Group.
  1.  ;---> The code examines Imm Hx array BIHX(VacGrp, Current Season, Dose#) for
  1.  ;---> each patient.
  1.  ;---> Each Quit represents a condition that a child in that age group
  1.  ;---> must meet in order to be "appropriate for age."
  1.  ;
  1.  ;---> Following lines matrix: Vaccine Group, Dose#.
  1.  ;
  1.  ;---> X=1 is NOT Current/appropriate for age; X=2 IS Current/appropriate for age.
  1.  N X
  1.  ;---> For 6-23m old patients (BIAGRP=1).
  1.  S X=1
  1.  I BIAGRP=1 D  D STOR(BIDFN,BIQDT,X) Q
  1.  .Q:'$D(BIHX(10))
  1.  .;---> If patient has Flu, Current season, 2 doses; then he's appropriate.
  1.  .I $D(BIHX(10,1,2)) D APPRO(BIAGRP) S X=2 Q
  1.  .;---> If pt has Current season, 1 dose; Past season, 1 dose; then appropriate.
  1.  .I $D(BIHX(10,1,1)),$D(BIHX(10,0,1)) D APPRO(BIAGRP) S X=2 Q
  1.  ;
  1.  ;---> For 2-4y old patients (BIAGRP=2).
  1.  S X=1
  1.  I BIAGRP=2 D  D STOR(BIDFN,BIQDT,X) Q
  1.  .Q:'$D(BIHX(10))
  1.  .;---> If patient has Flu, Current season, 2 doses; then he's appropriate.
  1.  .I $D(BIHX(10,1,2)) D APPRO(BIAGRP) S X=2 Q
  1.  .;---> If pt has Current season, 1 dose; Past season, 2 doses; then appropriate.
  1.  .I $D(BIHX(10,1,1)),$D(BIHX(10,0,2)) D APPRO(BIAGRP) S X=2 Q
  1.  ;
  1.  S X=1
  1.  ;---> For all other Age Groups.
  1.  D  D STOR(BIDFN,BIQDT,X)
  1.  .Q:'$D(BIHX(10))
  1.  .;---> If patient has Flu, Current season 1 dose; then he's appropriate.
  1.  .;---> Also, if this is 18-49 and the patient is High Risk set in Group 5.
  1.  .I $D(BIHX(10,1,1)) D APPRO(BIAGRP) D:((BIAGRP=4)&BIRISKI) APPRO(5) S X=2 Q
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. APPRO(BIAGRP) ;EP
  1.  ;---> Store Patient in Appropriate for Age Group.
  1.  ;---> Parameters:
  1.  ;     1 - BIAGRP (req) Node/number for this Age Group.
  1.  ;
  1.  ;---> Store Patient in Age Group.
  1.  N Z S Z=$G(BITMP("STATS","APPRO",BIAGRP))
  1.  S BITMP("STATS","APPRO",BIAGRP)=Z+1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. STOR(BIDFN,BIQDT,BIVAL) ;EP
  1.  ;---> Store in ^TMP for displaying List of Patients.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient IEN.
  1.  ;     2 - BIQDT  (req) Quarter Ending Date.
  1.  ;     3 - BIVAL  (opt) Value to set ^TMP(Pat...) node equal to.
  1.  ;
  1.  Q:'$G(BIDFN)  S:'$G(BIQDT) BIQDT=DT
  1.  ;D UPDATE^BIPATUP(BIDFN,DT,,1)
  1.  D STORE^BIDUR1(BIDFN,BIQDT,1,,$G(BIVAL))
  1.  Q