Routine: BIREPQ4

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)

 ;----------

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

 .;---> 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

 .;---> 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

 ;----------

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

 ;----------

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))

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

BIREPQ4.m