BIREPQ4 ;IHS/CMI/MWR - REPORT, QUARTERLY IMM; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; QUARTERLY IMM REPORT, GATHER/STORE PATIENTS.
;
;
;----------
GETPATS(BIBEGDT,BIENDDT,BIAGRP,BICC,BIHCF,BICM,BIBEN,BIQDT,BIHPV,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 - BIAGRP (req) Node/number for this Age Group.
; 4 - BICC (req) Current Community array.
; 5 - BIHCF (req) Health Care Facility array.
; 6 - BICM (req) Case Manager array.
; 7 - BIBEN (req) Beneficiary Type array.
; 8 - BIQDT (req) Quarter Ending Date.
; 9 - BIHPV (req) 1=Include Varicella & Pneumo.
; 10 - 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(BIAGRP)
;---> Start 1 day prior to Begin Date and $O into the desired DOB's.
N N S N=BIBEGDT-1
F S N=$O(^DPT("ADOB",N)) Q:(N>BIENDDT!('N)) D
.S BIDFN=0
.F S BIDFN=$O(^DPT("ADOB",N,BIDFN)) Q:'BIDFN D
..D CHKSET(BIDFN,.BICC,.BIHCF,.BICM,.BIBEN,BIAGRP,BIQDT,BIHPV,BIUP)
Q
;
;
;----------
CHKSET(BIDFN,BICC,BIHCF,BICM,BIBEN,BIAGRP,BIQDT,BIHPV,BIUP) ;EP
;---> Check if this patient fits criteria; if so, set DFN
;---> in ^TMP("BIREPQ1".
;---> 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 - BIAGRP (req) Node/number for this Age Group.
; 7 - BIQDT (req) Quarter Ending Date.
; 8 - BIHPV (req) 1=Include Varicella & Pneumo.
; 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)
Q:'$G(BIAGRP)
Q:'$G(BIQDT)
Q:'$D(BIHPV)
Q:$G(BIUP)=""
;
;---> 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.
S ^TMP("BIREPQ1",$J,"PATS",BIAGRP,BIDFN)=""
;
;---> 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.
;---> Fifth parameter=0: Split out combinations as if given individually.
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)=""
;
;---> Set BIHX=to a valid Immunization History.
N BIHX S BIHX=$P(BIRETVAL,BI31,1)
;
;---> Add this Patient's History to stats.
N BIHIB,BIPCV,I,Y
;
;---> 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 BIDOSE,BIIEN,BINVLD,BIVDAT,BIVGRP,Q
.S BIIEN=$P(Y,"|",2),BIVGRP=$P(Y,"|",3),BIVDAT=$P(Y,"|",4),BINVLD=$P(Y,"|",5)
.;
.;---> Quit (don't count) if Visit was AFTER Quarter Ending Date.
.Q:(BIVDAT>BIQDT) Q:'$G(BIVGRP)
.;
.;---> Quit if this dose has been overrided as Invalid (1-4).
.Q:(1234[+BINVLD)
.;
.;---> Set this immunization in the STATS array by: Vaccine Group, Dose#, and Age Group.
.;---> Set Dose# (increment by 1's to assign highest/latest dose#).
.N Q 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
.;
.N Z S Z=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
.S BITMP("STATS",BIVGRP,BIDOSE,BIAGRP)=Z+1
.;
.;---> If this was a Hib or PCV, store it in local array for UTD eval:
.;---> BIHIB(age_in_mths,IEN_of_vaccine)
.I BIVGRP=3 S BIHIB($$AGE^BIUTL1(BIDFN,2,BIVDAT),BIIEN)=""
.I BIVGRP=11 S BIPCV($$AGE^BIUTL1(BIDFN,2,BIVDAT),BIIEN)=""
;
;
;---> Now check whether the first 2 Hibs were Hibs=127; if so, BIH127=2.
N BIH127,I,N S BIH127=0,N=""
F I=1:1:2 S N=$O(BIHIB(N)) Q:'N D
.I $O(BIHIB(N,0))=127 S BIH127=BIH127+1
;
;
;---> Now calculate Hib Need (BIHNEED).
N BIHNEED
D
.;---> If patient is 1st age group, need 1 Hib.
.I BIAGRP=1 S BIHNEED=1 Q
.;---> If patient is 2nd age group, need 2 Hibs.
.I BIAGRP=2 S BIHNEED=2 Q
.;
.I BIAGRP=3 D Q
..;---> If patient is 3rd age group:
..;---> If at least 2 Hibs recvd at 7 mths or greater, then need only 2 Hibs.
..I $$NEED(.BIHIB,7,2) S BIHNEED=2 Q
..;---> If patient rcvd 2 127's, then need only 2 Hibs.
..I BIH127=2 S BIHNEED=2 Q
..;---> Otherwise, 3rd group needs 3 Hibs.
..S BIHNEED=3
.;
.;
.;---> BIAGRP must =4, 5, or 6.
.;---> If at least 1 Hib recvd at 15 mths or greater, then need only 1 Hib.
.I $$NEED(.BIHIB,15,1) S BIHNEED=1 Q
.;
.;---> If at least 2 Hibs recvd at 12 mths or greater, then need only 2 Hibs.
.I $$NEED(.BIHIB,12,2) S BIHNEED=2 Q
.;
.;---> If at least 3 Hibs recvd at 7 mths or greater, then need only 3 Hibs.
.I $$NEED(.BIHIB,7,3) S BIHNEED=3 Q
.;
.;---> If patient rcvd at least 2 127's, then need only 3 Hibs.
.I BIH127=2 S BIHNEED=3 Q
.;
.;---> Otherwise, 4th-6th group needs 4 Hibs.
.S BIHNEED=4
;
;
;---> Now calculate PCV Need (BIPNEED).
N BIPNEED
D
.;---> If patient is 1st age group, need 1 PCV.
.I BIAGRP=1 S BIPNEED=1 Q
.;---> If patient is 2nd age group, need 2 PCVs.
.I BIAGRP=2 S BIPNEED=2 Q
.;
.I BIAGRP=3 D Q
..;---> If patient is 3rd age group:
..;---> If at least 2 PCVs recvd at 7 mths or greater, then need only 2 PCVs.
..I $$NEED(.BIPCV,7,2) S BIPNEED=2 Q
..;---> Otherwise, 3rd group needs 3 PCVs.
..S BIPNEED=3
.;
.;
.;---> BIAGRP must =4, 5, or 6.
.;---> If at least 1 PCV recvd at 15 mths or greater, then need only 1 PCV.
.I $$NEED(.BIPCV,15,1) S BIPNEED=1 Q
.;
.;---> If at least 2 PCVs recvd at 12 mths or greater, then need only 2 PCVs.
.I $$NEED(.BIPCV,12,2) S BIPNEED=2 Q
.;
.;---> If at least 3 PCVs recvd at 7 mths or greater, then need only 3 PCVs.
.I $$NEED(.BIPCV,7,3) S BIPNEED=3 Q
.;
.;---> Otherwise, 4th-6th group needs 4 Hibs.
.S BIPNEED=4
;
;
;---> Next Section:
;---> If this patient has the minimum required immunizations for
;---> his/her Age Group, then increment by 1 the "Appro for Age"
;---> tally for that Age Group.
;---> The code examines Imm Hx array BIHX(VacGrp,Dose#) for each patient.
;---> Each Quit represents a condition that a child in that age group
;---> must meet in order to be "appropriate for age."
;
;---> Following lines matrix: Vaccine Group, Dose#.
;---> 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, PCV=11, ROT=15
;
N X S X=1
I BIAGRP=1 D D STOR(BIDFN,BIQDT,X) Q
.Q:'$D(BIHX(1,1))
.Q:'$D(BIHX(2,1))
.Q:'$D(BIHX(3,BIHNEED))
.Q:'$D(BIHX(4,1))
.;Q:'$D(BIHX(15,1)) ;Rotavirus, "not at this time" says Ros Singleton, 4-24-07
.Q:(($G(BIHPV))&('$D(BIHX(11,BIPNEED))))
.D APPRO(BIAGRP) S X=2
;
I BIAGRP=2 D D STOR(BIDFN,BIQDT,X) Q
.Q:'$D(BIHX(1,2))
.Q:'$D(BIHX(2,2))
.Q:'$D(BIHX(3,BIHNEED))
.Q:'$D(BIHX(4,2))
.;Q:'$D(BIHX(15,2))
.Q:(($G(BIHPV))&('$D(BIHX(11,BIPNEED))))
.D APPRO(BIAGRP) S X=2
;
I BIAGRP=3 D D STOR(BIDFN,BIQDT,X) Q
.Q:'$D(BIHX(1,3))
.Q:'$D(BIHX(2,2))
.Q:'$D(BIHX(3,BIHNEED))
.Q:'$D(BIHX(4,2))
.;Q:'$D(BIHX(15,3))
.Q:(($G(BIHPV))&('$D(BIHX(11,BIPNEED))))
.D APPRO(BIAGRP) S X=2
;
I BIAGRP=4 D D STOR(BIDFN,BIQDT,X) Q
.Q:'$D(BIHX(1,3))
.Q:'$D(BIHX(2,2))
.Q:'$D(BIHX(3,BIHNEED))
.Q:'$D(BIHX(4,2))
.Q:'$D(BIHX(6,1))
.;Q:'$D(BIHX(15,3))
.Q:(($G(BIHPV))&('$D(BIHX(11,BIPNEED))))
.Q:(($G(BIHPV))&('$D(BIHX(7,1))))
.D APPRO(BIAGRP) S X=2
;
I BIAGRP=5 D D STOR(BIDFN,BIQDT,X) Q
.Q:'$D(BIHX(1,4))
.Q:'$D(BIHX(2,3))
.Q:'$D(BIHX(3,BIHNEED))
.Q:'$D(BIHX(4,3))
.Q:'$D(BIHX(6,1))
.;Q:'$D(BIHX(15,3))
.Q:(($G(BIHPV))&('$D(BIHX(11,BIPNEED))))
.Q:(($G(BIHPV))&('$D(BIHX(7,1))))
.D APPRO(BIAGRP) S X=2
;
I BIAGRP=6 D D STOR(BIDFN,BIQDT,X) Q
.Q:'$D(BIHX(1,4))
.Q:'$D(BIHX(2,3))
.Q:'$D(BIHX(3,BIHNEED))
.Q:'$D(BIHX(4,3))
.Q:'$D(BIHX(6,1))
.;Q:'$D(BIHX(15,3))
.Q:(($G(BIHPV))&('$D(BIHX(11,BIPNEED))))
.Q:(($G(BIHPV))&('$D(BIHX(7,1))))
.;Q:(($G(BIHPV))&('$D(BIHX(9,1)))) ;Never include Hep A.
.D APPRO(BIAGRP) S X=2
Q
;
;
;----------
APPRO(BIAGRP) ;EP
;---> Store Patient in Appropriate for Age Group.
;---> Parameters:
; 1 - BIAGRP (req) Node/number for this Age Group.
;
;---> Store Patient in Age Group.
N Z S Z=$G(BITMP("STATS","APPRO",BIAGRP))
S BITMP("STATS","APPRO",BIAGRP)=Z+1
Q
;
;
;----------
STOR(BIDFN,BIQDT,BIVAL) ;EP
;---> Store in ^TMP for displaying List of Patients.
;---> Parameters:
; 1 - BIDFN (req) Patient IEN.
; 2 - BIQDT (req) Quarter Ending Date.
; 3 - BIVAL (opt) Value to set ^TMP(Pat...) node equal to.
;
Q:'$G(BIDFN) S:'$G(BIQDT) BIQDT=DT
D UPDATE^BIPATUP(BIDFN,DT,,1)
D STORE^BIDUR1(BIDFN,BIQDT,1,,$G(BIVAL))
Q
;
;
NEED(BIARR,BIAGE,BIREQ) ;EP
;---> Return 1 if BIARRay contains required number of doses (BIREQ) after BIAGE.
;---> Parameters:
; 1 - BIARR (req) Array contains doses of vaccine in question.
; 2 - BIAGE (req) Age in months after which doses need to have been received.
; 3 - BIREQ (req) Required number of doses received after BIAGE.
;
;---> If at least 2 Hibs recvd at 12 mths or greater, then need only 2 Hibs.
N M,N S M=0,N=""
F S N=$O(BIARR(N)) Q:N="" S:(N'<BIAGE) M=M+1
I M'<BIREQ Q 1
Q 0
BIREPQ4 ;IHS/CMI/MWR - REPORT, QUARTERLY IMM; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; QUARTERLY IMM REPORT, GATHER/STORE PATIENTS.
+4 ;
+5 ;
+6 ;----------
GETPATS(BIBEGDT,BIENDDT,BIAGRP,BICC,BIHCF,BICM,BIBEN,BIQDT,BIHPV,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 - BIAGRP (req) Node/number for this Age Group.
+6 ; 4 - BICC (req) Current Community array.
+7 ; 5 - BIHCF (req) Health Care Facility array.
+8 ; 6 - BICM (req) Case Manager array.
+9 ; 7 - BIBEN (req) Beneficiary Type array.
+10 ; 8 - BIQDT (req) Quarter Ending Date.
+11 ; 9 - BIHPV (req) 1=Include Varicella & Pneumo.
+12 ; 10 - 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(BIAGRP)
QUIT
+17 ;---> Start 1 day prior to Begin Date and $O into the desired DOB's.
+18 NEW N
SET N=BIBEGDT-1
+19 FOR
SET N=$ORDER(^DPT("ADOB",N))
IF (N>BIENDDT!('N))
QUIT
Begin DoDot:1
+20 SET BIDFN=0
+21 FOR
SET BIDFN=$ORDER(^DPT("ADOB",N,BIDFN))
IF 'BIDFN
QUIT
Begin DoDot:2
+22 DO CHKSET(BIDFN,.BICC,.BIHCF,.BICM,.BIBEN,BIAGRP,BIQDT,BIHPV,BIUP)
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
+25 ;
+26 ;----------
CHKSET(BIDFN,BICC,BIHCF,BICM,BIBEN,BIAGRP,BIQDT,BIHPV,BIUP) ;EP
+1 ;---> Check if this patient fits criteria; if so, set DFN
+2 ;---> in ^TMP("BIREPQ1".
+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 - BIAGRP (req) Node/number for this Age Group.
+10 ; 7 - BIQDT (req) Quarter Ending Date.
+11 ; 8 - BIHPV (req) 1=Include Varicella & Pneumo.
+12 ; 9 - BIUP (req) User Population/Group (Registered, Imm, User, Active).
+13 ;
+14 IF '$GET(BIDFN)
QUIT
+15 IF '$DATA(BICC)
QUIT
+16 IF '$DATA(BIHCF)
QUIT
+17 IF '$DATA(BICM)
QUIT
+18 IF '$DATA(BIBEN)
QUIT
+19 IF '$GET(BIAGRP)
QUIT
+20 IF '$GET(BIQDT)
QUIT
+21 IF '$DATA(BIHPV)
QUIT
+22 IF $GET(BIUP)=""
QUIT
+23 ;
+24 ;---> Filter for standard Patient Population parameter.
+25 IF '$$PPFILTR^BIREP(BIDFN,.BIHCF,BIQDT,BIUP)
QUIT
+26 ;
+27 ;---> Quit if Current Community doesn't match.
+28 IF $$CURCOM^BIEXPRT2(BIDFN,.BICC)
QUIT
+29 ;
+30 ;---> Quit if Case Manager doesn't match.
+31 IF $$CMGR^BIDUR(BIDFN,.BICM)
QUIT
+32 ;
+33 ;---> Quit if Beneficiary Type doesn't match.
+34 IF $$BENT^BIDUR1(BIDFN,.BIBEN)
QUIT
+35 ;
+36 ;---> Store Patient in Age Group.
+37 SET ^TMP("BIREPQ1",$JOB,"PATS",BIAGRP,BIDFN)=""
+38 ;
+39 ;---> RPC to gather Immunization History.
+40 NEW BI31,BIDE,BIRETVAL,BIRETERR,I
SET BI31=$CHAR(31)_$CHAR(31)
SET BIRETVAL=""
+41 ;---> 30=Vaccine IEN, 55=Vaccine Group IEN, 56=Date of Visit(Fileman),
+42 ;---> 65=Invalid Dose (1-4).
+43 FOR I=30,55,56,65
SET BIDE(I)=""
+44 ;---> Fourth parameter=0: Do not return Skin Tests.
+45 ;---> Fifth parameter=0: Split out combinations as if given individually.
+46 DO IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,0,0)
+47 ;
+48 ;---> If BIRETERR has a value, store it and quit.
+49 SET BIRETERR=$PIECE(BIRETVAL,BI31,2)
+50 IF BIRETERR]""
QUIT
+51 ;
+52 ;---> Add refusals, if any.
+53 NEW Z
DO CONTRA^BIUTL11(BIDFN,.Z,1)
IF $ORDER(Z(0))
SET BITMP("REFUSALS",BIDFN)=""
+54 ;
+55 ;---> Set BIHX=to a valid Immunization History.
+56 NEW BIHX
SET BIHX=$PIECE(BIRETVAL,BI31,1)
+57 ;
+58 ;---> Add this Patient's History to stats.
+59 NEW BIHIB,BIPCV,I,Y
+60 ;
+61 ;---> Loop through "^"-pieces of Imm History, getting data.
+62 FOR I=1:1
SET Y=$PIECE(BIHX,U,I)
IF Y=""
QUIT
Begin DoDot:1
+63 ;
+64 ;---> BIIEN=Vaccine IEN, BIVGRP=Vaccine Group, BIVDAT=Visit Date, BINVLD=Invalid Code.
+65 NEW BIDOSE,BIIEN,BINVLD,BIVDAT,BIVGRP,Q
+66 SET BIIEN=$PIECE(Y,"|",2)
SET BIVGRP=$PIECE(Y,"|",3)
SET BIVDAT=$PIECE(Y,"|",4)
SET BINVLD=$PIECE(Y,"|",5)
+67 ;
+68 ;---> Quit (don't count) if Visit was AFTER Quarter Ending Date.
+69 IF (BIVDAT>BIQDT)
QUIT
IF '$GET(BIVGRP)
QUIT
+70 ;
+71 ;---> Quit if this dose has been overrided as Invalid (1-4).
+72 IF (1234[+BINVLD)
QUIT
+73 ;
+74 ;---> Set this immunization in the STATS array by: Vaccine Group, Dose#, and Age Group.
+75 ;---> Set Dose# (increment by 1's to assign highest/latest dose#).
+76 NEW Q
SET BIDOSE=1
SET Q=0
+77 FOR
IF Q
QUIT
Begin DoDot:2
+78 IF $DATA(BIHX(BIVGRP,BIDOSE))
SET BIDOSE=BIDOSE+1
QUIT
+79 SET BIHX(BIVGRP,BIDOSE)=""
SET Q=1
End DoDot:2
+80 ;
+81 NEW Z
SET Z=$GET(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
+82 SET BITMP("STATS",BIVGRP,BIDOSE,BIAGRP)=Z+1
+83 ;
+84 ;---> If this was a Hib or PCV, store it in local array for UTD eval:
+85 ;---> BIHIB(age_in_mths,IEN_of_vaccine)
+86 IF BIVGRP=3
SET BIHIB($$AGE^BIUTL1(BIDFN,2,BIVDAT),BIIEN)=""
+87 IF BIVGRP=11
SET BIPCV($$AGE^BIUTL1(BIDFN,2,BIVDAT),BIIEN)=""
End DoDot:1
+88 ;
+89 ;
+90 ;---> Now check whether the first 2 Hibs were Hibs=127; if so, BIH127=2.
+91 NEW BIH127,I,N
SET BIH127=0
SET N=""
+92 FOR I=1:1:2
SET N=$ORDER(BIHIB(N))
IF 'N
QUIT
Begin DoDot:1
+93 IF $ORDER(BIHIB(N,0))=127
SET BIH127=BIH127+1
End DoDot:1
+94 ;
+95 ;
+96 ;---> Now calculate Hib Need (BIHNEED).
+97 NEW BIHNEED
+98 Begin DoDot:1
+99 ;---> If patient is 1st age group, need 1 Hib.
+100 IF BIAGRP=1
SET BIHNEED=1
QUIT
+101 ;---> If patient is 2nd age group, need 2 Hibs.
+102 IF BIAGRP=2
SET BIHNEED=2
QUIT
+103 ;
+104 IF BIAGRP=3
Begin DoDot:2
+105 ;---> If patient is 3rd age group:
+106 ;---> If at least 2 Hibs recvd at 7 mths or greater, then need only 2 Hibs.
+107 IF $$NEED(.BIHIB,7,2)
SET BIHNEED=2
QUIT
+108 ;---> If patient rcvd 2 127's, then need only 2 Hibs.
+109 IF BIH127=2
SET BIHNEED=2
QUIT
+110 ;---> Otherwise, 3rd group needs 3 Hibs.
+111 SET BIHNEED=3
End DoDot:2
QUIT
+112 ;
+113 ;
+114 ;---> BIAGRP must =4, 5, or 6.
+115 ;---> If at least 1 Hib recvd at 15 mths or greater, then need only 1 Hib.
+116 IF $$NEED(.BIHIB,15,1)
SET BIHNEED=1
QUIT
+117 ;
+118 ;---> If at least 2 Hibs recvd at 12 mths or greater, then need only 2 Hibs.
+119 IF $$NEED(.BIHIB,12,2)
SET BIHNEED=2
QUIT
+120 ;
+121 ;---> If at least 3 Hibs recvd at 7 mths or greater, then need only 3 Hibs.
+122 IF $$NEED(.BIHIB,7,3)
SET BIHNEED=3
QUIT
+123 ;
+124 ;---> If patient rcvd at least 2 127's, then need only 3 Hibs.
+125 IF BIH127=2
SET BIHNEED=3
QUIT
+126 ;
+127 ;---> Otherwise, 4th-6th group needs 4 Hibs.
+128 SET BIHNEED=4
End DoDot:1
+129 ;
+130 ;
+131 ;---> Now calculate PCV Need (BIPNEED).
+132 NEW BIPNEED
+133 Begin DoDot:1
+134 ;---> If patient is 1st age group, need 1 PCV.
+135 IF BIAGRP=1
SET BIPNEED=1
QUIT
+136 ;---> If patient is 2nd age group, need 2 PCVs.
+137 IF BIAGRP=2
SET BIPNEED=2
QUIT
+138 ;
+139 IF BIAGRP=3
Begin DoDot:2
+140 ;---> If patient is 3rd age group:
+141 ;---> If at least 2 PCVs recvd at 7 mths or greater, then need only 2 PCVs.
+142 IF $$NEED(.BIPCV,7,2)
SET BIPNEED=2
QUIT
+143 ;---> Otherwise, 3rd group needs 3 PCVs.
+144 SET BIPNEED=3
End DoDot:2
QUIT
+145 ;
+146 ;
+147 ;---> BIAGRP must =4, 5, or 6.
+148 ;---> If at least 1 PCV recvd at 15 mths or greater, then need only 1 PCV.
+149 IF $$NEED(.BIPCV,15,1)
SET BIPNEED=1
QUIT
+150 ;
+151 ;---> If at least 2 PCVs recvd at 12 mths or greater, then need only 2 PCVs.
+152 IF $$NEED(.BIPCV,12,2)
SET BIPNEED=2
QUIT
+153 ;
+154 ;---> If at least 3 PCVs recvd at 7 mths or greater, then need only 3 PCVs.
+155 IF $$NEED(.BIPCV,7,3)
SET BIPNEED=3
QUIT
+156 ;
+157 ;---> Otherwise, 4th-6th group needs 4 Hibs.
+158 SET BIPNEED=4
End DoDot:1
+159 ;
+160 ;
+161 ;---> Next Section:
+162 ;---> If this patient has the minimum required immunizations for
+163 ;---> his/her Age Group, then increment by 1 the "Appro for Age"
+164 ;---> tally for that Age Group.
+165 ;---> The code examines Imm Hx array BIHX(VacGrp,Dose#) for each patient.
+166 ;---> Each Quit represents a condition that a child in that age group
+167 ;---> must meet in order to be "appropriate for age."
+168 ;
+169 ;---> Following lines matrix: Vaccine Group, Dose#.
+170 ;---> Relies on the following Vaccine Group IEN's in ^BISERT:
+171 ;---> DTP=1, OPV=2, HIB=3, HEPB=4, MMR=6, VAR=7, HEPA=9, FLU=10, PCV=11, ROT=15
+172 ;
+173 NEW X
SET X=1
+174 IF BIAGRP=1
Begin DoDot:1
+175 IF '$DATA(BIHX(1,1))
QUIT
+176 IF '$DATA(BIHX(2,1))
QUIT
+177 IF '$DATA(BIHX(3,BIHNEED))
QUIT
+178 IF '$DATA(BIHX(4,1))
QUIT
+179 ;Q:'$D(BIHX(15,1)) ;Rotavirus, "not at this time" says Ros Singleton, 4-24-07
+180 IF (($GET(BIHPV))&('$DATA(BIHX(11,BIPNEED))))
QUIT
+181 DO APPRO(BIAGRP)
SET X=2
End DoDot:1
DO STOR(BIDFN,BIQDT,X)
QUIT
+182 ;
+183 IF BIAGRP=2
Begin DoDot:1
+184 IF '$DATA(BIHX(1,2))
QUIT
+185 IF '$DATA(BIHX(2,2))
QUIT
+186 IF '$DATA(BIHX(3,BIHNEED))
QUIT
+187 IF '$DATA(BIHX(4,2))
QUIT
+188 ;Q:'$D(BIHX(15,2))
+189 IF (($GET(BIHPV))&('$DATA(BIHX(11,BIPNEED))))
QUIT
+190 DO APPRO(BIAGRP)
SET X=2
End DoDot:1
DO STOR(BIDFN,BIQDT,X)
QUIT
+191 ;
+192 IF BIAGRP=3
Begin DoDot:1
+193 IF '$DATA(BIHX(1,3))
QUIT
+194 IF '$DATA(BIHX(2,2))
QUIT
+195 IF '$DATA(BIHX(3,BIHNEED))
QUIT
+196 IF '$DATA(BIHX(4,2))
QUIT
+197 ;Q:'$D(BIHX(15,3))
+198 IF (($GET(BIHPV))&('$DATA(BIHX(11,BIPNEED))))
QUIT
+199 DO APPRO(BIAGRP)
SET X=2
End DoDot:1
DO STOR(BIDFN,BIQDT,X)
QUIT
+200 ;
+201 IF BIAGRP=4
Begin DoDot:1
+202 IF '$DATA(BIHX(1,3))
QUIT
+203 IF '$DATA(BIHX(2,2))
QUIT
+204 IF '$DATA(BIHX(3,BIHNEED))
QUIT
+205 IF '$DATA(BIHX(4,2))
QUIT
+206 IF '$DATA(BIHX(6,1))
QUIT
+207 ;Q:'$D(BIHX(15,3))
+208 IF (($GET(BIHPV))&('$DATA(BIHX(11,BIPNEED))))
QUIT
+209 IF (($GET(BIHPV))&('$DATA(BIHX(7,1))))
QUIT
+210 DO APPRO(BIAGRP)
SET X=2
End DoDot:1
DO STOR(BIDFN,BIQDT,X)
QUIT
+211 ;
+212 IF BIAGRP=5
Begin DoDot:1
+213 IF '$DATA(BIHX(1,4))
QUIT
+214 IF '$DATA(BIHX(2,3))
QUIT
+215 IF '$DATA(BIHX(3,BIHNEED))
QUIT
+216 IF '$DATA(BIHX(4,3))
QUIT
+217 IF '$DATA(BIHX(6,1))
QUIT
+218 ;Q:'$D(BIHX(15,3))
+219 IF (($GET(BIHPV))&('$DATA(BIHX(11,BIPNEED))))
QUIT
+220 IF (($GET(BIHPV))&('$DATA(BIHX(7,1))))
QUIT
+221 DO APPRO(BIAGRP)
SET X=2
End DoDot:1
DO STOR(BIDFN,BIQDT,X)
QUIT
+222 ;
+223 IF BIAGRP=6
Begin DoDot:1
+224 IF '$DATA(BIHX(1,4))
QUIT
+225 IF '$DATA(BIHX(2,3))
QUIT
+226 IF '$DATA(BIHX(3,BIHNEED))
QUIT
+227 IF '$DATA(BIHX(4,3))
QUIT
+228 IF '$DATA(BIHX(6,1))
QUIT
+229 ;Q:'$D(BIHX(15,3))
+230 IF (($GET(BIHPV))&('$DATA(BIHX(11,BIPNEED))))
QUIT
+231 IF (($GET(BIHPV))&('$DATA(BIHX(7,1))))
QUIT
+232 ;Q:(($G(BIHPV))&('$D(BIHX(9,1)))) ;Never include Hep A.
+233 DO APPRO(BIAGRP)
SET X=2
End DoDot:1
DO STOR(BIDFN,BIQDT,X)
QUIT
+234 QUIT
+235 ;
+236 ;
+237 ;----------
APPRO(BIAGRP) ;EP
+1 ;---> Store Patient in Appropriate for Age Group.
+2 ;---> Parameters:
+3 ; 1 - BIAGRP (req) Node/number for this Age Group.
+4 ;
+5 ;---> Store Patient in Age Group.
+6 NEW Z
SET Z=$GET(BITMP("STATS","APPRO",BIAGRP))
+7 SET BITMP("STATS","APPRO",BIAGRP)=Z+1
+8 QUIT
+9 ;
+10 ;
+11 ;----------
STOR(BIDFN,BIQDT,BIVAL) ;EP
+1 ;---> Store in ^TMP for displaying List of Patients.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient IEN.
+4 ; 2 - BIQDT (req) Quarter Ending Date.
+5 ; 3 - BIVAL (opt) Value to set ^TMP(Pat...) node equal to.
+6 ;
+7 IF '$GET(BIDFN)
QUIT
IF '$GET(BIQDT)
SET BIQDT=DT
+8 DO UPDATE^BIPATUP(BIDFN,DT,,1)
+9 DO STORE^BIDUR1(BIDFN,BIQDT,1,,$GET(BIVAL))
+10 QUIT
+11 ;
+12 ;
NEED(BIARR,BIAGE,BIREQ) ;EP
+1 ;---> Return 1 if BIARRay contains required number of doses (BIREQ) after BIAGE.
+2 ;---> Parameters:
+3 ; 1 - BIARR (req) Array contains doses of vaccine in question.
+4 ; 2 - BIAGE (req) Age in months after which doses need to have been received.
+5 ; 3 - BIREQ (req) Required number of doses received after BIAGE.
+6 ;
+7 ;---> If at least 2 Hibs recvd at 12 mths or greater, then need only 2 Hibs.
+8 NEW M,N
SET M=0
SET N=""
+9 FOR
SET N=$ORDER(BIARR(N))
IF N=""
QUIT
IF (N'<BIAGE)
SET M=M+1
+10 IF M'<BIREQ
QUIT 1
+11 QUIT 0
